- 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 Jan 18, 2025@03:36:51 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