Module

rLabs

Path

C:\CPRS\CPRS30\rLabs.pas

Last Modified

7/15/2014 3:26:44 PM

Units Used in Implementation

Name Comments
rCore -
rMisc -
uCore -

Procedures

Name Owner Declaration Scope Comments
Cumulative - procedure Cumulative(Dest: TStrings; const PatientDFN: string; daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string); Interfaced DFN*
GetNewestOldest - procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string); Interfaced
DFN*
DFN*
Interim - procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); Interfaced
DFN*
DFN*
Micro - procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); Interfaced DFN*
PrintLabsToDevice - procedure PrintLabsToDevice(AReport: string; ADaysBack: Integer; const PatientDFN, ADevice: string; ATests: TStrings; var ErrMsg: string; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string); Interfaced Prints a report on the selected device
RemoteLab - procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype, ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String); Interfaced -
RemoteLabCumulative - procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string; daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String); Interfaced -
RemoteLabInterim - procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String); Interfaced -
RemoteLabMicro - procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String); Interfaced -
RemoteLabReports - procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype, ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String); Interfaced -
Reports - procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype, ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string); Interfaced DFN*
SpecimenDefaults - procedure SpecimenDefaults(var blood, urine, serum, plasma: string); Interfaced -
UTGAdd - procedure UTGAdd(tests: TStrings); Interfaced -
UTGDelete - procedure UTGDelete(testgroup: integer); Interfaced -
UTGReplace - procedure UTGReplace(tests: TStrings; testgroup: integer); Interfaced -

Functions

Name Owner Declaration Scope Comments
AllTests - function AllTests(const StartFrom: string; Direction: Integer): TStrings; Interfaced -
ATest - function ATest(test: integer): TStrings; Interfaced -
ATestGroup - function ATestGroup(testgroup: Integer; user: int64): TStrings; Interfaced -
AtomicTests - function AtomicTests(const StartFrom: string; Direction: Integer): TStrings; Interfaced -
ChemTest - function ChemTest(const StartFrom: string; Direction: Integer): TStrings; Interfaced -
GetChart - function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec, test: string): TStrings; Interfaced DFN*
GetFormattedLabReport - function GetFormattedLabReport(AReport: string; ADaysBack: Integer; const PatientDFN: string; ATests: TStrings; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string): TStrings; Interfaced Prints a report on the selected Windows device
InterimGrid - function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime; direction, format: integer): TStrings; Interfaced DFN*
InterimSelect - function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime; tests: TStrings): TStrings; Interfaced DFN*
LabPatchInstalled - function LabPatchInstalled: boolean; Interfaced -
Specimens - function Specimens(const StartFrom: string; Direction: Integer): TStrings; Interfaced -
TestGroups - function TestGroups(user: int64): TStrings; Interfaced -
TestInfo - function TestInfo(Test: String): TStrings; Interfaced -
Users - function Users(const StartFrom: string; Direction: Integer): TStrings; Interfaced -
Worksheet - function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec: string; tests: TStrings): TStrings; Interfaced DFN*

Global Variables

Name Type Declaration Comments
uLabPatchInstalled uLabPatchInstalled: TLabPatchInstalled; -

Constants

Name Declaration Scope Comments
PSI_05_118 'LR*5.2*364' Global -


Module Source

1     unit rLabs;
2     
3     interface
4     
5     uses SysUtils, Classes, ORNet, ORFn;
6     
7     type
8     
9       TLabPatchInstalled = record
10        PatchInstalled: boolean;
11        PatchChecked: boolean;
12      end;
13    
14    
15    function AtomicTests(const StartFrom: string; Direction: Integer): TStrings;
16    function Specimens(const StartFrom: string; Direction: Integer): TStrings;
17    function AllTests(const StartFrom: string; Direction: Integer): TStrings;
18    function ChemTest(const StartFrom: string; Direction: Integer): TStrings;
19    function Users(const StartFrom: string; Direction: Integer): TStrings;
20    function TestGroups(user: int64): TStrings;
21    function ATest(test: integer): TStrings;
22    function ATestGroup(testgroup: Integer; user: int64): TStrings;
23    procedure UTGAdd(tests: TStrings);
24    procedure UTGReplace(tests: TStrings; testgroup: integer);
25    procedure UTGDelete(testgroup: integer);
26    procedure SpecimenDefaults(var blood, urine, serum, plasma: string);
27    procedure Cumulative(Dest: TStrings; const PatientDFN: string;
28      daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string);
29    procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string;
30      daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String);
31    procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string);  //*DFN*
32    procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1,
33      ADate2: TFMDateTime; ASite, ARemoteRPC: String);
34    procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1,
35      ADate2: TFMDateTime; ARpc: string);  //*DFN*
36    procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1,
37      ADate2: TFMDateTime; ASite, ARemoteRPC: String);
38    function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
39      tests: TStrings): TStrings;  //*DFN*
40    function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime;
41      direction, format: integer): TStrings;  //*DFN*
42    function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
43      spec: string; tests: TStrings): TStrings;  //*DFN*
44    procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
45      ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string);  //*DFN*
46    procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
47      ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
48    procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype,
49      ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
50    procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string);  //*DFN*
51    function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
52      spec, test: string): TStrings;  //*DFN*
53    procedure PrintLabsToDevice(AReport: string; ADaysBack: Integer;
54      const PatientDFN, ADevice: string; ATests: TStrings;
55      var ErrMsg: string; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string);
56    function GetFormattedLabReport(AReport: string; ADaysBack: Integer; const PatientDFN: string;
57      ATests: TStrings; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string): TStrings;
58    function TestInfo(Test: String): TStrings;
59    function LabPatchInstalled: boolean;
60    
61    
62    implementation
63    
64    uses rCore, uCore, graphics, rMisc;
65    
66    const
67      PSI_05_118 = 'LR*5.2*364';
68    var
69      uLabPatchInstalled: TLabPatchInstalled;
70    
71    function AtomicTests(const StartFrom: string; Direction: Integer): TStrings;
72    begin
73      CallV('ORWLRR ATOMICS', [StartFrom, Direction]);
74      MixedCaseList(RPCBrokerV.Results);
75      Result := RPCBrokerV.Results;
76    end;
77    
78    function Specimens(const StartFrom: string; Direction: Integer): TStrings;
79    begin
80      CallV('ORWLRR SPEC', [StartFrom, Direction]);
81      MixedCaseList(RPCBrokerV.Results);
82      Result := RPCBrokerV.Results;
83    end;
84    
85    function AllTests(const StartFrom: string; Direction: Integer): TStrings;
86    begin
87      CallV('ORWLRR ALLTESTS', [StartFrom, Direction]);
88      MixedCaseList(RPCBrokerV.Results);
89      Result := RPCBrokerV.Results;
90    end;
91    
92    function ChemTest(const StartFrom: string; Direction: Integer): TStrings;
93    begin
94      CallV('ORWLRR CHEMTEST', [StartFrom, Direction]);
95      MixedCaseList(RPCBrokerV.Results);
96      Result := RPCBrokerV.Results;
97    end;
98    
99    function Users(const StartFrom: string; Direction: Integer): TStrings;
100   begin
101     CallV('ORWLRR USERS', [StartFrom, Direction]);
102     MixedCaseList(RPCBrokerV.Results);
103     Result := RPCBrokerV.Results;
104   end;
105   
106   function TestGroups(user: int64): TStrings;
107   begin
108     CallV('ORWLRR TG', [user]);
109     MixedCaseList(RPCBrokerV.Results);
110     Result := RPCBrokerV.Results;
111   end;
112   
113   function ATest(test: integer): TStrings;
114   begin
115     CallV('ORWLRR ATESTS', [test]);
116     MixedCaseList(RPCBrokerV.Results);
117     Result := RPCBrokerV.Results;
118   end;
119   
120   function ATestGroup(testgroup: Integer; user: int64): TStrings;
121   begin
122     CallV('ORWLRR ATG', [testgroup, user]);
123     MixedCaseList(RPCBrokerV.Results);
124     Result := RPCBrokerV.Results;
125   end;
126   
127   procedure UTGAdd(tests: TStrings);
128   begin
129     CallV('ORWLRR UTGA', [tests]);
130   end;
131   
132   procedure UTGReplace(tests: TStrings; testgroup: integer);
133   begin
134     CallV('ORWLRR UTGR', [tests, testgroup]);
135   end;
136   
137   procedure UTGDelete(testgroup: integer);
138   begin
139     CallV('ORWLRR UTGD', [testgroup]);
140   end;
141   
142   procedure SpecimenDefaults(var blood, urine, serum, plasma: string);
143   begin
144     CallV('ORWLRR PARAM', [nil]);
145     blood := Piece(RPCBrokerV.Results[0], '^', 1);
146     urine := Piece(RPCBrokerV.Results[0], '^', 2);
147     serum := Piece(RPCBrokerV.Results[0], '^', 3);
148     plasma := Piece(RPCBrokerV.Results[0], '^', 4);
149   end;
150   
151   procedure Cumulative(Dest: TStrings; const PatientDFN: string; daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string);  //*DFN*
152   begin
153     if Length(ARpc) > 0 then
154       begin
155         CallV(ARpc, [PatientDFN, daysback, ADate1, ADate2]);
156         QuickCopy(RPCBrokerV.Results,Dest);
157       end
158     else
159       begin
160         Dest.Add('RPC is missing from report definition (file 101.24).');
161         Dest.Add('Please contact Technical Support.');
162       end;
163   end;
164   
165   procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string;
166     daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String);
167   begin
168     CallV('XWB REMOTE RPC', [ASite, ARemoteRPC, 0, PatientDFN, daysback, Adate1, Adate2]);
169     QuickCopy(RPCBrokerV.Results,Dest);
170   end;
171   
172   procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string);  //*DFN*
173   begin
174     if Length(ARpc) > 0 then
175       begin
176         CallV(ARpc, [PatientDFN, ADate1, ADate2]);
177         QuickCopy(RPCBrokerV.Results,Dest);
178       end
179     else
180       begin
181         Dest.Add('RPC is missing from report definition (file 101.24).');
182         Dest.Add('Please contact Technical Support.');
183       end;
184   end;
185   
186   procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1,
187     ADate2: TFMDateTime; ASite, ARemoteRPC: String);
188   begin
189     CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN, Adate1, Adate2]);
190     QuickCopy(RPCBrokerV.Results,Dest);
191   end;
192   
193   procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string);  //*DFN*
194   begin
195     if Length(ARpc) > 0 then
196       begin
197         CallV(ARpc, [PatientDFN, ADate1, ADate2]);
198         QuickCopy(RPCBrokerV.Results,Dest);
199       end
200     else
201       begin
202         Dest.Add('RPC is missing from report definition (file 101.24).');
203         Dest.Add('Please contact Technical Support.');
204       end;
205   end;
206   
207   procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1,
208     ADate2: TFMDateTime; ASite, ARemoteRPC: String);
209   begin
210     CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN, Adate1, Adate2]);
211     QuickCopy(RPCBrokerV.Results,Dest);
212   end;
213   
214   function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime; tests: TStrings): TStrings;  //*DFN*
215   begin
216     CallV('ORWLRR INTERIMS', [PatientDFN, ADate1, ADate2, tests]);
217     Result := RPCBrokerV.Results;
218   end;
219   
220   function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime; direction, format: integer): TStrings;  //*DFN*
221   begin
222     CallV('ORWLRR INTERIMG', [PatientDFN, ADate1, direction, format]);
223     Result := RPCBrokerV.Results;
224   end;
225   
226   function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec: string; tests: TStrings): TStrings;  //*DFN*
227   begin
228     CallV('ORWLRR GRID', [PatientDFN, ADate1, ADate2, spec, tests]);
229     Result := RPCBrokerV.Results;
230   end;
231   
232   procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype, ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string);  //*DFN*
233   begin
234     if Length(ARpc) > 0 then
235       begin
236         CallV(ARpc, [PatientDFN, reportid, hstype, ADate, section, Adate2, Adate1]);
237         QuickCopy(RPCBrokerV.Results,Dest);
238       end
239     else
240       begin
241         Dest.Add('RPC is missing from report definition (file 101.24).');
242         Dest.Add('Please contact Technical Support.');
243       end;
244   end;
245   
246   procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
247     ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
248   begin
249     CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN,
250           reportid + ';1', hstype, ADate, section, Adate2, Adate1]);
251     QuickCopy(RPCBrokerV.Results,Dest);
252   end;
253   
254   procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype,
255     ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
256   begin
257     CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN,
258           reportid + ';1', hstype, ADate, section, Adate2, Adate1]);
259     QuickCopy(RPCBrokerV.Results,Dest);
260   end;
261   
262   procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string);  //*DFN*
263   begin
264     CallV('ORWLRR NEWOLD', [PatientDFN]);
265     newest := Piece(RPCBrokerV.Results[0], '^', 1);
266     oldest := Piece(RPCBrokerV.Results[0], '^', 2);
267   end;
268   
269   function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec, test: string): TStrings;  //*DFN*
270   begin
271     CallV('ORWLRR CHART', [PatientDFN, ADate1, ADate2, spec, test]);
272     Result := RPCBrokerV.Results;
273   end;
274   
275   procedure PrintLabsToDevice(AReport: string; ADaysBack: Integer;
276    const PatientDFN, ADevice: string; ATests: TStrings; var ErrMsg: string;
277    ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string);
278   { prints a report on the selected device }
279   var
280     j: integer;
281     RemoteHandle,Report: string;
282     aHandles: TStringlist;
283   begin
284     aHandles := TStringList.Create;
285     if Length(ARemoteSiteID) > 0 then
286       begin
287         RemoteHandle := '';
288         for j := 0 to RemoteReports.Count - 1 do
289           begin
290             Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
291             if Report = ARemoteQuery then
292               begin
293                 RemoteHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle
294                   + '^' + Pieces(Report,'^',9,10);
295                 break;
296               end;
297           end;
298         if Length(RemoteHandle) > 1 then
299           with RemoteSites.SiteList do
300               aHandles.Add(ARemoteSiteID + '^' + RemoteHandle);
301       end;
302     if aHandles.Count > 0 then
303       begin
304         ErrMsg := sCallV('ORWRP PRINT LAB REMOTE',[ADevice, PatientDFN, AReport, aHandles]);
305         if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
306       end
307     else
308       begin
309         ErrMsg := sCallV('ORWRP PRINT LAB REPORTS',[ADevice, PatientDFN, AReport,
310           ADaysBack, ATests, ADate2, ADate1]);
311         if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
312       end;
313     aHandles.Clear;
314     aHandles.Free;
315   end;
316   
317   function GetFormattedLabReport(AReport: String; ADaysBack: Integer;
318     const PatientDFN: string; ATests: TStrings; ADate1, ADate2: TFMDateTime;
319     ARemoteSiteID, ARemoteQuery: string): TStrings;
320   { prints a report on the selected Windows device }
321   var
322     j: integer;
323     RemoteHandle,Report: string;
324     aHandles: TStringlist;
325   begin
326     aHandles := TStringList.Create;
327     if Length(ARemoteSiteID) > 0 then
328       begin
329         RemoteHandle := '';
330         for j := 0 to RemoteReports.Count - 1 do
331           begin
332             Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
333             if Report = ARemoteQuery then
334               begin
335                 RemoteHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle
336                   + '^' + Pieces(Report,'^',9,10);
337                 break;
338               end;
339           end;
340         if Length(RemoteHandle) > 1 then
341           with RemoteSites.SiteList do
342               aHandles.Add(ARemoteSiteID + '^' + RemoteHandle);
343       end;
344     if aHandles.Count > 0 then
345       begin
346         CallV('ORWRP PRINT WINDOWS LAB REMOTE',[PatientDFN, AReport, aHandles]);
347         Result := RPCBrokerV.Results;
348       end
349     else
350       begin
351         CallV('ORWRP WINPRINT LAB REPORTS',[PatientDFN, AReport, ADaysBack, ATests,
352           ADate2, ADate1]);
353         Result := RPCBrokerV.Results;
354       end;
355     aHandles.Clear;
356     aHandles.Free;
357   end;
358   
359   function TestInfo(Test: String): TStrings;
360   begin
361     CallV('ORWLRR INFO',[Test]);
362     Result := RPCBrokerV.Results;
363   end;
364   
365   function LabPatchInstalled: boolean;
366   begin
367     with uLabPatchInstalled do
368       if not PatchChecked then
369         begin
370           PatchInstalled := ServerHasPatch(PSI_05_118);
371           PatchChecked := True;
372         end;
373     Result := uLabPatchInstalled.PatchInstalled;
374   end;
375   
376   end.

Module Calls (2 levels)


rLabs
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 └rMisc
   └fOrders

Module Called-By (2 levels)


                    rLabs
           fGraphOthers┤ 
              fGraphs┤ │ 
       fGraphProfiles┘ │ 
                  fLabs┤ 
               fFrame┤ │ 
             fLabTest┤ │ 
            fLabTests┤ │ 
       fLabTestGroups┤ │ 
            fLabPrint┤ │ 
fOptionsReportsCustom┘ │ 
            fLabTest...┤ 
           fLabTests...┤ 
      fLabTestGroups...┤ 
           fLabPrint...┤ 
               fLabInfo┘ 
            fFrame...┘