| 1 | ORCDPSIV ;SLC/MKB-Pharmacy IV dialog utilities ;5/07/08
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,38,48,158,195,243**;Dec 17, 1997;Build 242
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | CKSCH ; -- validate schedule [Called from P-S Action]
|
|---|
| 5 | N ORX S ORX=ORDIALOG(PROMPT,ORI) Q:ORX=$G(ORESET) K ORSD
|
|---|
| 6 | D EN^PSSGS0(.ORX,"I")
|
|---|
| 7 | I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX Q
|
|---|
| 8 | W $C(7),!,"Enter a standard schedule for administering this medication."
|
|---|
| 9 | Q
|
|---|
| 10 | ISONETIM(SCH) ;
|
|---|
| 11 | N DUR
|
|---|
| 12 | I SCH="" Q 0
|
|---|
| 13 | K ^TMP($J,"ORCDPSIV GETSCHTYP")
|
|---|
| 14 | D ZERO^PSS51P1(,SCH,"PSJ","O","ORCDPSIV GETSCHTYP")
|
|---|
| 15 | I +^TMP($J,"ORCDPSIV GETSCHTYP",0)>0 D Q 1
|
|---|
| 16 | .S DUR=$$PTR^ORCD("OR GTX DURATION")
|
|---|
| 17 | .I $G(ORDIALOG(DUR,1))="" Q
|
|---|
| 18 | .S ORDIALOG(DUR,1)=""
|
|---|
| 19 | .W !,"IV Orders with a schedule type of one-time cannot have a duration."
|
|---|
| 20 | .W !,"The duration has been deleted from this quick order." H 1
|
|---|
| 21 | K ^TMP($J,"ORCDPSIV GETSCHTYP")
|
|---|
| 22 | Q 0
|
|---|
| 23 | ;
|
|---|
| 24 | PROVIDER ; -- Check provider, if authorized to write med orders
|
|---|
| 25 | I $D(^XUSEC("OREMAS",DUZ)),'$$GET^XPAR("ALL","OR OREMAS MED ORDERS") W $C(7),!!,"OREMAS key holders may not enter medication orders." S ORQUIT=1 Q
|
|---|
| 26 | N PS,NAME S PS=$G(^VA(200,+$G(ORNP),"PS")),NAME=$P($G(^(20)),U,2)
|
|---|
| 27 | I '$L(NAME) S NAME=$P(^VA(200,+$G(ORNP),0),U)
|
|---|
| 28 | I '$P(PS,U) W $C(7),!!,NAME_" is not authorized to write medication orders!" S ORQUIT=1
|
|---|
| 29 | I $P(PS,U,4),$$NOW^XLFDT>$P(PS,U,4) W $C(7),!!,NAME_" is no longer authorized to write medication orders!" S ORQUIT=1
|
|---|
| 30 | I $G(ORQUIT) W !,"You must select another provider to continue.",! S PS=$$MEDPROV I PS S ORXNP=ORNP,ORNP=PS K ORQUIT
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | MEDPROV() ; -- Return ordering med provider
|
|---|
| 34 | N X,Y,D,DIC
|
|---|
| 35 | S DIC=200,DIC(0)="AEQ",DIC("A")="Select PROVIDER: ",D="AK.PROVIDER"
|
|---|
| 36 | S DIC("S")="I $P($G(^(""PS"")),U),'$P(^(""PS""),U,4)!($P(^(""PS""),U,4)>$$NOW^XLFDT)"
|
|---|
| 37 | D IX^DIC S:Y>0 Y=+Y I Y'>0 S Y="^"
|
|---|
| 38 | Q Y
|
|---|
| 39 | ;
|
|---|
| 40 | CHANGED(TYPE) ; -- Kill dependent values when OI changes
|
|---|
| 41 | N PROMPTS,NAME,PTR,P,I
|
|---|
| 42 | Q:'$L($G(TYPE)) S PROMPTS=""
|
|---|
| 43 | S:TYPE="B" PROMPTS="VOLUME"
|
|---|
| 44 | S:TYPE="A" PROMPTS="STRENGTH PSIV^UNITS"
|
|---|
| 45 | S:TYPE="T" PROMPTS="INFUSION RATE^SCHEDULE"
|
|---|
| 46 | F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
|
|---|
| 47 | . S PTR=$O(^ORD(101.41,"AB","OR GTX "_NAME,0)) Q:'PTR
|
|---|
| 48 | . S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I)
|
|---|
| 49 | . K ORDIALOG(PTR,"LIST")
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | INACTIVE(TYPE) ; -- Check OI inactive date
|
|---|
| 53 | N OI,X,I,PSOI,DEA,EXIT S:$G(TYPE)'="A" TYPE="S"
|
|---|
| 54 | S OI=+$G(ORDIALOG(PROMPT,INST)) Q:OI'>0
|
|---|
| 55 | I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D Q ;inactive
|
|---|
| 56 | . S X=$S(TYPE="A":"additive",1:"solution"),ORQUIT=1
|
|---|
| 57 | . W $C(7),!,"This "_X_" may not be ordered anymore. Please select another."
|
|---|
| 58 | S I=$S(TYPE="A":4,1:3) I '$P($G(^ORD(101.43,OI,"PS")),U,I) D Q
|
|---|
| 59 | . S X=$S(TYPE="A":"an additive",1:"a solution"),ORQUIT=1
|
|---|
| 60 | . W $C(7),!,"This item may not be ordered as "_X_"."
|
|---|
| 61 | S EXIT=$$INPT^ORCD I EXIT=0 D ROUTECHK Q
|
|---|
| 62 | Q:'$L($T(IVDEA^PSSUTIL1)) ;DBIA #3784
|
|---|
| 63 | S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2)
|
|---|
| 64 | S DEA=$$IVDEA^PSSUTIL1(PSOI,TYPE) I DEA>0 D Q:$G(ORQUIT)
|
|---|
| 65 | . I $G(ORNP),'$L($P($G(^VA(200,+ORNP,"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S ORQUIT=1 Q
|
|---|
| 66 | . I DEA=1 W $C(7),!,"This order will require a wet signature!"
|
|---|
| 67 | D ROUTECHK
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | VOLUME ; -- get allowable volumes for solution
|
|---|
| 71 | N PSOI,ORY,CNT,I,XORY K ORDIALOG(PROMPT,"LIST")
|
|---|
| 72 | S PSOI=+$P($G(^ORD(101.43,+$$VAL^ORCD("SOLUTION",INST),0)),U,2)_"B"
|
|---|
| 73 | D ENVOL^PSJORUT2(PSOI,.ORY) Q:'ORY
|
|---|
| 74 | ;S (I,CNT)=0 F S I=$O(ORY(I)) Q:I'>0 S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",+ORY(I))=+ORY(I)
|
|---|
| 75 | S (I,CNT)=0 F S I=$O(ORY(I)) Q:I'>0 D
|
|---|
| 76 | . S CNT=CNT+1
|
|---|
| 77 | . S XORY(I)=+ORY(I) I XORY(I)<1,$E(XORY(I),1,2)'="0." S XORY(I)=0_XORY(I)
|
|---|
| 78 | . S ORDIALOG(PROMPT,"LIST",XORY(I))=XORY(I)
|
|---|
| 79 | S ORDIALOG(PROMPT,"LIST")=CNT_"^1"
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | UNITS ; -- get allowable units for current additive
|
|---|
| 83 | N PSOI,ORY,I,UNITS
|
|---|
| 84 | S PSOI=+$P(^ORD(101.43,+ORDIALOG($$PTR^ORCD("OR GTX ADDITIVE"),INST),0),U,2)_"A"
|
|---|
| 85 | D ENVOL^PSJORUT2(PSOI,.ORY)
|
|---|
| 86 | S I=$O(ORY(0)) Q:'I S UNITS=$P($G(ORY(I)),U,2)
|
|---|
| 87 | S ORDIALOG($$PTR^ORCD("OR GTX UNITS"),INST)=UNITS
|
|---|
| 88 | W !," (Units for this additive are "_UNITS_")"
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | PREMIX() ; -- Returns 1 or 0, if IV base is a premix solution
|
|---|
| 92 | N BASE,PS,I,Y
|
|---|
| 93 | S BASE=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),Y=0
|
|---|
| 94 | S I=0 F S I=$O(ORDIALOG(BASE,I)) Q:I'>0 D Q:Y
|
|---|
| 95 | . S PS=$G(^ORD(101.43,+$G(ORDIALOG(BASE,I)),"PS"))
|
|---|
| 96 | . I $P(PS,U,3)&($P(PS,U,4)) S Y=1
|
|---|
| 97 | Q Y
|
|---|
| 98 | ;
|
|---|
| 99 | IVRTEENT ;
|
|---|
| 100 | N ARRAY,DIR,RIEN,TROUTE
|
|---|
| 101 | I ORTYPE'="Z" Q
|
|---|
| 102 | S RIEN=$P($G(ORDIALOG("B","ROUTE")),U,2) Q:RIEN'>0
|
|---|
| 103 | S EXIT=0,TROUTE=$G(ORDIALOG(RIEN,1)) Q:TROUTE'>0
|
|---|
| 104 | I $$IVRTESCR(TROUTE)=1 Q
|
|---|
| 105 | S ORDIALOG(RIEN,1)=""
|
|---|
| 106 | W !!,"The selected route is not a valid route for this order."
|
|---|
| 107 | W !,"Select a new route for this order from the list of routes below."
|
|---|
| 108 | D RTEDISP(.ARRAY)
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | BIVOI(ARRAY) ;
|
|---|
| 112 | N CNT,NUM,OIIEN,OTYPE
|
|---|
| 113 | S CNT=0
|
|---|
| 114 | F OTYPE="SOLUTION","ADDITIVE" D
|
|---|
| 115 | .S OIIEN=+$P($G(ORDIALOG("B",OTYPE)),U,2) I OIIEN>0 D
|
|---|
| 116 | ..S NUM=0 F S NUM=$O(ORDIALOG(OIIEN,NUM)) Q:NUM'>0 I +$G(ORDIALOG(OIIEN,NUM))>0 D
|
|---|
| 117 | ...S CNT=CNT+1,ARRAY(CNT)=ORDIALOG(OIIEN,NUM)
|
|---|
| 118 | Q
|
|---|
| 119 | ;
|
|---|
| 120 | LVROUTES ;
|
|---|
| 121 | N ARRAY,ROUTES
|
|---|
| 122 | D BIVOI(.ARRAY)
|
|---|
| 123 | D IVDOSFRM^ORWDPS33(.ROUTES,.ARRAY,0,1)
|
|---|
| 124 | D RTEDISP(.ROUTES)
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | RTEDISP(ROUTES) ;
|
|---|
| 128 | N CNT
|
|---|
| 129 | S CNT="" F S CNT=$O(ROUTES(CNT)) Q:CNT'>0 D
|
|---|
| 130 | .W !,$P($G(ROUTES(CNT)),U,2)
|
|---|
| 131 | Q
|
|---|
| 132 | ;
|
|---|
| 133 | IVRTESCR(Y) ;
|
|---|
| 134 | N ARRAY,ROUTES,VALUE
|
|---|
| 135 | D BIVOI(.ARRAY)
|
|---|
| 136 | S VALUE=$$IVQOVAL^ORWDPS33(.ARRAY,Y) I VALUE'="" Q 1
|
|---|
| 137 | Q 0
|
|---|
| 138 | ;
|
|---|
| 139 | ROUTECHK ;
|
|---|
| 140 | N CNT,IEN,ROUTE,VALUE
|
|---|
| 141 | S RIEN=$P($G(ORDIALOG("B","ROUTE")),U,2) Q:RIEN'>0
|
|---|
| 142 | S TROUTE=$G(ORDIALOG(RIEN,1)) Q:TROUTE'>0
|
|---|
| 143 | I $$IVRTESCR(TROUTE)=1 Q
|
|---|
| 144 | S ORDIALOG(RIEN,1)=""
|
|---|
| 145 | W !!,"The route defined for this order is an invalid route."
|
|---|
| 146 | W !,"You will need to define a new route for this order."
|
|---|
| 147 | Q
|
|---|
| 148 | ;
|
|---|
| 149 | ENRATE ; -- set display text, help based on IV TYPE
|
|---|
| 150 | N X,MSG S X=$G(ORIVTYPE),MSG=""
|
|---|
| 151 | S ORDIALOG(PROMPT,"A")=$S(X="I":"Infuse over time (min): ",1:"Infusion Rate (ml/hr): ")
|
|---|
| 152 | S MSG="Enter the "_$S(X="I":"number of minutes over which to infuse this medication.",1:"infusion rate, as the number of ml/hr or Text@Number of Labels per day. ")
|
|---|
| 153 | S ORDIALOG(PROMPT,"?")=MSG
|
|---|
| 154 | I X="I" D
|
|---|
| 155 | .N RATEI,RATEV,TIME,UNIT
|
|---|
| 156 | .S RATEI=$P($G(ORDIALOG("B","INFUSION RATE")),U,2) Q:RATEI'>0
|
|---|
| 157 | .S RATEV=$G(ORDIALOG(RATEI,1)) Q:'$L(RATEV)
|
|---|
| 158 | .I RATEV'["INFUSE OVER" Q
|
|---|
| 159 | .S TIME=$P(RATEV," ",3)
|
|---|
| 160 | .S UNIT=$P(RATEV," ",4)
|
|---|
| 161 | .I TIME["." Q
|
|---|
| 162 | .I UNIT="Hours" S TIME=TIME*60
|
|---|
| 163 | .S ORDIALOG(RATEI,1)=TIME
|
|---|
| 164 | Q
|
|---|
| 165 | ;
|
|---|
| 166 | INF ; -- input transform for INFUSION RATE
|
|---|
| 167 | N ALPHA,CNT,EXIT,FAIL,LDEC,RDEC,TEMP
|
|---|
| 168 | I $G(ORIVTYPE)="I" D Q
|
|---|
| 169 | .I X["." W !,"Infuse Over Time must be a whole number." K X Q
|
|---|
| 170 | .I $L(X)>4 W !,"Infuse Over Time cannot exceed 4 spaces for minutes." K X
|
|---|
| 171 | .S FAIL=0
|
|---|
| 172 | .F CNT=1:1:$L(X) D I FAIL=1 Q
|
|---|
| 173 | ..I ($A($E(X,CNT))<48)!($A($E(X,CNT))>58) S FAIL=1
|
|---|
| 174 | .I FAIL=1 W !,"Infuse Over Time must be a whole number." K X Q
|
|---|
| 175 | K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q
|
|---|
| 176 | I $G(ORIVTYPE)="C" D Q
|
|---|
| 177 | .S TEMP=$E(X,($L(X)-5),$L(X))
|
|---|
| 178 | .I X["@",$$UP^XLFSTR(TEMP)=" ML/HR" Q
|
|---|
| 179 | .S ALPHA=0
|
|---|
| 180 | .I X'["@" D I ALPHA=1 K X Q
|
|---|
| 181 | ..F CNT=1:1:$L(X) D I ALPHA=1 Q
|
|---|
| 182 | ...I ($A($E(X,CNT))<48)!($A($E(X,CNT))>58) S ALPHA=1
|
|---|
| 183 | .S EXIT=0
|
|---|
| 184 | .I X[".",X'["@" D I EXIT=1 K X Q
|
|---|
| 185 | ..S LDEC=$P(X,"."),RDEC=$P(X,".",2)
|
|---|
| 186 | ..I LDEC="" W !,"Infusion Rate required a leading numeric value." S EXIT=1
|
|---|
| 187 | ..I $L(RDEC)>1 W !,"Infusion Rate cannot exceed one decimal place." S EXIT=1
|
|---|
| 188 | ..S ALPHA=0
|
|---|
| 189 | ..F CNT=1:1:$L(LDEC) D I ALPHA=1 S EXIT=1 Q
|
|---|
| 190 | ...I ($A($E(LDEC,CNT))<48)!($A($E(LDEC,CNT))>58) S ALPHA=1
|
|---|
| 191 | ..I $L(RDEC)=0 Q
|
|---|
| 192 | ..F CNT=1:1:$L(RDEC) D I ALPHA=1 S EXIT=1 Q
|
|---|
| 193 | ...I ($A($E(RDEC,CNT))<48)!($A($E(RDEC,CNT))>58) S ALPHA=1
|
|---|
| 194 | .D ORINF^PSIVSP Q
|
|---|
| 195 | ; -- assume #minutes for now
|
|---|
| 196 | K:(X'=+X)!(X<1)!(X>999) X ;range?
|
|---|
| 197 | Q
|
|---|
| 198 | ;
|
|---|
| 199 | VALIDAYS(X) ; -- Validate IV duration
|
|---|
| 200 | N UNITS,X1,X2,Y,I
|
|---|
| 201 | I X'?1.N." "1.A Q 0
|
|---|
| 202 | S UNITS="^MIN^HOURS^DAYS^M^H^D^",(X1,X2)=""
|
|---|
| 203 | F I=1:1:$L(X) S Y=$E(X,I) S:Y?1N X1=X1_Y S:Y?1A X2=X2_$$UP^XLFSTR(Y)
|
|---|
| 204 | I 'X1 Q 0
|
|---|
| 205 | I UNITS'[(U_X2_U) Q 0
|
|---|
| 206 | Q 1
|
|---|
| 207 | ;
|
|---|
| 208 | VALDURA(X) ;-- Validate IV duration/limitation
|
|---|
| 209 | K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q
|
|---|
| 210 | ;
|
|---|
| 211 | IVPSI ;INPUT-TRANSFORM
|
|---|
| 212 | I $L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) S X="" Q
|
|---|
| 213 | I $L(X)>1,X[" " W !,"Spaces are not allow in the duration." K X Q
|
|---|
| 214 | I $E(X)=0 W !,!,"Duration cannot start with a zero." K X Q
|
|---|
| 215 | I X["." W !,!,"Invalid duration or total volume.",!,"Duration has to be integer value!" S X="" Q
|
|---|
| 216 | S X=$$UP^XLFSTR(X)
|
|---|
| 217 | I X["DOSES" D Q
|
|---|
| 218 | .I $G(ORIVTYPE)'="I" K X W !,"Continuous IV Orders cannot have DOSES as a duration." Q
|
|---|
| 219 | .I +$P(X,"DOSES")<1,+$P(X,"DOSES")>200000 W !,"Invalid number of Doses.",! K X Q
|
|---|
| 220 | I (X'?.N1.2A),(X'?.N1".".N1.2A) W !,!,"Invalid duration or total volume.",! S X="" Q
|
|---|
| 221 | I (X?.N1A) D
|
|---|
| 222 | . I (X["L")!(X["H")!(X["D") Q
|
|---|
| 223 | . E W !,!,"Invalid duration or total volume.",! S X="" Q
|
|---|
| 224 | I (X?.N1".".N1A) D
|
|---|
| 225 | . I X["L" Q
|
|---|
| 226 | . E W !,!,"Invalid duration or total volume.",!,"Duration has to be integer value!",! S X="" Q
|
|---|
| 227 | I (X?.N2A)!(X?.N1".".N2A) D
|
|---|
| 228 | . I (X["ML")!(X["CC") Q
|
|---|
| 229 | . E W !,!,"Invalid duration or total volume",! S X="" Q
|
|---|
| 230 | I X="" K X
|
|---|
| 231 | Q
|
|---|
| 232 | ;
|
|---|
| 233 | IVPSI1 ; ASK ON CONDITION
|
|---|
| 234 | N DURI,DURV
|
|---|
| 235 | I $G(OROTSCH)=1 Q
|
|---|
| 236 | S DURI=$P($G(ORDIALOG("B","LIMITATION")),U,2)
|
|---|
| 237 | I DURI>0 S DURV=$G(ORDIALOG(DURI,1))
|
|---|
| 238 | I $L(DURV)>1,$E(DURV)="f",DURV["doses" D
|
|---|
| 239 | .S TEMPX=$P(DURV," ",5)_"DOSES"
|
|---|
| 240 | .I TEMPX'="",TEMPX'=DURV S ORDIALOG(DURI,1)=TEMPX
|
|---|
| 241 | N INT,IVTYPE,ONETIME,TYPE,SCH,SCHNAME
|
|---|
| 242 | I $G(ORIVTYPE)'="I" D G IVPS1X
|
|---|
| 243 | .W !,!,"Enter the length of administrative time or total volume for IV fluid order followed by ML or CC for milliliters, L for liters, D for days, H for hours to set limitation."
|
|---|
| 244 | .W !,"(Examples: 1500ML, 1000CC, 1L, 3D, or 72H)",!
|
|---|
| 245 | W !,"This field is optional a value does not need to be entered."
|
|---|
| 246 | W !,!,"Enter the length of administrative time or total volume for IV fluid order followed by ML or CC for milliliters, L for liters, D for days, H for hours or DOSES to set limitation."
|
|---|
| 247 | W !,"(Examples: 1500ML, 1000CC, 1L, 3D, 72H, or 10DOSES)",!
|
|---|
| 248 | IVPS1X ;
|
|---|
| 249 | W !,"This field is optional a value does not need to be entered."
|
|---|
| 250 | I 1
|
|---|
| 251 | Q
|
|---|
