- ORCDPS1 ;SLC/MKB-Pharmacy dialog utilities ;Nov 13, 2019@09:12:46
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,117,141,149,195,215,243,280,337,311,350,377,405,499**;Dec 17, 1997;Build 165
- ;
- ; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J)
- ; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J)
- ; DBIA 2534 SC^PSOCP
- ; DBIA 3237 ^PSOSIG
- ; DBIA 3278 ^PSOSIGDS
- ; DBIA 3423 ^PSSGS0
- ; DBIA 3233 ^PSSORUTL
- ; DBIA 3239 ^PSSUTIL1
- ; DBIA 3373 ^PSSUTLA1
- ;
- EN(TYPE) ; -- entry action for Meds dialogs
- S ORINPT=$$INPT^ORCD,ORCAT=$G(TYPE)
- I 'ORINPT,ORCAT="I" D IMOLOC^ORIMO(.ORINPT,+ORL,+ORVP) S:ORINPT<0 ORINPT=0 ;allow inpt meds at this location?
- I ORCAT="" D
- . 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
- . S ORCAT=$S(ORINPT:"I",1:"O")
- S ORDG=+$O(^ORD(100.98,"B",$S(ORCAT="I":"UD RX",1:"O RX"),0))
- K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
- I $G(ORENEW)!$G(OREWRITE)!$G(OREDIT)!$G(ORXFER) D Q:$G(ORQUIT)
- . I 'ORINPT,ORCAT="I" D Q:$G(ORQUIT)
- .. N OI S OI=+$O(^OR(100,+$G(ORIFN),.1,"B",0)) Q:OI<1
- .. 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
- . K ORDIALOG($$PTR("START DATE/TIME"),1)
- . K ORDIALOG($$PTR("NOW"),1) Q:ORCAT'="O"
- . N WP S WP=$$PTR("WORD PROCESSING 1")
- . I '$G(ORXFER),'$$DRAFT^ORWDX2($G(ORIFN)) K ORDIALOG(WP,1),^TMP("ORWORD",$J,WP)
- . I $G(OREDIT),'$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) K ^TMP("ORWORD",$J)
- I ORINPT,ORCAT="O" W $C(7),!!,"NOTE: This will create an outpatient prescription for an inpatient!",!
- Q
- ;
- EN1 ; -- setup Meds dialog for quick order editor using ORDG
- N DG S DG=$P($G(^ORD(100.98,+$G(ORDG),0)),U,3)
- I $P(DG," ")="O"!(DG="SPLY") S ORINPT=0,ORCAT="O"
- E S ORINPT=1,ORCAT="I"
- K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
- Q
- ;
- ENOI ; -- setup OI prompt
- N D S D=$G(ORDIALOG(PROMPT,"D"))
- S:D="S.RX" ORDIALOG(PROMPT,"D")=$S(ORCAT="I":"S.UD RX",1:"S.O RX")
- I ORCAT="I",'ORINPT,D="S.UD RX" D ;limit to IV meds for outpt's
- . S ORDIALOG(PROMPT,"D")="S.IVM RX" ;ORDG=+$O(^ORD(100.98,"B","O RX",0))
- . S ORDIALOG(PROMPT,"?")="Enter the IV medication you wish to order for this patient."
- Q
- ;
- DEA ; -- ck DEA# of ordering provider if SchedII drug
- Q:$G(ORTYPE)="Z" N DEAFLG,PSOI,ORDEA ; patch 499
- S PSOI=+$P($G(^ORD(101.43,+$G(Y),0)),U,2) Q:PSOI'>0
- S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,ORCAT) Q:DEAFLG'>0 ;ok
- ; patch 499 - multiple DEA numbers for one provider
- I $G(ORNP) S ORDEA=$$PRDEA^XUSER(ORNP) I '$L(ORDEA),'$L($P($G(^VA(200,+ORNP,"PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" K DONE Q
- I DEAFLG=1 W $C(7),!,"This order will require a wet signature!"
- Q
- ;
- CHANGED(X) ; -- Kill dependent values when prompt X changes
- N PROMPTS,NAME,PTR,P,I
- S PROMPTS=X I X="OI" D
- . S PROMPTS="INSTRUCTIONS^ROUTE^SCHEDULE^START DATE/TIME^DURATION^AND/THEN^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS^DAYS SUPPLY^QUANTITY^REFILLS^SERVICE CONNECTED"
- . K ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,ORQTY,ORQTYUNT,OREFILLS,ORCOPAY
- . K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
- I X="DS" S PROMPTS="QUANTITY^REFILLS" K OREFILLS
- F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
- . S PTR=$$PTR(NAME) Q:'PTR
- . S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I)
- . K ORDIALOG(PTR,"LIST"),^TMP("ORWORD",$J,PTR)
- Q
- ;
- ORDITM(OI) ; -- Check OI, get dependent info
- Q:OI'>0 ;quit - no value
- N ORPS,ORPSOI,ORDEA S ORPS=$G(^ORD(101.43,+OI,"PS")),ORPSOI=+$P($G(^(0)),U,2)
- S ORIV=$S($P(ORPS,U)=2:1,1:0)
- 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
- I $G(ORCAT)="I" D Q:$G(ORQUIT)
- . 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
- . I '$G(ORINPT),'ORIV W $C(7),!,"This drug may not be ordered for an outpatient." S ORQUIT=1 D WAIT Q
- I $G(ORTYPE)="Q" D I $G(ORQUIT) D WAIT Q
- . N DEAFLG S DEAFLG=$$OIDEA^PSSUTLA1(ORPSOI,ORCAT) Q:DEAFLG'>0 ;ok
- . ; patch 499 - multiple DEA numbers for one provider
- . I $G(ORNP) S ORDEA=$$PRDEA^XUSER(ORNP) I $L(ORDEA),'$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
- . I DEAFLG=1 W $C(7),!,"This order will require a wet signature!"
- OI1 ; -ck NF status
- I $P(ORPS,U,6),'$G(ORENEW) D ;alternative
- . W !!,"*** This medication is not in the formulary! ***"
- . N PSX,CNT,ORX,DIR,X,Y,DTOUT,DUOUT
- . D EN1^PSSUTIL1(.ORPSOI,ORCAT) I '$O(ORPSOI(0)) D Q
- .. W !," There are no formulary alternatives entered for this item."
- .. W !," Please consult with your pharmacy before ordering it."
- . S PSX=0,CNT=0 F S PSX=$O(ORPSOI(PSX)) Q:PSX'>0 D
- .. S ORX=+$O(^ORD(101.43,"ID",PSX_";99PSP",0)) Q:ORX'>0
- .. S CNT=CNT+1,ORPSOI("OI",CNT)=ORX_U_PSX
- .. S DIR("A",CNT)=$J(CNT,3)_" "_$P($G(^ORD(101.43,ORX,0)),U)
- . S DIR(0)="NAO^1:"_CNT,DIR("A")="Select alternative (or <return> to continue): "
- . 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."
- . Q:CNT'>0 W !," Formulary alternatives:" D ^DIR
- . I Y'>0 S:$D(DTOUT)!$D(DUOUT) ORQUIT=1 Q
- . D:OI'=+ORPSOI("OI",+Y) CHANGED("OI") ;reset parameters if different
- . S OI=+ORPSOI("OI",+Y),ORDIALOG(PROMPT,INST)=OI,OROI=OI
- . S ORPSOI=+$P(ORPSOI("OI",+Y),U,2)
- OI2 ; -get routes, doses [also called from NF^ORCDPS]
- D:'$D(^TMP("PSJMR",$J)) START^PSSJORDF(ORPSOI,$G(ORCAT)) ;DBIA 2418
- I '$D(ORDOSE) D
- . D DOSE^PSSORUTL(.ORDOSE,ORPSOI,$S($G(ORCAT)="I":"U",1:"O"),+ORVP)
- . K:$G(ORDOSE(1))=-1 ORDOSE Q:'$D(ORDOSE)
- . S ORDOSE("LOCAL")=0
- . N DOSAGE
- . S DOSAGE=0 F S DOSAGE=$O(ORDOSE(DOSAGE)) Q:+$G(DOSAGE)=0 D
- . . S:+$P(ORDOSE(DOSAGE),U,1)=0 ORDOSE("LOCAL")=1
- Q
- ;
- NFI(OI) ; -- Show NFI restrictions, if exist
- N PSOI,I,J,LCNT,MAX,X,STOP
- S PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2)
- D EN^PSSDIN(PSOI,"") Q:'$D(^TMP("PSSDIN",$J,"OI",PSOI)) ;DBIA 3166
- S I=0,LCNT=0,MAX=$S($G(IOBM)&$G(IOTM):IOBM-IOTM+1,1:24) W !
- F S I=$O(^TMP("PSSDIN",$J,"OI",PSOI,I)) Q:I'>0 D
- . 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)
- .. S LCNT=LCNT+1 I LCNT'<MAX S:'$$CONT STOP=1 Q:$G(STOP) S LCNT=1
- .. W !,X
- W ! K ^TMP("PSSDIN",$J,"OI",PSOI)
- Q
- ;
- CONT() ; -- Cont or stop?
- N X,Y,DIR,DUOUT,DTOUT,DIRUT,DIROUT S DIR(0)="EA"
- S DIR("A")="Press <return> to continue or ^ to stop ..."
- D ^DIR S:$D(DUOUT)!$D(DTOUT) Y=""
- Q +Y
- ;
- WAIT ; -- Wait for user
- N X W !,"Press <return> to continue ..." R X:DTIME
- Q
- ;
- ROUTES ; -- Get med routes
- Q:$G(ORDIALOG(PROMPT,"LIST")) N I,X,CNT S (I,CNT)=0
- 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)
- S:$G(CNT) ORDIALOG(PROMPT,"LIST")=CNT
- S:$G(ORTYPE)'="Z" REQD=$S(ORCAT="I":1,$P($G(^ORD(101.43,+$G(OROI),"PS")),U,5):0,1:1)
- Q
- ;
- DEFRTE ; -- Get default route
- N INST1 S INST1=$O(ORDIALOG(PROMPT,0)) S:INST1'>0 INST1=INST
- I INST1=INST S Y=+$P($G(^TMP("PSJMR",$J,1)),U,3) K:Y'>0 Y Q
- S Y=+$G(ORDIALOG(PROMPT,INST1)) K:Y'>0 Y S:$G(Y) EDITONLY=1
- Q
- ;
- CKSCH ; -- validate schedule [Called from P-S Action]
- N ORX S ORX=ORDIALOG(PROMPT,ORI) Q:ORX=$G(ORESET) K ORSD
- D EN^PSSGS0(.ORX,$G(ORCAT))
- I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX D CHANGED("QUANTITY") Q ;ok
- W $C(7),!,"Enter a standard schedule for administering this medication"
- K DONE I $G(ORCAT)="I" W ".",! Q
- W " or one of your own,",!,"up to 20 characters.",!
- Q
- ;
- DEFCONJ ; -- Set default conjuction for previous instance [P-S Action]
- N LAST,DUR,CONJ
- S LAST=$O(ORDIALOG(PROMPT,ORI),-1) Q:LAST'>0 ;first instance
- S CONJ=$$PTR("AND/THEN") Q:$L($G(ORDIALOG(CONJ,LAST)))
- S DUR=$G(ORDIALOG($$PTR("DURATION"),LAST))
- S ORDIALOG(CONJ,LAST)=$S(+DUR'>0:"A",1:"T")
- Q
- ;
- ENCONJ ; -- Get allowable values, if req'd for INST
- N P S P=$$PTR("INSTRUCTIONS")
- S:$G(ORTYPE)'="Z" REQD=$S($O(ORDIALOG(P,INST)):1,1:0) ;DJE/VM *350 quick orders should not require this field
- S ORDIALOG(PROMPT,"A")="And/then:"
- S $P(ORDIALOG(PROMPT,0),U,2)="A:AND;T:THEN;"
- Q
- ;
- INPCONJ ;
- N LETTER,DUR
- I $G(X)="" Q
- S LETTER=$$UP^XLFSTR($E(X,1))
- I LETTER'="T" Q
- S DUR=$$PTR("DURATION") I '$L($G(ORDIALOG(DUR,INST))) D
- .W !,"A duration is required when using a 'Then' conjunction."
- .K X
- Q
- ;
- DSUP ; -- Get max/default days supply
- N ORX,Y
- S ORX("PATIENT")=+$G(ORVP),ORX("DRUG")=+$G(ORDRUG)
- D DSUP^PSOSIGDS(.ORX) S Y=+$G(ORX("DAYS SUPPLY")) S:Y'>0 Y=90
- ;S $P(ORDIALOG(PROMPT,0),U,2)="1:"_Y ;max allowed
- I '$G(ORDIALOG(PROMPT,1)),$G(ORTYPE)'="Z" S ORDIALOG(PROMPT,1)=Y
- Q
- ;
- QTY() ; -- Return default quantity [Expects ORDSUP]
- N INSTR,DOSE,DUR,SCH,I,ORX,X,Y
- S Y="" I $G(ORDSUP)'>0!'$G(ORDRUG) G QTYQ ;need days supply, disp drug
- S INSTR=$$PTR("INSTRUCTIONS")
- S DOSE=$$PTR("DOSE"),CONJ=$$PTR("AND/THEN")
- S DUR=$$PTR("DURATION"),SCH=$$PTR("SCHEDULE")
- S I=0 F S I=$O(ORDIALOG(INSTR,I)) Q:I'>0 D Q:'$D(ORX)
- . S X=$P($G(ORDIALOG(DOSE,I)),"&",3) I X'>0 K ORX Q
- . S ORX("DOSE ORDERED",I)=X,ORX("SCHEDULE",I)=$G(ORDIALOG(SCH,I))
- . S X=$G(ORDIALOG(DUR,I)),ORX("DURATION",I)=$$HL7DUR^ORMBLDPS
- . S ORX("CONJUNCTION",I)=$G(ORDIALOG(CONJ,I))
- G:'$D(ORX) QTYQ ;no doses
- S ORX("PATIENT")=+$G(ORVP),ORX("DRUG")=+$G(ORDRUG)
- S ORX("DAYS SUPPLY")=+$G(ORDSUP)
- D QTYX^PSOSIG(.ORX) S Y=$G(ORX("QTY"))
- QTYQ Q Y
- ;
- MAXREFS ; -- Get max refills allowed [Entry Action]
- Q:$G(ORCAT)'="O" N ORX,X
- S ORX("ITEM")=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
- S ORX("DRUG")=+$G(ORDRUG),ORX("PATIENT")=+$G(ORVP)
- I $G(OREVENT),$$TYPE^OREVNTX(OREVENT)="D" S ORX("DISCHARGE")=1
- S ORX("DAYS SUPPLY")=$G(ORDSUP) D MAX^PSOSIGDS(.ORX)
- S OREFILLS=$G(ORX("MAX")),X=$G(ORDIALOG(PROMPT,INST))
- I OREFILLS'>0 S ORDIALOG(PROMPT,INST)=0 W !,"No refills allowed." Q
- S $P(ORDIALOG(PROMPT,0),U,2)="0:"_OREFILLS
- S ORDIALOG(PROMPT,"A")="Refills (0-"_OREFILLS_"): "
- I X,X>OREFILLS S ORDIALOG(PROMPT,INST)=OREFILLS
- Q
- ;
- ASKSC() ; -- Return 1 or 0, if SC prompt should be asked
- I $$SC^PSOCP(+ORVP,+$G(ORDRUG)) Q 0
- ;I $$RXST^IBARXEU(+ORVP)>0 Q 0 ;exempt from copay
- Q 1
- ;
- PTR(X) ; -- Return ptr to prompt OR GTX X
- Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
- ;
- EXIT ; -- exit action for Meds
- S:$G(ORXNP) ORNP=ORXNP
- K ORXNP,ORINPT,ORCAT,ORPKG,OROI,ORIV,ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,OREFILLS,ORQTY,ORQTYUNT,ORCOPAY,PSJNOPC,ORCOMPLX
- K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSJIND",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDPS1 10707 printed Feb 18, 2025@23:54:42 Page 2
- ORCDPS1 ;SLC/MKB-Pharmacy dialog utilities ;Nov 13, 2019@09:12:46
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,117,141,149,195,215,243,280,337,311,350,377,405,499**;Dec 17, 1997;Build 165
- +2 ;
- +3 ; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J)
- +4 ; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J)
- +5 ; DBIA 2534 SC^PSOCP
- +6 ; DBIA 3237 ^PSOSIG
- +7 ; DBIA 3278 ^PSOSIGDS
- +8 ; DBIA 3423 ^PSSGS0
- +9 ; DBIA 3233 ^PSSORUTL
- +10 ; DBIA 3239 ^PSSUTIL1
- +11 ; DBIA 3373 ^PSSUTLA1
- +12 ;
- EN(TYPE) ; -- entry action for Meds dialogs
- +1 SET ORINPT=$$INPT^ORCD
- SET ORCAT=$GET(TYPE)
- +2 ;allow inpt meds at this location?
- IF 'ORINPT
- IF ORCAT="I"
- DO IMOLOC^ORIMO(.ORINPT,+ORL,+ORVP)
- if ORINPT<0
- SET ORINPT=0
- +3 IF ORCAT=""
- Begin DoDot:1
- +4 ;use value from order, via ORCACT4
- IF $GET(ORENEW)!$GET(OREWRITE)!$DATA(OREDIT)
- IF $LENGTH($PIECE($GET(OR0),U,12))
- SET ORCAT=$PIECE(OR0,U,12)
- QUIT
- +5 SET ORCAT=$SELECT(ORINPT:"I",1:"O")
- End DoDot:1
- +6 SET ORDG=+$ORDER(^ORD(100.98,"B",$SELECT(ORCAT="I":"UD RX",1:"O RX"),0))
- +7 KILL ^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB)
- +8 IF $GET(ORENEW)!$GET(OREWRITE)!$GET(OREDIT)!$GET(ORXFER)
- Begin DoDot:1
- +9 IF 'ORINPT
- IF ORCAT="I"
- Begin DoDot:2
- +10 NEW OI
- SET OI=+$ORDER(^OR(100,+$GET(ORIFN),.1,"B",0))
- if OI<1
- QUIT
- +11 IF '$ORDER(^ORD(101.43,OI,9,"B","IVM RX",0))
- SET ORQUIT=1
- WRITE $CHAR(7),!!,"This order may not be placed at this location!"
- QUIT
- End DoDot:2
- if $GET(ORQUIT)
- QUIT
- +12 KILL ORDIALOG($$PTR("START DATE/TIME"),1)
- +13 KILL ORDIALOG($$PTR("NOW"),1)
- if ORCAT'="O"
- QUIT
- +14 NEW WP
- SET WP=$$PTR("WORD PROCESSING 1")
- +15 IF '$GET(ORXFER)
- IF '$$DRAFT^ORWDX2($GET(ORIFN))
- KILL ORDIALOG(WP,1),^TMP("ORWORD",$JOB,WP)
- +16 IF $GET(OREDIT)
- IF '$ORDER(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0))
- KILL ^TMP("ORWORD",$JOB)
- End DoDot:1
- if $GET(ORQUIT)
- QUIT
- +17 IF ORINPT
- IF ORCAT="O"
- WRITE $CHAR(7),!!,"NOTE: This will create an outpatient prescription for an inpatient!",!
- +18 QUIT
- +19 ;
- EN1 ; -- setup Meds dialog for quick order editor using ORDG
- +1 NEW DG
- SET DG=$PIECE($GET(^ORD(100.98,+$GET(ORDG),0)),U,3)
- +2 IF $PIECE(DG," ")="O"!(DG="SPLY")
- SET ORINPT=0
- SET ORCAT="O"
- +3 IF '$TEST
- SET ORINPT=1
- SET ORCAT="I"
- +4 KILL ^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB)
- +5 QUIT
- +6 ;
- ENOI ; -- setup OI prompt
- +1 NEW D
- SET D=$GET(ORDIALOG(PROMPT,"D"))
- +2 if D="S.RX"
- SET ORDIALOG(PROMPT,"D")=$SELECT(ORCAT="I":"S.UD RX",1:"S.O RX")
- +3 ;limit to IV meds for outpt's
- IF ORCAT="I"
- IF 'ORINPT
- IF D="S.UD RX"
- Begin DoDot:1
- +4 ;ORDG=+$O(^ORD(100.98,"B","O RX",0))
- SET ORDIALOG(PROMPT,"D")="S.IVM RX"
- +5 SET ORDIALOG(PROMPT,"?")="Enter the IV medication you wish to order for this patient."
- End DoDot:1
- +6 QUIT
- +7 ;
- DEA ; -- ck DEA# of ordering provider if SchedII drug
- +1 ; patch 499
- if $GET(ORTYPE)="Z"
- QUIT
- NEW DEAFLG,PSOI,ORDEA
- +2 SET PSOI=+$PIECE($GET(^ORD(101.43,+$GET(Y),0)),U,2)
- if PSOI'>0
- QUIT
- +3 ;ok
- SET DEAFLG=$$OIDEA^PSSUTLA1(PSOI,ORCAT)
- if DEAFLG'>0
- QUIT
- +4 ; patch 499 - multiple DEA numbers for one provider
- +5 IF $GET(ORNP)
- SET ORDEA=$$PRDEA^XUSER(ORNP)
- IF '$LENGTH(ORDEA)
- IF '$LENGTH($PIECE($GET(^VA(200,+ORNP,"PS")),U,3))
- WRITE $CHAR(7),!,$PIECE($GET(^(0)),U)_" must have a DEA# or VA# to order this drug!"
- KILL DONE
- QUIT
- +6 IF DEAFLG=1
- WRITE $CHAR(7),!,"This order will require a wet signature!"
- +7 QUIT
- +8 ;
- CHANGED(X) ; -- Kill dependent values when prompt X changes
- +1 NEW PROMPTS,NAME,PTR,P,I
- +2 SET PROMPTS=X
- IF X="OI"
- Begin DoDot:1
- +3 SET PROMPTS="INSTRUCTIONS^ROUTE^SCHEDULE^START DATE/TIME^DURATION^AND/THEN^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS^DAYS SUPPLY^QUANTITY^REFILLS^SERVICE CONNECTED"
- +4 KILL ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,ORQTY,ORQTYUNT,OREFILLS,ORCOPAY
- +5 KILL ^TMP("PSJINS",$JOB),^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB)
- End DoDot:1
- +6 IF X="DS"
- SET PROMPTS="QUANTITY^REFILLS"
- KILL OREFILLS
- +7 FOR P=1:1:$LENGTH(PROMPTS,U)
- SET NAME=$PIECE(PROMPTS,U,P)
- Begin DoDot:1
- +8 SET PTR=$$PTR(NAME)
- if 'PTR
- QUIT
- +9 SET I=0
- FOR
- SET I=$ORDER(ORDIALOG(PTR,I))
- if I'>0
- QUIT
- KILL ORDIALOG(PTR,I)
- +10 KILL ORDIALOG(PTR,"LIST"),^TMP("ORWORD",$JOB,PTR)
- End DoDot:1
- +11 QUIT
- +12 ;
- ORDITM(OI) ; -- Check OI, get dependent info
- +1 ;quit - no value
- if OI'>0
- QUIT
- +2 NEW ORPS,ORPSOI,ORDEA
- SET ORPS=$GET(^ORD(101.43,+OI,"PS"))
- SET ORPSOI=+$PIECE($GET(^(0)),U,2)
- +3 SET ORIV=$SELECT($PIECE(ORPS,U)=2:1,1:0)
- +4 IF $GET(ORCAT)="O"
- IF '$PIECE(ORPS,U,2)
- WRITE $CHAR(7),!,"This drug may not be used in an outpatient order."
- SET ORQUIT=1
- DO WAIT
- QUIT
- +5 IF $GET(ORCAT)="I"
- Begin DoDot:1
- +6 IF $GET(ORINPT)
- IF '$PIECE(ORPS,U)
- WRITE $CHAR(7),!,"This drug may not be used in an inpatient order."
- SET ORQUIT=1
- DO WAIT
- QUIT
- +7 IF '$GET(ORINPT)
- IF 'ORIV
- WRITE $CHAR(7),!,"This drug may not be ordered for an outpatient."
- SET ORQUIT=1
- DO WAIT
- QUIT
- End DoDot:1
- if $GET(ORQUIT)
- QUIT
- +8 IF $GET(ORTYPE)="Q"
- Begin DoDot:1
- +9 ;ok
- NEW DEAFLG
- SET DEAFLG=$$OIDEA^PSSUTLA1(ORPSOI,ORCAT)
- if DEAFLG'>0
- QUIT
- +10 ; patch 499 - multiple DEA numbers for one provider
- +11 IF $GET(ORNP)
- SET ORDEA=$$PRDEA^XUSER(ORNP)
- IF $LENGTH(ORDEA)
- IF '$LENGTH($PIECE($GET(^("PS")),U,3))
- WRITE $CHAR(7),!,$PIECE($GET(^(0)),U)_" must have a DEA# or VA# to order this drug!"
- SET ORQUIT=1
- QUIT
- +12 IF DEAFLG=1
- WRITE $CHAR(7),!,"This order will require a wet signature!"
- End DoDot:1
- IF $GET(ORQUIT)
- DO WAIT
- QUIT
- OI1 ; -ck NF status
- +1 ;alternative
- IF $PIECE(ORPS,U,6)
- IF '$GET(ORENEW)
- Begin DoDot:1
- +2 WRITE !!,"*** This medication is not in the formulary! ***"
- +3 NEW PSX,CNT,ORX,DIR,X,Y,DTOUT,DUOUT
- +4 DO EN1^PSSUTIL1(.ORPSOI,ORCAT)
- IF '$ORDER(ORPSOI(0))
- Begin DoDot:2
- +5 WRITE !," There are no formulary alternatives entered for this item."
- +6 WRITE !," Please consult with your pharmacy before ordering it."
- End DoDot:2
- QUIT
- +7 SET PSX=0
- SET CNT=0
- FOR
- SET PSX=$ORDER(ORPSOI(PSX))
- if PSX'>0
- QUIT
- Begin DoDot:2
- +8 SET ORX=+$ORDER(^ORD(101.43,"ID",PSX_";99PSP",0))
- if ORX'>0
- QUIT
- +9 SET CNT=CNT+1
- SET ORPSOI("OI",CNT)=ORX_U_PSX
- +10 SET DIR("A",CNT)=$JUSTIFY(CNT,3)_" "_$PIECE($GET(^ORD(101.43,ORX,0)),U)
- End DoDot:2
- +11 SET DIR(0)="NAO^1:"_CNT
- SET DIR("A")="Select alternative (or <return> to continue): "
- +12 SET 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."
- +13 if CNT'>0
- QUIT
- WRITE !," Formulary alternatives:"
- DO ^DIR
- +14 IF Y'>0
- if $DATA(DTOUT)!$DATA(DUOUT)
- SET ORQUIT=1
- QUIT
- +15 ;reset parameters if different
- if OI'=+ORPSOI("OI",+Y)
- DO CHANGED("OI")
- +16 SET OI=+ORPSOI("OI",+Y)
- SET ORDIALOG(PROMPT,INST)=OI
- SET OROI=OI
- +17 SET ORPSOI=+$PIECE(ORPSOI("OI",+Y),U,2)
- End DoDot:1
- OI2 ; -get routes, doses [also called from NF^ORCDPS]
- +1 ;DBIA 2418
- if '$DATA(^TMP("PSJMR",$JOB))
- DO START^PSSJORDF(ORPSOI,$GET(ORCAT))
- +2 IF '$DATA(ORDOSE)
- Begin DoDot:1
- +3 DO DOSE^PSSORUTL(.ORDOSE,ORPSOI,$SELECT($GET(ORCAT)="I":"U",1:"O"),+ORVP)
- +4 if $GET(ORDOSE(1))=-1
- KILL ORDOSE
- if '$DATA(ORDOSE)
- QUIT
- +5 SET ORDOSE("LOCAL")=0
- +6 NEW DOSAGE
- +7 SET DOSAGE=0
- FOR
- SET DOSAGE=$ORDER(ORDOSE(DOSAGE))
- if +$GET(DOSAGE)=0
- QUIT
- Begin DoDot:2
- +8 if +$PIECE(ORDOSE(DOSAGE),U,1)=0
- SET ORDOSE("LOCAL")=1
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- NFI(OI) ; -- Show NFI restrictions, if exist
- +1 NEW PSOI,I,J,LCNT,MAX,X,STOP
- +2 SET PSOI=+$PIECE($GET(^ORD(101.43,+$GET(OI),0)),U,2)
- +3 ;DBIA 3166
- DO EN^PSSDIN(PSOI,"")
- if '$DATA(^TMP("PSSDIN",$JOB,"OI",PSOI))
- QUIT
- +4 SET I=0
- SET LCNT=0
- SET MAX=$SELECT($GET(IOBM)&$GET(IOTM):IOBM-IOTM+1,1:24)
- WRITE !
- +5 FOR
- SET I=$ORDER(^TMP("PSSDIN",$JOB,"OI",PSOI,I))
- if I'>0
- QUIT
- Begin DoDot:1
- +6 SET J=0
- FOR
- SET J=$ORDER(^TMP("PSSDIN",$JOB,"OI",PSOI,I,J))
- if J'>0
- QUIT
- SET X=$GET(^(J))
- Begin DoDot:2
- +7 SET LCNT=LCNT+1
- IF LCNT'<MAX
- if '$$CONT
- SET STOP=1
- if $GET(STOP)
- QUIT
- SET LCNT=1
- +8 WRITE !,X
- End DoDot:2
- if $GET(STOP)
- QUIT
- End DoDot:1
- +9 WRITE !
- KILL ^TMP("PSSDIN",$JOB,"OI",PSOI)
- +10 QUIT
- +11 ;
- CONT() ; -- Cont or stop?
- +1 NEW X,Y,DIR,DUOUT,DTOUT,DIRUT,DIROUT
- SET DIR(0)="EA"
- +2 SET DIR("A")="Press <return> to continue or ^ to stop ..."
- +3 DO ^DIR
- if $DATA(DUOUT)!$DATA(DTOUT)
- SET Y=""
- +4 QUIT +Y
- +5 ;
- WAIT ; -- Wait for user
- +1 NEW X
- WRITE !,"Press <return> to continue ..."
- READ X:DTIME
- +2 QUIT
- +3 ;
- ROUTES ; -- Get med routes
- +1 if $GET(ORDIALOG(PROMPT,"LIST"))
- QUIT
- NEW I,X,CNT
- SET (I,CNT)=0
- +2 FOR
- SET I=$ORDER(^TMP("PSJMR",$JOB,I))
- if I'>0
- QUIT
- SET X=^(I)
- SET CNT=CNT+1
- SET ORDIALOG(PROMPT,"LIST",CNT)=$PIECE(X,U,3)_U_$PIECE(X,U,1,2)
- SET ORDIALOG(PROMPT,"LIST","B",$PIECE(X,U))=$PIECE(X,U,3)
- +3 if $GET(CNT)
- SET ORDIALOG(PROMPT,"LIST")=CNT
- +4 if $GET(ORTYPE)'="Z"
- SET REQD=$SELECT(ORCAT="I":1,$PIECE($GET(^ORD(101.43,+$GET(OROI),"PS")),U,5):0,1:1)
- +5 QUIT
- +6 ;
- DEFRTE ; -- Get default route
- +1 NEW INST1
- SET INST1=$ORDER(ORDIALOG(PROMPT,0))
- if INST1'>0
- SET INST1=INST
- +2 IF INST1=INST
- SET Y=+$PIECE($GET(^TMP("PSJMR",$JOB,1)),U,3)
- if Y'>0
- KILL Y
- QUIT
- +3 SET Y=+$GET(ORDIALOG(PROMPT,INST1))
- if Y'>0
- KILL Y
- if $GET(Y)
- SET EDITONLY=1
- +4 QUIT
- +5 ;
- CKSCH ; -- validate schedule [Called from P-S Action]
- +1 NEW ORX
- SET ORX=ORDIALOG(PROMPT,ORI)
- if ORX=$GET(ORESET)
- QUIT
- KILL ORSD
- +2 DO EN^PSSGS0(.ORX,$GET(ORCAT))
- +3 ;ok
- IF $DATA(ORX)
- SET ORDIALOG(PROMPT,ORI)=ORX
- DO CHANGED("QUANTITY")
- QUIT
- +4 WRITE $CHAR(7),!,"Enter a standard schedule for administering this medication"
- +5 KILL DONE
- IF $GET(ORCAT)="I"
- WRITE ".",!
- QUIT
- +6 WRITE " or one of your own,",!,"up to 20 characters.",!
- +7 QUIT
- +8 ;
- DEFCONJ ; -- Set default conjuction for previous instance [P-S Action]
- +1 NEW LAST,DUR,CONJ
- +2 ;first instance
- SET LAST=$ORDER(ORDIALOG(PROMPT,ORI),-1)
- if LAST'>0
- QUIT
- +3 SET CONJ=$$PTR("AND/THEN")
- if $LENGTH($GET(ORDIALOG(CONJ,LAST)))
- QUIT
- +4 SET DUR=$GET(ORDIALOG($$PTR("DURATION"),LAST))
- +5 SET ORDIALOG(CONJ,LAST)=$SELECT(+DUR'>0:"A",1:"T")
- +6 QUIT
- +7 ;
- ENCONJ ; -- Get allowable values, if req'd for INST
- +1 NEW P
- SET P=$$PTR("INSTRUCTIONS")
- +2 ;DJE/VM *350 quick orders should not require this field
- if $GET(ORTYPE)'="Z"
- SET REQD=$SELECT($ORDER(ORDIALOG(P,INST)):1,1:0)
- +3 SET ORDIALOG(PROMPT,"A")="And/then:"
- +4 SET $PIECE(ORDIALOG(PROMPT,0),U,2)="A:AND;T:THEN;"
- +5 QUIT
- +6 ;
- INPCONJ ;
- +1 NEW LETTER,DUR
- +2 IF $GET(X)=""
- QUIT
- +3 SET LETTER=$$UP^XLFSTR($EXTRACT(X,1))
- +4 IF LETTER'="T"
- QUIT
- +5 SET DUR=$$PTR("DURATION")
- IF '$LENGTH($GET(ORDIALOG(DUR,INST)))
- Begin DoDot:1
- +6 WRITE !,"A duration is required when using a 'Then' conjunction."
- +7 KILL X
- End DoDot:1
- +8 QUIT
- +9 ;
- DSUP ; -- Get max/default days supply
- +1 NEW ORX,Y
- +2 SET ORX("PATIENT")=+$GET(ORVP)
- SET ORX("DRUG")=+$GET(ORDRUG)
- +3 DO DSUP^PSOSIGDS(.ORX)
- SET Y=+$GET(ORX("DAYS SUPPLY"))
- if Y'>0
- SET Y=90
- +4 ;S $P(ORDIALOG(PROMPT,0),U,2)="1:"_Y ;max allowed
- +5 IF '$GET(ORDIALOG(PROMPT,1))
- IF $GET(ORTYPE)'="Z"
- SET ORDIALOG(PROMPT,1)=Y
- +6 QUIT
- +7 ;
- QTY() ; -- Return default quantity [Expects ORDSUP]
- +1 NEW INSTR,DOSE,DUR,SCH,I,ORX,X,Y
- +2 ;need days supply, disp drug
- SET Y=""
- IF $GET(ORDSUP)'>0!'$GET(ORDRUG)
- GOTO QTYQ
- +3 SET INSTR=$$PTR("INSTRUCTIONS")
- +4 SET DOSE=$$PTR("DOSE")
- SET CONJ=$$PTR("AND/THEN")
- +5 SET DUR=$$PTR("DURATION")
- SET SCH=$$PTR("SCHEDULE")
- +6 SET I=0
- FOR
- SET I=$ORDER(ORDIALOG(INSTR,I))
- if I'>0
- QUIT
- Begin DoDot:1
- +7 SET X=$PIECE($GET(ORDIALOG(DOSE,I)),"&",3)
- IF X'>0
- KILL ORX
- QUIT
- +8 SET ORX("DOSE ORDERED",I)=X
- SET ORX("SCHEDULE",I)=$GET(ORDIALOG(SCH,I))
- +9 SET X=$GET(ORDIALOG(DUR,I))
- SET ORX("DURATION",I)=$$HL7DUR^ORMBLDPS
- +10 SET ORX("CONJUNCTION",I)=$GET(ORDIALOG(CONJ,I))
- End DoDot:1
- if '$DATA(ORX)
- QUIT
- +11 ;no doses
- if '$DATA(ORX)
- GOTO QTYQ
- +12 SET ORX("PATIENT")=+$GET(ORVP)
- SET ORX("DRUG")=+$GET(ORDRUG)
- +13 SET ORX("DAYS SUPPLY")=+$GET(ORDSUP)
- +14 DO QTYX^PSOSIG(.ORX)
- SET Y=$GET(ORX("QTY"))
- QTYQ QUIT Y
- +1 ;
- MAXREFS ; -- Get max refills allowed [Entry Action]
- +1 if $GET(ORCAT)'="O"
- QUIT
- NEW ORX,X
- +2 SET ORX("ITEM")=+$PIECE($GET(^ORD(101.43,+$GET(OROI),0)),U,2)
- +3 SET ORX("DRUG")=+$GET(ORDRUG)
- SET ORX("PATIENT")=+$GET(ORVP)
- +4 IF $GET(OREVENT)
- IF $$TYPE^OREVNTX(OREVENT)="D"
- SET ORX("DISCHARGE")=1
- +5 SET ORX("DAYS SUPPLY")=$GET(ORDSUP)
- DO MAX^PSOSIGDS(.ORX)
- +6 SET OREFILLS=$GET(ORX("MAX"))
- SET X=$GET(ORDIALOG(PROMPT,INST))
- +7 IF OREFILLS'>0
- SET ORDIALOG(PROMPT,INST)=0
- WRITE !,"No refills allowed."
- QUIT
- +8 SET $PIECE(ORDIALOG(PROMPT,0),U,2)="0:"_OREFILLS
- +9 SET ORDIALOG(PROMPT,"A")="Refills (0-"_OREFILLS_"): "
- +10 IF X
- IF X>OREFILLS
- SET ORDIALOG(PROMPT,INST)=OREFILLS
- +11 QUIT
- +12 ;
- ASKSC() ; -- Return 1 or 0, if SC prompt should be asked
- +1 IF $$SC^PSOCP(+ORVP,+$GET(ORDRUG))
- QUIT 0
- +2 ;I $$RXST^IBARXEU(+ORVP)>0 Q 0 ;exempt from copay
- +3 QUIT 1
- +4 ;
- PTR(X) ; -- Return ptr to prompt OR GTX X
- +1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
- +2 ;
- EXIT ; -- exit action for Meds
- +1 if $GET(ORXNP)
- SET ORNP=ORXNP
- +2 KILL ORXNP,ORINPT,ORCAT,ORPKG,OROI,ORIV,ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,OREFILLS,ORQTY,ORQTYUNT,ORCOPAY,PSJNOPC,ORCOMPLX
- +3 KILL ^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB),^TMP("PSJIND",$JOB)
- +4 QUIT