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