351 lines
13 KiB
Plaintext
351 lines
13 KiB
Plaintext
|
unit rLabs;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses SysUtils, Classes, ORNet, ORFn;
|
||
|
|
|
||
|
|
function AtomicTests(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
function Specimens(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
function AllTests(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
function ChemTest(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
function Users(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
function TestGroups(user: int64): TStrings;
|
||
|
|
function ATest(test: integer): TStrings;
|
||
|
|
function ATestGroup(testgroup: Integer; user: int64): TStrings;
|
||
|
|
procedure UTGAdd(tests: TStrings);
|
||
|
|
procedure UTGReplace(tests: TStrings; testgroup: integer);
|
||
|
|
procedure UTGDelete(testgroup: integer);
|
||
|
|
procedure SpecimenDefaults(var blood, urine, serum, plasma: string);
|
||
|
|
procedure Cumulative(Dest: TStrings; const PatientDFN: string;
|
||
|
|
daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string);
|
||
|
|
procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string;
|
||
|
|
daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
|
||
|
|
procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1,
|
||
|
|
ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1,
|
||
|
|
ADate2: TFMDateTime; ARpc: string); //*DFN*
|
||
|
|
procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1,
|
||
|
|
ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
|
||
|
|
tests: TStrings): TStrings; //*DFN*
|
||
|
|
function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime;
|
||
|
|
direction, format: integer): TStrings; //*DFN*
|
||
|
|
function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
|
||
|
|
spec: string; tests: TStrings): TStrings; //*DFN*
|
||
|
|
procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
||
|
|
ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string); //*DFN*
|
||
|
|
procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
||
|
|
ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
||
|
|
ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string); //*DFN*
|
||
|
|
function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
|
||
|
|
spec, test: string): TStrings; //*DFN*
|
||
|
|
procedure PrintLabsToDevice(AReport, ADaysBack: Integer;
|
||
|
|
const PatientDFN, ADevice: string; ATests: TStrings;
|
||
|
|
var ErrMsg: string; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string);
|
||
|
|
function GetFormattedLabReport(AReport, ADaysBack: Integer; const PatientDFN: string;
|
||
|
|
ATests: TStrings; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string): TStrings;
|
||
|
|
function TestInfo(Test: String): TStrings;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses rCore, uCore, graphics;
|
||
|
|
|
||
|
|
function AtomicTests(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR ATOMICS', [StartFrom, Direction]);
|
||
|
|
MixedCaseList(RPCBrokerV.Results);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function Specimens(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR SPEC', [StartFrom, Direction]);
|
||
|
|
MixedCaseList(RPCBrokerV.Results);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function AllTests(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR ALLTESTS', [StartFrom, Direction]);
|
||
|
|
MixedCaseList(RPCBrokerV.Results);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function ChemTest(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR CHEMTEST', [StartFrom, Direction]);
|
||
|
|
MixedCaseList(RPCBrokerV.Results);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function Users(const StartFrom: string; Direction: Integer): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR USERS', [StartFrom, Direction]);
|
||
|
|
MixedCaseList(RPCBrokerV.Results);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TestGroups(user: int64): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR TG', [user]);
|
||
|
|
MixedCaseList(RPCBrokerV.Results);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function ATest(test: integer): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR ATESTS', [test]);
|
||
|
|
MixedCaseList(RPCBrokerV.Results);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function ATestGroup(testgroup: Integer; user: int64): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR ATG', [testgroup, user]);
|
||
|
|
MixedCaseList(RPCBrokerV.Results);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure UTGAdd(tests: TStrings);
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR UTGA', [tests]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure UTGReplace(tests: TStrings; testgroup: integer);
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR UTGR', [tests, testgroup]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure UTGDelete(testgroup: integer);
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR UTGD', [testgroup]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure SpecimenDefaults(var blood, urine, serum, plasma: string);
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR PARAM', [nil]);
|
||
|
|
blood := Piece(RPCBrokerV.Results[0], '^', 1);
|
||
|
|
urine := Piece(RPCBrokerV.Results[0], '^', 2);
|
||
|
|
serum := Piece(RPCBrokerV.Results[0], '^', 3);
|
||
|
|
plasma := Piece(RPCBrokerV.Results[0], '^', 4);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure Cumulative(Dest: TStrings; const PatientDFN: string; daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
|
||
|
|
begin
|
||
|
|
if Length(ARpc) > 0 then
|
||
|
|
begin
|
||
|
|
CallV(ARpc, [PatientDFN, daysback, ADate1, ADate2]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Dest.Add('RPC is missing from report definition (file 101.24).');
|
||
|
|
Dest.Add('Please contact Technical Support.');
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string;
|
||
|
|
daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
begin
|
||
|
|
CallV('XWB REMOTE RPC', [ASite, ARemoteRPC, 0, PatientDFN, daysback, Adate1, Adate2]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
|
||
|
|
begin
|
||
|
|
if Length(ARpc) > 0 then
|
||
|
|
begin
|
||
|
|
CallV(ARpc, [PatientDFN, ADate1, ADate2]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Dest.Add('RPC is missing from report definition (file 101.24).');
|
||
|
|
Dest.Add('Please contact Technical Support.');
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1,
|
||
|
|
ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
begin
|
||
|
|
CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN, Adate1, Adate2]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
|
||
|
|
begin
|
||
|
|
if Length(ARpc) > 0 then
|
||
|
|
begin
|
||
|
|
CallV(ARpc, [PatientDFN, ADate1, ADate2]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Dest.Add('RPC is missing from report definition (file 101.24).');
|
||
|
|
Dest.Add('Please contact Technical Support.');
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1,
|
||
|
|
ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
begin
|
||
|
|
CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN, Adate1, Adate2]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime; tests: TStrings): TStrings; //*DFN*
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR INTERIMS', [PatientDFN, ADate1, ADate2, tests]);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime; direction, format: integer): TStrings; //*DFN*
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR INTERIMG', [PatientDFN, ADate1, direction, format]);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec: string; tests: TStrings): TStrings; //*DFN*
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR GRID', [PatientDFN, ADate1, ADate2, spec, tests]);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype, ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string); //*DFN*
|
||
|
|
begin
|
||
|
|
if Length(ARpc) > 0 then
|
||
|
|
begin
|
||
|
|
CallV(ARpc, [PatientDFN, reportid, hstype, ADate, section, Adate2, Adate1]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Dest.Add('RPC is missing from report definition (file 101.24).');
|
||
|
|
Dest.Add('Please contact Technical Support.');
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
||
|
|
ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
begin
|
||
|
|
CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN,
|
||
|
|
reportid + ';1', hstype, ADate, section, Adate2, Adate1]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
||
|
|
ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
|
||
|
|
begin
|
||
|
|
CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN,
|
||
|
|
reportid + ';1', hstype, ADate, section, Adate2, Adate1]);
|
||
|
|
QuickCopy(RPCBrokerV.Results,Dest);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string); //*DFN*
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR NEWOLD', [PatientDFN]);
|
||
|
|
newest := Piece(RPCBrokerV.Results[0], '^', 1);
|
||
|
|
oldest := Piece(RPCBrokerV.Results[0], '^', 2);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec, test: string): TStrings; //*DFN*
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR CHART', [PatientDFN, ADate1, ADate2, spec, test]);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure PrintLabsToDevice(AReport, ADaysBack: Integer;
|
||
|
|
const PatientDFN, ADevice: string; ATests: TStrings; var ErrMsg: string;
|
||
|
|
ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string);
|
||
|
|
{ prints a report on the selected device }
|
||
|
|
var
|
||
|
|
j: integer;
|
||
|
|
RemoteHandle,Report: string;
|
||
|
|
aHandles: TStringlist;
|
||
|
|
begin
|
||
|
|
aHandles := TStringList.Create;
|
||
|
|
if Length(ARemoteSiteID) > 0 then
|
||
|
|
begin
|
||
|
|
RemoteHandle := '';
|
||
|
|
for j := 0 to RemoteReports.Count - 1 do
|
||
|
|
begin
|
||
|
|
Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
|
||
|
|
if Report = ARemoteQuery then
|
||
|
|
begin
|
||
|
|
RemoteHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle
|
||
|
|
+ '^' + Pieces(Report,'^',9,10);
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if Length(RemoteHandle) > 1 then
|
||
|
|
with RemoteSites.SiteList do
|
||
|
|
aHandles.Add(ARemoteSiteID + '^' + RemoteHandle);
|
||
|
|
end;
|
||
|
|
if aHandles.Count > 0 then
|
||
|
|
begin
|
||
|
|
ErrMsg := sCallV('ORWRP PRINT LAB REMOTE',[ADevice, PatientDFN, AReport, aHandles]);
|
||
|
|
if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
ErrMsg := sCallV('ORWRP PRINT LAB REPORTS',[ADevice, PatientDFN, AReport,
|
||
|
|
ADaysBack, ATests, ADate2, ADate1]);
|
||
|
|
if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
|
||
|
|
end;
|
||
|
|
aHandles.Clear;
|
||
|
|
aHandles.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetFormattedLabReport(AReport, ADaysBack: Integer;
|
||
|
|
const PatientDFN: string; ATests: TStrings; ADate1, ADate2: TFMDateTime;
|
||
|
|
ARemoteSiteID, ARemoteQuery: string): TStrings;
|
||
|
|
{ prints a report on the selected Windows device }
|
||
|
|
var
|
||
|
|
j: integer;
|
||
|
|
RemoteHandle,Report: string;
|
||
|
|
aHandles: TStringlist;
|
||
|
|
begin
|
||
|
|
aHandles := TStringList.Create;
|
||
|
|
if Length(ARemoteSiteID) > 0 then
|
||
|
|
begin
|
||
|
|
RemoteHandle := '';
|
||
|
|
for j := 0 to RemoteReports.Count - 1 do
|
||
|
|
begin
|
||
|
|
Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
|
||
|
|
if Report = ARemoteQuery then
|
||
|
|
begin
|
||
|
|
RemoteHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle
|
||
|
|
+ '^' + Pieces(Report,'^',9,10);
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if Length(RemoteHandle) > 1 then
|
||
|
|
with RemoteSites.SiteList do
|
||
|
|
aHandles.Add(ARemoteSiteID + '^' + RemoteHandle);
|
||
|
|
end;
|
||
|
|
if aHandles.Count > 0 then
|
||
|
|
begin
|
||
|
|
CallV('ORWRP PRINT WINDOWS LAB REMOTE',[PatientDFN, AReport, aHandles]);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
CallV('ORWRP WINPRINT LAB REPORTS',[PatientDFN, AReport, ADaysBack, ATests,
|
||
|
|
ADate2, ADate1]);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
aHandles.Clear;
|
||
|
|
aHandles.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TestInfo(Test: String): TStrings;
|
||
|
|
begin
|
||
|
|
CallV('ORWLRR INFO',[Test]);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|