| [623] | 1 | ORCDPS1 ;SLC/MKB-Pharmacy dialog utilities ; 08 May 2002 2:12 PM
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,117,141,149,195,215**;Dec 17, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J)
|
|---|
| 5 | ; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J)
|
|---|
| 6 | ;
|
|---|
| 7 | EN(TYPE) ; -- entry action for Meds dialogs
|
|---|
| 8 | S ORINPT=$$INPT^ORCD,ORCAT=$G(TYPE)
|
|---|
| 9 | I 'ORINPT,ORCAT="I" D IMOLOC^ORIMO(.ORINPT,+ORL,+ORVP) S:ORINPT<0 ORINPT=0 ;allow inpt meds at this location?
|
|---|
| 10 | I ORCAT="" D
|
|---|
| 11 | . I $G(ORENEW)!$G(OREWRITE)!$D(OREDIT),$L($P($G(OR0),U,12)) S ORCAT=$P(OR0,U,12) Q ;use value from order, via ORCACT4
|
|---|
| 12 | . S ORCAT=$S(ORINPT:"I",1:"O")
|
|---|
| 13 | S ORDG=+$O(^ORD(100.98,"B",$S(ORCAT="I":"UD RX",1:"O RX"),0))
|
|---|
| 14 | K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
|
|---|
| 15 | I $G(ORENEW)!$G(OREWRITE)!$D(OREDIT)!$G(ORXFER) D Q:$G(ORQUIT)
|
|---|
| 16 | . I 'ORINPT,ORCAT="I" D Q:$G(ORQUIT)
|
|---|
| 17 | .. N OI S OI=+$O(^OR(100,+$G(ORIFN),.1,"B",0)) Q:OI<1
|
|---|
| 18 | .. I '$O(^ORD(101.43,OI,9,"B","IVM RX",0)) S ORQUIT=1 W $C(7),!!,"This order may not be placed at this location!" Q
|
|---|
| 19 | . K ORDIALOG($$PTR("START DATE/TIME"),1)
|
|---|
| 20 | . K ORDIALOG($$PTR("NOW"),1) Q:ORCAT'="O"
|
|---|
| 21 | . I $G(OREDIT)!$G(OREWRITE) N PI S PI=$$PTR("PATIENT INSTRUCTIONS") K ORDIALOG(PI,1),^TMP("ORWORD",$J,PI)
|
|---|
| 22 | . I $D(OREDIT),'$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) K ^TMP("ORWORD",$J)
|
|---|
| 23 | I ORINPT,ORCAT="O" W $C(7),!!,"NOTE: This will create an outpatient prescription for an inpatient!",!
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | EN1 ; -- setup Meds dialog for quick order editor using ORDG
|
|---|
| 27 | N DG S DG=$P($G(^ORD(100.98,+$G(ORDG),0)),U,3)
|
|---|
| 28 | I $P(DG," ")="O"!(DG="SPLY") S ORINPT=0,ORCAT="O"
|
|---|
| 29 | E S ORINPT=1,ORCAT="I"
|
|---|
| 30 | K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | ENOI ; -- setup OI prompt
|
|---|
| 34 | N D S D=$G(ORDIALOG(PROMPT,"D"))
|
|---|
| 35 | S:D="S.RX" ORDIALOG(PROMPT,"D")=$S(ORCAT="I":"S.UD RX",1:"S.O RX")
|
|---|
| 36 | I ORCAT="I",'ORINPT,D="S.UD RX" D ;limit to IV meds for outpt's
|
|---|
| 37 | . S ORDIALOG(PROMPT,"D")="S.IVM RX" ;ORDG=+$O(^ORD(100.98,"B","O RX",0))
|
|---|
| 38 | . S ORDIALOG(PROMPT,"?")="Enter the IV medication you wish to order for this patient."
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | DEA ; -- ck DEA# of ordering provider if SchedII drug
|
|---|
| 42 | Q:$G(ORTYPE)="Z" N DEAFLG,PSOI
|
|---|
| 43 | S PSOI=+$P($G(^ORD(101.43,+$G(Y),0)),U,2) Q:PSOI'>0
|
|---|
| 44 | S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,ORCAT) Q:DEAFLG'>0 ;ok
|
|---|
| 45 | 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!" K DONE Q
|
|---|
| 46 | I DEAFLG=1 W $C(7),!,"This order will require a wet signature!"
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | CHANGED(X) ; -- Kill dependent values when prompt X changes
|
|---|
| 50 | N PROMPTS,NAME,PTR,P,I
|
|---|
| 51 | S PROMPTS=X I X="OI" D
|
|---|
| 52 | . S PROMPTS="INSTRUCTIONS^ROUTE^SCHEDULE^START DATE/TIME^DURATION^AND/THEN^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS^DAYS SUPPLY^QUANTITY^REFILLS^SERVICE CONNECTED"
|
|---|
| 53 | . K ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,ORQTY,ORQTYUNT,OREFILLS,ORCOPAY
|
|---|
| 54 | . K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
|
|---|
| 55 | I X="DS" S PROMPTS="QUANTITY^REFILLS" K OREFILLS
|
|---|
| 56 | F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
|
|---|
| 57 | . S PTR=$$PTR(NAME) Q:'PTR
|
|---|
| 58 | . S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I)
|
|---|
| 59 | . K ORDIALOG(PTR,"LIST"),^TMP("ORWORD",$J,PTR)
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | ORDITM(OI) ; -- Check OI, get dependent info
|
|---|
| 63 | Q:OI'>0 ;quit - no value
|
|---|
| 64 | N ORPS,ORPSOI S ORPS=$G(^ORD(101.43,+OI,"PS")),ORPSOI=+$P($G(^(0)),U,2)
|
|---|
| 65 | S ORIV=$S($P(ORPS,U)=2:1,1:0)
|
|---|
| 66 | I $G(ORCAT)="O",'$P(ORPS,U,2) W $C(7),!,"This drug may not be used in an outpatient order." S ORQUIT=1 D WAIT Q
|
|---|
| 67 | I $G(ORCAT)="I" D Q:$G(ORQUIT)
|
|---|
| 68 | . I $G(ORINPT),'$P(ORPS,U) W $C(7),!,"This drug may not be used in an inpatient order." S ORQUIT=1 D WAIT Q
|
|---|
| 69 | . I '$G(ORINPT),'ORIV W $C(7),!,"This drug may not be ordered for an outpatient." S ORQUIT=1 D WAIT Q
|
|---|
| 70 | I $G(ORTYPE)="Q" D I $G(ORQUIT) D WAIT Q
|
|---|
| 71 | . N DEAFLG S DEAFLG=$$OIDEA^PSSUTLA1(ORPSOI,ORCAT) Q:DEAFLG'>0 ;ok
|
|---|
| 72 | . 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
|
|---|
| 73 | . I DEAFLG=1 W $C(7),!,"This order will require a wet signature!"
|
|---|
| 74 | OI1 ; -ck NF status
|
|---|
| 75 | I $P(ORPS,U,6),'$G(ORENEW) D ;alternative
|
|---|
| 76 | . W !!,"*** This medication is not in the formulary! ***"
|
|---|
| 77 | . N PSX,CNT,ORX,DIR,X,Y,DTOUT,DUOUT
|
|---|
| 78 | . D EN1^PSSUTIL1(.ORPSOI,ORCAT) I '$O(ORPSOI(0)) D Q
|
|---|
| 79 | .. W !," There are no formulary alternatives entered for this item."
|
|---|
| 80 | .. W !," Please consult with your pharmacy before ordering it."
|
|---|
| 81 | . S PSX=0,CNT=0 F S PSX=$O(ORPSOI(PSX)) Q:PSX'>0 D
|
|---|
| 82 | .. S ORX=+$O(^ORD(101.43,"ID",PSX_";99PSP",0)) Q:ORX'>0
|
|---|
| 83 | .. S CNT=CNT+1,ORPSOI("OI",CNT)=ORX_U_PSX
|
|---|
| 84 | .. S DIR("A",CNT)=$J(CNT,3)_" "_$P($G(^ORD(101.43,ORX,0)),U)
|
|---|
| 85 | . S DIR(0)="NAO^1:"_CNT,DIR("A")="Select alternative (or <return> to continue): "
|
|---|
| 86 | . S DIR("?")="The medication selected is not in the formulary; you may select one of the above listed alternatives instead, or press <return> to continue processing this order."
|
|---|
| 87 | . Q:CNT'>0 W !," Formulary alternatives:" D ^DIR
|
|---|
| 88 | . I Y'>0 S:$D(DTOUT)!$D(DUOUT) ORQUIT=1 Q
|
|---|
| 89 | . D:OI'=+ORPSOI("OI",+Y) CHANGED("OI") ;reset parameters if different
|
|---|
| 90 | . S OI=+ORPSOI("OI",+Y),ORDIALOG(PROMPT,INST)=OI,OROI=OI
|
|---|
| 91 | . S ORPSOI=+$P(ORPSOI("OI",+Y),U,2)
|
|---|
| 92 | OI2 ; -get routes, doses [also called from NF^ORCDPS]
|
|---|
| 93 | D:'$D(^TMP("PSJMR",$J)) START^PSSJORDF(ORPSOI,$G(ORCAT)) ;DBIA 2418
|
|---|
| 94 | I '$D(ORDOSE) D
|
|---|
| 95 | . D DOSE^PSSORUTL(.ORDOSE,ORPSOI,$S($G(ORCAT)="I":"U",1:"O"),+ORVP)
|
|---|
| 96 | . K:$G(ORDOSE(1))=-1 ORDOSE
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | NFI(OI) ; -- Show NFI restrictions, if exist
|
|---|
| 100 | N PSOI,I,J,LCNT,MAX,X,STOP
|
|---|
| 101 | S PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2)
|
|---|
| 102 | D EN^PSSDIN(PSOI,"") Q:'$D(^TMP("PSSDIN",$J,"OI",PSOI)) ;DBIA 3166
|
|---|
| 103 | S I=0,LCNT=0,MAX=$S($G(IOBM)&$G(IOTM):IOBM-IOTM+1,1:24) W !
|
|---|
| 104 | F S I=$O(^TMP("PSSDIN",$J,"OI",PSOI,I)) Q:I'>0 D
|
|---|
| 105 | . S J=0 F S J=$O(^TMP("PSSDIN",$J,"OI",PSOI,I,J)) Q:J'>0 S X=$G(^(J)) D Q:$G(STOP)
|
|---|
| 106 | .. S LCNT=LCNT+1 I LCNT'<MAX S:'$$CONT STOP=1 Q:$G(STOP) S LCNT=1
|
|---|
| 107 | .. W !,X
|
|---|
| 108 | W ! K ^TMP("PSSDIN",$J,"OI",PSOI)
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | CONT() ; -- Cont or stop?
|
|---|
| 112 | N X,Y,DIR,DUOUT,DTOUT,DIRUT,DIROUT S DIR(0)="EA"
|
|---|
| 113 | S DIR("A")="Press <return> to continue or ^ to stop ..."
|
|---|
| 114 | D ^DIR S:$D(DUOUT)!$D(DTOUT) Y=""
|
|---|
| 115 | Q +Y
|
|---|
| 116 | ;
|
|---|
| 117 | WAIT ; -- Wait for user
|
|---|
| 118 | N X W !,"Press <return> to continue ..." R X:DTIME
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
| 121 | ROUTES ; -- Get med routes
|
|---|
| 122 | Q:$G(ORDIALOG(PROMPT,"LIST")) N I,X,CNT S (I,CNT)=0
|
|---|
| 123 | F S I=$O(^TMP("PSJMR",$J,I)) Q:I'>0 S X=^(I),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=$P(X,U,3)_U_$P(X,U,1,2),ORDIALOG(PROMPT,"LIST","B",$P(X,U))=$P(X,U,3)
|
|---|
| 124 | S:$G(CNT) ORDIALOG(PROMPT,"LIST")=CNT
|
|---|
| 125 | S:$G(ORTYPE)'="Z" REQD=$S(ORCAT="I":1,$P($G(^ORD(101.43,+$G(OROI),"PS")),U,5):0,1:1)
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | DEFRTE ; -- Get default route
|
|---|
| 129 | N INST1 S INST1=$O(ORDIALOG(PROMPT,0)) S:INST1'>0 INST1=INST
|
|---|
| 130 | I INST1=INST S Y=+$P($G(^TMP("PSJMR",$J,1)),U,3) K:Y'>0 Y Q
|
|---|
| 131 | S Y=+$G(ORDIALOG(PROMPT,INST1)) K:Y'>0 Y S:$G(Y) EDITONLY=1
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | CKSCH ; -- validate schedule [Called from P-S Action]
|
|---|
| 135 | N ORX S ORX=ORDIALOG(PROMPT,ORI) Q:ORX=$G(ORESET) K ORSD
|
|---|
| 136 | D EN^PSSGS0(.ORX,$G(ORCAT))
|
|---|
| 137 | I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX D CHANGED("QUANTITY") Q ;ok
|
|---|
| 138 | W $C(7),!,"Enter a standard administration schedule"
|
|---|
| 139 | K DONE I $G(ORCAT)="I" W ".",! Q
|
|---|
| 140 | W " or one of your own,",!,"up to 70 characters and no more than 2 spaces.",!
|
|---|
| 141 | Q
|
|---|
| 142 | ;
|
|---|
| 143 | DEFCONJ ; -- Set default conjuction for previous instance [P-S Action]
|
|---|
| 144 | N LAST,DUR,CONJ
|
|---|
| 145 | S LAST=$O(ORDIALOG(PROMPT,ORI),-1) Q:LAST'>0 ;first instance
|
|---|
| 146 | S CONJ=$$PTR("AND/THEN") Q:$L($G(ORDIALOG(CONJ,LAST)))
|
|---|
| 147 | S DUR=$G(ORDIALOG($$PTR("DURATION"),LAST))
|
|---|
| 148 | S ORDIALOG(CONJ,LAST)=$S(+DUR'>0:"A",1:"T")
|
|---|
| 149 | Q
|
|---|
| 150 | ;
|
|---|
| 151 | ENCONJ ; -- Get allowable values, if req'd for INST
|
|---|
| 152 | N P S P=$$PTR("INSTRUCTIONS")
|
|---|
| 153 | S REQD=$S($O(ORDIALOG(P,INST)):1,1:0)
|
|---|
| 154 | S ORDIALOG(PROMPT,"A")="And/then"_$S(ORCAT="O":"/except: ",1:": ")
|
|---|
| 155 | S $P(ORDIALOG(PROMPT,0),U,2)="A:AND;T:THEN;"_$S(ORCAT="O":"X:EXCEPT;",1:"")
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
| 158 | DSUP ; -- Get max/default days supply
|
|---|
| 159 | N ORX,Y
|
|---|
| 160 | S ORX("PATIENT")=+$G(ORVP),ORX("DRUG")=+$G(ORDRUG)
|
|---|
| 161 | D DSUP^PSOSIGDS(.ORX) S Y=+$G(ORX("DAYS SUPPLY")) S:Y'>0 Y=90
|
|---|
| 162 | ;S $P(ORDIALOG(PROMPT,0),U,2)="1:"_Y ;max allowed
|
|---|
| 163 | I '$G(ORDIALOG(PROMPT,1)),$G(ORTYPE)'="Z" S ORDIALOG(PROMPT,1)=Y
|
|---|
| 164 | Q
|
|---|
| 165 | ;
|
|---|
| 166 | QTY() ; -- Return default quantity [Expects ORDSUP]
|
|---|
| 167 | N INSTR,DOSE,DUR,SCH,I,ORX,X,Y
|
|---|
| 168 | S Y="" I $G(ORDSUP)'>0!'$G(ORDRUG) G QTYQ ;need days supply, disp drug
|
|---|
| 169 | S INSTR=$$PTR("INSTRUCTIONS")
|
|---|
| 170 | S DOSE=$$PTR("DOSE"),CONJ=$$PTR("AND/THEN")
|
|---|
| 171 | S DUR=$$PTR("DURATION"),SCH=$$PTR("SCHEDULE")
|
|---|
| 172 | S I=0 F S I=$O(ORDIALOG(INSTR,I)) Q:I'>0 D Q:'$D(ORX)
|
|---|
| 173 | . S X=$P($G(ORDIALOG(DOSE,I)),"&",3) I X'>0 K ORX Q
|
|---|
| 174 | . S ORX("DOSE ORDERED",I)=X,ORX("SCHEDULE",I)=$G(ORDIALOG(SCH,I))
|
|---|
| 175 | . S X=$G(ORDIALOG(DUR,I)),ORX("DURATION",I)=$$HL7DUR^ORMBLDPS
|
|---|
| 176 | . S ORX("CONJUNCTION",I)=$G(ORDIALOG(CONJ,I))
|
|---|
| 177 | G:'$D(ORX) QTYQ ;no doses
|
|---|
| 178 | S ORX("PATIENT")=+$G(ORVP),ORX("DRUG")=+$G(ORDRUG)
|
|---|
| 179 | S ORX("DAYS SUPPLY")=+$G(ORDSUP)
|
|---|
| 180 | D QTYX^PSOSIG(.ORX) S Y=$G(ORX("QTY"))
|
|---|
| 181 | QTYQ Q Y
|
|---|
| 182 | ;
|
|---|
| 183 | MAXREFS ; -- Get max refills allowed [Entry Action]
|
|---|
| 184 | Q:$G(ORCAT)'="O" N ORX,X
|
|---|
| 185 | S ORX("ITEM")=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
|
|---|
| 186 | S ORX("DRUG")=+$G(ORDRUG),ORX("PATIENT")=+$G(ORVP)
|
|---|
| 187 | I $G(OREVENT),$$TYPE^OREVNTX(OREVENT)="D" S ORX("DISCHARGE")=1
|
|---|
| 188 | S ORX("DAYS SUPPLY")=$G(ORDSUP) D MAX^PSOSIGDS(.ORX)
|
|---|
| 189 | S OREFILLS=$G(ORX("MAX")),X=$G(ORDIALOG(PROMPT,INST))
|
|---|
| 190 | I OREFILLS'>0 S ORDIALOG(PROMPT,INST)=0 W !,"No refills allowed." Q
|
|---|
| 191 | S $P(ORDIALOG(PROMPT,0),U,2)="0:"_OREFILLS
|
|---|
| 192 | S ORDIALOG(PROMPT,"A")="Refills (0-"_OREFILLS_"): "
|
|---|
| 193 | I X,X>OREFILLS S ORDIALOG(PROMPT,INST)=OREFILLS
|
|---|
| 194 | Q
|
|---|
| 195 | ;
|
|---|
| 196 | ASKSC() ; -- Return 1 or 0, if SC prompt should be asked
|
|---|
| 197 | I $$SC^PSOCP(+ORVP,+$G(ORDRUG)) Q 0
|
|---|
| 198 | ;I $$RXST^IBARXEU(+ORVP)>0 Q 0 ;exempt from copay
|
|---|
| 199 | Q 1
|
|---|
| 200 | ;
|
|---|
| 201 | PTR(X) ; -- Return ptr to prompt OR GTX X
|
|---|
| 202 | Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
|
|---|
| 203 | ;
|
|---|
| 204 | EXIT ; -- exit action for Meds
|
|---|
| 205 | S:$G(ORXNP) ORNP=ORXNP
|
|---|
| 206 | K ORXNP,ORINPT,ORCAT,ORPKG,OROI,ORIV,ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,OREFILLS,ORQTY,ORQTYUNT,ORCOPAY,PSJNOPC,ORCOMPLX
|
|---|
| 207 | K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
|
|---|
| 208 | Q
|
|---|
