source: cprs/trunk/CPRS-Chart/rMeds.pas@ 872

Last change on this file since 872 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 8.2 KB
Line 
1unit rMeds;
2
3{$O-}
4
5interface
6
7uses SysUtils, Classes, ORFn, ORNet, uCore, uConst;
8
9type
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
29procedure ClearMedList(AList: TList);
30function DetailMedLM(ID: string): TStrings;
31function MedAdminHistory(OrderID: string): TStrings;
32function MedStatusGroup(const s: string): Integer;
33procedure LoadActiveMedLists(InPtMeds, OutPtMeds, NonVAMeds: TList; var view: integer);
34function GetNewDialog: string;
35function PickUpDefault: string;
36procedure Refill(AnOrderID, PickUpAt: string);
37function IsFirstDoseNowOrder(OrderID: string): boolean;
38function GetMedStatus(MedID: TStringList): boolean;
39
40implementation
41
42procedure ClearMedList(AList: TList);
43var
44 i: Integer;
45begin
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;
54end;
55
56function DetailMedLM(ID: string): TStrings;
57begin
58 CallV('ORWPS DETAIL', [Patient.DFN, UpperCase(ID)]);
59 Result := RPCBrokerV.Results;
60end;
61
62function MedAdminHistory(OrderID: string): TStrings;
63begin
64 CallV('ORWPS MEDHIST', [Patient.DFN, OrderID]);
65 Result := RPCBrokerV.Results;
66end;
67
68function MedStatusGroup(const s: string): Integer;
69const
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^';
74begin
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;
78end;
79
80procedure 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 }
83begin
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;
106end;
107
108function 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 }
110var
111 Status1, Status2: Integer;
112 loc1, loc2: string;
113 Med1, Med2: TMedListRec;
114begin
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;
130end;
131
132function 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 }
134var
135 //Status1, Status2: Integer;
136 loc1, loc2: string;
137 Med1, Med2: TMedListRec;
138begin
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;
156end;
157
158procedure LoadActiveMedLists(InPtMeds, OutPtMeds, NonVAMeds: TList; var view: integer);
159var
160 idx, ASeq: Integer;
161 x, y: string;
162 ClinMeds, tmpInPtMeds: TList;
163 AMed: TMedListRec;
164begin
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);
219end;
220
221function GetNewDialog: string;
222{ get dialog for new medications depending on patient being inpatient or outpatient }
223begin
224 Result := sCallV('ORWPS1 NEWDLG', [Patient.Inpatient]);
225end;
226
227function PickUpDefault: string;
228{ returns 'C', 'W', or 'M' for location to pickup refill }
229begin
230 Result := sCallV('ORWPS1 PICKUP', [nil]);
231end;
232
233procedure Refill(AnOrderID, PickUpAt: string);
234{ sends request for refill to pharmacy }
235begin
236 CallV('ORWPS1 REFILL', [AnOrderID, PickUpAt, Patient.DFN, Encounter.Provider, Encounter.Location]);
237end;
238
239function IsFirstDoseNowOrder(OrderID: string): boolean;
240begin
241 Result := SCallV('ORWDXR ISNOW',[OrderID])= '1';
242end;
243
244function GetMedStatus(MedID: TStringList): boolean;
245begin
246 Result := SCallV('ORWDX1 STCHANGE',[Patient.DFN, MedID])= '1';
247end;
248
249end.
Note: See TracBrowser for help on using the repository browser.