Module

rCover

Path

C:\CPRS\CPRS30\rCover.pas

Last Modified

7/15/2014 3:26:44 PM

Units Used in Interface

Name Comments
fFrame -
uConst -

Units Used in Implementation

Name Comments
rCore -
rMeds -
uCore -
uReminders -

Classes

Name Comments
TCoverSheetList -

Procedures

Name Owner Declaration Scope Comments
Add TCoverSheetList procedure Add(APanel: TPanel; ALabel: TOROffsetLabel; AListBox: TORListBox); Public -
AssignList - procedure AssignList(DestList: TStrings; const SectionID: string); Local -
ExtractActiveMeds - procedure ExtractActiveMeds(Dest: TStrings; Src: TStringList); Global -
ListActiveMeds - procedure ListActiveMeds(Dest: TStrings); Interfaced -
ListActiveProblems - procedure ListActiveProblems(Dest: TStrings); Interfaced Lists active problems, format: IEN^ProblemText^ICD^onset^last modified^SC^SpExp
ListAllBackGround - procedure ListAllBackGround(var Done: Boolean; DestProb, DestCWAD, DestMeds, DestRmnd, DestLabs, DestVitl, DestVsit: TStrings; const IPAddr: string; AHandle: HWND); Interfaced -
ListAllergies - procedure ListAllergies(Dest: TStrings); Interfaced Lists allergies, format:
ListGeneric - procedure ListGeneric(Dest: TStrings; ARpc: String; ACase, AInvert: Boolean; ADatePiece: integer; ADateFormat, AParam1, ADetail, AID: String); Interfaced -
ListPostings - procedure ListPostings(Dest: TStrings); Interfaced -
ListRecentLabs - procedure ListRecentLabs(Dest: TStrings); Interfaced -
ListReminders - procedure ListReminders(Dest: TStrings); Interfaced -
ListVisits - procedure ListVisits(Dest: TStrings); Interfaced -
ListVitals - procedure ListVitals(Dest: TStrings); Interfaced -
LoadCoverSheetList - procedure LoadCoverSheetList(Dest: TStrings); Interfaced -
LoadDemographics - procedure LoadDemographics(Dest: TStrings); Interfaced -
StopCoverSheet - procedure StopCoverSheet(const ADFN, IPAddress: string; AHandle: HWND); Interfaced
DFN*
DFN*

Functions

Name Owner Declaration Scope Comments
CVlbl TCoverSheetList function CVlbl(index: integer): TOROffsetLabel; Public -
CVlst TCoverSheetList function CVlst(index: integer): TORListBox; Public -
CVpln TCoverSheetList function CVpln(index: integer): TPanel; Public -
DetailAllergy - function DetailAllergy(IEN: Integer): TStrings; Interfaced -
DetailGeneric - function DetailGeneric(IEN: integer; ID, aRPC: string): TStrings; Interfaced -
DetailMed - function DetailMed(ID: string): TStrings; Interfaced -
DetailPosting - function DetailPosting(ID: string): TStrings; Interfaced -
DetailProblem - function DetailProblem(IEN: Integer): TStrings; Interfaced -
NoDataText - function NoDataText(Reminders: boolean): string; Interfaced -
StartCoverSheet - function StartCoverSheet(const IPAddress: string; const AHandle: HWND; const DontDo: string; const NewReminders: boolean): string; Interfaced -
SubListPresent - function SubListPresent(const AName: string): Boolean; Local -


Module Source

1     unit rCover;
2     
3     interface
4     
5     uses SysUtils, Windows, Classes, ORNet, ORFn, uConst, extctrls, ORCtrls, fFrame;
6     
7     type
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    
22    function DetailGeneric(IEN: integer; ID, aRPC: string): TStrings;
23    function DetailProblem(IEN: Integer): TStrings;
24    function DetailAllergy(IEN: Integer): TStrings;
25    function DetailPosting(ID: string): TStrings;
26    function DetailMed(ID: string): TStrings;
27    procedure LoadCoverSheetList(Dest: TStrings);
28    procedure ListGeneric(Dest: TStrings; ARpc: String; ACase, AInvert: Boolean;
29      ADatePiece: integer; ADateFormat, AParam1, ADetail, AID: String);
30    procedure ListActiveProblems(Dest: TStrings);
31    procedure ListAllergies(Dest: TStrings);
32    procedure ListPostings(Dest: TStrings);
33    procedure ListReminders(Dest: TStrings);
34    procedure ListActiveMeds(Dest: TStrings);
35    procedure ListRecentLabs(Dest: TStrings);
36    procedure ListVitals(Dest: TStrings);
37    procedure ListVisits(Dest: TStrings);
38    procedure LoadDemographics(Dest: TStrings);
39    
40    function StartCoverSheet(const IPAddress: string; const AHandle: HWND;
41                             const DontDo: string; const NewReminders: boolean): string;
42    procedure StopCoverSheet(const ADFN, IPAddress: string; AHandle: HWND);  //*DFN*
43    procedure ListAllBackGround(var Done: Boolean; DestProb, DestCWAD, DestMeds, DestRmnd, DestLabs,
44      DestVitl, DestVsit: TStrings; const IPAddr: string; AHandle: HWND);
45    function NoDataText(Reminders: boolean): string;
46    
47    implementation
48    
49    uses rCore, uCore, rMeds, uReminders;
50    
51    procedure TCoverSheetList.Add(APanel: TPanel; ALabel: TOROffsetLabel; AListBox: TORListBox);
52    begin
53      FPanel.Add(APanel);
54      FLabel.Add(ALabel);
55      FListBox.Add(AListBox);
56    end;
57    
58    constructor TCoverSheetList.Create;
59    begin
60      FPanel := TList.Create;
61      FLabel := TList.Create;
62      FListBox := TList.Create;
63    end;
64    
65    destructor TCoverSheetList.Destroy;
66    begin
67      FPanel.Free;
68      FLabel.Free;
69      FListBox.Free;
70      inherited;
71    end;
72    
73    function TCoverSheetList.CVpln(index: integer): TPanel;
74    begin
75      Result := TPanel(FPanel[index]);
76    end;
77    
78    function TCoverSheetList.CVlbl(index: integer): TOROffsetLabel;
79    begin
80      Result := TOROffsetLabel(FLabel[index]);
81    end;
82    
83    function TCoverSheetList.CVlst(index: integer): TORListBox;
84    begin
85      Result := TORListBox(FListBox[index]);
86    end;
87    
88    function DetailGeneric(IEN: integer; ID, aRPC: string): TStrings;
89    begin
90      CallV(aRPC, [Patient.DFN, IEN, ID]);
91      Result := RPCBrokerV.Results;
92    end;
93    
94    function DetailProblem(IEN: Integer): TStrings;
95    begin
96      CallV('ORQQPL DETAIL', [Patient.DFN, IEN, '']);
97      Result := RPCBrokerV.Results;
98    end;
99    
100   function DetailAllergy(IEN: Integer): TStrings;
101   begin
102     CallV('ORQQAL DETAIL', [Patient.DFN, IEN, '']);
103     Result := RPCBrokerV.Results;
104   end;
105   
106   function DetailPosting(ID: string): TStrings;
107   begin
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;
112   end;
113   
114   function DetailMed(ID: string): TStrings;
115   begin
116     (*
117     CallV('ORQQPS DETAIL', [Patient.DFN, UpperCase(ID)]);
118     Result := RPCBrokerV.Results;
119     *)
120     Result := DetailMedLM(ID);  // from rMeds
121   end;
122   
123   procedure LoadCoverSheetList(Dest: TStrings);
124   begin
125     CallV('ORWCV1 COVERSHEET LIST', [nil]);
126     FastAssign(RPCBrokerV.Results, Dest);
127   end;
128   
129   procedure ExtractActiveMeds(Dest: TStrings; Src: TStringList);
130   const
131     MED_TYPE: array[boolean] of string = ('INPT', 'OUTPT');
132   var
133     i: Integer;
134     MedType, NonVA, x: string;
135     MarkForDelete: Boolean;
136   begin
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     FastAssign(Src, Dest);
179   end;
180   
181   procedure ListGeneric(Dest: TStrings; ARpc: String; ACase, AInvert: Boolean;
182     ADatePiece: integer; ADateFormat, AParam1, ADetail, AID: String);
183   var
184     Param: array[0..1] of string;
185     i: integer;
186     s, x0, x2: string;
187     tmplist: TStringList;
188   begin
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           FastAssign(RPCBrokerV.Results, Dest);
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         FastAssign(RPCBrokerV.Results, tmpList);
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       FastAssign(tmplist, Dest);
244     finally
245       tmplist.Free;
246     end;
247   end;
248   
249   procedure ListActiveProblems(Dest: TStrings);
250   { lists active problems, format: IEN^ProblemText^ICD^onset^last modified^SC^SpExp }
251   const
252     ACTIVE_PROBLEMS = 'A';
253   var
254     i: integer;
255     x0, x2: string;
256   begin
257     CallV('ORQQPL LIST', [Patient.DFN, ACTIVE_PROBLEMS]);
258     MixedCaseList(RPCBrokerV.Results);
259     FastAssign(RPCBrokerV.Results, Dest);
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;
268   end;
269   
270   procedure ListAllergies(Dest: TStrings);
271   { lists allergies, format: }
272   begin
273     CallV('ORQQAL LIST', [Patient.DFN]);
274     MixedCaseList(RPCBrokerV.Results);
275     FastAssign(RPCBrokerV.Results, Dest);
276   end;
277   
278   procedure ListPostings(Dest: TStrings);
279   begin
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       FastAssign(Results, Dest);
286     end;
287   end;
288   
289   procedure ListReminders(Dest: TStrings);
290   begin
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       FastAssign(Results, Dest);
302     end;
303   end;
304   
305   procedure ListActiveMeds(Dest: TStrings);
306   begin
307     CallV('ORWPS COVER', [Patient.DFN]);  // PharmID^DrugName^OrderID^StatusName
308     ExtractActiveMeds(Dest, TStringList(RPCBrokerV.Results));
309   end;
310   
311   procedure ListRecentLabs(Dest: TStrings);
312   begin
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       FastAssign(Results, Dest);
319     end;
320   end;
321   
322   procedure ListVitals(Dest: TStrings);
323   begin
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       FastAssign(Results, Dest);
330     end;
331   end;
332   
333   procedure ListVisits(Dest: TStrings);
334   begin
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       FastAssign(Results, Dest);
342     end;
343   end;
344   
345   procedure ListAllBackGround(var Done: Boolean; DestProb, DestCWAD, DestMeds, DestRmnd, DestLabs,
346     DestVitl, DestVsit: TStrings; const IPAddr: string; AHandle: HWND);
347   var
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       FastAssign(tmplst, DestList);
390     end;
391   
392   begin
393     if frmFrame.DLLActive = true then exit;  
394     CallV('ORWCV POLL', [Patient.DFN, IPAddr, IntToHex(AHandle, 8)]);
395     with RPCBrokerV do
396     begin
397       tmplst := TStringList.Create;
398       try
399         Done := Results.Values['~Done'] = '1';
400         if SubListPresent('~PROB') then AssignList(DestProb, 'PROB');
401         if SubListPresent('~CWAD') then AssignList(DestCWAD, 'CWAD');
402         if SubListPresent('~MEDS') then
403         begin
404           tmplst.Clear;
405           ExtractItems(tmplst, Results, 'MEDS');
406           ExtractActiveMeds(DestMeds, tmplst);
407         end;
408         if SubListPresent('~RMND') then
409           AssignList(DestRmnd, 'RMND');
410         if SubListPresent('~LABS') then AssignList(DestLabs, 'LABS');
411         if SubListPresent('~VITL') then AssignList(DestVitl, 'VITL');
412         if SubListPresent('~VSIT') then AssignList(DestVsit, 'VSIT');
413       finally
414         tmplst.Free;
415       end;
416     end;
417   end;
418   
419   function NoDataText(Reminders: boolean): string;
420   begin
421     if(Reminders) then
422       Result := '0^No reminders due'
423     else
424       Result := '0^No data found';
425   end;
426   
427   procedure LoadDemographics(Dest: TStrings);
428   begin
429     CallV('ORWPT PTINQ', [Patient.DFN]);
430     FastAssign(RPCBrokerV.Results, Dest);
431   end;
432   
433   function StartCoverSheet(const IPAddress: string; const AHandle: HWND;
434                            const DontDo: string; const NewReminders: boolean): string;
435   begin
436     Result := sCallV('ORWCV START', [Patient.DFN, IPAddress, IntToHex(AHandle, 8),
437                                      Encounter.Location, DontDo, NewReminders]);
438   end;
439   
440   procedure StopCoverSheet(const ADFN, IPAddress: string; AHandle: HWND);  //*DFN*
441   begin
442     CallV('ORWCV STOP', [ADFN, IPAddress, IntToHex(AHandle, 8)]);
443   end;
444   
445   end.

Module Calls (2 levels)


rCover
 ├uConst
 ├fFrame
 │ ├fPage
 │ ├uConst
 │ ├VERGENCECONTEXTORLib_TLB
 │ ├fBase508Form
 │ ├XuDsigS
 │ ├rCore
 │ ├fPtSelMsg
 │ ├fPtSel
 │ ├fCover
 │ ├fProbs
 │ ├fMeds
 │ ├fOrders
 │ ├rOrders
 │ ├fNotes
 │ ├fConsults
 │ ├fDCSumm
 │ ├rMisc
 │ ├fLabs
 │ ├fReports
 │ ├rReports
 │ ├fPtDemo
 │ ├fEncnt
 │ ├fPtCWAD
 │ ├uCore
 │ ├fAbout
 │ ├fReview
 │ ├fxBroker
 │ ├fxLists
 │ ├fxServer
 │ ├fRptBox
 │ ├rODAllergy
 │ ├uInit
 │ ├fLabInfo
 │ ├uReminders
 │ ├fReminderTree
 │ ├fDeviceSelect
 │ ├fDrawers
 │ ├fReminderDialog
 │ ├fOptions
 │ ├fGraphs
 │ ├fGraphData
 │ ├rTemplates
 │ ├fSurgery
 │ ├rSurgery
 │ ├uEventHooks
 │ ├uSignItems
 │ ├rECS
 │ ├fIconLegend
 │ ├uOrders
 │ ├uSpell
 │ ├uOrPtf
 │ ├fPatientFlagMulti
 │ ├fAlertForward
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOrdersSign
 │ ├uVitals
 │ ├fMHTest
 │ ├uFormMonitor
 │ ├fOtherSchedule
 │ ├uVA508CPRSCompatibility
 │ ├fIVRoutes
 │ ├fPrintLocation
 │ ├fTemplateEditor
 │ └fCombatVet
 ├uCore...
 ├rMeds
 │ ├uCore...
 │ └uConst
 └uReminders...

Module Called-By (2 levels)


             rCover
           fCover┤ 
         fFrame┤ │ 
      fARTAllgy┘ │ 
        fAllgyBox┤ 
      fCover...┘ │ 
     fARTAllgy...┤ 
           fProbs┤ 
      fFrame...┤ │ 
       fProbEdt┤ │ 
       fProbflt┤ │ 
       fProbLex┘ │ 
          fPtDemo┤ 
      fFrame...┘ │ 
          fPtCWAD┤ 
      fFrame...┤ │ 
       fODAllgy┘ │ 
fPatientFlagMulti┤ 
      fFrame...┤ │ 
      fCover...┘ │ 
         fODAllgy┘