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);
|
---|
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);
|
---|
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, True]);
|
---|
174 | ASeq := 0;
|
---|
175 | if (view = 0) and (RPCBrokerV.Results.Count > 0) then
|
---|
176 | view := StrToIntDef(RPCBrokerV.Results.Strings[0],0);
|
---|
177 | with RPCBrokerV do while Results.Count > 0 do
|
---|
178 | begin
|
---|
179 | x := Results[0];
|
---|
180 | Results.Delete(0);
|
---|
181 | if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
|
---|
182 | y := '';
|
---|
183 | while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') do
|
---|
184 | begin
|
---|
185 | if CharAt(Results[0], 1) = '\' then y := y + CRLF;
|
---|
186 | y := y + Copy(Results[0], 2, Length(Results[0])) + ' ';
|
---|
187 | Results.Delete(0);
|
---|
188 | end;
|
---|
189 | AMed := TMedListRec.Create;
|
---|
190 | SetMedFields(AMed, x, y);
|
---|
191 | Inc(ASeq);
|
---|
192 | AMed.SrvSeq := ASeq;
|
---|
193 | if (AMed.Inpatient) then
|
---|
194 | begin
|
---|
195 | tmpInPtMeds.Add(AMed);
|
---|
196 | //if (Copy(x,2,2)='CP') then tmpInPtMeds.Add(AMed);
|
---|
197 | // if (Copy(x,2,2)='CP') and ((view = 2) or (view = 0)) then ClinMeds.Add(AMed)
|
---|
198 | // else tmpInPtMeds.Add(AMed);
|
---|
199 | end
|
---|
200 | else
|
---|
201 | if AMed.NonVAMed then
|
---|
202 | NonVAMeds.Add(AMed)
|
---|
203 | else
|
---|
204 | OutPtMeds.Add(AMed);
|
---|
205 | end;
|
---|
206 | // 12-4 if view <> 1 then ClinMeds.Sort(ByStatusThenStop);
|
---|
207 | // 12-4 if view = 1 then tmpInPtMeds.Sort(ByStatusThenLocation)
|
---|
208 | // 12-4 else tmpInPtMeds.Sort(ByStatusThenStop);
|
---|
209 | //tmpInPtMeds.Sort(ByStatusThenStop); //IMO
|
---|
210 | //12-4 if view <> 1 then InPtMeds.Assign(ClinMeds);
|
---|
211 | for idx := 0 to tmpInPtMeds.Count - 1 do
|
---|
212 | InPtMeds.Add(TMedListRec(tmpInPtMeds.Items[idx]));
|
---|
213 | //if view <> 1 then OutPtMeds.Sort(ByStatusThenStop)
|
---|
214 | //else OutPtMeds.Sort(ByStatusThenLocation);
|
---|
215 | //12-4 if view <> 1 then NonVAMeds.Sort(ByStatusThenStop)
|
---|
216 | //12-4 else NonVAMeds.Sort(ByStatusThenLocation);
|
---|
217 | if Assigned(ClinMeds) then FreeAndNil(ClinMeds);
|
---|
218 | if Assigned(tmpInPtMeds) then FreeAndNil(tmpInPtMeds);
|
---|
219 | end;
|
---|
220 |
|
---|
221 | function GetNewDialog: string;
|
---|
222 | { get dialog for new medications depending on patient being inpatient or outpatient }
|
---|
223 | begin
|
---|
224 | Result := sCallV('ORWPS1 NEWDLG', [Patient.Inpatient]);
|
---|
225 | end;
|
---|
226 |
|
---|
227 | function PickUpDefault: string;
|
---|
228 | { returns 'C', 'W', or 'M' for location to pickup refill }
|
---|
229 | begin
|
---|
230 | Result := sCallV('ORWPS1 PICKUP', [nil]);
|
---|
231 | end;
|
---|
232 |
|
---|
233 | procedure Refill(AnOrderID, PickUpAt: string);
|
---|
234 | { sends request for refill to pharmacy }
|
---|
235 | begin
|
---|
236 | CallV('ORWPS1 REFILL', [AnOrderID, PickUpAt, Patient.DFN, Encounter.Provider, Encounter.Location]);
|
---|
237 | end;
|
---|
238 |
|
---|
239 | function IsFirstDoseNowOrder(OrderID: string): boolean;
|
---|
240 | begin
|
---|
241 | Result := SCallV('ORWDXR ISNOW',[OrderID])= '1';
|
---|
242 | end;
|
---|
243 |
|
---|
244 | function GetMedStatus(MedID: TStringList): boolean;
|
---|
245 | begin
|
---|
246 | Result := SCallV('ORWDX1 STCHANGE',[Patient.DFN, MedID])= '1';
|
---|
247 | end;
|
---|
248 |
|
---|
249 | end.
|
---|