source: cprs/branches/tmg-cprs/CPRS-Chart/rLabs.pas@ 834

Last change on this file since 834 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

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