Module

rMeds

Path

C:\CPRS\CPRS30\rMeds.pas

Last Modified

7/15/2014 3:26:44 PM

Units Used in Interface

Name Comments
uConst -
uCore -

Classes

Name Comments
TMedListRec -

Procedures

Name Owner Declaration Scope Comments
ClearMedList - procedure ClearMedList(AList: TList); Interfaced -
LoadActiveMedLists - procedure LoadActiveMedLists(InPtMeds, OutPtMeds, NonVAMeds: TList; var view: integer; var DateRange: string); Interfaced -
Refill - procedure Refill(AnOrderID, PickUpAt: string); Interfaced Sends request for refill to pharmacy
SetMedFields - procedure SetMedFields(AMed: TMedListRec; const x, y: string); Global -

Functions

Name Owner Declaration Scope Comments
ByStatusThenLocation - function ByStatusThenLocation(Item1, Item2: Pointer): Integer; Global -
ByStatusThenStop - function ByStatusThenStop(Item1, Item2: Pointer): Integer; Global -
DetailMedLM - function DetailMedLM(ID: string): TStrings; Interfaced -
GetMedStatus - function GetMedStatus(MedID: TStringList): boolean; Interfaced -
GetNewDialog - function GetNewDialog: string; Interfaced Get dialog for new medications depending on patient being inpatient or outpatient
IsFirstDoseNowOrder - function IsFirstDoseNowOrder(OrderID: string): boolean; Interfaced -
MedAdminHistory - function MedAdminHistory(OrderID: string): TStrings; Interfaced -
MedStatusGroup - function MedStatusGroup(const s: string): Integer; Interfaced -
PickUpDefault - function PickUpDefault: string; Interfaced Returns 'C', 'W', or 'M' for location to pickup refill


Module Source

1     unit rMeds;
2     
3     {$O-}
4     
5     interface
6     
7     uses SysUtils, Classes, ORFn, ORNet, uCore, uConst;
8     
9     type
10      TMedListRec = class
11      public
12        PharmID:   string;
13        OrderID:   string;
14        Instruct:  string;
15        StartDate: TFMDateTime;
16        StopDate:  TFMDateTime;
17        Status:    string;
18        Refills:   string;
19        Inpatient: Boolean;
20        NonVAMed:  Boolean;
21        IVFluid:   Boolean;
22        SrvSeq:    Integer;
23        LastFill:  TFMDateTime;
24        Location:   String;
25        Drug:      String;
26        //Action:    Integer;
27      end;
28    
29    procedure ClearMedList(AList: TList);
30    function DetailMedLM(ID: string): TStrings;
31    function MedAdminHistory(OrderID: string): TStrings;
32    function MedStatusGroup(const s: string): Integer;
33    procedure LoadActiveMedLists(InPtMeds, OutPtMeds, NonVAMeds: TList; var view: integer; var DateRange: string);
34    function GetNewDialog: string;
35    function PickUpDefault: string;
36    procedure Refill(AnOrderID, PickUpAt: string);
37    function IsFirstDoseNowOrder(OrderID: string): boolean;
38    function GetMedStatus(MedID: TStringList): boolean;
39    
40    implementation
41    
42    procedure ClearMedList(AList: TList);
43    var
44      i: Integer;
45    begin
46      if Assigned(AList) then with AList do
47      begin
48        for i := 0 to Count - 1 do
49          if Assigned(Items[i]) then TMedListRec(Items[i]).Free;
50        Clear;
51      end;
52      //with AList do for i := 0 to Count - 1 do with TMedListRec(Items[i]) do Free;
53      //AList.Clear;
54    end;
55    
56    function DetailMedLM(ID: string): TStrings;
57    begin
58      CallV('ORWPS DETAIL', [Patient.DFN, UpperCase(ID)]);
59      Result := RPCBrokerV.Results;
60    end;
61    
62    function MedAdminHistory(OrderID: string): TStrings;
63    begin
64      CallV('ORWPS MEDHIST', [Patient.DFN, OrderID]);
65      Result := RPCBrokerV.Results;
66    end;
67    
68    function MedStatusGroup(const s: string): Integer;
69    const
70      MG_ACTIVE  = '^ACTIVE^REFILL^HOLD^SUSPENDED^PROVIDER HOLD^ON CALL^';
71      MG_PENDING = '^NON-VERIFIED^DRUG INTERACTIONS^INCOMPLETE^PENDING^';
72      MG_NONACT  = '^DONE^EXPIRED^DISCONTINUED^DELETED^DISCONTINUED BY PROVIDER' +
73                   '^DISCONTINUED (EDIT)^REINSTATED^RENEWED^';
74    begin
75      Result := MED_ACTIVE;
76      if Pos(U+UpperCase(s)+U, MG_PENDING) > 0 then Result := MED_PENDING;
77      if Pos(U+UpperCase(s)+U, MG_NONACT)  > 0 then Result := MED_NONACTIVE;
78    end;
79    
80    procedure SetMedFields(AMed: TMedListRec; const x, y: string);
81    {          1     2      3     4       5     6       7       8        9      10     11
82    { Pieces: Typ^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID^Status^LastFill  }
83    begin
84      with AMed do
85      begin
86        PharmID   := Piece(x, U, 2);
87        OrderID   := Piece(x, U, 9);
88        Instruct  := TrimRight(y);
89        StopDate  := MakeFMDateTime(Piece(x, U, 5));
90        Status    := MixedCase(Piece(x, U, 10));
91        Refills   := Piece(x, U, 6);
92       if ( Piece(Piece(x, U, 2), ';', 2) = 'I' )
93           or (Piece(Piece(x, U, 2), ';', 2) = 'C') then
94             Inpatient := True
95         else
96           Inpatient := False;
97        NonVAMed  := Piece(x, U, 1) = '~NV';
98        if NonVAMed then
99            Instruct := 'Non-VA  ' + Instruct;
100       IVFluid   := Piece(x, U, 1) = '~IV';
101       SrvSeq    := 0;
102       LastFill  := MakeFMDateTime(Piece(x, U, 11));
103       Location  := Piece(Piece(x,U,1),':',2);
104       //LocationID := StrToIntDef(Piece(Piece(x,U,1),':',3),0);
105     end;
106   end;
107   
108   function ByStatusThenStop(Item1, Item2: Pointer): Integer;
109   { < 0 if Item1 is less and Item2, 0 if they are equal and > 0 if Item1 is greater than Item2 }
110   var
111     Status1, Status2: Integer;
112     loc1, loc2: string;
113     Med1, Med2: TMedListRec;
114   begin
115     Med1 := TMedListRec(Item1);
116     Med2 := TMedListRec(Item2);
117     loc1 := Med1.Location;
118     loc2 := Med2.Location;
119     Status1 := MedStatusGroup(Med1.Status);
120     Status2 := MedStatusGroup(Med2.Status);
121     if ( compareText(loc1,loc2)>0 ) then Result := -1
122     else if ( compareText(loc1,loc2)<0 ) then Result := 1
123     else if Status1 < Status2 then Result := -1
124     else if Status1 > Status2 then Result := 1
125     else if Med1.StopDate > Med2.StopDate then Result := -1
126     else if Med1.StopDate < Med2.StopDate then Result := 1
127     else if Med1.SrvSeq < Med2.SrvSeq then Result := -1
128     else if Med1.SrvSeq > Med2.SrvSeq then Result := 1
129     else Result := 0;
130   end;
131   
132   function ByStatusThenLocation(Item1, Item2: Pointer): Integer;
133   { < 0 if Item1 is less and Item2, 0 if they are equal and > 0 if Item1 is greater than Item2 }
134   var
135     //Status1, Status2: Integer;
136     loc1, loc2: string;
137     Med1, Med2: TMedListRec;
138   begin
139     Med1 := TMedListRec(Item1);
140     Med2 := TMedListRec(Item2);
141     loc1 := Med1.Location;
142     loc2 := Med2.Location;
143     //Status1 := MedStatusGroup(Med1.Status);
144     //Status2 := MedStatusGroup(Med2.Status);
145     if (compareText(Med1.Status,Med2.Status) >0) then Result := 1
146     else if (compareText(Med1.Status,Med2.Status) <0) then Result := -1
147     else if ( compareText(loc1,loc2)>0 ) then Result := -1
148     else if ( compareText(loc1,loc2)<0 ) then Result := 1
149     else if (compareText(Med1.Drug,Med2.Drug) >0) then Result := 1
150     else if (compareText(Med1.Drug,Med2.Drug) <0) then Result := -1
151     //else if Med1.StopDate > Med2.StopDate then Result := -1
152     //else if Med1.StopDate < Med2.StopDate then Result := 1
153     //else if Med1.SrvSeq < Med2.SrvSeq then Result := -1
154     //else if Med1.SrvSeq > Med2.SrvSeq then Result := 1
155     else Result := 0;
156   end;
157   
158   procedure LoadActiveMedLists(InPtMeds, OutPtMeds, NonVAMeds: TList; var view: integer; var DateRange: string);
159   var
160     idx, ASeq: Integer;
161     x, y: string;
162     ClinMeds, tmpInPtMeds: TList;
163     AMed: TMedListRec;
164   begin
165     //Check for CQ 9814 this should prevent an M error is DFn is not defined.
166     if patient=nil then exit;
167     if patient.DFN='' then exit;
168     ClinMeds := TList.Create;           //IMO new
169     tmpInPtMeds := TList.Create;        //IMO new
170     ClearMedList(InPtMeds);
171     ClearMedList(OutPtMeds);
172     ClearMedList(NonVAMeds);
173     CallV('ORWPS ACTIVE', [Patient.DFN, User.DUZ, view, '1']);
174     ASeq := 0;
175     if (view = 0) and (RPCBrokerV.Results.Count > 0) then
176       view := StrToIntDef(Piece(RPCBrokerV.Results.Strings[0], U, 1), 0);
177     DateRange := Piece(RPCBrokerV.Results.Strings[0], U, 2);
178     with RPCBrokerV do while Results.Count > 0 do
179     begin
180       x := Results[0];
181       Results.Delete(0);
182       if CharAt(x, 1) <> '~' then Continue;        // only happens if out of synch
183       y := '';
184       while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') do
185       begin
186         if CharAt(Results[0], 1) = '\' then y := y + CRLF;
187         y := y + Copy(Results[0], 2, Length(Results[0])) + ' ';
188         Results.Delete(0);
189       end;
190       AMed := TMedListRec.Create;
191       SetMedFields(AMed, x, y);
192       Inc(ASeq);
193       AMed.SrvSeq := ASeq;
194       if (AMed.Inpatient) then
195       begin
196         tmpInPtMeds.Add(AMed);
197         //if (Copy(x,2,2)='CP') then tmpInPtMeds.Add(AMed);
198        // if (Copy(x,2,2)='CP') and ((view = 2) or (view = 0)) then ClinMeds.Add(AMed)
199        // else tmpInPtMeds.Add(AMed);
200       end
201       else
202       if  AMed.NonVAMed then
203           NonVAMeds.Add(AMed)
204       else
205          OutPtMeds.Add(AMed);
206     end;
207    // 12-4 if view <> 1 then ClinMeds.Sort(ByStatusThenStop);
208    // 12-4 if view = 1 then tmpInPtMeds.Sort(ByStatusThenLocation)
209    // 12-4 else tmpInPtMeds.Sort(ByStatusThenStop);
210     //tmpInPtMeds.Sort(ByStatusThenStop);                           //IMO
211    //12-4 if view <> 1 then InPtMeds.Assign(ClinMeds);
212     for idx := 0 to tmpInPtMeds.Count - 1 do
213       InPtMeds.Add(TMedListRec(tmpInPtMeds.Items[idx]));
214     //if view <> 1 then OutPtMeds.Sort(ByStatusThenStop)
215     //else OutPtMeds.Sort(ByStatusThenLocation);
216    //12-4 if view <> 1 then NonVAMeds.Sort(ByStatusThenStop)
217    //12-4 else NonVAMeds.Sort(ByStatusThenLocation);
218     if Assigned(ClinMeds) then FreeAndNil(ClinMeds);
219     if Assigned(tmpInPtMeds) then FreeAndNil(tmpInPtMeds);
220   end;
221   
222   function GetNewDialog: string;
223   { get dialog for new medications depending on patient being inpatient or outpatient }
224   begin
225     Result := sCallV('ORWPS1 NEWDLG', [Patient.Inpatient]);
226   end;
227   
228   function PickUpDefault: string;
229   { returns 'C', 'W', or 'M' for location to pickup refill }
230   begin
231     Result := sCallV('ORWPS1 PICKUP', [nil]);
232   end;
233   
234   procedure Refill(AnOrderID, PickUpAt: string);
235   { sends request for refill to pharmacy }
236   begin
237     CallV('ORWPS1 REFILL', [AnOrderID, PickUpAt, Patient.DFN, Encounter.Provider, Encounter.Location]);
238   end;
239   
240   function IsFirstDoseNowOrder(OrderID: string): boolean;
241   begin
242     Result := SCallV('ORWDXR ISNOW',[OrderID])= '1';
243   end;
244   
245   function GetMedStatus(MedID: TStringList): boolean;
246   begin
247    Result := SCallV('ORWDX1 STCHANGE',[Patient.DFN, MedID])= '1';
248   end;
249   
250   end.

Module Calls (2 levels)


rMeds
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 └uConst

Module Called-By (2 levels)


                       rMeds
                   uOrders┤ 
                   uCore┤ │ 
                 fODBase┤ │ 
                 rODBase┤ │ 
                  fFrame┤ │ 
                 fOrders┤ │ 
             fOrdersSign┤ │ 
                   fMeds┤ │ 
               fARTAllgy┤ │ 
                  fNotes┤ │ 
               fConsults┤ │ 
         fReminderDialog┤ │ 
                 fReview┤ │ 
            fOrdersRenew┤ │ 
               fOrdersCV┤ │ 
                 fODMeds┤ │ 
                 fOMNavA┤ │ 
         fOrderSaveQuick┤ │ 
                  fOMSet┤ │ 
          fOrdersRelease┤ │ 
                 fOMHTML┤ │ 
               fODMedNVA┤ │ 
fODChangeUnreleasedRenew┤ │ 
          fOrdersOnChart┤ │ 
         fODReleaseEvent┤ │ 
               fODActive┘ │ 
                fOrders...┤ 
                    rCover┤ 
                  fCover┤ │ 
               fAllgyBox┤ │ 
            fARTAllgy...┤ │ 
                  fProbs┤ │ 
                 fPtDemo┤ │ 
                 fPtCWAD┤ │ 
       fPatientFlagMulti┤ │ 
                fODAllgy┘ │ 
                  fMeds...┤ 
       fActivateDeactivate┤ 
              fOrders...┤ │ 
                fMeds...┘ │ 
             fOrdersRefill┘ 
                fMeds...┘