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