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