- ORCDPSH ;SLC/CLA-Pharmacy dialog utilities-Non-VA Meds ; 09 April 2003 11:00 AM
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,215,243**;Dec 17, 1997;Build 242
- ;
- ; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J)
- ; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J)
- ;
- 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 a non-VA med order." S ORQUIT=1 D WAIT Q
- OI1 ; ck NF status (don't care if Non-VA 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDPSH 4135 printed Feb 18, 2025@23:54:45 Page 2
- ORCDPSH ;SLC/CLA-Pharmacy dialog utilities-Non-VA Meds ; 09 April 2003 11:00 AM
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,215,243**;Dec 17, 1997;Build 242
- +2 ;
- +3 ; DBIA 2418 START^PSSJORDF ^TMP("PSJMR",$J)
- +4 ; DBIA 3166 EN^PSSDIN ^TMP("PSSDIN",$J)
- +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 a non-VA med order."
- SET ORQUIT=1
- DO WAIT
- QUIT
- OI1 ; ck NF status (don't care if Non-VA 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