ORCDPSH ;SLC/CLA-Pharmacy dialog utilities-Non-VA Meds ;14-May-2010 11:04;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,1004,215,243,1010**;Dec 17, 1997;Build 47
;
; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J)
; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J)
;Modified - IHS/MSC/PLS - 5/14/2010 - Lines ORDITM+4, ORDITM+5
EN(TYPE) ; -- entry action for Meds dialogs
S ORDG=+$O(^ORD(100.98,"B","NV RX",0)),ORCAT="O"
K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
I $G(ORENEW)!$G(OREWRITE)!$D(OREDIT)!$G(ORXFER) D
. K ORDIALOG($$PTR("START DATE/TIME"),1)
. K ORDIALOG($$PTR("NOW"),1)
. I $D(OREDIT),'$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) K ^TMP("ORWORD",$J)
Q
;
EN1 ; -- setup Non-VA Meds dialog for quick order editor using ORDG
N DG S DG=$P($G(^ORD(100.98,+$G(ORDG),0)),U,3)
S ORINPT=0,ORCAT="O"
K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
Q
;
ENOI ; -- setup OI prompt
S ORDIALOG(PROMPT,"D")="S.NV RX"
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^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS"
. K ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,ORQTY,ORQTYUNT,OREFILLS,ORCOPAY
. K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
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 inactive date & type, get dependent info
Q:OI'>0 ;quit - no value
N ORPS,PSOI S ORPS=$G(^ORD(101.43,+OI,"PS")),PSOI=+$P($G(^(0)),U,2)
S ORIV=$S($P(ORPS,U)=2:1,1:0)
I '$P(ORPS,U,7) W $C(7),!,"This drug may not be used in an outside med order." S ORQUIT=1 D WAIT Q
OI1 ; ck NF status (don't care if outside meds are formulary or not)
OI2 ; -get selectable routes, doses [also called from NF^ORCDPS]
D:'$D(^TMP("PSJMR",$J)) START^PSSJORDF(PSOI,$G(ORCAT)) ;DBIA 2418
I '$D(ORDOSE) D
. D DOSE^PSSORUTL(.ORDOSE,PSOI,"X",+ORVP)
. K:$G(ORDOSE(1))=-1 ORDOSE
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() ; -- Press return to cont or ^ to 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 allowable 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 REQD=0
Q
;
DEFRTE ; -- Get default route
N INST1 S INST1=$O(ORDIALOG(PROMPT,0)) S:INST1'>0 INST1=INST ;1st 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 ;reset
D EN^PSSGS0(.ORX,"X")
I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX D CHANGED("QUANTITY") Q ;ok
W $C(7),!,"Enter a standard schedule for administering this medication or one of your own,",!,"up to 20 characters.",!
K DONE
Q
;
PTR(X) ; -- Return ptr to prompt OR GTX X
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
;
EXIT ; -- exit action for Meds dialogs
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)
Q
ORCDPSH ;SLC/CLA-Pharmacy dialog utilities-Non-VA Meds ;14-May-2010 11:04;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,1004,215,243,1010**;Dec 17, 1997;Build 47
+2 ;
+3 ; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J)
+4 ; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J)
+5 ;Modified - IHS/MSC/PLS - 5/14/2010 - Lines ORDITM+4, ORDITM+5
EN(TYPE) ; -- entry action for Meds dialogs
+1 SET ORDG=+$ORDER(^ORD(100.98,"B","NV RX",0))
SET ORCAT="O"
+2 KILL ^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB)
+3 IF $GET(ORENEW)!$GET(OREWRITE)!$DATA(OREDIT)!$GET(ORXFER)
Begin DoDot:1
+4 KILL ORDIALOG($$PTR("START DATE/TIME"),1)
+5 KILL ORDIALOG($$PTR("NOW"),1)
+6 IF $DATA(OREDIT)
IF '$ORDER(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0))
KILL ^TMP("ORWORD",$JOB)
End DoDot:1
+7 QUIT
+8 ;
EN1 ; -- setup Non-VA Meds dialog for quick order editor using ORDG
+1 NEW DG
SET DG=$PIECE($GET(^ORD(100.98,+$GET(ORDG),0)),U,3)
+2 SET ORINPT=0
SET ORCAT="O"
+3 KILL ^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB)
+4 QUIT
+5 ;
ENOI ; -- setup OI prompt
+1 SET ORDIALOG(PROMPT,"D")="S.NV RX"
+2 QUIT
+3 ;
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^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS"
+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 FOR P=1:1:$LENGTH(PROMPTS,U)
SET NAME=$PIECE(PROMPTS,U,P)
Begin DoDot:1
+7 SET PTR=$$PTR(NAME)
IF 'PTR
QUIT
+8 SET I=0
FOR
SET I=$ORDER(ORDIALOG(PTR,I))
IF I'>0
QUIT
KILL ORDIALOG(PTR,I)
+9 KILL ORDIALOG(PTR,"LIST"),^TMP("ORWORD",$JOB,PTR)
End DoDot:1
+10 QUIT
+11 ;
ORDITM(OI) ; -- Check OI inactive date & type, get dependent info
+1 ;quit - no value
IF OI'>0
QUIT
+2 NEW ORPS,PSOI
SET ORPS=$GET(^ORD(101.43,+OI,"PS"))
SET PSOI=+$PIECE($GET(^(0)),U,2)
+3 SET ORIV=$SELECT($PIECE(ORPS,U)=2:1,1:0)
+4 IF '$PIECE(ORPS,U,7)
WRITE $CHAR(7),!,"This drug may not be used in an outside med order."
SET ORQUIT=1
DO WAIT
QUIT
OI1 ; ck NF status (don't care if outside meds are formulary or not)
OI2 ; -get selectable routes, doses [also called from NF^ORCDPS]
+1 ;DBIA 2418
IF '$DATA(^TMP("PSJMR",$JOB))
DO START^PSSJORDF(PSOI,$GET(ORCAT))
+2 IF '$DATA(ORDOSE)
Begin DoDot:1
+3 DO DOSE^PSSORUTL(.ORDOSE,PSOI,"X",+ORVP)
+4 IF $GET(ORDOSE(1))=-1
KILL ORDOSE
End DoDot:1
+5 QUIT
+6 ;
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() ; -- Press return to cont or ^ to 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 allowable 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 SET REQD=0
+5 QUIT
+6 ;
DEFRTE ; -- Get default route
+1 ;1st inst
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 ;reset
NEW ORX
SET ORX=ORDIALOG(PROMPT,ORI)
IF ORX=$GET(ORESET)
QUIT
KILL ORSD
+2 DO EN^PSSGS0(.ORX,"X")
+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 or one of your own,",!,"up to 20 characters.",!
+5 KILL DONE
+6 QUIT
+7 ;
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 dialogs
+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)
+4 QUIT
