source: cprs/branches/tmg-cprs/CPRS-Chart/rMeds.pas@ 1547

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

Initial upload of TMG-CPRS 1.0.26.69

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