source: cprs/trunk/CPRS-Chart/Orders/rODLab.pas

Last change on this file was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28

File size: 10.7 KB
Line 
1unit rODLab;
2
3interface
4
5uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs ;
6
7 { Laboratory Ordering Calls }
8function ODForLab(Location: integer; Division: integer = 0): TStrings;
9procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;
10procedure LoadSamples(LoadList: TStringList) ;
11procedure LoadSpecimens(SpecimenList: TStringList) ;
12function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;
13function CalcStopDate(Text: string): string ;
14function MaxDays(Location, Schedule: integer): integer;
15function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;
16function ImmediateCollectTimes: TStrings;
17function LabCollectFutureDays(Location: integer; Division: integer = 0): integer;
18function GetDefaultImmCollTime: TFMDateTime;
19function ValidImmCollTime(CollTime: TFMDateTime): string;
20function GetOneCollSamp(LRFSAMP: integer): TStrings;
21function GetOneSpecimen(LRFSPEC: integer): string;
22procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
23function GetLastCollectionTime: string;
24procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
25procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string);
26procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer);
27procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
28procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
29function StatAllowed(PatientID: string): boolean;
30function RemoveCollTimeDefault: boolean;
31function GetDiagnosticPanelLocation: boolean;
32procedure GetBloodComponents(Dest: TStrings);
33procedure GetDiagnosticTests(Dest: TStrings);
34function NursAdminSuppress: boolean;
35function GetSubtype(TestName: string): string;
36function TNSDaysBack: integer;
37procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string);
38procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList);
39function GetLCtoWCInstructions(Alocation: integer): string;
40procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings);
41procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings);
42
43const
44 TX0 = 'The following Lab orders will be changed to Ward Collect:';
45 TX2 = 'Order Date' + #9 +#9 + 'Reason Changed to Ward Collect';
46 TX5 = 'Please contact the ward staff to insure the specimen is collected.';
47 TX6 = 'You can print this screen for reference.';
48 TX_BLANK = '';
49
50implementation
51
52uses rODBase;
53
54procedure GetBloodComponents(Dest: TStrings);
55begin
56 tCallV(Dest, 'ORWDXVB COMPORD', []);
57end;
58
59procedure GetDiagnosticTests(Dest: TStrings);
60begin
61 tCallV(Dest, 'ORWDXVB3 DIAGORD', []);
62end;
63
64function NursAdminSuppress: boolean;
65begin
66 Result := (StrToInt(sCallV('ORWDXVB NURSADMN',[nil])) < 1);
67end;
68
69function StatAllowed(PatientID: string): boolean;
70begin
71 Result := (StrToInt(sCallV('ORWDXVB STATALOW',[PatientID])) > 0);
72end;
73
74function RemoveCollTimeDefault: boolean;
75begin
76 Result := (StrToInt(sCallV('ORWDXVB3 COLLTIM',[nil])) > 0);
77end;
78
79function GetDiagnosticPanelLocation: boolean;
80begin
81 Result := (StrToInt(sCallV('ORWDXVB3 SWPANEL',[nil])) > 0);
82end;
83
84procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
85begin
86 tCallV(Dest, 'ORWDXVB RAW', [PatientID, ATests]);
87end;
88
89procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
90begin
91 tCallV(Dest, 'ORWDXVB RESULTS', [PatientID, ATests]);
92end;
93
94procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
95begin
96 tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]);
97end;
98
99function GetSubtype(TestName: string): string;
100begin
101 Result := sCallV('ORWDXVB SUBCHK', [TestName]);
102end;
103
104function TNSDaysBack: integer;
105begin
106 Result := StrToIntDef(sCallV('ORWDXVB VBTNS', [nil]),3);
107end;
108
109procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string);
110begin
111 CallV('ORWUL QV4DG', [DGrpNm]);
112 AListIEN := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 1), 0);
113 ACount := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0);
114end;
115
116procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer);
117var
118 i: Integer;
119begin
120 CallV('ORWUL QVSUB', [AListIEN,'','']);
121 for i := 0 to RPCBrokerV.Results.Count -1 do
122 Dest.Add(RPCBrokerV.Results[i]);
123end;
124
125function ODForLab(Location, Division: integer): TStrings;
126{ Returns init values for laboratory dialog. The results must be used immediately. }
127begin
128 CallV('ORWDLR32 DEF', [Location,Division]);
129 Result := RPCBrokerV.Results;
130end;
131
132procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;
133begin
134 tCallV(LoadData, 'ORWDLR32 LOAD', [LabTestIEN]);
135end ;
136
137procedure LoadSamples(LoadList: TStringList) ;
138begin
139 tCallV(LoadList, 'ORWDLR32 ALLSAMP', [nil]);
140end ;
141
142function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;
143begin
144 Callv('ORWDLR32 ALLSPEC',[StartFrom, Direction]);
145 Result := RPCBrokerV.Results;
146end ;
147
148procedure LoadSpecimens(SpecimenList: TStringList) ;
149begin
150 tCallV(SpecimenList, 'ORWDLR32 ABBSPEC', [nil]);
151end ;
152
153function CalcStopDate(Text: string): string ;
154begin
155 Result := sCallV('ORWDLR32 STOP', [Text]);
156end ;
157
158function MaxDays(Location, Schedule: integer): integer;
159begin
160 Result := StrToInt(sCallV('ORWDLR32 MAXDAYS',[Location, Schedule]));
161end;
162
163function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;
164begin
165 Result := (StrToInt(sCallV('ORWDLR32 LAB COLL TIME',[ADateTime,Location])) > 0);
166end;
167
168function LabCollectFutureDays(Location: integer; Division: integer): integer;
169begin
170 Result := StrToInt(sCallV('ORWDLR33 FUTURE LAB COLLECTS',[Location, Division]));
171end;
172
173function ImmediateCollectTimes: TStrings;
174begin
175 CallV('ORWDLR32 IMMED COLLECT',[nil]);
176 Result := RPCBrokerV.Results;
177end;
178
179function GetDefaultImmCollTime: TFMDateTime;
180begin
181 CallV('ORWDLR32 IC DEFAULT',[nil]);
182 Result := StrToFloat(Piece(RPCBrokerV.Results[0], U, 1));
183end;
184
185function ValidImmCollTime(CollTime: TFMDateTime): string;
186begin
187 CallV('ORWDLR32 IC VALID',[CollTime]);
188 Result := RPCBrokerV.Results[0];
189end;
190
191function GetOneCollSamp(LRFSAMP: integer): TStrings;
192begin
193 CallV('ORWDLR32 ONE SAMPLE', [LRFSAMP]);
194 Result := RPCBrokerV.Results;
195end;
196
197function GetOneSpecimen(LRFSPEC: integer): string;
198begin
199 Result := sCallV('ORWDLR32 ONE SPECIMEN', [LRFSPEC]);
200end;
201
202function GetLastCollectionTime: string;
203begin
204 Result := sCallV('ORWDLR33 LASTTIME', [nil]);
205end
206;
207procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
208var
209 Prefix: string;
210 i: integer;
211begin
212 CallV('ORWDLR32 GET LAB TIMES', [LabDate, Location]);
213 with Dest do
214 begin
215 Assign(RPCBrokerV.Results);
216 if (Count > 0) and (Piece(Strings[0], U, 1) <> '-1') then
217 for i := 0 to Count - 1 do
218 begin
219 if Strings[i] > '1159' then Prefix := 'PM Collection: ' else Prefix := 'AM Collection: ';
220 Strings[i] := Strings[i] + U + Prefix + Copy(Strings[i], 1, 2) + ':' + Copy(Strings[i], 3, 2);
221 end;
222 end;
223end;
224
225procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string);
226var
227 AList: TStringList;
228begin
229 AList := TStringList.Create;
230 try
231 CallV('ORCDLR2 CHECK ONE LC TO WC', [ALocation, '', AStartDate, ACollType, ASchedule, ADuration]);
232 FastAssign(RPCBrokerV.Results, AList);
233 FormatLCtoWCDisplayTextOnAccept(AList, Dest);
234 finally
235 AList.Free;
236 end;
237end;
238
239procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList);
240var
241 AList: TStringList;
242begin
243 AList := TStringList.Create;
244 try
245 CallV('ORCDLR2 CHECK ALL LC TO WC', [ALocation, OrderList]);
246 FastAssign(RPCBrokerV.Results, AList);
247 FormatLCtoWCDisplayTextOnRelease(AList, Dest);
248 finally
249 AList.Free;
250 end;
251end;
252
253procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings);
254var
255 i: integer;
256 x: string;
257begin
258 OutputList.Clear;
259 for i := InputList.Count - 1 downto 0 do
260 if Piece(InputList[i], U, 2) = '1' then InputList.Delete(i);
261 if InputList.Count > 0 then
262 begin
263 SetListFMDateTime('mmm dd, yyyy@hh:nn', TStringList(InputList), U, 1);
264 with OutputList do
265 begin
266 Add(TX0);
267 Add(TX_BLANK);
268 Add('Patient :' + #9 + Patient.Name);
269 Add('SSN :' + #9 + Patient.SSN);
270 Add('Location:' + #9 + Encounter.LocationName + CRLF);
271 for i := 0 to InputList.Count - 1 do
272 Add(Piece(InputList[i], U, 1) + #9 + Piece(InputList[i], U, 3));
273 Add(TX_BLANK);
274 x := GetLCtoWCInstructions(Encounter.Location);
275 if x = '' then x := TX5;
276 Add(x);
277 Add(TX6);
278 end;
279 end;
280end;
281
282procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings);
283var
284 i, j, k, Changed: integer;
285 AList: TStringlist;
286 x: string;
287begin
288 OutputList.Clear;
289 Changed := StrToIntDef(ExtractDefault(InputList, 'COUNT'), 0);
290 if Changed > 0 then
291 begin
292 AList := TStringList.Create;
293 try
294 with OutputList do
295 begin
296 Add(TX0);
297 Add(TX_BLANK);
298 Add('Patient :' + #9 + Patient.Name);
299 Add('SSN :' + #9 + Patient.SSN);
300 Add('Location:' + #9 + Encounter.LocationName);
301 for i := 1 to Changed do
302 begin
303 Add(TX_BLANK);
304 AList.Clear;
305 ExtractText(AList, InputList, 'ORDER_' + IntToStr(i));
306 Add('Order :' + #9 + AList[0]);
307 k := Length(OutputList[Count-1]);
308 if AList.Count > 1 then
309 for j := 1 to AList.Count - 1 do
310 begin
311 Add(StringOfChar(' ', 9) + #9 + AList[j]);
312 k := HigherOf(k, Length(OutputList[Count - 1]));
313 end;
314 Add(StringOfChar('-', k + 4));
315 AList.Clear;
316 ExtractItems(AList, InputList, 'ORDER_' + IntToStr(i));
317 SetListFMDateTime('mmm dd, yyyy@hh:nn', AList, U, 1);
318 for j := 0 to AList.Count - 1 do
319 OutputList.Add(Piece(AList[j], U, 1) + #9 + Piece(AList[j], U, 3));
320 end;
321 Add(TX_BLANK);
322 x := GetLCtoWCInstructions(Encounter.Location);
323 if x = '' then x := TX5;
324 Add(x);
325 Add(TX6);
326 end;
327 finally
328 AList.Free;
329 end;
330 end;
331end;
332
333function GetLCtoWCInstructions(Alocation: integer): string;
334begin
335 Result := sCallV('ORWDLR33 LC TO WC', [Encounter.Location]);
336end;
337
338end.
339
340
Note: See TracBrowser for help on using the repository browser.