source: cprs/trunk/CPRS-Chart/rLabs.pas@ 1800

Last change on this file since 1800 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 13.1 KB
Line 
1unit rLabs;
2
3interface
4
5uses SysUtils, Classes, ORNet, ORFn;
6
7type
8
9 TLabPatchInstalled = record
10 PatchInstalled: boolean;
11 PatchChecked: boolean;
12 end;
13
14
15function AtomicTests(const StartFrom: string; Direction: Integer): TStrings;
16function Specimens(const StartFrom: string; Direction: Integer): TStrings;
17function AllTests(const StartFrom: string; Direction: Integer): TStrings;
18function ChemTest(const StartFrom: string; Direction: Integer): TStrings;
19function Users(const StartFrom: string; Direction: Integer): TStrings;
20function TestGroups(user: int64): TStrings;
21function ATest(test: integer): TStrings;
22function ATestGroup(testgroup: Integer; user: int64): TStrings;
23procedure UTGAdd(tests: TStrings);
24procedure UTGReplace(tests: TStrings; testgroup: integer);
25procedure UTGDelete(testgroup: integer);
26procedure SpecimenDefaults(var blood, urine, serum, plasma: string);
27procedure Cumulative(Dest: TStrings; const PatientDFN: string;
28 daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string);
29procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string;
30 daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String);
31procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
32procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1,
33 ADate2: TFMDateTime; ASite, ARemoteRPC: String);
34procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1,
35 ADate2: TFMDateTime; ARpc: string); //*DFN*
36procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1,
37 ADate2: TFMDateTime; ASite, ARemoteRPC: String);
38function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
39 tests: TStrings): TStrings; //*DFN*
40function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime;
41 direction, format: integer): TStrings; //*DFN*
42function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
43 spec: string; tests: TStrings): TStrings; //*DFN*
44procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
45 ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string); //*DFN*
46procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
47 ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
48procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype,
49 ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
50procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string); //*DFN*
51function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
52 spec, test: string): TStrings; //*DFN*
53procedure PrintLabsToDevice(AReport: string; ADaysBack: Integer;
54 const PatientDFN, ADevice: string; ATests: TStrings;
55 var ErrMsg: string; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string);
56function GetFormattedLabReport(AReport: string; ADaysBack: Integer; const PatientDFN: string;
57 ATests: TStrings; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string): TStrings;
58function TestInfo(Test: String): TStrings;
59function LabPatchInstalled: boolean;
60
61
62implementation
63
64uses rCore, uCore, graphics, rMisc;
65
66const
67 PSI_05_118 = 'LR*5.2*364';
68var
69 uLabPatchInstalled: TLabPatchInstalled;
70
71function AtomicTests(const StartFrom: string; Direction: Integer): TStrings;
72begin
73 CallV('ORWLRR ATOMICS', [StartFrom, Direction]);
74 MixedCaseList(RPCBrokerV.Results);
75 Result := RPCBrokerV.Results;
76end;
77
78function Specimens(const StartFrom: string; Direction: Integer): TStrings;
79begin
80 CallV('ORWLRR SPEC', [StartFrom, Direction]);
81 MixedCaseList(RPCBrokerV.Results);
82 Result := RPCBrokerV.Results;
83end;
84
85function AllTests(const StartFrom: string; Direction: Integer): TStrings;
86begin
87 CallV('ORWLRR ALLTESTS', [StartFrom, Direction]);
88 MixedCaseList(RPCBrokerV.Results);
89 Result := RPCBrokerV.Results;
90end;
91
92function ChemTest(const StartFrom: string; Direction: Integer): TStrings;
93begin
94 CallV('ORWLRR CHEMTEST', [StartFrom, Direction]);
95 MixedCaseList(RPCBrokerV.Results);
96 Result := RPCBrokerV.Results;
97end;
98
99function Users(const StartFrom: string; Direction: Integer): TStrings;
100begin
101 CallV('ORWLRR USERS', [StartFrom, Direction]);
102 MixedCaseList(RPCBrokerV.Results);
103 Result := RPCBrokerV.Results;
104end;
105
106function TestGroups(user: int64): TStrings;
107begin
108 CallV('ORWLRR TG', [user]);
109 MixedCaseList(RPCBrokerV.Results);
110 Result := RPCBrokerV.Results;
111end;
112
113function ATest(test: integer): TStrings;
114begin
115 CallV('ORWLRR ATESTS', [test]);
116 MixedCaseList(RPCBrokerV.Results);
117 Result := RPCBrokerV.Results;
118end;
119
120function ATestGroup(testgroup: Integer; user: int64): TStrings;
121begin
122 CallV('ORWLRR ATG', [testgroup, user]);
123 MixedCaseList(RPCBrokerV.Results);
124 Result := RPCBrokerV.Results;
125end;
126
127procedure UTGAdd(tests: TStrings);
128begin
129 CallV('ORWLRR UTGA', [tests]);
130end;
131
132procedure UTGReplace(tests: TStrings; testgroup: integer);
133begin
134 CallV('ORWLRR UTGR', [tests, testgroup]);
135end;
136
137procedure UTGDelete(testgroup: integer);
138begin
139 CallV('ORWLRR UTGD', [testgroup]);
140end;
141
142procedure SpecimenDefaults(var blood, urine, serum, plasma: string);
143begin
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);
149end;
150
151procedure Cumulative(Dest: TStrings; const PatientDFN: string; daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
152begin
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;
163end;
164
165procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string;
166 daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String);
167begin
168 CallV('XWB REMOTE RPC', [ASite, ARemoteRPC, 0, PatientDFN, daysback, Adate1, Adate2]);
169 QuickCopy(RPCBrokerV.Results,Dest);
170end;
171
172procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
173begin
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;
184end;
185
186procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1,
187 ADate2: TFMDateTime; ASite, ARemoteRPC: String);
188begin
189 CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN, Adate1, Adate2]);
190 QuickCopy(RPCBrokerV.Results,Dest);
191end;
192
193procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
194begin
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;
205end;
206
207procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1,
208 ADate2: TFMDateTime; ASite, ARemoteRPC: String);
209begin
210 CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN, Adate1, Adate2]);
211 QuickCopy(RPCBrokerV.Results,Dest);
212end;
213
214function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime; tests: TStrings): TStrings; //*DFN*
215begin
216 CallV('ORWLRR INTERIMS', [PatientDFN, ADate1, ADate2, tests]);
217 Result := RPCBrokerV.Results;
218end;
219
220function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime; direction, format: integer): TStrings; //*DFN*
221begin
222 CallV('ORWLRR INTERIMG', [PatientDFN, ADate1, direction, format]);
223 Result := RPCBrokerV.Results;
224end;
225
226function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec: string; tests: TStrings): TStrings; //*DFN*
227begin
228 CallV('ORWLRR GRID', [PatientDFN, ADate1, ADate2, spec, tests]);
229 Result := RPCBrokerV.Results;
230end;
231
232procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype, ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string); //*DFN*
233begin
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;
244end;
245
246procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
247 ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
248begin
249 CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN,
250 reportid + ';1', hstype, ADate, section, Adate2, Adate1]);
251 QuickCopy(RPCBrokerV.Results,Dest);
252end;
253
254procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype,
255 ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
256begin
257 CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN,
258 reportid + ';1', hstype, ADate, section, Adate2, Adate1]);
259 QuickCopy(RPCBrokerV.Results,Dest);
260end;
261
262procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string); //*DFN*
263begin
264 CallV('ORWLRR NEWOLD', [PatientDFN]);
265 newest := Piece(RPCBrokerV.Results[0], '^', 1);
266 oldest := Piece(RPCBrokerV.Results[0], '^', 2);
267end;
268
269function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec, test: string): TStrings; //*DFN*
270begin
271 CallV('ORWLRR CHART', [PatientDFN, ADate1, ADate2, spec, test]);
272 Result := RPCBrokerV.Results;
273end;
274
275procedure 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 }
279var
280 j: integer;
281 RemoteHandle,Report: string;
282 aHandles: TStringlist;
283begin
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;
315end;
316
317function 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 }
321var
322 j: integer;
323 RemoteHandle,Report: string;
324 aHandles: TStringlist;
325begin
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;
357end;
358
359function TestInfo(Test: String): TStrings;
360begin
361 CallV('ORWLRR INFO',[Test]);
362 Result := RPCBrokerV.Results;
363end;
364
365function LabPatchInstalled: boolean;
366begin
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;
374end;
375
376end.
Note: See TracBrowser for help on using the repository browser.