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 Dec 13, 2024@02:28:08 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
