source: cprs/trunk/CPRS-Chart/rCover.pas@ 801

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

Initial Upload of Official WV CPRS 1.0.26.76

File size: 13.5 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 if (Piece(Src[i], U, 5)='C') then // Clin Meds
159 begin
160 MarkForDelete := False; // always display non-VA meds
161 x := Src[i];
162 SetPiece(x, U, 2, 'Clin Meds ' + Piece(x, U, 2));
163 Src[i] := x;
164 end;
165 // clear non-active meds (SHOULD THIS INCLUDE PENDING ORDERS?)
166 if MedStatusGroup(Piece(Src[i], U, 4)) = MED_NONACTIVE then MarkForDelete := True;
167 if MarkForDelete then Src.Delete(i)
168 else if MedType = 'IO' then // for DOM patients only, distinguish between inpatient/outpatient meds
169 begin
170 x := Src[i];
171 SetPiece(x, U, 2, MED_TYPE[Piece(Piece(x, U, 1), ';', 2)='O'] + ' - ' + Piece(x, U, 2));
172 Src[i] := x;
173 end;
174 end;
175 InvertStringList(Src); // makes inverse chronological by order time
176 MixedCaseList(Src);
177 if Src.Count = 0 then Src.Add('0^No active medications found');
178 Dest.Assign(Src);
179end;
180
181procedure ListGeneric(Dest: TStrings; ARpc: String; ACase, AInvert: Boolean;
182 ADatePiece: integer; ADateFormat, AParam1, ADetail, AID: String);
183var
184 Param: array[0..1] of string;
185 i: integer;
186 s, x0, x2: string;
187 tmplist: TStringList;
188begin
189 Param[0] := Patient.DFN;
190 Param[1] := '';
191 if AID = '50' then
192 begin
193 if (InteractiveRemindersActive) then //special path for Reminders
194 CallV('ORQQPXRM REMINDERS APPLICABLE', [Patient.DFN, Encounter.Location])
195 else
196 begin
197 CallV('ORQQPX REMINDERS LIST', [Patient.DFN]);
198 SetListFMDateTime('mmm dd,yy', TStringList(RPCBrokerV.Results), U, 3, TRUE);
199 end;
200 Dest.Assign(RPCBrokerV.Results);
201 exit;
202 end;
203 tmplist := TStringList.Create;
204 try
205 tmplist.Clear;
206 if Length(AParam1) > 0 then
207 begin
208 Param[1] := AParam1;
209 CallV(ARpc, [Param[0], Param[1]]);
210 end
211 else
212 CallV(ARpc, [Param[0]]);
213 if AID = '40' then
214 ExtractActiveMeds(TStringList(tmplist), TStringList(RPCBrokerV.Results))
215 else
216 tmpList.Assign(RPCBrokerV.Results);
217 if ACase = TRUE then MixedCaseList(tmplist);
218 if AID = '10' then for i := 0 to tmplist.Count - 1 do // capitalize SC exposures for problems
219 begin
220 x0 := tmplist[i];
221 x2 := Piece(x0, U, 2);
222 if Pos('(', x2) > 0 then SetPiece(x2, '(', 2, UpperCase(Piece(x2, '(', 2)));
223 SetPiece(x0, U, 2, x2);
224 tmplist[i] := x0;
225 end;
226 if AInvert = TRUE then InvertStringList(TStringList(tmplist));
227 if ADatePiece > 0 then
228 begin
229 if ADateFormat = 'D' then
230 SetListFMDateTime('mmm dd,yyyy', TStringList(tmplist), U, ADatePiece, TRUE)
231 else
232 SetListFMDateTime('mmm dd,yyyy hh:nn', TStringList(tmplist), U, ADatePiece, TRUE);
233 end;
234 if Length(ADetail) > 0 then
235 begin
236 for i := 0 to tmplist.Count - 1 do
237 begin
238 s := tmplist[i];
239 SetPiece(s, U, 12, ADetail);
240 tmplist[i] := s
241 end;
242 end;
243 Dest.Assign(tmplist);
244 finally
245 tmplist.Free;
246 end;
247end;
248
249procedure ListActiveProblems(Dest: TStrings);
250{ lists active problems, format: IEN^ProblemText^ICD^onset^last modified^SC^SpExp }
251const
252 ACTIVE_PROBLEMS = 'A';
253var
254 i: integer;
255 x0, x2: string;
256begin
257 CallV('ORQQPL LIST', [Patient.DFN, ACTIVE_PROBLEMS]);
258 MixedCaseList(RPCBrokerV.Results);
259 Dest.Assign(RPCBrokerV.Results);
260 for i := 0 to Dest.Count - 1 do
261 begin
262 x0 := Dest[i];
263 x2 := Piece(x0, U, 2);
264 if Pos('(', x2) > 0 then SetPiece(x2, '(', 2, UpperCase(Piece(x2, '(', 2)));
265 SetPiece(x0, U, 2, x2);
266 Dest[i] := x0;
267 end;
268end;
269
270procedure ListAllergies(Dest: TStrings);
271{ lists allergies, format: }
272begin
273 CallV('ORQQAL LIST', [Patient.DFN]);
274 MixedCaseList(RPCBrokerV.Results);
275 Dest.Assign(RPCBrokerV.Results);
276end;
277
278procedure ListPostings(Dest: TStrings);
279begin
280 CallV('ORQQPP LIST', [Patient.DFN]);
281 with RPCBrokerV do
282 begin
283 MixedCaseList(Results);
284 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 3);
285 Dest.Assign(Results);
286 end;
287end;
288
289procedure ListReminders(Dest: TStrings);
290begin
291 with RPCBrokerV do
292 begin
293 if(InteractiveRemindersActive) then
294 CallV('ORQQPXRM REMINDERS APPLICABLE', [Patient.DFN, Encounter.Location])
295 else
296 begin
297 CallV('ORQQPX REMINDERS LIST', [Patient.DFN]);
298 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 3, TRUE);
299 end;
300// MixedCaseList(Results);
301 Dest.Assign(Results);
302 end;
303end;
304
305procedure ListActiveMeds(Dest: TStrings);
306begin
307 CallV('ORWPS COVER', [Patient.DFN]); // PharmID^DrugName^OrderID^StatusName
308 ExtractActiveMeds(Dest, TStringList(RPCBrokerV.Results));
309end;
310
311procedure ListRecentLabs(Dest: TStrings);
312begin
313 CallV('ORWCV LAB', [Patient.DFN]);
314 with RPCBrokerV do
315 begin
316 MixedCaseList(Results);
317 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 3);
318 Dest.Assign(Results);
319 end;
320end;
321
322procedure ListVitals(Dest: TStrings);
323begin
324 CallV('ORQQVI VITALS', [Patient.DFN]); // nulls are start/stop dates
325 with RPCBrokerV do
326 begin
327 SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 4);
328 if Results.Count = 0 then Results.Add('0^No vitals found');
329 Dest.Assign(Results);
330 end;
331end;
332
333procedure ListVisits(Dest: TStrings);
334begin
335 CallV('ORWCV VST', [Patient.DFN]);
336 with RPCBrokerV do
337 begin
338 InvertStringList(TStringList(Results));
339 MixedCaseList(Results);
340 SetListFMDateTime('mmm dd,yy hh:nn', TStringList(Results), U, 2);
341 Dest.Assign(Results);
342 end;
343end;
344
345procedure ListAllBackGround(var Done: Boolean; DestProb, DestCWAD, DestMeds, DestRmnd, DestLabs,
346 DestVitl, DestVsit: TStrings; const IPAddr: string; AHandle: HWND);
347var
348 tmplst: TStringList;
349
350 function SubListPresent(const AName: string): Boolean;
351 var
352 i: Integer;
353 begin
354 Result := False;
355 with RPCBrokerV do for i := 0 to Results.Count - 1 do
356 if Results[i] = AName then
357 begin
358 Result := True;
359 break;
360 end;
361 end;
362
363 procedure AssignList(DestList: TStrings; const SectionID: string);
364 var
365 i: integer;
366 x0, x2: string;
367 begin
368 tmplst.Clear;
369 ExtractItems(tmplst, RPCBrokerV.Results, SectionID);
370 if SectionID = 'VSIT' then InvertStringList(tmplst);
371 if(SectionID <> 'VITL') and (SectionID <> 'RMND') then MixedCaseList(tmplst);
372 if SectionID <> 'PROB' then
373 begin
374 if SectionID = 'VSIT' then SetListFMDateTime('mmm dd,yy hh:nn', tmplst, U, 2)
375 else if SectionID = 'VITL' then SetListFMDateTime('mmm dd,yy hh:nn', tmplst, U, 4)
376 else if (SectionID <> 'RMND') or (not InteractiveRemindersActive) then
377 SetListFMDateTime('mmm dd,yy', tmplst, U, 3, (SectionID = 'RMND'));
378 end
379 else for i := 0 to tmplst.Count - 1 do // capitalize SC exposures for problems
380 begin
381 x0 := tmplst[i];
382 x2 := Piece(x0, U, 2);
383 if Pos('(', x2) > 0 then SetPiece(x2, '(', 2, UpperCase(Piece(x2, '(', 2)));
384 SetPiece(x0, U, 2, x2);
385 tmplst[i] := x0;
386 end;
387 if tmplst.Count = 0 then
388 tmplst.Add(NoDataText(SectionID = 'RMND'));
389 DestList.Assign(tmplst);
390 end;
391
392begin
393 CallV('ORWCV POLL', [Patient.DFN, IPAddr, IntToHex(AHandle, 8)]);
394 with RPCBrokerV do
395 begin
396 tmplst := TStringList.Create;
397 try
398 Done := Results.Values['~Done'] = '1';
399 if SubListPresent('~PROB') then AssignList(DestProb, 'PROB');
400 if SubListPresent('~CWAD') then AssignList(DestCWAD, 'CWAD');
401 if SubListPresent('~MEDS') then
402 begin
403 tmplst.Clear;
404 ExtractItems(tmplst, Results, 'MEDS');
405 ExtractActiveMeds(DestMeds, tmplst);
406 end;
407 if SubListPresent('~RMND') then
408 AssignList(DestRmnd, 'RMND');
409 if SubListPresent('~LABS') then AssignList(DestLabs, 'LABS');
410 if SubListPresent('~VITL') then AssignList(DestVitl, 'VITL');
411 if SubListPresent('~VSIT') then AssignList(DestVsit, 'VSIT');
412 finally
413 tmplst.Free;
414 end;
415 end;
416end;
417
418function NoDataText(Reminders: boolean): string;
419begin
420 if(Reminders) then
421 Result := '0^No reminders due'
422 else
423 Result := '0^No data found';
424end;
425
426procedure LoadDemographics(Dest: TStrings);
427begin
428 CallV('ORWPT PTINQ', [Patient.DFN]);
429 Dest.Assign(RPCBrokerV.Results);
430end;
431
432function StartCoverSheet(const IPAddress: string; const AHandle: HWND;
433 const DontDo: string; const NewReminders: boolean): string;
434begin
435 Result := sCallV('ORWCV START', [Patient.DFN, IPAddress, IntToHex(AHandle, 8),
436 Encounter.Location, DontDo, NewReminders]);
437end;
438
439procedure StopCoverSheet(const ADFN, IPAddress: string; AHandle: HWND); //*DFN*
440begin
441 CallV('ORWCV STOP', [ADFN, IPAddress, IntToHex(AHandle, 8)]);
442end;
443
444end.
445
Note: See TracBrowser for help on using the repository browser.