ORWDPS3 ;SLC/KCM,JLI - ORDER DIALOGS AND MENUS ;Aug 30, 2018@09:12
;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,94,116,132,187,195,215,280,350,397**;Dec 17, 1997;Build 22
;
;
;
MEDXFER ; -- setup ORDIALOG for a med that is transferred (from SETUP^ORWDXM4)
N IVDIALOG,OI K ^TMP("PS",$J)
S IVDIALOG=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
S ORDIALOG=$O(^ORD(101.41,"AB","PS MEDS",0))
I +$P($G(^OR(100,+ORIT,0)),U,5)=IVDIALOG S ORDIALOG=IVDIALOG
S ORDG=+$P(^ORD(101.41,ORDIALOG,0),U,5)
D GETDLG^ORCD(ORDIALOG)
D GETORDER^ORCD("^OR(100,"_+ORIT_",4.5)")
;I ORDIALOG=IVDIALOG Q
S OI=$$VAL^ORCD("MEDICATION")
I ORDIALOG'=IVDIALOG,'$$MEDOK(OI,ORCAT) D SETERR(ORIT,"This may not be ordered as an "_$S(ORCAT="I":"in",1:"out")_"patient drug.") Q
I +$G(OI)>0,$G(^ORD(101.43,OI,.1)),(^(.1)<$$NOW^XLFDT) D SETERR(ORIT,"This may no longer be ordered.") Q
I (ORDIALOG'=IVDIALOG),(ORCAT="I") D OUT^ORCMED
I (ORDIALOG'=IVDIALOG),(ORCAT="O") D IN^ORCMED
S ORWPSWRG="" ; force interactive dialog for transfers
Q
MEDOK(OI,CAT) ; return 1 if med may be ordered for this patient category
N P S P=$S(CAT="I":1,1:2)
I ORIMO S P=1
N THEGRP,INPTGRP
S THEGRP=0
I $D(ORIT),+ORIT S THEGRP=$P($G(^OR(100,+ORIT,0)),U,11)
S INPTGRP=$O(^ORD(100.98,"B","UD RX",0))
I P=2,(INPTGRP=THEGRP),($P($G(^ORD(101.43,+OI,"PS")),U,1)=2) Q 2
E Q $P($G(^ORD(101.43,+OI,"PS")),U,P)
;
SETERR(ID,X) ; sets LST to rejection with error message
D GETTXT^ORWORR(.LST,ID)
S LST(0)="8^0",LST(.5)=X,LST(.6)=""
Q
;
PS ; setup environment for medications
D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds
K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
N PROMPT,OI
S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
S OI=""
I $D(ORDIALOG(PROMPT,1)) S OI=ORDIALOG(PROMPT,1) D MEDACTV Q:$G(ORQUIT)
N PSOI
S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) D START^PSSJORDF(PSOI,ORCAT)
S PROMPT=$O(^ORD(101.41,"AB","OR GTX SCHEDULE",0))
I $D(ORDIALOG(PROMPT,1)) S ORSCH=ORDIALOG(PROMPT,1)
I (ORCAT="I"),$L($G(ORSCH)) D
. S ORSD=""
. I $L($G(^DPT(+ORVP,.1))) S ORSD=$$STARTSTP^PSJORPOE(+ORVP,ORSCH,PSOI,+$G(ORWARD),"")
. I $P(ORSD,U)="NEXT" S $P(ORSD,U)="NEXTA"
S PROMPT=$O(^ORD(101.41,"AB","OR GTX DAYS SUPPLY",0))
I $D(ORDIALOG(PROMPT,1)) S ORDSUP=ORDIALOG(PROMPT,1)
S PROMPT=$O(^ORD(101.41,"AB","OR GTX DISPENSE DRUG",0))
I $D(ORDIALOG(PROMPT,1)) S ORDRUG=ORDIALOG(PROMPT,1)
S PROMPT=$O(^ORD(101.41,"AB","OR GTX REFILLS",0))
I $D(ORDIALOG(PROMPT,1)) S OREFILLS=ORDIALOG(PROMPT,1)
I ORCAT="O" S ORCOPAY=$$ASKSC^ORCDPS1
I ORCAT="I" S PROMPT=$O(^ORD(101.41,"AB","OR GTX START DATE/TIME",0)) D
. I $L($P($G(ORSD),U)),'$D(ORDIALOG(PROMPT,1)) S ORDIALOG(PROMPT,1)=$P(ORSD,U)
; create a SIG if none exists (i.e., when copying pre-POE orders)
I '$L($G(ORDIALOG($$PTR^ORCD("OR GTX SIG"),1))) D
. N ORDOSE,ORDRUG,ORWPSOI,PROMPT,DRUG
. S PROMPT=$$PTR^ORCD("OR GTX INSTRUCTIONS")
. S ORDRUG=$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1))
. S ORWPSOI=+$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
. I ORWPSOI S ORWPSOI=+$P($G(^ORD(101.43,+ORWPSOI,0)),U,2)
. D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,$S(ORCAT="I":"U",1:"O"),ORVP) ; dflt doses
. D D1^ORCDPS2 ; set up ORDOSE & xrefs in ORDIALOG
. S DRUG=$G(ORDOSE("DD",+ORDRUG))
. I DRUG,ORCAT="O" D RESETID^ORCDPS
. D SIG^ORCDPS2
Q
AUTHMED ; sets ORQUIT if not authorized to write meds
N NOAUTH,NAME
D AUTH^ORWDPS32(.NOAUTH,ORNP,$G(ORDIALOG))
I +NOAUTH D
. S ORQUIT=1
. S LST(0)="8^0"
. I $P(NOAUTH,U,2)'="" S LST(.5)=$P(NOAUTH,U,2) Q
. S NAME=$P($G(^VA(200,+ORNP,20)),U,2)
. I '$L(NAME) S NAME=$P($G(^VA(200,+ORNP,0)),U,1)
. S LST(.5)=NAME_" is not authorized to write med orders."
Q
MEDACTV ; sets ORQUIT if the orderable item is not active for a med
Q:'$G(OI)
I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D
. S ORQUIT=1
. S LST(0)="8^0"
. S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore."
I $D(ORQUIT) Q:ORQUIT
; copied from ORDITM^ORCDPS1 to make sure quick order if for right dialog
N ORPS,PSOI,ORIV,ORINPT
S ORINPT=$$INPT^ORCD
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 $G(ORCAT)="O",'$P(ORPS,U,2),'ORIMO S LST(.5)="This drug may not be used in an outpatient order."
I $G(ORCAT)="I" D
. I $G(ORINPT),'$P(ORPS,U),'$P(ORPS,"^",5),'ORIMO S LST(.5)="This drug may not be used in an inpatient order."
. I '$G(ORINPT),'ORIV,'ORIMO S LST(.5)="This drug may not be ordered for an outpatient."
I $L($G(LST(.5))) S ORQUIT=1,LST(0)="8^0"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDPS3 4644 printed Apr 09, 2024@21:30:58 Page 2
ORWDPS3 ;SLC/KCM,JLI - ORDER DIALOGS AND MENUS ;Aug 30, 2018@09:12
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,94,116,132,187,195,215,280,350,397**;Dec 17, 1997;Build 22
+2 ;
+3 ;
+4 ;
MEDXFER ; -- setup ORDIALOG for a med that is transferred (from SETUP^ORWDXM4)
+1 NEW IVDIALOG,OI
KILL ^TMP("PS",$JOB)
+2 SET IVDIALOG=$ORDER(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
+3 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","PS MEDS",0))
+4 IF +$PIECE($GET(^OR(100,+ORIT,0)),U,5)=IVDIALOG
SET ORDIALOG=IVDIALOG
+5 SET ORDG=+$PIECE(^ORD(101.41,ORDIALOG,0),U,5)
+6 DO GETDLG^ORCD(ORDIALOG)
+7 DO GETORDER^ORCD("^OR(100,"_+ORIT_",4.5)")
+8 ;I ORDIALOG=IVDIALOG Q
+9 SET OI=$$VAL^ORCD("MEDICATION")
+10 IF ORDIALOG'=IVDIALOG
IF '$$MEDOK(OI,ORCAT)
DO SETERR(ORIT,"This may not be ordered as an "_$SELECT(ORCAT="I":"in",1:"out")_"patient drug.")
QUIT
+11 IF +$GET(OI)>0
IF $GET(^ORD(101.43,OI,.1))
IF (^(.1)<$$NOW^XLFDT)
DO SETERR(ORIT,"This may no longer be ordered.")
QUIT
+12 IF (ORDIALOG'=IVDIALOG)
IF (ORCAT="I")
DO OUT^ORCMED
+13 IF (ORDIALOG'=IVDIALOG)
IF (ORCAT="O")
DO IN^ORCMED
+14 ; force interactive dialog for transfers
SET ORWPSWRG=""
+15 QUIT
MEDOK(OI,CAT) ; return 1 if med may be ordered for this patient category
+1 NEW P
SET P=$SELECT(CAT="I":1,1:2)
+2 IF ORIMO
SET P=1
+3 NEW THEGRP,INPTGRP
+4 SET THEGRP=0
+5 IF $DATA(ORIT)
IF +ORIT
SET THEGRP=$PIECE($GET(^OR(100,+ORIT,0)),U,11)
+6 SET INPTGRP=$ORDER(^ORD(100.98,"B","UD RX",0))
+7 IF P=2
IF (INPTGRP=THEGRP)
IF ($PIECE($GET(^ORD(101.43,+OI,"PS")),U,1)=2)
QUIT 2
+8 IF '$TEST
QUIT $PIECE($GET(^ORD(101.43,+OI,"PS")),U,P)
+9 ;
SETERR(ID,X) ; sets LST to rejection with error message
+1 DO GETTXT^ORWORR(.LST,ID)
+2 SET LST(0)="8^0"
SET LST(.5)=X
SET LST(.6)=""
+3 QUIT
+4 ;
PS ; setup environment for medications
+1 ; checks authorized to write meds
DO AUTHMED
if $GET(ORQUIT)
QUIT
+2 KILL ^TMP("PSJINS",$JOB),^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB)
+3 NEW PROMPT,OI
+4 SET PROMPT=$ORDER(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
+5 SET OI=""
+6 IF $DATA(ORDIALOG(PROMPT,1))
SET OI=ORDIALOG(PROMPT,1)
DO MEDACTV
if $GET(ORQUIT)
QUIT
+7 NEW PSOI
+8 SET PSOI=+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
DO START^PSSJORDF(PSOI,ORCAT)
+9 SET PROMPT=$ORDER(^ORD(101.41,"AB","OR GTX SCHEDULE",0))
+10 IF $DATA(ORDIALOG(PROMPT,1))
SET ORSCH=ORDIALOG(PROMPT,1)
+11 IF (ORCAT="I")
IF $LENGTH($GET(ORSCH))
Begin DoDot:1
+12 SET ORSD=""
+13 IF $LENGTH($GET(^DPT(+ORVP,.1)))
SET ORSD=$$STARTSTP^PSJORPOE(+ORVP,ORSCH,PSOI,+$GET(ORWARD),"")
+14 IF $PIECE(ORSD,U)="NEXT"
SET $PIECE(ORSD,U)="NEXTA"
End DoDot:1
+15 SET PROMPT=$ORDER(^ORD(101.41,"AB","OR GTX DAYS SUPPLY",0))
+16 IF $DATA(ORDIALOG(PROMPT,1))
SET ORDSUP=ORDIALOG(PROMPT,1)
+17 SET PROMPT=$ORDER(^ORD(101.41,"AB","OR GTX DISPENSE DRUG",0))
+18 IF $DATA(ORDIALOG(PROMPT,1))
SET ORDRUG=ORDIALOG(PROMPT,1)
+19 SET PROMPT=$ORDER(^ORD(101.41,"AB","OR GTX REFILLS",0))
+20 IF $DATA(ORDIALOG(PROMPT,1))
SET OREFILLS=ORDIALOG(PROMPT,1)
+21 IF ORCAT="O"
SET ORCOPAY=$$ASKSC^ORCDPS1
+22 IF ORCAT="I"
SET PROMPT=$ORDER(^ORD(101.41,"AB","OR GTX START DATE/TIME",0))
Begin DoDot:1
+23 IF $LENGTH($PIECE($GET(ORSD),U))
IF '$DATA(ORDIALOG(PROMPT,1))
SET ORDIALOG(PROMPT,1)=$PIECE(ORSD,U)
End DoDot:1
+24 ; create a SIG if none exists (i.e., when copying pre-POE orders)
+25 IF '$LENGTH($GET(ORDIALOG($$PTR^ORCD("OR GTX SIG"),1)))
Begin DoDot:1
+26 NEW ORDOSE,ORDRUG,ORWPSOI,PROMPT,DRUG
+27 SET PROMPT=$$PTR^ORCD("OR GTX INSTRUCTIONS")
+28 SET ORDRUG=$GET(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1))
+29 SET ORWPSOI=+$GET(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
+30 IF ORWPSOI
SET ORWPSOI=+$PIECE($GET(^ORD(101.43,+ORWPSOI,0)),U,2)
+31 ; dflt doses
DO DOSE^PSSORUTL(.ORDOSE,ORWPSOI,$SELECT(ORCAT="I":"U",1:"O"),ORVP)
+32 ; set up ORDOSE & xrefs in ORDIALOG
DO D1^ORCDPS2
+33 SET DRUG=$GET(ORDOSE("DD",+ORDRUG))
+34 IF DRUG
IF ORCAT="O"
DO RESETID^ORCDPS
+35 DO SIG^ORCDPS2
End DoDot:1
+36 QUIT
AUTHMED ; sets ORQUIT if not authorized to write meds
+1 NEW NOAUTH,NAME
+2 DO AUTH^ORWDPS32(.NOAUTH,ORNP,$GET(ORDIALOG))
+3 IF +NOAUTH
Begin DoDot:1
+4 SET ORQUIT=1
+5 SET LST(0)="8^0"
+6 IF $PIECE(NOAUTH,U,2)'=""
SET LST(.5)=$PIECE(NOAUTH,U,2)
QUIT
+7 SET NAME=$PIECE($GET(^VA(200,+ORNP,20)),U,2)
+8 IF '$LENGTH(NAME)
SET NAME=$PIECE($GET(^VA(200,+ORNP,0)),U,1)
+9 SET LST(.5)=NAME_" is not authorized to write med orders."
End DoDot:1
+10 QUIT
MEDACTV ; sets ORQUIT if the orderable item is not active for a med
+1 if '$GET(OI)
QUIT
+2 IF $GET(^ORD(101.43,OI,.1))
IF ^(.1)'>$$NOW^XLFDT
Begin DoDot:1
+3 SET ORQUIT=1
+4 SET LST(0)="8^0"
+5 SET LST(.5)=$PIECE($GET(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore."
End DoDot:1
+6 IF $DATA(ORQUIT)
if ORQUIT
QUIT
+7 ; copied from ORDITM^ORCDPS1 to make sure quick order if for right dialog
+8 NEW ORPS,PSOI,ORIV,ORINPT
+9 SET ORINPT=$$INPT^ORCD
+10 SET ORPS=$GET(^ORD(101.43,+OI,"PS"))
SET PSOI=+$PIECE($GET(^(0)),U,2)
+11 SET ORIV=$SELECT($PIECE(ORPS,U)=2:1,1:0)
+12 IF $GET(ORCAT)="O"
IF '$PIECE(ORPS,U,2)
IF 'ORIMO
SET LST(.5)="This drug may not be used in an outpatient order."
+13 IF $GET(ORCAT)="I"
Begin DoDot:1
+14 IF $GET(ORINPT)
IF '$PIECE(ORPS,U)
IF '$PIECE(ORPS,"^",5)
IF 'ORIMO
SET LST(.5)="This drug may not be used in an inpatient order."
+15 IF '$GET(ORINPT)
IF 'ORIV
IF 'ORIMO
SET LST(.5)="This drug may not be ordered for an outpatient."
End DoDot:1
+16 IF $LENGTH($GET(LST(.5)))
SET ORQUIT=1
SET LST(0)="8^0"
+17 QUIT
