เคยลองแล้ว วิธีนี้ก็ไม่ได้
ขอบคุณครับ

         
          วันนี้ทาง BMS มีเมนูการใช้งานใหม่มาแนะนำค่ะ เป็นเมนูที่สามารถตรวจสอบการบริจาคอวัยวะของผู้รับบริการซึ่งทาง รพ. สามารถ ใช้งานได้ ในโปรแกรม  BMS-HOSxP XE Release  5251 เป็นต้นไป ประมาณเดือนมิถุนายน นะคะ

         เมนูนี้จะช่วยให้การบริจาคอวัยวะนั้นของประชาชนไม่สูญเปล่า เพิ่มโอกาสในการส่งต่อไปยังผู้รอคิวรับบริจาค

        สามารถ เข้าใช้งานได้ที่เมนู OPD Registry >> EMR >> Patient EMR >> เลือกผู้ป่วย >> กดปุ่ม การบริจาคอวัยวะ

สามารถ ดาวน์โหลดจากคู่มือการใช้งาน จาก link นี้นะคะ : https://drive.google.com/file/d/1Eebvy9J-VNblPF5Y_tBMO4x1-riRnsoi/view?usp=sharing]

[ Guests cannot view attachments ]

[ Guests cannot view attachments ]

เพิ่ม sql ใน query where doctor_cert_id =:doctor_cert_id ก็จะมี new parameter ขึ้นมาครับ

สวัสดีครับ
           ใช้ tools BMS43StandardExport ส่งออก มีข้อความแจ้งใน log : message PID check error : tmp_exp_212_admission has invalid pid = 390 Records ... และพอส่งออกข้อมูล ไปยังแล้ว error
    เบื้องต้นได้ทำการ clear stat -> update structure แล้วก็ยังไม่หายครับ รบกวนช่วยตรวจสอบหน่อยครับ ขอบคุณครับ.
https://drive.google.com/file/d/1iZ-NahHln8rBpXVEGwpKejRT1V1gR-ja/view?usp=sharing

ใช้แทน DUE  + UE-Form ที่ไม่ขึ้น pop-up auto ถ้า remed ครับ
เปลี่ยน icode และตั้งค่าให้ run ใน SYS_VN_SCRIPT ด้วยครับ

SYS_VN_SCRIPT
if getsqldata('SELECT COUNT(*) ' +
              'FROM opitemrece o ' +
              'INNER JOIN drugitems d ON o.icode = d.icode ' +
              'WHERE o.vn="' + vn + '" ' +
              'AND o.qty > 0 ' +
              'AND o.icode IN (' +
              '"1000013", /* CELECOXIB */ ' +
              '"1000014", /* DIACERINE */ ' +
              '"1000240", /* SODIUM HYALURONATE 1% */ ' +
              '"1000274", /* OCTREOTIDE */ ' +
              '"1000288", /* SULPROSTONE */ ' +
              '"1000291", /* FINASTERIDE */ ' +
              '"1000423", /* ENOXAPARIN */ ' +
              '"1000452", /* CLOMIPHENE */ ' +
              '"1000473", /* ALBUMIN HUMAN */ ' +
              '"1500038", /* CLOPIDOGREL */ ' +
              '"1500039", /* ENOXAPARIN */ ' +
              '"1510041", /* CEFDINIR */ ' +
              '"1510042", /* CEFDINIR */ ' +
              '"1510044", /* ACYCLOVIR */ ' +
              '"1510052", /* CIPROFLOXACIN */ ' +
              '"1520803", /* GABAPENTIN */ ' +
              '"1530304", /* AZITHROMYCIN */ ' +
              '"1540113", /* PREGABALIN */ ' +
              '"1540126", /* ACYCLOVIR */ ' +
              '"1510044", /* ACYCLOVIR */ ' +
              '"1540128", /* MEROPENEM */ ' +
              '"1550012", /* EPOETINBETA */ ' +
              '"1550132", /* ALTEPLASE */ ' +
              '"1550133", /* AZITHROMYCIN */ ' +
              '"1550134", /* MOMETASONE */ ' +
              '"1550137", /* CLARITHROMYCIN */ ' +
              '"1550138", /* VANCOMYCIN */ ' +
              '"1550147", /* ERTAPENEM */ ' +
              '"1550148", /* PIPERACILLIN+TAZOBACTAM */ ' +
              '"1550168", /* CIPROFLOXACIN */ ' +
              '"1550174", /* CEFIXIME */ ' +
              '"1560091", /* MOXIFLOXACIN */ ' +
              '"1560092", /* SODIUM HYALURONATE ED */ ' +
              '"1570044", /* COLISTIMETHATE */ ' +
              '"1570046", /* CEFOSULPERAZONE+SULBACTAM */ ' +
              '"1570052", /* LEVOFLOXACIN */ ' +
              '"1570082", /* PANTOPRAZOLE */ ' +
              '"1570085", /* LANTHANUM */ ' +
              '"1570092", /* DEFERIPRONE */ ' +
              '"1580083", /* BIPHASIC INSULIN ASPART */ ' +
              '"1580125", /* ALENDRONATE */ ' +
              '"1590084", /* LEVOFLOXACIN */ ' +
              '"1600159", /* QUETIAPINE */ ' +
              '"1600184", /* FILGRASTIM */ ' +
              '"1620178", /* BISMUTH SUBSALICYLATE */ ' +
              '"1620180", /* ETORICOXIB */ ' +
              '"1620182", /* SITAGLIPTIN */ ' +
              '"1620183", /* TIOTROPIUM + OLODETEROL */ ' +
              '"1620184", /* TIOTROPIUM + OLODETEROL */ ' +
              '"1630131", /* SODIUM HYALURONATE */ ' +
              '"1630133", /* TICAGRELOR */ ' +
              '"1640048", /* FLUCYTOSTINE */ ' +
              '"1640120", /* QUETIAPINE */ ' +
              '"1640131", /* TERIPARATIDE */ ' +
              '"1650034", /* ESCITALOPRAM */ ' +
              '"1650055", /* DENOSUMAB */ ' +
              '"1650149", /* BEVACIZUMAB */ ' +
              '"1650162", /* OLOPATADINE */ ' +
              '"1650182", /* LEVOFLOXACIN */ ' +
              '"1650184", /* FOSFOMYCIN */ ' +
              '"1650186", /* EMPAGLIFLOZIN */ ' +
              '"1650225", /* LIRAGLUTIDE */ ' +
              '"1650249", /* TIMOLOL+DORZOLAMIDE */ ' +
              '"1650256", /* DIOSMECTITE */ ' +
              '"1660062", /* TENOFOVIR ALAFENAMIDE */ ' +
              '"1660178", /* TENOFOVIR*/ ' +
              '"1660128", /* ENTECAVIR */ ' +
              '"1660164", /* VENLAFAXINE */ ' +
              '"1660166", /* EPOETINBETA */ ' +
              '"1660168", /* PREGABALIN */ ' +
              '"1660170", /* CELECOXIB */ ' +
              '"1660208", /* INSULIN GLARGINE */ ' +
              '"1660210", /* VALSARTAN + SACUBITRIL */ ' +
              '"1670041" /* LETROZOLE */ ' +
              ')') > 0 then
      begin
          //runHOSxP_ScriptProgram('DUE Complete');
          runHOSxP_ScriptProgram('DUE_Version2');
      end;
Source
[attachimg=1]
unit DUE;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ActnList, DBCtrls, dblookup, DB, DBClient, Grids,
  DBGrids, SQLDB;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    pdxLabel: TLabel;
    Label1: TLabel;
    Shape1: TShape;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Panel1: TPanel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Year: TLabel;
    age_yLabel: TLabel;
    ListBox2: TListBox;
    Shape2: TShape;
    Button2: TButton;

  private
    procedure CheckBoxClick(Sender: TObject);
    procedure SaveCheckedItemsToDatabase;
    procedure showdata(Sender: TObject);
    procedure CreateCheckBoxesForGenericNames(tc: TClientDataSet);
    procedure LoadPatientData(vn: string);
    procedure LoadGenericNames(vn: string);
    function GetCheckBoxForGenericName(i: Integer): Boolean;
    function GetVN: string;
    function GetHN: string;
  public
    procedure showdata(Sender: TObject);
  end;

var
  Form1: TForm1;
  genericNameList, icodeList: TStringList;
  drugName,tradeName: TLabel;
  CheckBoxList: TStringList;


implementation

{$R *.dfm}


function GetVN: string;
begin
  Result := GetGlobalValue('VN');
  if Result = '' then
    Result := '670911151440'; // Default value
end;

function getHN: string;
begin
  Result := getsqldata('SELECT hn FROM vn_stat WHERE vn="' + getVN + '"');
end;


// ===========================================================
// Helper function to load patient data
procedure TForm1.LoadPatientData(vn: string);
var
  hn, fullname, pttype, age_y, pdx: string;
begin
  // Load patient's hn, full name, pttype, age, and pdx
  hn := getHN;//getsqldata('SELECT hn FROM vn_stat WHERE vn="' + vn + '"');
  fullname := getsqldata('SELECT CONCAT(pname, fname, " ", lname) FROM patient WHERE hn="' + hn + '"');
  pttype := getsqldata('SELECT p.name FROM opitemrece o inner join pttype p on o.pttype = p.pttype WHERE vn="' + vn + '"');
  age_y := getsqldata('SELECT age_y FROM vn_stat WHERE vn="' + vn + '"');
  pdx := getsqldata('SELECT CONCAT(vs.pdx," : ",i.name) FROM vn_stat vs inner join icd101 i on vs.pdx = i.code WHERE vn="' + vn + '"');

  // Assign retrieved data to labels
  Label10.Caption := hn;
  Label12.Caption := fullname;
  Label14.Caption := pttype;
  age_yLabel.Caption := age_y;
  pdxLabel.Caption := pdx;
end;



// ===========================================================
// Helper function to load generic names and initialize CheckBoxList
procedure TForm1.LoadGenericNames(vn: string);
var
  tc0: TClientDataSet;
begin
  // Initialize genericNameList and CheckBoxList
  genericNameList := TStringList.Create;
  CheckBoxList := TStringList.Create;
  icodeList := TStringList.Create;

  // Retrieve distinct generic names from the database
  tc0 := TClientDataset.Create(nil);
  try
      tc0.Data := hosxp_getdataset('SELECT DISTINCT d.generic_name,o.icode FROM opitemrece o ' +
          'INNER JOIN drugitems d ON o.icode = d.icode ' +
          'WHERE o.vn="' + vn + '" AND d.icode IN (' +
          '"1000013", /* CELECOXIB */ ' +
          '"1000014", /* DIACERINE */ ' +
          '"1000240", /* SODIUM HYALURONATE 1% */ ' +
          '"1000274", /* OCTREOTIDE */ ' +
          '"1000288", /* SULPROSTONE */ ' +
          '"1000291", /* FINASTERIDE */ ' +
          '"1000423", /* ENOXAPARIN */ ' +
          '"1000452", /* CLOMIPHENE */ ' +
          '"1000473", /* ALBUMIN HUMAN */ ' +
          '"1500038", /* CLOPIDOGREL */ ' +
          '"1500039", /* ENOXAPARIN */ ' +
          '"1510041", /* CEFDINIR */ ' +
          '"1510042", /* CEFDINIR */ ' +
          '"1510044", /* ACYCLOVIR */ ' +
          '"1510052", /* CIPROFLOXACIN */ ' +
          '"1520803", /* GABAPENTIN */ ' +
          '"1530304", /* AZITHROMYCIN */ ' +
          '"1540113", /* PREGABALIN */ ' +
          '"1540126", /* ACYCLOVIR */ ' +
          '"1540128", /* MEROPENEM */ ' +
          '"1550012", /* EPOETINBETA */ ' +
          '"1550132", /* ALTEPLASE */ ' +
          '"1550133", /* AZITHROMYCIN */ ' +
          '"1550134", /* MOMETASONE */ ' +
          '"1550137", /* CLARITHROMYCIN */ ' +
          '"1550138", /* VANCOMYCIN */ ' +
          '"1550147", /* ERTAPENEM */ ' +
          '"1550148", /* PIPERACILLIN+TAZOBACTAM */ ' +
          '"1550168", /* CIPROFLOXACIN */ ' +
          '"1550174", /* CEFIXIME */ ' +
          '"1560091", /* MOXIFLOXACIN */ ' +
          '"1560092", /* SODIUM HYALURONATE ED */ ' +
          '"1570044", /* COLISTIMETHATE */ ' +
          '"1570046", /* CEFOSULPERAZONE+SULBACTAM */ ' +
          '"1570052", /* LEVOFLOXACIN */ ' +
          '"1570082", /* PANTOPRAZOLE */ ' +
          '"1570085", /* LANTHANUM */ ' +
          '"1570092", /* DEFERIPRONE */ ' +
          '"1580083", /* BIPHASIC INSULIN ASPART */ ' +
          '"1580125", /* ALENDRONATE */ ' +
          '"1590084", /* LEVOFLOXACIN */ ' +
          '"1600159", /* QUETIAPINE */ ' +
          '"1600184", /* FILGRASTIM */ ' +
          '"1620178", /* BISMUTH SUBSALICYLATE */ ' +
          '"1620180", /* ETORICOXIB */ ' +
          '"1620182", /* SITAGLIPTIN */ ' +
          '"1620183", /* TIOTROPIUM + OLODETEROL */ ' +
          '"1620184", /* TIOTROPIUM + OLODETEROL */ ' +
          '"1630131", /* SODIUM HYALURONATE */ ' +
          '"1630133", /* TICAGRELOR */ ' +
          '"1640048", /* FLUCYTOSTINE */ ' +
          '"1640120", /* QUETIAPINE */ ' +
          '"1640131", /* TERIPARATIDE */ ' +
          '"1650034", /* ESCITALOPRAM */ ' +
          '"1650055", /* DENOSUMAB */ ' +
          '"1650149", /* BEVACIZUMAB */ ' +
          '"1650162", /* OLOPATADINE */ ' +
          '"1650182", /* LEVOFLOXACIN */ ' +
          '"1650184", /* FOSFOMYCIN */ ' +
          '"1650186", /* EMPAGLIFLOZIN */ ' +
          '"1650225", /* LIRAGLUTIDE */ ' +
          '"1650249", /* TIMOLOL+DORZOLAMIDE */ ' +
          '"1650256", /* DIOSMECTITE */ ' +
          '"1660062", /* TENOFOVIR ALAFENAMIDE */ ' +
          '"1660128", /* ENTECAVIR */ ' +
          '"1660164", /* VENLAFAXINE */ ' +
          '"1660166", /* EPOETINBETA */ ' +
          '"1660178", /* TDF */ ' +
          '"1660168", /* PREGABALIN */ ' +
          '"1660170", /* CELECOXIB */ ' +
          '"1660208", /* INSULIN GLARGINE */ ' +
          '"1660210", /* VALSARTAN + SACUBITRIL */ ' +
          '"1670041" /* LETROZOLE */' +
          ')');
    tc0.First;
    while not tc0.Eof do
    begin
      genericNameList.Add(tc0.FieldByName('generic_name').AsString);
      icodeList.Add(tc0.FieldByName('icode').AsString);
      tc0.Next;
    end;
  finally
    tc0.Free;
  end;
end;

procedure TForm1.CreateCheckBoxesForGenericNames(tc: TClientDataSet);
var
  CheckBoxTop, i: Integer;
  CheckBox: TCheckBox;
  LabelCaption,TT: TLabel;
  UniqueName: string;
  CaptionText: string;
  TextHeight, RequiredLines: Integer;
  ExistingDueList: TClientDataSet;
  RecordExists: Boolean;
begin
  CheckBoxTop := 150;
  ExistingDueList := TClientDataSet.Create(nil);
  try
    ExistingDueList.Data := hosxp_getdataset('SELECT generic_name, indication FROM drug_due_list WHERE vn = "' + GetVN + '"');
    ExistingDueList.Open;

  // Iterate over the generic names to create checkboxes
  for i := 0 to genericNameList.Count - 1 do
  begin
    // Create a label for the generic name
    drugName := TLabel.Create(Self);
    drugName.Parent := Self;
    drugName.Top := CheckBoxTop;
    drugName.Left := 30;
    drugName.Caption :={ QuotedStr(i+1)+'.'+}genericNameList[i];
    tradeName := TLabel.Create(Self);
    tradeName.Parent := Self;
    tradeName.Top := CheckBoxTop + 15;
    tradeName.Left := 30;
    tradeName.Caption := getsqldata('select trade_name from drugitems where icode = "'+ icodeList[i] +'"');


    // Retrieve associated items
    tc.Data := hosxp_getdataset('SELECT universal_item_value_name, universal_item_value_code FROM universal_item_value_list ' +
      'WHERE universal_item_value_code LIKE ' + QuotedStr(genericNameList[i] + '%'));

    // Create checkboxes for the associated values
    if not tc.IsEmpty then
    begin
      tc.First;
      while not tc.Eof do
      begin
        // Generate a unique name for each CheckBox
        UniqueName := Format('chk_%d_%d', [i, tc.RecNo]);
        //UniqueName := Format('chk_%s_%d', [genericNameList[i], tc.RecNo]);
        CaptionText := tc.FieldByName('universal_item_value_name').AsString;

        // Create the checkbox without a long caption
        CheckBox := TCheckBox.Create(Self);
        CheckBox.Parent := Self;
        CheckBox.Left := 200;
        CheckBox.Top := CheckBoxTop;
        CheckBox.Width := 15;  // Narrow checkbox without text
        CheckBox.Name := UniqueName; // Use the unique name
        CheckBox.OnClick := CheckBoxClick;
        CheckBox.Tag := i + 1;
        Checkbox.Caption := CaptionText;

          // Check if this checkbox should be marked as checked based on existing records
          ExistingDueList.First;
          RecordExists := False;
          while not ExistingDueList.Eof do
          begin
            if (ExistingDueList.FieldByName('generic_name').AsString = genericNameList[i]) and
               (ExistingDueList.FieldByName('indication').AsString = CheckBox.Caption) then
            begin
              RecordExists := True;
              Break;
            end;
            ExistingDueList.Next;
          end;

          // If the record exists, set the checkbox as checked
          if RecordExists then
            CheckBox.Checked := True;

        // Create a label for the checkbox caption
        LabelCaption := TLabel.Create(Self);
        LabelCaption.Parent := Self;
        LabelCaption.Left := CheckBox.Left + 30;  // Indent from the checkbox
        LabelCaption.Top := CheckBoxTop;
        LabelCaption.Width := 500;  // Set width for proper word wrapping
        LabelCaption.WordWrap := True;
        LabelCaption.Caption := CaptionText;
        LabelCaption.AutoSize := True;
        LabelCaption.Visible := False;

        TT := TLabel.Create(Self);
        TT.Parent := Self;
        TT.Caption :=  CaptionText;
        TT.WordWrap := True;
        TT.Width := 500;
        TT.Left := CheckBox.Left + 25;
        // Calculate the required height of the label
        TT.Top := CheckBoxTop ;
        TT.AutoSize := True;
        TT.Height := LabelCaption.Height;

        // Calculate the required number of lines for the wrapped text
        RequiredLines := (Length(CaptionText) + 99) div 100;
       
        // Set the label's height to accommodate all lines
        LabelCaption.Height := RequiredLines * 12;

        // Add the CheckBox to the list
        CheckBoxList.AddObject(CheckBox.Name, CheckBox);

        // Adjust the CheckBoxTop based on the label height
        CheckBoxTop := CheckBoxTop + LabelCaption.Height + 10;
        tc.Next;
      end;
    end
    else
      ShowMessage('No data found for ' + genericNameList[i]);
      CheckBoxTop := CheckBoxTop + 15;
    end;
  finally
    ExistingDueList.Free;
  end;
end;



// ===========================================================
// Procedure that gets called when any checkbox is clicked
procedure TForm1.CheckBoxClick(Sender: TObject);
var
  CheckBox: TCheckBox;
  CheckBoxName: string;
begin
  CheckBox := TCheckBox(Sender);
  CheckBoxName := CheckBox.Caption;

  if CheckBox.Checked then
  begin
    if CheckBoxList.IndexOf(CheckBoxName) = -1 then
      CheckBoxList.AddObject(CheckBoxName, CheckBox);
  end
  else
    CheckBoxList.Delete(CheckBoxList.IndexOf(CheckBoxName));
end;

// ===========================================================
// Helper function to validate that at least one checkbox is checked per generic name
function TForm1.GetCheckBoxForGenericName(i: Integer): Boolean;
var
  j: Integer;
  CheckBox: TCheckBox;
begin
  Result := False;

  for j := 0 to CheckBoxList.Count - 1 do
  begin
    CheckBox := TCheckBox(CheckBoxList.Objects[j]);

    if (CheckBox.Tag = i + 1) and CheckBox.Checked then
    begin
      Result := True;
      Break;
    end;
  end;
end;

// ===========================================================
// Main procedure that handles form data display
procedure TForm1.showdata(Sender: TObject);
var
  vn: string;
  tc: TClientDataSet;
begin
  vn := GetVN;

  LoadPatientData(vn);
  LoadGenericNames(vn);

  // Create and initialize the second dataset for checkboxes
  tc := TClientDataset.Create(nil);
  try
    CreateCheckBoxesForGenericNames(tc);
  finally
    tc.Free;
  end;
end;

// ===========================================================
// Procedure to save checked items to the database
procedure TForm1.SaveCheckedItemsToDatabase;
var
  i: Integer;
  vn, doctor: string;
  fcdsDUE: TClientDataSet;
  CheckBox: TCheckBox;
  OriginalName, ModifiedName: string;
  UnderscorePos: Integer;
  RecordExists: Boolean;
  ShouldInsert: Boolean;
  RecordsToDelete: TStringList; // Use TStringList for IDs
  DeleteID: string;
begin
  // Retrieve global values
  vn := GetVN;
  RecordsToDelete := TStringList.Create;

  try
    if CheckBoxList.Count > 0 then
    begin
      // Initialize and set up the TClientDataSet for inserting data
      fcdsDUE := TClientDataSet.Create(nil);
      try
        fcdsDUE.Data := hosxp_getdataset('SELECT * FROM drug_due_list WHERE vn = "' + vn + '"');
       
        if not fcdsDUE.Active then
          fcdsDUE.Open;

        // Collect records to delete
        fcdsDUE.First;
        while not fcdsDUE.Eof do
        begin
          RecordExists := False;
          for i := 0 to CheckBoxList.Count - 1 do
          begin
            CheckBox := TCheckBox(CheckBoxList.Objects[i]);

            if CheckBox.Checked then
            begin
              OriginalName := genericNameList[CheckBox.Tag - 1];
              UnderscorePos := Pos('_', OriginalName);
              if UnderscorePos > 0 then
                ModifiedName := Copy(OriginalName, 1, UnderscorePos - 1)
              else
                ModifiedName := OriginalName;

              if (fcdsDUE.FieldByName('generic_name').AsString = ModifiedName) and
                 (fcdsDUE.FieldByName('indication').AsString = CheckBox.Caption) then
              begin
                RecordExists := True;
                Break;
              end;
            end;
          end;

          if not RecordExists then
          begin
            DeleteID := fcdsDUE.FieldByName('drug_due_id').AsString;
            RecordsToDelete.Add(DeleteID); // Collect IDs to delete
          end;

          fcdsDUE.Next;
        end;

        // Delete the collected records
        fcdsDUE.First;
        while not fcdsDUE.Eof do
        begin
          if RecordsToDelete.IndexOf(fcdsDUE.FieldByName('drug_due_id').AsString) > -1 then
          begin
            fcdsDUE.Delete;
          end
          else
          begin
            fcdsDUE.Next;
          end;
        end;

        // Insert new records
        for i := 0 to CheckBoxList.Count - 1 do
        begin
          CheckBox := TCheckBox(CheckBoxList.Objects[i]);

          if CheckBox.Checked then
          begin
            OriginalName := genericNameList[CheckBox.Tag - 1];
            UnderscorePos := Pos('_', OriginalName);
            if UnderscorePos > 0 then
              ModifiedName := Copy(OriginalName, 1, UnderscorePos - 1)
            else
              ModifiedName := OriginalName;

            doctor := getsqldata('SELECT o.doctor FROM opitemrece o WHERE vn="' + vn + '" AND icode ="' + icodeList[CheckBox.Tag - 1] + '" LIMIT 1');
           
            // Check if the record already exists
            fcdsDUE.First;
            RecordExists := False;
            while not fcdsDUE.Eof do
            begin
              if (fcdsDUE.FieldByName('vn').AsString = vn) and
                 (fcdsDUE.FieldByName('generic_name').AsString = ModifiedName) and
                 (fcdsDUE.FieldByName('indication').AsString = CheckBox.Caption) then
              begin
                RecordExists := True;
                Break;
              end;
              fcdsDUE.Next;
            end;

            // Determine if the record should be inserted
            ShouldInsert := not RecordExists;

            if ShouldInsert then
            begin
              fcdsDUE.Insert;
              fcdsDUE.FieldByName('drug_due_id').AsString := getsqldata('SELECT get_serialnumber("drug_due_list")');
              fcdsDUE.FieldByName('generic_name').AsString := ModifiedName;
              fcdsDUE.FieldByName('vn').AsString := vn;
              fcdsDUE.FieldByName('doctor').AsString := doctor;
              fcdsDUE.FieldByName('entry_date').AsDateTime := Now;
              fcdsDUE.FieldByName('indication').AsString := CheckBox.Caption;
              fcdsDUE.FieldByName('hn').AsString := getHN;
              fcdsDUE.FieldByName('icode').AsString := icodeList[CheckBox.Tag - 1];
              fcdsDUE.Post;
            end;
          end;
        end;

        // Check if there are any changes
        if fcdsDUE.ChangeCount > 0 then
        begin
          // Update the database
          hosxp_updatedelta(fcdsDUE.Delta, 'SELECT * FROM drug_due_list');
        end
        else
        begin
         // ShowMessage('No changes to save.');
        end;
       
      except
        on E: Exception do
          ShowMessage('Error processing data: ' + E.Message);
      end;
    end
    else
    begin
      ShowMessage('No checkboxes are selected.');
    end;
  finally
    fcdsDUE.Free;
    RecordsToDelete.Free;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  i, j: Integer;
  CheckBox: TCheckBox;
  AtLeastOneChecked: Boolean;
begin
  // Iterate over each generic name in the list
  for i := 0 to genericNameList.Count - 1 do
  begin
    AtLeastOneChecked := False;

    // Check if at least one checkbox associated with the current generic name is checked
    for j := 0 to CheckBoxList.Count - 1 do
    begin
      CheckBox := TCheckBox(CheckBoxList.Objects[j]);
     
      // Assume CheckBox.Tag stores the index corresponding to the generic name in genericNameList
      if (CheckBox.Tag = i + 1) and CheckBox.Checked then
      begin
        AtLeastOneChecked := True;
        Break; // Exit the loop as soon as we find one checked checkbox for the current generic name
      end;
    end;

    // If no checkbox is checked for the current generic name, show a message and exit
    if not AtLeastOneChecked then
    begin
      ShowMessage('ÂѧäÁèä´éàÅ×Í¡à˵ؼšÒÃãªéÂÒ ' + genericNameList[i]);
      Exit;
    end;
  end;

  // If all checks pass, proceed to save
  try
    SaveCheckedItemsToDatabase;
    Close; // Close the form if everything is valid
  except
    on E: Exception do
      ShowMessage('Error saving data: ' + E.Message);
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  CheckBoxList.Free; // Free CheckBoxList when the form is destroyed
  genericNameList.Free;
  icodeList.Free;
end;

end.



DFM

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Drug Use Evaluation (DUE)'
  ClientHeight = 600
  ClientWidth = 800
  Color = clWindow
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnShow = showdata                 
  PixelsPerInch = 96
  TextHeight = 13
  object Shape1: TShape
    Left = 10
    Top = 10
    Width = 780
    Height = 85
    Pen.Color = clWindowFrame
  end
    object Shape2: TShape
    Left = 10
    Top = 105
    Width = 780
    Height = 485
    Pen.Color = clWindowFrame
  end
  object Label2: TLabel
    Left = 168
    Top = 48
    Width = 33
    Height = 16
    Caption = 'ª×èÍ - Ê¡ØÅ'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label3: TLabel
    Left = 400
    Top = 48
    Width = 22
    Height = 16
    Caption = 'ÍÒÂØ'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
   object Year: TLabel
    Left = 450
    Top = 48
    Width = 22
    Height = 16
    Caption = '»Õ'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
    object age_yLabel: TLabel
    Left = 430
    Top = 48
    Width = 22
    Height = 16
    Caption = '»Õ'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label4: TLabel
    Left = 32
    Top = 68
    Width = 54
    Height = 16
    Caption = 'Diagnosis'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object pdxLabel: TLabel
    Left = 100
    Top = 68
    Width = 20
    Height = 16
    Caption = 'pdx'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label1: TLabel
    Left = 32
    Top = 48
    Width = 16
    Height = 16
    Caption = 'HN'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label8: TLabel
    Left = 30
    Top = 16
    Width = 108
    Height = 16
    Caption = 'Patient information'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end

  object Label10: TLabel
    Left = 55
    Top = 48
    Width = 14
    Height = 16
    Caption = 'hn'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label12: TLabel
    Left = 230
    Top = 48
    Width = 49
    Height = 16
    Caption = 'fullname'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label13: TLabel
    Left = 500
    Top = 48
    Width = 35
    Height = 16
    Caption = 'ÊÔ·¸Ô¡ÒÃÃÑ¡ÉÒ'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label14: TLabel
    Left = 580
    Top = 48
    Width = 35
    Height = 16
    Caption = 'Pttype'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end

  object DoctorLabel: TLabel
    Left = 480
    Top = 532
    Width = 35
    Height = 16
    Caption = ''
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end

  object Button1: TButton
    Left = 660
    Top = 530
    Width = 75
    Height = 25
    Caption = 'ºÑ¹·Ö¡'
    TabOrder = 0
    OnClick = Button1Click
  end

  object Button2: TButton
    Left = 570
    Top = 530
    Width = 75
    Height = 25
    Caption = 'àÅ×Í¡¢éÍà´ÔÁ'
    TabOrder = 0
    OnClick = Button2Click
    Visible = false
  end


end