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;
cds: TClientDataSet;
ds: TDataSource;
cds2: TClientDataSet;
ds2: TDataSource;
cds3: TClientDataSet;
ds3: TDataSource;
cds4: TClientDataSet;
TempCDS: TClientDataSet;
reclabel1: TLabel;
reclabel2: TLabel;
reclabel3: TLabel;
reclabel4: TLabel;
procedure showdata(Sender: TObject);
procedure LoadPatientData(vn: string);
function getVN: string;
function getAN: string;
function getHN: 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
//if Result = '' then
//Result := '661130062500'; // Default VN
//Result := '671107054724'; // Default VN }
end;
function TForm1.getAN: string;
begin
Result := GetGlobalValue('AN');// Uncomment if GetGlobalValue is available
end;
function TForm1.isAdmit: Boolean;
begin
Result := (getAN <> '');
end;
function getHN: string;
begin
Result := getsqldata('SELECT hn FROM vn_stat WHERE vn="' + getVN + '"');
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;
procedure TForm1.recordOpen(Sender: TObject);
var
tc0, tc1: TClientDataSet;
universal_head_id, universal_detail_id,onlineid,user: string;
nextDetailID, i: Integer;
begin
// Record universal head
onlineid:=get_onlineid;
user := getsqldata('select kskloginname from onlineuser where onlineid="'+onlineid+'"');
//showmessage(user);
tc0 := TClientDataSet.Create(nil);
//if user = 'isarak' then
// Exit;
try
// Get a new universal_head_id
universal_head_id := getsqldata('SELECT COALESCE(MAX(universal_head_id), 0) + 1 FROM universal_head');
tc0.Data := hosxp_getdataset('SELECT * FROM universal_head');
tc0.Open;
// Insert the new head record
tc0.Insert;
tc0.FieldByName('universal_head_id').AsString := universal_head_id;
tc0.FieldByName('entry_date').AsDateTime := Now;
tc0.FieldByName('staff').AsString := user;
tc0.FieldByName('hn').AsString := getHN;
tc0.FieldByName('vn').AsString := GetVN;
tc0.FieldByName('universal_form_id').AsString := '53';
tc0.FieldByName('entry_time').AsDateTime := Time;
tc0.Post;
// Save changes to the database if any were made
if tc0.ChangeCount > 0 then
hosxp_updatedelta(tc0.Delta, 'SELECT * FROM universal_head');
except
on E: Exception do
ShowMessage('Error recording universal head: ' + E.Message);
end;
tc0.Free;
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.hos_guid,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 and LatestEGFR <= 45) 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 = '' then
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);
recordOpen(Sender);
// 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);
var
vn: string;
begin
vn := GetVN;
// Load datasets
cds3.Data := hosxp_getdataset('SELECT * FROM opitemrece o WHERE o.vn = "' + vn + '"');
cds4.Data := hosxp_getdataset('SELECT * FROM opitemrece_summary o WHERE o.vn = "' + vn + '"');
// Delete from cds3
cds3.First;
while not cds3.Eof do
begin
if cds3.FieldByName('icode').AsString = RecordID then
begin
cds3.Delete;
Break;
end;
cds3.Next;
end;
// Delete from cds4
cds4.First;
while not cds4.Eof do
begin
if cds4.FieldByName('icode').AsString = RecordID then
begin
cds4.Delete;
Break;
end;
cds4.Next;
end;
// Apply changes if any record was deleted
if (cds3.ChangeCount > 0) or (cds4.ChangeCount > 0) then
begin
// Apply changes to both cds3 and cds4
hosxp_updatedelta(cds3.Delta, 'SELECT * FROM opitemrece o WHERE o.vn = "' + vn + '"');
hosxp_updatedelta(cds4.Delta, 'SELECT * FROM opitemrece_summary o WHERE o.vn = "' + vn + '"');
ShowMessage('Record deleted successfully.');
end
else
ShowMessage('Record not found or no changes to apply.');
end;
procedure TForm1.UpdateRecord(const drugusage: string);
var
vn: string;
begin
vn := GetVN;
cds3.Data := hosxp_getdataset('SELECT * FROM opitemrece o WHERE o.vn = "' + vn + '" and o.icode = "1000210"');
cds3.First;
while not cds3.Eof do
begin
// Update the drugusage field to the specified value if found
cds3.Edit;
cds3.FieldByName('drugusage').AsString := drugusage;
cds3.Post;
Break;
end;
// Check if there are changes and apply them to the database
if cds3.ChangeCount > 0 then
begin
hosxp_updatedelta(cds3.Delta, 'SELECT * FROM opitemrece o WHERE o.vn = "' + vn + '" ');
//ShowMessage('Record updated successfully.');
end
else
ShowMessage('Record not found or no changes to apply.');
end;
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;
cds4.Close;
// Set the form to be released from memory
Action := caFree;
end;
end.
procedure TForm1.DeleteRecord(const RecordID: string);
procedure TForm1.UpdateRecord(const drugusage: string);
ฝาก recheck 2 procedure นี้ด้วยครับ ผมไม่มั่นใจว่าเวลาลบรายการ แก้ไขวิธีใช้ต้องอัพเดตตารางไหนบ้าง ไม่ได้ trace sql ของ HOSxP ดูครับ
หัวข้อ: การแจ้งเตือนการจ่ายยากับผู้ ป่วยที่มีผล lab ที่กำหนด (อ่าน 13482 ครั้ง)