source: cprs/branches/tmg-cprs/CPRS-Chart/rCover.pas@ 830

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

Fixed Text Object Parameters
File size: 14.4 KB
Line 
1//kt -- Modified with SourceScanner on 8/17/2007
2unit rCover;
3
4interface
5
6uses SysUtils, Windows, Classes, ORNet, ORFn, uConst, extctrls, ORCtrls;
7
8type
9 TCoverSheetList = class(TObject)
10 private
11 FPanel: TList;
12 FLabel: TList;
13 FListBox: TList;
14 public
15 constructor Create;
16 destructor Destroy; override;
17 procedure Add(APanel: TPanel; ALabel: TOROffsetLabel; AListBox: TORListBox);
18 function CVpln(index: integer): TPanel;
19 function CVlbl(index: integer): TOROffsetLabel;
20 function CVlst(index: integer): TORListBox;
21 end;
22
23function DetailGeneric(IEN: integer; ID, aRPC: string): TStrings;
24function DetailProblem(IEN: Integer): TStrings;
25function DetailAllergy(IEN: Integer): TStrings;
26function DetailPosting(ID: string): TStrings;
27function DetailMed(ID: string): TStrings;
28procedure LoadCoverSheetList(Dest: TStrings);
29procedure ListGeneric(Dest: TStrings; ARpc: String; ACase, AInvert: Boolean;
30 ADatePiece: integer; ADateFormat, AParam1, ADetail, AID: String);
31procedure ListActiveProblems(Dest: TStrings);
32procedure ListAllergies(Dest: TStrings);
33procedure ListPostings(Dest: TStrings);
34procedure ListReminders(Dest: TStrings);
35procedure ListActiveMeds(Dest: TStrings);
36procedure ListRecentLabs(Dest: TStrings);
37procedure ListVitals(Dest: TStrings);
38procedure ListVisits(Dest: TStrings);
39procedure LoadDemographics(Dest: TStrings);
40
41function StartCoverSheet(const IPAddress: string; const AHandle: HWND;
42 const DontDo: string; const NewReminders: boolean): string;
43procedure StopCoverSheet(const ADFN, IPAddress: string; AHandle: HWND); //*DFN*
44procedure ListAllBackGround(var Done: Boolean; DestProb, DestCWAD, DestMeds, DestRmnd, DestLabs,
45 DestVitl, DestVsit: TStrings; const IPAddr: string; AHandle: HWND);
46function NoDataText(Reminders: boolean): string;
47
48implementation
49
50uses rCore, uCore, rMeds, uReminders
51 ,DKLang //kt
52 ;
53
54procedure TCoverSheetList.Add(APanel: TPanel; ALabel: TOROffsetLabel; AListBox: TORListBox);
55begin
56 FPanel.Add(APanel);
57 FLabel.Add(ALabel);
58 FListBox.Add(AListBox);
59end;
60
61constructor TCoverSheetList.Create;
62begin
63 FPanel := TList.Create;
64 FLabel := TList.Create;
65 FListBox := TList.Create;
66end;
67
68destructor TCoverSheetList.Destroy;
69begin
70 FPanel.Free;
71 FLabel.Free;
72 FListBox.Free;
73 inherited;
74end;
75
76function TCoverSheetList.CVpln(index: integer): TPanel;
77begin
78 Result := TPanel(FPanel[index]);
79end;
80
81function TCoverSheetList.CVlbl(index: integer): TOROffsetLabel;
82begin
83 Result := TOROffsetLabel(FLabel[index]);
84end;
85
86function TCoverSheetList.CVlst(index: integer): TORListBox;
87begin
88 Result := TORListBox(FListBox[index]);
89end;
90
91function DetailGeneric(IEN: integer; ID, aRPC: string): TStrings;
92begin
93 CallV(aRPC, [Patient.DFN, IEN, ID]);
94 Result := RPCBrokerV.Results;
95end;
96
97function DetailProblem(IEN: Integer): TStrings;
98begin
99 CallV('ORQQPL DETAIL', [Patient.DFN, IEN, '']);
100 Result := RPCBrokerV.Results;
101end;
102
103function DetailAllergy(IEN: Integer): TStrings;
104begin
105 CallV('ORQQAL DETAIL', [Patient.DFN, IEN, '']);
106 Result := RPCBrokerV.Results;
107end;
108
109function DetailPosting(ID: string): TStrings;
110begin
111 if ID = 'A' then CallV('ORQQAL LIST REPORT', [Patient.DFN])
112 else if Length(ID) > 0 then CallV('TIU GET RECORD TEXT', [ID])
113 else RPCBrokerV.Results.Clear;
114 Result := RPCBrokerV.Results;
115end;
116
117function DetailMed(ID: string): TStrings;
118begin
119 (*
120 CallV('ORQQPS DETAIL', [Patient.DFN, UpperCase(ID)]);
121 Result := RPCBrokerV.Results;
122 *)
123 Result := DetailMedLM(ID); // from rMeds
124end;
125
126procedure LoadCoverSheetList(Dest: TStrings);
127begin
128 CallV('ORWCV1 COVERSHEET LIST', [nil]);
129 Dest.Assign(RPCBrokerV.Results);
130end;
131
132procedure ExtractActiveMeds(Dest: TStrings; Src: TStringList);
133const
134 MED_TYPE: array[boolean] of string = ('INPT', 'OUTPT');
135
136var
137 i: Integer;
138 MedType, NonVA, x: string;
139 MarkForDelete: Boolean;
140begin
141 NonVA := 'N;';
142 if Patient.Inpatient then
143 begin
144 if Patient.WardService = 'D' then MedType := 'IO' // Inpatient - DOM - show both
145 else MedType := 'I'; // Inpatient non-DOM
146 end
147 else
148 MedType := 'O'; // Outpatient
149 for i := Src.Count - 1 downto 0 do
150 begin
151 MarkForDelete := False;
152 // clear outpt meds if inpt, inpt meds if outpt. Keep all for DOM patients.
153 if (Pos(Piece(Piece(Src[i], U, 1), ';', 2), MedType) = 0)
154 and (Piece(Src[i], U, 5)<> 'C') then MarkForDelete := True;
155 if Pos(NonVA, Piece(Src[i], U, 1)) > 0 then // Non-VA Med
156 begin
157 MarkForDelete := False; // always display non-VA meds
158 x := Src[i];
159// SetPiece(x, U, 2, 'Non-VA ' + Piece(x, U, 2)); <-- original line. //kt 8/17/2007
160 SetPiece(x, U, 2, DKLangConstW('rCover_NonxVA') + Piece(x, U, 2)); //kt added 8/17/2007
161 Src[i] := x;
162 end;
163 if (Piece(Src[i], U, 5)='C') then // Clin Meds
164 begin
165 MarkForDelete := False; // always display non-VA meds
166 x := Src[i];
167// SetPiece(x, U, 2, 'Clin Meds ' + Piece(x, U, 2)); <-- original line. //kt 8/17/2007
168 SetPiece(x, U, 2, DKLangConstW('rCover_Clin_Meds') + Piece(x, U, 2)); //kt added 8/17/2007
169 Src[i] := x;
170 end;
171 // clear non-active meds (SHOULD THIS INCLUDE PENDING ORDERS?)
172 if MedStatusGroup(Piece(Src[i], U, 4)) = MED_NONACTIVE then MarkForDelete := True;
173 if MarkForDelete then Src.Delete(i)
174 else if MedType = 'IO' then // for DOM patients only, distinguish between inpatient/outpatient meds
175 begin
176 x := Src[i];
177 SetPiece(x, U, 2, MED_TYPE[Piece(Piece(x, U, 1), ';', 2)='O'] + ' - ' + Piece(x, U, 2));
178 Src[i] := x;
179 end;
180 end;
181 InvertStringList(Src); // makes inverse chronological by order time
182 MixedCaseList(Src);
183//if Src.Count = 0 then Src.Add('0^No active medications found'); <-- original line. //kt 8/17/2007
184 if Src.Count = 0 then Src.Add('0^'+DKLangConstW('rCover_No_active_medications_found')); //kt added 8/17/2007
185 Dest.Assign(Src);
186end;
187
188procedure ListGeneric(Dest: TStrings; ARpc: String; ACase, AInvert: Boolean;
189 ADatePiece: integer; ADateFormat, AParam1, ADetail, AID: String);
190var
191 Param: array[0..1] of string;
192 i: integer;
193 s, x0, x2: string;
194 tmplist: TStringList;
195begin
196 Param[0] := Patient.DFN;
197 Param[1] := '';
198 if AID = '50' then
199 begin
200 if (InteractiveRemindersActive) then //special path for Reminders
201 CallV('ORQQPXRM REMINDERS APPLICABLE', [Patient.DFN, Encounter.Location])
202 else
203 begin
204 CallV('ORQQPX REMINDERS LIST', [Patient.DFN]);
205 SetListFMDateTime('mmm dd,yy', TStringList(RPCBrokerV.Results), U, 3, TRUE);
206 end;
207 Dest.Assign(RPCBrokerV.Results);
208 exit;
209 end;
210 tmplist := TStringList.Create;
211 try
212 tmplist.Clear;
213 if Length(AParam1) > 0 then
214 begin
215 Param[1] := AParam1;
216 CallV(ARpc, [Param[0], Param[1]]);
217 end
218 else
219 CallV(ARpc, [Param[0]]);
220 if AID = '40' then
221 ExtractActiveMeds(TStringList(tmplist), TStringList(RPCBrokerV.Results))
222 else
223 tmpList.Assign(RPCBrokerV.Results);
224 if ACase = TRUE then MixedCaseList(tmplist);
225 if AID = '10' then for i := 0 to tmplist.Count - 1 do // capitalize SC exposures for problems
226 begin
227 x0 := tmplist[i];
228 x2 := Piece(x0, U, 2);
229 if Pos('(', x2) > 0 then SetPiece(x2, '(', 2, UpperCase(Piece(x2, '(', 2)));
230 SetPiece(x0, U, 2, x2);
231 tmplist[i] := x0;
232 end;
233 if AInvert = TRUE then InvertStringList(TStringList(tmplist));
234 if ADatePiece > 0 then
235 begin
236 if ADateFormat = 'D' then
237 SetListFMDateTime('mmm dd,yyyy', TStringList(tmplist), U, ADatePiece, TRUE)
238 else
239 SetListFMDateTime('mmm dd,yyyy hh:nn', TStringList(tmplist), U, ADatePiece, TRUE);
240 end;
241 if Length(ADetail) > 0 then
242 begin
243 for i := 0 to tmplist.Count - 1 do
244 begin
245 s := tmplist[i];
246 SetPiece(s, U, 12, ADetail);
247 tmplist[i] := s
248 end;
249 end;
250 Dest.Assign(tmplist);
251 finally
252 tmplist.Free;
253 end;
254end;
255
256procedure ListActiveProblems(Dest: TStrings);
257{ lists active problems, format: IEN^ProblemText^ICD^onset^last modified^SC^SpExp }
258const
259 ACTIVE_PROBLEMS = 'A';
260var
261 i: integer;
262 x0, x2: string;
263begin
264 CallV('ORQQPL LIST', [Patient.DFN, ACTIVE_PROBLEMS]);
265 MixedCaseList(RPCBrokerV.Results);
266 Dest.Assign(RPCBrokerV.Results);
267 for i := 0 to Dest.Count - 1 do
268 begin
269 x0 := Dest[i];
270 x2 := Piece(x0, U, 2);
271 if Pos('(', x2) > 0 then SetPiece(x2, '(', 2, UpperCase(Piece(x2, '(', 2)));
272 SetPiece(x0, U, 2, x2);
273 Dest[i] := x0;
274 end;
275end;
276
277procedure ListAllergies(Dest: TStrings);
278{ lists allergies, format: }
279begin
280 CallV('ORQQAL LIST', [Patient.DFN]);
281 MixedCaseList(RPCBrokerV.Results);
282 Dest.Assign(RPCBrokerV.Results);
283end;
284
285procedure ListPostings(Dest: TStrings);
286begin
287 CallV('ORQQPP LIST', [Patient.DFN]);
288 with RPCBrokerV do
289 begin
290 MixedCaseList(Results);
291 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 3);
292 Dest.Assign(Results);
293 end;
294end;
295
296procedure ListReminders(Dest: TStrings);
297begin
298 with RPCBrokerV do
299 begin
300 if(InteractiveRemindersActive) then
301 CallV('ORQQPXRM REMINDERS APPLICABLE', [Patient.DFN, Encounter.Location])
302 else
303 begin
304 CallV('ORQQPX REMINDERS LIST', [Patient.DFN]);
305 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 3, TRUE);
306 end;
307// MixedCaseList(Results);
308 Dest.Assign(Results);
309 end;
310end;
311
312procedure ListActiveMeds(Dest: TStrings);
313begin
314 CallV('ORWPS COVER', [Patient.DFN]); // PharmID^DrugName^OrderID^StatusName
315 ExtractActiveMeds(Dest, TStringList(RPCBrokerV.Results));
316end;
317
318procedure ListRecentLabs(Dest: TStrings);
319begin
320 CallV('ORWCV LAB', [Patient.DFN]);
321 with RPCBrokerV do
322 begin
323 MixedCaseList(Results);
324 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 3);
325 Dest.Assign(Results);
326 end;
327end;
328
329procedure ListVitals(Dest: TStrings);
330begin
331 CallV('ORQQVI VITALS', [Patient.DFN]); // nulls are start/stop dates
332 with RPCBrokerV do
333 begin
334 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 4);
335// if Results.Count = 0 then Results.Add('0^No vitals found'); <-- original line. //kt 8/17/2007
336 if Results.Count = 0 then Results.Add('0^'+DKLangConstW('rCover_No_vitals_found')); //kt added 8/17/2007
337 Dest.Assign(Results);
338 end;
339end;
340
341procedure ListVisits(Dest: TStrings);
342begin
343 CallV('ORWCV VST', [Patient.DFN]);
344 with RPCBrokerV do
345 begin
346 InvertStringList(TStringList(Results));
347 MixedCaseList(Results);
348 SetListFMDateTime('mmm dd,yy hh:nn', TStringList(Results), U, 2);
349 Dest.Assign(Results);
350 end;
351end;
352
353procedure ListAllBackGround(var Done: Boolean; DestProb, DestCWAD, DestMeds, DestRmnd, DestLabs,
354 DestVitl, DestVsit: TStrings; const IPAddr: string; AHandle: HWND);
355var
356 tmplst: TStringList;
357
358 function SubListPresent(const AName: string): Boolean;
359 var
360 i: Integer;
361 begin
362 Result := False;
363 with RPCBrokerV do for i := 0 to Results.Count - 1 do
364 if Results[i] = AName then
365 begin
366 Result := True;
367 break;
368 end;
369 end;
370
371 procedure AssignList(DestList: TStrings; const SectionID: string);
372 var
373 i: integer;
374 x0, x2: string;
375 begin
376 tmplst.Clear;
377 ExtractItems(tmplst, RPCBrokerV.Results, SectionID);
378 if SectionID = 'VSIT' then InvertStringList(tmplst);
379 if(SectionID <> 'VITL') and (SectionID <> 'RMND') then MixedCaseList(tmplst);
380 if SectionID <> 'PROB' then
381 begin
382 if SectionID = 'VSIT' then SetListFMDateTime('mmm dd,yy hh:nn', tmplst, U, 2)
383 else if SectionID = 'VITL' then SetListFMDateTime('mmm dd,yy hh:nn', tmplst, U, 4)
384 else if (SectionID <> 'RMND') or (not InteractiveRemindersActive) then
385 SetListFMDateTime('mmm dd,yy', tmplst, U, 3, (SectionID = 'RMND'));
386 end
387 else for i := 0 to tmplst.Count - 1 do // capitalize SC exposures for problems
388 begin
389 x0 := tmplst[i];
390 x2 := Piece(x0, U, 2);
391 if Pos('(', x2) > 0 then SetPiece(x2, '(', 2, UpperCase(Piece(x2, '(', 2)));
392 SetPiece(x0, U, 2, x2);
393 tmplst[i] := x0;
394 end;
395 if tmplst.Count = 0 then
396 tmplst.Add(NoDataText(SectionID = 'RMND'));
397 DestList.Assign(tmplst);
398 end;
399
400begin
401 CallV('ORWCV POLL', [Patient.DFN, IPAddr, IntToHex(AHandle, 8)]);
402 with RPCBrokerV do
403 begin
404 tmplst := TStringList.Create;
405 try
406 Done := Results.Values['~Done'] = '1'; //kt restored original line 4/15/10
407// Done := Results.Values[DKLangConstW('rCover_xDone')] = '1'; //kt added 8/17/2007
408 if SubListPresent('~PROB') then AssignList(DestProb, 'PROB');
409 if SubListPresent('~CWAD') then AssignList(DestCWAD, 'CWAD');
410 if SubListPresent('~MEDS') then
411 begin
412 tmplst.Clear;
413 ExtractItems(tmplst, Results, 'MEDS');
414 ExtractActiveMeds(DestMeds, tmplst);
415 end;
416 if SubListPresent('~RMND') then
417 AssignList(DestRmnd, 'RMND');
418 if SubListPresent('~LABS') then AssignList(DestLabs, 'LABS');
419 if SubListPresent('~VITL') then AssignList(DestVitl, 'VITL');
420 if SubListPresent('~VSIT') then AssignList(DestVsit, 'VSIT');
421 finally
422 tmplst.Free;
423 end;
424 end;
425end;
426
427function NoDataText(Reminders: boolean): string;
428begin
429 if(Reminders) then
430// Result := '0^No reminders due' <-- original line. //kt 8/17/2007
431 Result := '0^'+DKLangConstW('rCover_No_reminders_due') //kt added 8/17/2007
432 else
433// Result := 'No data found'; <-- original line. //kt 8/17/2007
434 Result := DKLangConstW('rCover_No_data_found'); //kt added 8/17/2007
435end;
436
437procedure LoadDemographics(Dest: TStrings);
438begin
439 CallV('ORWPT PTINQ', [Patient.DFN]);
440 Dest.Assign(RPCBrokerV.Results);
441end;
442
443function StartCoverSheet(const IPAddress: string; const AHandle: HWND;
444 const DontDo: string; const NewReminders: boolean): string;
445begin
446 Result := sCallV('ORWCV START', [Patient.DFN, IPAddress, IntToHex(AHandle, 8),
447 Encounter.Location, DontDo, NewReminders]);
448end;
449
450procedure StopCoverSheet(const ADFN, IPAddress: string; AHandle: HWND); //*DFN*
451begin
452 CallV('ORWCV STOP', [ADFN, IPAddress, IntToHex(AHandle, 8)]);
453end;
454
455end.
456
Note: See TracBrowser for help on using the repository browser.