Drugblocker
unit DB;
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)
StringGrid1: TStringGrid;
Button1: TButton;
Button2: TButton;
HeadLabel: TLabel;
hnLabel: TLabel;
hntxt: TLabel;
pdxLabel: TLabel;
Label1: TLabel;
Shape1: TShape;
Label8: TLabel;
Label9: TLabel;
fullnametxt: TLabel;
Label13: TLabel;
pttypetxt: TLabel;
Panel1: TPanel;
currentlabel: TLabel;
Panel3: TPanel;
Year: TLabel;
age_yLabel: TLabel;
ListBox2: TListBox;
Shape2: TShape;
DBGrid1: TDBGrid;
DBGrid2: TDBGrid;
DBGrid3: TDBGrid;
cds: TClientDataSet;
ds: TDataSource;
cds2: TClientDataSet;
ds2: TDataSource;
cds3: TClientDataSet;
ds3: TDataSource;
TempCDS: TClientDataSet;
reclabel1: TLabel;
reclabel2: TLabel;
reclabel3: TLabel;
reclabel4: TLabel;
procedure showdata(Sender: TObject);
procedure LoadPatientData(vn: string);
function GetVN: string;
procedure FormCreate(Sender: TObject);
procedure btnConfirmClick(Sender: TObject);
private
procedure DisplayPatientInfo(hn, fullname, pttype: string; age_y: Integer);
procedure LoadLabData(hn: string);
procedure LoadPrescriptionData(vn: string);
procedure DeleteRecord(const RecordID: string);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// GetVN retrieves the VN (visit number) or uses a default if none is found.
function TForm1.GetVN: string;
begin
Result := GetGlobalValue('VN');// Uncomment if GetGlobalValue is available
end;
// Display patient information on the form.
procedure TForm1.DisplayPatientInfo(hn, fullname, pttype: string; age_y: Integer);
begin
hntxt.Caption := hn;
fullnametxt.Caption := fullname;
pttypetxt.Caption := pttype;
age_yLabel.Caption := IntToStr(age_y);
end;
// LoadPatientData retrieves and displays patient information based on the VN.
procedure TForm1.LoadPatientData(vn: string);
var
hn, fullname, pttype, age_y_str: string;
age_y, sex: Integer;
begin
try
hn := getsqldata('SELECT hn FROM vn_stat WHERE vn = "' + vn + '"');
fullname := getsqldata('SELECT CONCAT(pname, fname, " ", lname) FROM patient WHERE hn = "' + hn + '"');
sex := StrToInt(getsqldata('SELECT sex 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_str := getsqldata('SELECT age_y FROM vn_stat WHERE vn = "' + vn + '"');
age_y := StrToInt(age_y_str);
pdxLabel.Caption := getsqldata('SELECT CONCAT(vs.pdx, " : ", i.name) FROM vn_stat vs INNER JOIN icd101 i ON vs.pdx = i.code WHERE vn = "' + vn + '"');
DisplayPatientInfo(hn, fullname, pttype, age_y);
except
on E: Exception do
ShowMessage('Error loading patient data: ' + E.Message);
end;
end;
// Load lab data into cds.
procedure TForm1.LoadLabData(hn: string);
begin
cds.Data := hosxp_getdataset(
'SELECT DATE_FORMAT(DATE_ADD(lh.report_date, INTERVAL 543 YEAR), ''%d/%m/%Y'') AS report_date, ' +
'lh.vn, lh.hn, os.bw AS weight, vs.age_y AS age, vs.sex, ' +
'MAX(CASE WHEN lo.lab_items_code = ''231'' THEN lo.lab_order_result END) AS Creatinine, ' +
'MAX(CASE WHEN lo.lab_items_code = ''660'' THEN lo.lab_order_result END) AS eGFR, ' +
'CASE WHEN os.bw IS NULL OR os.bw = 0 OR os.bw > 150 THEN ''-'' ' +
'WHEN vs.sex = ''1'' THEN ROUND(((140 - vs.age_y) * os.bw) / (72 * NULLIF(MAX(CASE WHEN lo.lab_items_code = ''231'' THEN lo.lab_order_result END), 0)), 2) ' +
'WHEN vs.sex = ''2'' THEN ROUND(0.85 * ((140 - vs.age_y) * os.bw) / (72 * NULLIF(MAX(CASE WHEN lo.lab_items_code = ''231'' THEN lo.lab_order_result END), 0)), 2) ' +
'END AS CrCl ' +
'FROM lab_head lh ' +
'INNER JOIN lab_order lo ON lh.lab_order_number = lo.lab_order_number ' +
'INNER JOIN opdscreen os ON lh.vn = os.vn ' +
'INNER JOIN vn_stat vs ON lh.vn = vs.vn ' +
'WHERE lh.hn = "' + hn + '" ' +
'AND lo.lab_items_code IN (''231'', ''660'') AND lo.lab_order_result > 0 ' +
'AND lo.lab_order_result REGEXP ''^[0-9]+\.?[0-9]*$'' ' +
'GROUP BY lh.report_date, lh.vn, lh.hn, os.bw, vs.age_y, vs.sex ' +
'ORDER BY lh.report_date DESC LIMIT 5'
);
end;
// Load prescription data into cds2.
procedure TForm1.LoadPrescriptionData(vn: string);
begin
cds2.Data := hosxp_getdataset(
'SELECT o.vstdate, CONCAT(d.name, " ", d.strength) AS name, o.icode, ' +
'COALESCE(du.code, CONCAT(su.name1, su.name2, su.name3)) AS usage_or_sp_usage, o.qty ' +
'FROM opitemrece o ' +
'INNER JOIN drugitems d ON o.icode = d.icode ' +
'LEFT OUTER JOIN drugusage du ON o.drugusage = du.drugusage ' +
'LEFT OUTER JOIN sp_use su ON o.sp_use = su.sp_use ' +
'WHERE o.vn = "' + vn + '" AND o.icode = "1000210"'
);
end;
procedure TForm1.UpdateCheckboxVisibility(LatestEGFR: Double);
begin
if LatestEGFR < 30 then
begin
// Show Checkfordelete and Checkforconfirm, hide other checkboxes
Checkfordelete.Visible := True;
Checkforconfirm.Visible := True;
Checkforconfirm.Top := 25;
Checkhalfx1.Visible := False;
Check1x1.Visible := False;
Check1x2.Visible := False;
Check2x1.Visible := False;
Check110.Visible := False;
end
else if (LatestEGFR >= 30) then
begin
// Hide Checkfordelete and Checkforconfirm, show other checkboxes
Checkfordelete.Visible := False;
Checkforconfirm.Visible := true;
Checkhalfx1.Visible := True;
Checkhalfx1.Top := 5;
Check1x1.Top := 25;
Check1x2.Top := 45;
Check2x1.Top := 65;
Check110.Top := 85;
Checkforconfirm.Top := 105;
Check1x1.Visible := True;
Check1x2.Visible := True;
Check2x1.Visible := True;
Check110.Visible := True;
end
else
begin
// If LatestEGFR >= 45, you can customize visibility as needed
Checkfordelete.Visible := False;
Checkforconfirm.Visible := False;
Checkhalfx1.Visible := False;
Check1x1.Visible := False;
Check1x2.Visible := False;
Check2x1.Visible := False;
Check110.Visible := False;
end;
end;
procedure TForm1.showdata(Sender: TObject);
var
vn, hn: string;
LatestEGFR: Double;
begin
vn := GetVN;
LoadPatientData(vn);
hn := getsqldata('SELECT hn FROM vn_stat WHERE vn = "' + vn + '"');
try
LoadLabData(hn);
LoadPrescriptionData(vn);
// Calculate LatestEGFR based on loaded lab data
if cds.RecordCount > 0 then
begin
cds.First; // Ensure the dataset is on the first record
LatestEGFR := cds.FieldByName('eGFR').AsFloat;
UpdateCheckboxVisibility(LatestEGFR); // Call the procedure to update checkbox visibility
end;
except
on E: Exception do
ShowMessage('Error loading dataset: ' + E.Message);
end;
end;
// DeleteRecord deletes a specific record from cds2.
procedure TForm1.DeleteRecord(const RecordID: string);
procedure TForm1.UpdateRecord(const drugusage: string);
**********ต้องเขียนเองครับ*****************
procedure TForm1.btnConfirmClick(Sender: TObject);
var
CheckedCount: Integer;
begin
CheckedCount := 0;
// Count the number of checked boxes
if Checkhalfx1.Checked then CheckedCount := CheckedCount + 1;
if Check1x1.Checked then CheckedCount := CheckedCount + 1;
if Check1x2.Checked then CheckedCount := CheckedCount + 1;
if Check2x1.Checked then CheckedCount := CheckedCount + 1;
if Check110.Checked then CheckedCount := CheckedCount + 1;
if Checkfordelete.Checked then CheckedCount := CheckedCount + 1;
if Checkforconfirm.Checked then CheckedCount := CheckedCount + 1;
// If no checkboxes or more than one are checked, show a message and exit
if CheckedCount = 0 then
begin
ShowMessage('Please select one option to confirm.');
Exit;
end
else if CheckedCount > 1 then
begin
ShowMessage('Please select only one option to confirm.');
Exit;
end;
// If only one checkbox is selected, perform the appropriate action
try
if Checkhalfx1.Checked then
UpdateRecord('0168')
else if Check1x1.Checked then
UpdateRecord('0011')
else if Check1x2.Checked then
UpdateRecord('0022')
else if Check2x1.Checked then
UpdateRecord('0154')
else if Check110.Checked then
UpdateRecord('0317')
else if Checkfordelete.Checked then
DeleteRecord('1000210')
else if Checkforconfirm.Checked then
Close; // Close the form if Checkforconfirm is checked
Close; // Close the form after action
except
on E: Exception do
ShowMessage('Error confirming action: ' + E.Message);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Free resources like datasets and other allocated objects
cds.Close;
cds2.Close;
cds3.Close;
// Set the form to be released from memory
Action := caFree;
end;
end.
procedure TForm1.DeleteRecord(const RecordID: string);
**********ต้องเขียนเองครับ*************** ผมไม่มั่นใจความถูกต้อง
ใช้ cds3.Data := hosxp_getdataset('SELECT * FROM ...... ');
cds3.Delete;
if cds3.ChangeCount > 0 then
begin
hosxp_updatedelta(cds3.Delta, 'SELECT * FROM ....... ');
ShowMessage('Record deleted successfully.');
end
procedure TForm1.UpdateRecord(const drugusage: string);
cds3.Edit;
cds3.FieldByName('drugusage').AsString := drugusage;
cds3.Post;
หัวข้อ: การแจ้งเตือนการจ่ายยากับผู้ ป่วยที่มีผล lab ที่กำหนด (อ่าน 1776 ครั้ง)