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

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

Upgrade to version 27

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