source: cprs/branches/foia-cprs/CPRS-Chart/rCover.pas@ 459

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

Adding foia-cprs branch

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