source: cprs/branches/foia-cprs/CPRS-Chart/rMeds.pas@ 1676

Last change on this file since 1676 was 460, checked in by Kevin Toppenberg, 16 years ago

Uploading from OR_30_258

File size: 6.5 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 //Action: Integer;
26 end;
27
28procedure ClearMedList(AList: TList);
29function DetailMedLM(ID: string): TStrings;
30function MedAdminHistory(OrderID: string): TStrings;
31function MedStatusGroup(const s: string): Integer;
32procedure LoadActiveMedLists(InPtMeds, OutPtMeds, NonVAMeds: TList);
33function GetNewDialog: string;
34function PickUpDefault: string;
35procedure Refill(AnOrderID, PickUpAt: string);
36function IsFirstDoseNowOrder(OrderID: string): boolean;
37function GetMedStatus(MedID: TStringList): boolean;
38
39implementation
40
41procedure ClearMedList(AList: TList);
42var
43 i: Integer;
44begin
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;
53end;
54
55function DetailMedLM(ID: string): TStrings;
56begin
57 CallV('ORWPS DETAIL', [Patient.DFN, UpperCase(ID)]);
58 Result := RPCBrokerV.Results;
59end;
60
61function MedAdminHistory(OrderID: string): TStrings;
62begin
63 CallV('ORWPS MEDHIST', [Patient.DFN, OrderID]);
64 Result := RPCBrokerV.Results;
65end;
66
67function MedStatusGroup(const s: string): Integer;
68const
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^';
73begin
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;
77end;
78
79procedure 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 }
82begin
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;
105end;
106
107function 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 }
109var
110 Status1, Status2: Integer;
111 loc1, loc2: string;
112 Med1, Med2: TMedListRec;
113begin
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;
129end;
130
131procedure LoadActiveMedLists(InPtMeds, OutPtMeds, NonVAMeds: TList);
132var
133 idx, ASeq: Integer;
134 x, y: string;
135 ClinMeds,tmpInPtMeds: TList;
136 AMed: TMedListRec;
137begin
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);
184end;
185
186function GetNewDialog: string;
187{ get dialog for new medications depending on patient being inpatient or outpatient }
188begin
189 Result := sCallV('ORWPS1 NEWDLG', [Patient.Inpatient]);
190end;
191
192function PickUpDefault: string;
193{ returns 'C', 'W', or 'M' for location to pickup refill }
194begin
195 Result := sCallV('ORWPS1 PICKUP', [nil]);
196end;
197
198procedure Refill(AnOrderID, PickUpAt: string);
199{ sends request for refill to pharmacy }
200begin
201 CallV('ORWPS1 REFILL', [AnOrderID, PickUpAt, Patient.DFN, Encounter.Provider, Encounter.Location]);
202end;
203
204function IsFirstDoseNowOrder(OrderID: string): boolean;
205begin
206 Result := SCallV('ORWDXR ISNOW',[OrderID])= '1';
207end;
208
209function GetMedStatus(MedID: TStringList): boolean;
210begin
211 Result := SCallV('ORWDX1 STCHANGE',[Patient.DFN, MedID])= '1';
212end;
213
214end.
Note: See TracBrowser for help on using the repository browser.