| [613] | 1 | ORBCMA32 ; SLC/JLI - Pharmacy Calls for GUI Dialog 02/11/2008
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**133,243**;Dec 17, 1997;Build 242
|
|---|
| 3 | ;;BCMA ORDER V1.0 ;**133,243**;Jan 17, 2002
|
|---|
| 4 | ;
|
|---|
| 5 | NXT() ; -- returns next available index in return data array
|
|---|
| 6 | S ILST=ILST+1
|
|---|
| 7 | Q ILST
|
|---|
| 8 | ;
|
|---|
| 9 | DLGSLCT(LST,PSTYPE) ; return default lists for dialog
|
|---|
| 10 | ; PSTYPE: pharmacy type (U=unit dose, F=IV fluids, O=outpatient)
|
|---|
| 11 | N ILST S ILST=0
|
|---|
| 12 | I PSTYPE="F" D Q ; IV Fluids
|
|---|
| 13 | . S LST($$NXT)="~ShortList" D SHORT
|
|---|
| 14 | . S LST($$NXT)="~Priorities" D PRIOR
|
|---|
| 15 | ;
|
|---|
| 16 | S LST($$NXT)="~ShortList" D SHORT ; Unit Dose & Outpatient
|
|---|
| 17 | S LST($$NXT)="~Schedules" D SCHED
|
|---|
| 18 | S LST($$NXT)="~Priorities" D PRIOR
|
|---|
| 19 | I PSTYPE="O" D ; Outpatient
|
|---|
| 20 | . S LST($$NXT)="~Pickup" D PICKUP
|
|---|
| 21 | . S LST($$NXT)="~SCStatus" D SCLIST
|
|---|
| 22 | Q
|
|---|
| 23 | SHORT ; from DLGSLCT, get short list of med quick orders
|
|---|
| 24 | N I,X,TMP
|
|---|
| 25 | I PSTYPE="U" S X="UD RX"
|
|---|
| 26 | I PSTYPE="F" S X="IV RX"
|
|---|
| 27 | I PSTYPE="O" S X="O RX"
|
|---|
| 28 | D GETQLST^ORWDXQ(.TMP,X,"iQ")
|
|---|
| 29 | S I=0 F S I=$O(TMP(I)) Q:'I S LST($$NXT)=TMP(I)
|
|---|
| 30 | Q
|
|---|
| 31 | SCHED ; from DLGSLCT, get all pharmacy administration schedules
|
|---|
| 32 | N X
|
|---|
| 33 | K ^TMP($J,"ORBCMA32 SCHED")
|
|---|
| 34 | D AP^PSS51P1("PSJ",,,,"ORBCMA32 SCHED")
|
|---|
| 35 | S X="" F S X=$O(^TMP($J,"ORBCMA32 SCHED","APPSJ",X)) Q:X="" S LST($$NXT)="i"_X
|
|---|
| 36 | K ^TMP($J,"ORBCMA32 SCHED")
|
|---|
| 37 | Q
|
|---|
| 38 | SCHEDA ; (similar to SCHED, but also returns administration times)
|
|---|
| 39 | N X,IEN,SCH
|
|---|
| 40 | K ^TMP($J,"ORBCMA32 SCHEDA")
|
|---|
| 41 | D AP^PSS51P1("PSJ",,,,"ORBCMA32 SCHEDA")
|
|---|
| 42 | S SCH="" F S SCH=$O(^TMP($J,"ORBCMA32 SCHEDA","APPSJ",SCH)) Q:SCH="" D
|
|---|
| 43 | . S IEN=0 F S IEN=$O(^TMP($J,"ORBCMA32 SCHEDA","APPSJ",SCH,IEN)) Q:IEN'>0 D
|
|---|
| 44 | . . S X=$S($L(^TMP($J,"ORBCMA32 SCHEDA",IEN,2)):" ("_^TMP($J,"ORBCMA32 SCHEDA",IEN,2)_")",1:"")
|
|---|
| 45 | . . S LST($$NXT)="i"_IEN_U_SCH_X
|
|---|
| 46 | Q
|
|---|
| 47 | PRIOR ; from DLGSLCT, get list of allowed priorities
|
|---|
| 48 | N X,XREF
|
|---|
| 49 | S X=0
|
|---|
| 50 | S X=$O(^ORD(101.42,"B","DONE",X))
|
|---|
| 51 | S LST($$NXT)="i"_X_U_$P(^ORD(101.42,X,0),U,2)
|
|---|
| 52 | Q
|
|---|
| 53 | PICKUP ; from DLGSLCT, get prescription routing
|
|---|
| 54 | N X,EDITONLY
|
|---|
| 55 | F X="W^at Window","M^by Mail","C^in Clinic" S LST($$NXT)="i"_X
|
|---|
| 56 | S X=$$DEFPICK I $L(X) S LST($$NXT)="d"_X
|
|---|
| 57 | Q
|
|---|
| 58 | DEFPICK() ; return default routing
|
|---|
| 59 | N X,DLG,PRMT
|
|---|
| 60 | S DLG=$O(^ORD(101.41,"AB","PSO OERR",0)),X=""
|
|---|
| 61 | S PRMT=$O(^ORD(101.41,"AB","OR GTX ROUTING",0))
|
|---|
| 62 | I $D(^TMP("ORECALL",$J,+DLG,+PRMT,1)) S X=^(1)
|
|---|
| 63 | I X'="" S EDITONLY=1 Q X ; EDITONLY used by default action
|
|---|
| 64 | ;
|
|---|
| 65 | S X=$$GET^XPAR("ALL","ORWDPS ROUTING DEFAULT",1,"I")
|
|---|
| 66 | I X="C" S X="C^in Clinic" G XPICK
|
|---|
| 67 | I X="M" S X="M^by Mail" G XPICK
|
|---|
| 68 | I X="W" S X="W^at Window" G XPICK
|
|---|
| 69 | I X="N" S X="" G XPICK
|
|---|
| 70 | I X="" S X=$S($D(^PSX(550,"C")):"M^by Mail",1:"W^at Window")
|
|---|
| 71 | XPICK Q X
|
|---|
| 72 | ;
|
|---|
| 73 | SCLIST ; from DLGSLCT, get options for service connected
|
|---|
| 74 | F X="0^No","1^Yes" S LST($$NXT)="i"_X
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | OISLCT(LST,OI,PSTYPE,ORVP) ; return for defaults for pharmacy orderable item
|
|---|
| 78 | N ILST S ILST=0
|
|---|
| 79 | K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
|
|---|
| 80 | S LST($$NXT)="~Dispense" D DISPDRG
|
|---|
| 81 | S LST($$NXT)="~Instruct" D INSTRCT
|
|---|
| 82 | S LST($$NXT)="~Route" D ROUTE
|
|---|
| 83 | S LST($$NXT)="~Message" D MESSAGE
|
|---|
| 84 | I $L($G(^TMP("PSJSCH",$J))) S LST($$NXT)="~DefSched",LST($$NXT)="d"_^($J)
|
|---|
| 85 | K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | DISPDRUG(LST,OI) ; list dispense drugs for an orderable item
|
|---|
| 89 | N ILST,PSTYPE S ILST=0,PSTYPE="U" D DISPDRG
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | DISPDRG ; from OISLCT, get dispense drugs for this pharmacy orderable item
|
|---|
| 93 | N I,ORTMP,ORX
|
|---|
| 94 | S ORX=$T(ENDD^PSJORUTL),ORX=$L($P(ORX,";"),",")
|
|---|
| 95 | I ORX>3 D ENDD^PSJORUTL("^^^"_+$P($G(^ORD(101.43,OI,0)),"^",2),PSTYPE,.ORTMP,+ORVP)
|
|---|
| 96 | I ORX'>3 D ENDD^PSJORUTL("^^^"_+$P($G(^ORD(101.43,OI,0)),"^",2),PSTYPE,.ORTMP)
|
|---|
| 97 | S I="" F S I=$O(ORTMP(I)) Q:I="" D
|
|---|
| 98 | . I $P(ORTMP(I),U,4)="1" S $P(ORTMP(I),U,4)="NF"
|
|---|
| 99 | . S $P(ORTMP(I),U,3)="$"_$P(ORTMP(I),U,3)_" per "_$P(ORTMP(I),U,5)
|
|---|
| 100 | . S LST($$NXT)="i"_ORTMP(I)
|
|---|
| 101 | Q
|
|---|
| 102 | INSTRCT ; from OISLCT, get list of potential instructions (based on drug form)
|
|---|
| 103 | N INOUN,NOUN,IINS,INS,VERB,INSREC
|
|---|
| 104 | D START^PSSJORDF(+$P(^ORD(101.43,OI,0),U,2))
|
|---|
| 105 | I PSTYPE="U" Q ; don't use the instructions list for inpatients
|
|---|
| 106 | S IINS=0 F S IINS=$O(^TMP("PSJINS",$J,IINS)) Q:'IINS D
|
|---|
| 107 | . S INSREC=$G(^TMP("PSJINS",$J,IINS))
|
|---|
| 108 | . I '$D(VERB) S VERB=$P(INSREC,U)
|
|---|
| 109 | . I $L($P(INSREC,U,2)) S LST($$NXT)="i"_$P(INSREC,U,2)
|
|---|
| 110 | S LST($$NXT)="~Nouns"
|
|---|
| 111 | S INOUN=0 F S INOUN=$O(^TMP("PSJNOUN",$J,INOUN)) Q:'INOUN D
|
|---|
| 112 | . S LST($$NXT)="i"_$P(^TMP("PSJNOUN",$J,INOUN),U)
|
|---|
| 113 | I $D(VERB) S LST($$NXT)="~Verb",LST($$NXT)="d"_VERB
|
|---|
| 114 | ;
|
|---|
| 115 | Q
|
|---|
| 116 | MIXED(X) ; Return mixed case
|
|---|
| 117 | Q X ;$E(X)_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
|
|---|
| 118 | ;
|
|---|
| 119 | ROUTE ; from OISLCT, get list of routes for the drug form
|
|---|
| 120 | ; ** NEED BOTH ABBREVIATION & NAME IN LIST BOX
|
|---|
| 121 | N I,CNT,ABBR,IEN,ROUT,X
|
|---|
| 122 | S I="" F S I=$O(^TMP("PSJMR",$J,I)) Q:I="" D
|
|---|
| 123 | . S ROUT=$P(^TMP("PSJMR",$J,I),U),ABBR=$P(^(I),U,2),IEN=$P(^(I),U,3)
|
|---|
| 124 | . S LST($$NXT)="i"_IEN_U_ROUT_U_ABBR
|
|---|
| 125 | . I I=1,IEN S LST($$NXT)="d"_IEN_U_ROUT ;_U_ABBR ; assume first always default
|
|---|
| 126 | S I="" F S I=$O(^TMP("PSJMR",$J,I)) Q:I="" D
|
|---|
| 127 | . S ROUT=$P(^TMP("PSJMR",$J,I),U),ABBR=$P(^(I),U,2),IEN=$P(^(I),U,3)
|
|---|
| 128 | . I $L(ABBR),(ABBR'=ROUT) S LST($$NXT)="i"_IEN_U_ABBR_" ("_ROUT_")"_U_ABBR
|
|---|
| 129 | Q
|
|---|
| 130 | MESSAGE ; message
|
|---|
| 131 | S I=0 F S I=$O(^ORD(101.43,OI,8,I)) Q:I'>0 S LST($$NXT)="t"_^(I,0)
|
|---|
| 132 | Q
|
|---|
| 133 | ALLROUTE(LST) ; returns a list of all available med routes
|
|---|
| 134 | N I,X,ILST
|
|---|
| 135 | S ILST=0
|
|---|
| 136 | K ^TMP($J,"ORWDPS32 ALLROUTE")
|
|---|
| 137 | D ALL^PSS51P2(,"??",,,"ORWDPS32 ALLROUTE")
|
|---|
| 138 | S I=0 F S I=$O(^TMP($J,"ORWDPS32 ALLROUTE",I)) Q:'I D
|
|---|
| 139 | . I +$P(^TMP($J,"ORWDPS32 ALLROUTE",I,3),U)>0 S LST($$NXT)=I_U_^TMP($J,"ORWDPS32 ALLROUTE",I,.01)_U_^TMP($J,"ORWDPS32 ALLROUTE",I,1)
|
|---|
| 140 | Q
|
|---|
| 141 | VALROUTE(REC,X) ; validates route name & returns IEN + abbreviation
|
|---|
| 142 | N ABBR,NAME,IEN
|
|---|
| 143 | K ^TMP($J,"ORBCMA32 VALROUTE")
|
|---|
| 144 | S X=$$UPPER(X)
|
|---|
| 145 | D ALL^PSS51P2(,X,,1,"ORBCMA32 VALROUTE")
|
|---|
| 146 | I $P(^TMP($J,"ORBCMA32 VALROUTE",0),U)=-1 K ^TMP($J,"ORBCMA32 VALROUTE") S REC=0 Q
|
|---|
| 147 | S IEN=$O(^TMP($J,"ORBCMA32 VALROUTE","B",X,""))
|
|---|
| 148 | I IEN'>0 S IEN=$O(^TMP($J,"ORBCMA32 VALROUTE","C",X,""))
|
|---|
| 149 | I IEN'>0 S REC=0 Q
|
|---|
| 150 | S NAME=$G(^TMP($J,"ORBCMA32 VALROUTE",IEN,.01))
|
|---|
| 151 | S ABBR=$G(^TMP($J,"ORBCMA32 VALROUTE",IEN,1))
|
|---|
| 152 | I '$L(ABBR) S ABBR=NAME
|
|---|
| 153 | I ($$UPPER(NAME)'=X),($$UPPER(ABBR)'=X) S REC=0 K ^TMP($J,"ORBCMA32 VALROUTE") Q
|
|---|
| 154 | S REC=IEN_U_ABBR
|
|---|
| 155 | K ^TMP($J,"ORBCMA32 VALROUTE")
|
|---|
| 156 | Q
|
|---|
| 157 | AUTH(VAL,PRV) ; For inpatient meds, check restrictions
|
|---|
| 158 | N NAME,AUTH,INACT,X S VAL=0
|
|---|
| 159 | S NAME=$P($G(^VA(200,PRV,20)),U,2) S:'$L(NAME) NAME=$P(^(0),U)
|
|---|
| 160 | S X=$G(^VA(200,PRV,"PS")),AUTH=$P(X,U),INACT=$P(X,U,4)
|
|---|
| 161 | I 'AUTH!(INACT&(DT>INACT)) D Q
|
|---|
| 162 | . S VAL="1^"_NAME_" is not authorized to write medication orders."
|
|---|
| 163 | I $D(^XUSEC("OREMAS",DUZ)),'$$GET^XPAR("ALL","OR OREMAS MED ORDERS") D Q
|
|---|
| 164 | . S VAL="1^OREMAS key holders may not enter medication orders."
|
|---|
| 165 | Q
|
|---|
| 166 | DRUGMSG(VAL,IEN) ; return any message associated with a dispense drug
|
|---|
| 167 | N X S X=$$ENDCM^PSJORUTL(IEN)
|
|---|
| 168 | S VAL=$P(X,U,2)_U_$P(X,U,4)
|
|---|
| 169 | Q
|
|---|
| 170 | MEDISIV(VAL,IEN) ; return true if orderable item is IV medication
|
|---|
| 171 | S VAL=0
|
|---|
| 172 | I $P($G(^ORD(101.43,IEN,"PS")),U)=2 S VAL=1
|
|---|
| 173 | Q
|
|---|
| 174 | ISSPLY(VAL,IEN) ; return true if orderable item is a supply
|
|---|
| 175 | S VAL=0
|
|---|
| 176 | I $P($G(^ORD(101.43,IEN,"PS")),U,5)=1 S VAL=1
|
|---|
| 177 | Q
|
|---|
| 178 | IVAMT(VAL,OI,ORWTYP) ; return UNITS^AMOUNT |^AMOUNT^AMOUNT...| for IV soln
|
|---|
| 179 | N I,PSOI,ORWY,AMT,IVFLAG
|
|---|
| 180 | S IVFLAG=$P(OI,U,2)
|
|---|
| 181 | S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2)_ORWTYP,VAL=""
|
|---|
| 182 | I IVFLAG="NF" D ENVOL2^PSJORUT2(PSOI,.ORWY)
|
|---|
| 183 | I IVFLAG="" D ENVOL^PSJORUT2(PSOI,.ORWY)
|
|---|
| 184 | I ORWTYP="B" D
|
|---|
| 185 | . S I=0 F S I=$O(ORWY(I)) Q:I'>0 S AMT(+ORWY(I))=""
|
|---|
| 186 | . S AMT=0,VAL="ML" F S AMT=$O(AMT(AMT)) Q:AMT'>0 S VAL=VAL_U_AMT
|
|---|
| 187 | I ORWTYP="A" D
|
|---|
| 188 | . S I=+$O(ORWY(0)) S VAL=$P($G(ORWY(I)),U,2)
|
|---|
| 189 | . I '$L(VAL) S VAL="ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM^MMOL"
|
|---|
| 190 | Q
|
|---|
| 191 | VALRATE(VAL,X) ; return "1" (true) if IV rate text is valid
|
|---|
| 192 | I $E($RE($$UPPER(X)),1,5)="RH/LM" S X=$E(X,1,$L(X)-5)
|
|---|
| 193 | S X=$$TRIM(X)
|
|---|
| 194 | D ORINF^PSIVSP S VAL=$G(X) ;S OK=$S($D(X):1,1:0)
|
|---|
| 195 | Q
|
|---|
| 196 | UPPER(X) ; return uppercase
|
|---|
| 197 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 198 | ;
|
|---|
| 199 | TRIM(X) ; trim leading and trailing spaces
|
|---|
| 200 | S X=$RE(X) F S:$E(X)=" " X=$E(X,2,999) Q:$E(X)'=" " Q:'$L(X) ;trail
|
|---|
| 201 | S X=$RE(X) F S:$E(X)=" " X=$E(X,2,999) Q:$E(X)'=" " Q:'$L(X) ;lead
|
|---|
| 202 | Q X
|
|---|
| 203 | SCSTS(VAL,ORVP,ORDRUG) ; return service connected eligibility for patient
|
|---|
| 204 | N ORWP94 S ORWP94=$O(^ORD(101.41,"AB","PS MEDS",0))>0
|
|---|
| 205 | I $L($T(SC^PSOCP)),$$SC^PSOCP(+ORVP,+$G(ORDRUG)) S VAL=0 G XSCSTS
|
|---|
| 206 | I 'ORWP94,(+$$RXST^IBARXEU(+ORVP)>0) S VAL=0 G XSCSTS
|
|---|
| 207 | S VAL=1
|
|---|
| 208 | XSCSTS Q
|
|---|
| 209 | FORMALT(ORLST,IEN,PSTYPE) ; return a list of formulary alternatives
|
|---|
| 210 | D ENRFA^PSJORUTL(IEN,PSTYPE,.ORLST)
|
|---|
| 211 | S I=0 F S I=$O(ORLST(I)) Q:'I D
|
|---|
| 212 | . S OI=+$O(^ORD(101.43,"ID",+$P(ORLST(I),U,4)_";99PSP",0))
|
|---|
| 213 | . S $P(ORLST(I),U,4)=OI I OI S $P(ORLST(I),U,5)=$P(^ORD(101.43,OI,0),U)
|
|---|
| 214 | Q
|
|---|
| 215 | VALSCH(OK,X,PSTYPE) ; validate a schedule, return 1 if valid, 0 if not
|
|---|
| 216 | I '$L($T(EN^PSSGSGUI)) S OK=-1 Q
|
|---|
| 217 | I $E($T(EN^PSSGSGUI),1,4)="EN(X" D
|
|---|
| 218 | . N ORX S ORX=$G(X) D EN^PSSGSGUI(.ORX,$G(PSTYPE,"I"))
|
|---|
| 219 | . K X S:$D(ORX) X=ORX
|
|---|
| 220 | E D
|
|---|
| 221 | . D EN^PSSGSGUI
|
|---|
| 222 | S OK=$S($D(X):1,1:0)
|
|---|
| 223 | Q
|
|---|
| 224 | VALQTY(OK,X) ; validate a quantity, return 1 if valid, 0 if not
|
|---|
| 225 | ; to be compatible with LM, make sure X is integer from 1 to 240
|
|---|
| 226 | ; this is based on the input transform from 52,7
|
|---|
| 227 | K:(+X'>0)!(+X>99999999)!(X'?.8N.1".".2N)!($L(X)>12) X
|
|---|
| 228 | S OK=$S($D(X):1,1:0)
|
|---|
| 229 | Q
|
|---|
| 230 | DOSES(LST,OI) ; return doses for an orderable item - TEST ONLY
|
|---|
| 231 | N ORTMP,ORI,ORJ,ILST,NDF,VAPN,X,PSTYPE S PSTYPE="O"
|
|---|
| 232 | D ENDD^PSJORUTL("^^^"_+$P($G(^ORD(101.43,OI,0)),"^",2),PSTYPE,.ORTMP)
|
|---|
| 233 | S ORI=0 F S ORI=$O(ORTMP(ORI)) Q:'ORI S ORWDRG=+ORTMP(ORI) D
|
|---|
| 234 | . K ^TMP($J,"ORBCMA32 DRUG")
|
|---|
| 235 | . D NDF^PSS50(+ORWDRG,,,,,"ORBCMA32 DRUG")
|
|---|
| 236 | . S VAPN=$P($G(^TMP($J,"ORBCMA32 DRUG",+ORWDRG,22)),U),NDF=$P($G(^TMP($J,"ORBCMA32 DRUG",+ORWDRG,20)),U)
|
|---|
| 237 | . S X=$$DFSU^PSNAPIS(NDF,VAPN)
|
|---|
| 238 | . S LSTA($P(X,U,4),$P(X,U,6))=""
|
|---|
| 239 | . I +$P(X,U,4)=$P(X,U,4) S LSTA($P(X,U,4)*2,$P(X,U,6))=""
|
|---|
| 240 | K ^TMP($J,"ORBCMA32 DRUG")
|
|---|
| 241 | S ORI="",ILST=0 F S ORI=$O(LSTA(ORI)) Q:ORI="" D
|
|---|
| 242 | . S ORJ="" F S ORJ=$O(LSTA(ORI,ORJ)) Q:ORJ="" D
|
|---|
| 243 | . . S ILST=ILST+1,LST(ILST)=ORI_" "_ORJ
|
|---|
| 244 | Q
|
|---|
