PSODOSUN ;BIR/RTR - Dose Check Utility routine ;11/18/08
;;7.0;OUTPATIENT PHARMACY;**251,379,372,416,436,402,500,518**;DEC 1997;Build 3
;
DOSE() ;Write Dose output for renew, finish, copy, etc.
N PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,PSODLFLG,PSODLALZ,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1,PSODLOFF
N PSODLNN1,PSODLERR,PSODLERX,PSODLQT,PSOCPXG,PSOCPXRR,PSODLEXR,PSODELNX,PSODLECT,PSOCPXF,PSODTYPE,PSOCPXC,PSOLASTS,PSOQTOUT,PSOEDOUT,PSODSEQ
N PSOSIGC,PSOINTRO,PSOEXCPT,PSOERROR
S (PSODLERF,PSODLERZ,PSODLALZ,PSODLINS,PSODLINR,PSODLINX,PSODLERR,PSODLQT,PSOCPXG,PSOCPXF,PSOLASTS,PSOQTOUT,PSOEDOUT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0,PSODTYPE="N",PSOCPXC=1
I $G(PSORXED)&$G(PSOEDDOS) S PSOCPXC=0 ;don't show summary before accept of order if edit
I $G(PSOCPXB)<4 S PSOCPXC=0
W:$G(PSOEDIT)!$G(PSOCOPY)!($G(PSOFOERR)) @IOF I $P($G(^TMP($J,"PSOPDOSN","OUT",0)),"^")=-1 D S PSODLFLG=0,PSODLOFF=1 G END
.D HD N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF D MESG
.S X="Reason(s): "_$P(^TMP($J,"PSOPDOSN","OUT",0),"^",2),DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
.S PSODELXF=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D HD W:PSODELXF&('PSODLQT) ! D HD W:'PSODLQT " "_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S PSODELXF=1
.K ^UTILITY($J,"W")
;PSOCPXB = Number of Dosing Seq
S PSODLQT=0 K PSOCPXRR
D EN^PSODOSU2
END ;
I $G(PSORX("DFLG")) Q 0
I '$G(PSODLALZ),'$G(PSODLFLG),'$G(PSODLERR),'$G(PSODLOFF) Q 0
I '$G(PSODLFLG) W !
K PSODAILY,DIR,Y,PSODOSEX
D PROMPT Q:$G(PSORX("DFLG"))!$G(PSOQTOUT)!$G(PSODLQT) 1
I '$G(PSODLINS)&('$G(PSODLINR))&('$G(PSODLINX)) Q 0
I $D(^XUSEC("PSORPH",DUZ)) D I Y'=1!($D(DTOUT))!($D(DUOUT))!($G(PSRX("DFLG"))) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
.S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to Continue" D ^DIR K DIR
I '$G(PSODLINS)&'$G(PSODLINR)&('$G(PSODLINX)) Q 0
I '$D(^XUSEC("PSORPH",DUZ)) Q 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
W !!,"Do you want to Process or Cancel medication?" K DIR,Y S DIR("B")="P",DIR(0)="SA^1:PROCESS MEDICATION;0:CANCEL MEDICATION"
S DIR("A")=$$GETGN^PSODOSUN(PSODRUG("IEN"))_": " K ^TMP($J,"PSODOSUN GN")
S DIR("?",1)="Enter '1' or 'P' to Process medication",DIR("?")=" '^' to EXIT",DIR("?",2)=" '0' or 'C' to Cancel Medication"
D ^DIR K DIR
I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
;need to know if user cancelled or not
I Y=0 Q 3_"^"_$S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"MAX DAILY DOSE",$G(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
K PSODOSEX
S PSOSIGC=0
SIG1 ;
D SIG^XUSESIG
I 'PSOSIGC&($G(X1)="") D MSG1 S PSOSIGC=PSOSIGC+1 G SIG1
I $G(X1)="" D MSG2 Q 1
END2 ;
I $G(PSORX("DFLG")) Q 0
Q 2_"^"_$S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"MAX DAILY DOSE",$G(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
;
EVAL(PSODLINS,PSODLINR,PSODLINX) ;
Q $S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"MAX DAILY DOSE",$G(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
;
DOSEX(PSODLXNT) ;Write Dose exceptions for order entry/edit
N PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1
N PSODLNN1,PSODLERX,PSODLQT,PSODELNX,PSODTYPE,PSODCONT,PSODSEQ,PSODOSX,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR
W @IOF S (PSODLERF,PSODLERZ,PSODLINS,PSODLINR,PSODLINX,PSODLQT,PSODCONT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0,PSODTYPE="E"
I $G(PSOEDDOS) Q:$G(PSORXED("CONJUNCTION",1))="" 0 ;don't show messages when simple order before accept of order during edits
I PSOCPXB>3,$G(PSORXED)&$G(PSOEDDOS) S PSOCPXC=0 ;don't show summary before accept of order if edit
I $P($G(^TMP($J,"PSOPDOSN","OUT",0)),"^")=-1 D S PSODLFLG=0,PSODLOFF=1 G ENDX
.D HD N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF D MESG
.S X="Reason(s): "_$P(^TMP($J,"PSOPDOSN","OUT",0),"^",2),DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
.S PSODELXF=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D HD W:PSODELXF&('PSODLQT) ! D HD W:'PSODLQT " "_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S PSODELXF=1
.K ^UTILITY($J,"W")
D EN^PSODOSU2
ENDX ;
S PSODOSX=1
I $G(PSORX("DFLG")) Q 0
K PSOCPXRR
I '$G(PSODLALZ),'$G(PSODLFLG),'$G(PSODLERR),'$G(PSODLOFF) Q 0
;
;This "return to continue" occurs after the last dosing sequence for a complex order with 4 or more dosing sequences during an edit when finishing, placing a new order, copy or edit
;
I '$G(PSOCKCON)&($G(PSOFOERR)) D I $G(PSOQTOUT) Q 0
.Q:($G(PSODLFLG))&$D(^XUSEC("PSORPH",DUZ)) ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
.D RETURN
Q:$G(PSORX("DFLG"))!$G(PSOQTOUT)!$G(PSODLQT) 1
;
I '$G(PSOFOERR) D I $G(PSOQTOUT) Q 0
.Q:$G(PSODLFLG)&$D(^XUSEC("PSORPH",DUZ))
.I '$G(PSOEDIT) Q:$G(PSODOSNW)&'$G(PSOCPXD)&'$G(PSOCOPY)
.Q:($G(PSOCOPY)!$G(PSOEDIT))&'$G(PSOCPXV)
.Q:PSOCPXB>3&$G(PSOCPXV)
.D RETURN
Q:$G(PSORX("DFLG"))!$G(PSOQTOUT)!$G(PSODLQT) 1
;
I '$G(PSODLFLG) W !
I '$D(^XUSEC("PSORPH",DUZ)),$G(PSODLINS)!($G(PSODLINR))!($G(PSODLINX)),$G(PSODLFLG) Q 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
I 'PSODCONT Q:$G(PSOCPXV) 0
I $G(PSODLBD4)&'$G(PSODLINS)&'$G(PSODLINR)&'$G(PSODLINX)&('$G(PSODLALZ)) S Y=1 G ENDX2
K DIR,Y I $D(^XUSEC("PSORPH",DUZ)) S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to Continue" D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
ENDX2 ;
K PSODOSEX
W !
Q 0
DOSEZ() ;Write Dose output summary for complex orders
I $G(PSOEDDOS) Q:$G(PSORXED("CONJUNCTION",1))="" 0 ;don't show messages when simple order before accept of order during edits
N PSOCPXF,PSOCPXC,PSOCPXRR,PSOCPXG,PSODLESM,PSODELNX,PSOCPXH,PSODTYPE,PSOLASTS,PSOLASTD,PSOQTOUT,PSOEDOUT,PSODSEQ
N PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1
N PSODLNN1,PSODLERX,PSODLQT,PSODLEXR,PSODLECT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR
I '$G(PSOTOF) W @IOF
S (PSODLERF,PSODLERZ,PSODLINS,PSODLINR,PSODLINX,PSOCPXF,PSODLQT,PSOCPXH,PSOLASTS,PSOLASTD,PSOQTOUT,PSOEDOUT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0,PSODTYPE="C",PSOCPXC=1
I $G(PSORX("EDIT"))!($G(PSORXED)&$G(PSOEDDOS))!($G(PSOCOPY)&$G(PSODLBD4)) S PSOEDOUT=1
I PSOCPXB>3,$G(PSOEDOUT) S PSOCPXC=0
;I PSOCPXB>3,$G(PSOEDDOS) S PSOCPXC=0 ;don't show summary before accept of order if edit
I $G(PSOCPXB)<4 S PSOCPXC=0
Q:$G(PSOCPXB)<4&'$G(PSOFOERR)&('$G(PSODLFLG)) 0
I $P($G(^TMP($J,"PSOPDOSN","OUT",0)),"^")=-1 S PSODLQT=1 D S PSODLFLG=0,PSODLOFF=1 G ENDZ
.D:PSOCPXC HD W:'PSODLQT&(PSOCPXC) !! N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF D MESG
.S X="Reason(s): "_$P(^TMP($J,"PSOPDOSN","OUT",0),"^",2),DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
.S PSODELXF=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D:PSOCPXC HD W:PSODELXF&('PSODLQT)&(PSOCPXC) ! D:PSOCPXC HD W:'PSODLQT&(PSOCPXC) " "_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S PSODELXF=1
.K ^UTILITY($J,"W")
D EN^PSODOSU2
ENDZ ;
I $G(PSORX("DFLG")) Q 0
K PSODAILY
I '$G(PSODLALZ),'$G(PSODLFLG),'$G(PSODLERR),'$G(PSODLOFF) Q 0
D PROMPT Q:$G(PSORX("DFLG"))!$G(PSOQTOUT)!$G(PSODLQT) 0
I '$G(PSODLINS)&('$G(PSODLINR))&('$G(PSODLINX)) Q 0
I '$G(PSOCPXF)&(PSOLASTS'=PSOCPXB),PSOEDOUT Q 0
K PSODOSEX
I $D(^XUSEC("PSORPH",DUZ)) D I Y'=1!($D(DTOUT))!($D(DUOUT))!($G(PSRX("DFLG"))) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
.K DIR,Y S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to Continue" D ^DIR K DIR
ENDZC ;
I '$G(PSODLINS)&('$G(PSODLINR))&('$G(PSODLINX)) Q 0
I '$D(^XUSEC("PSORPH",DUZ)),$G(PSODLINS)!($G(PSODLINR))!($G(PSODLINX)) Q 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
G ENDZ2:$G(PSORX("EDIT"))!($G(PSORXED)&$G(PSOEDDOS))!($G(PSOCOPY)&$G(PSODLBD4))
W !!,"Do you want to Process or Cancel medication?" K DIR,Y S DIR("B")="P",DIR(0)="SA^1:PROCESS MEDICATION;0:CANCEL MEDICATION"
S DIR("A")=$$GETGN(PSODRUG("IEN"))_": " K ^TMP($J,"PSODOSUN GN")
S DIR("?",1)="Enter '1' or 'P' to Process medication",DIR("?")=" '^' to EXIT",DIR("?",2)=" '0' or 'C' to Cancel Medication"
D ^DIR K DIR,PSODOSEX
I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1 Q 1
S PSOSIGC=0
SIG2 ;
D SIG^XUSESIG
I 'PSOSIGC&($G(X1)="") D MSG1 S PSOSIGC=PSOSIGC+1 G SIG2
I $G(X1)="" D MSG2 Q 1
ENDZ2 ;
I $G(PSORX("DFLG")) Q 0
Q 2_"^"_$S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"MAX DAILY DOSE",$G(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
HD ;
I PSODLQT!(($Y+5)'>IOSL) Q
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
I $D(^XUSEC("PSORPH",DUZ)) D I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODOSEX=1 S:$G(PSOREINS) PSOQUIT=1,PSORX("DFLG")=1 Q 1
.K DIR,Y S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to Continue" D ^DIR K DIR
W @IOF W !
Q
MESG ;Write out System error heading
I 'PSODLQT D HD W !,"Dosing Checks could not be performed.",!
Q
GETGN(PSODRIEN) ;get generic name
K ^TMP($J,"PSODOSUN GN")
D DATA^PSS50(PSODRIEN,,,,,"PSODOSUN GN")
Q $S($D(^TMP($J,"PSODOSUN GN",PSODRIEN,.01)):^TMP($J,"PSODOSUN GN",PSODRIEN,.01),1:"")
;
PROMPT ;
;assumes that a previous check was made to verify that errors, exceptions or messages are present
;if only warnings (exceptions/errors) then display "Press return to continue"; otherwise display "Do you want to continue" prompt.
;FINISH and BACKDOOR are separated below in order keep to a mininum the vast number of scenarios to be tested
I $G(PSODLOFF)&(($Y+5)>IOSL) D RETURN Q
I $G(PSOFOERR) D ;FINISH
.Q:$D(^XUSEC("PSORPH",DUZ))&('$G(PSORENWD))
.I '$G(PSODLFLG) D
..Q:'$G(PSOEDOUT)&$D(^XUSEC("PSORPH",DUZ))&('$G(PSORENWD)) ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
..I '$G(PSORENWD) Q:PSOCPXB<4&('$G(PSODOSX))
..D RETURN
;
I '$G(PSOFOERR)&'$G(PSODLFLG) D ;BACKDOOR
.Q:'$G(PSOEDOUT)&$D(^XUSEC("PSORPH",DUZ))&('$G(PSORENWD)) ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
.I '$G(PSORENWD),('$D(^XUSEC("PSORPH",DUZ))&'$G(PSODCAN)) Q:PSOCPXB<4&('$G(PSODOSX))
.D RETURN
;
I $G(PSODLFLG)&'$D(^XUSEC("PSORPH",DUZ)) D
.I '$G(PSORENWD),('$D(^XUSEC("PSORPH",DUZ))&'$G(PSODCAN)) Q:PSOCPXB<4&('$G(PSODOSX))
.D RETURN
Q
;
RETURN ;
Q:'$D(^XUSEC("PSORPH",DUZ))&($Y<10)
W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR S:'Y PSODLQT=1,PSOQTOUT=1,PSORX("DFLG")=1 W @IOF
Q
;
HD3(PSOLINES,OVRRID) ;
N X,Y,DTOUT,DUOUT,DIR
S:'$G(PSODLQT) PSODLQT=0 S:'$G(OVRRID) OVRRID=0 S:'$G(PSOLINES) PSOLINES=5
I '$G(OVRRID),$G(PSODLQT)!(($Y+PSOLINES)<IOSL) Q
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y W ! K DIR,Y S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR K DIR,PSOLINES,OVRRID
I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q
W @IOF
Q
;
MSG1 ;
W !!," *** You must enter your Current Signature Code. ***"
Q
MSG2 ;
W !!," *** A Signature Code must be entered to continue with this order. ***",!
MSG3 ;
N MSGX,DIR
W ! K DIR S DIR(0)="E",DIR("A")="Press <Enter> to return to the order..." D ^DIR
S PSODLQT=1,PSOQTOUT=1,PSORX("DFLG")=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODOSUN 11580 printed Sep 23, 2025@20:03:33 Page 2
PSODOSUN ;BIR/RTR - Dose Check Utility routine ;11/18/08
+1 ;;7.0;OUTPATIENT PHARMACY;**251,379,372,416,436,402,500,518**;DEC 1997;Build 3
+2 ;
DOSE() ;Write Dose output for renew, finish, copy, etc.
+1 NEW PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,PSODLFLG,PSODLALZ,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1,PSODLOFF
+2 NEW PSODLNN1,PSODLERR,PSODLERX,PSODLQT,PSOCPXG,PSOCPXRR,PSODLEXR,PSODELNX,PSODLECT,PSOCPXF,PSODTYPE,PSOCPXC,PSOLASTS,PSOQTOUT,PSOEDOUT,PSODSEQ
+3 NEW PSOSIGC,PSOINTRO,PSOEXCPT,PSOERROR
+4 SET (PSODLERF,PSODLERZ,PSODLALZ,PSODLINS,PSODLINR,PSODLINX,PSODLERR,PSODLQT,PSOCPXG,PSOCPXF,PSOLASTS,PSOQTOUT,PSOEDOUT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0
SET PSODTYPE="N"
SET PSOCPXC=1
+5 ;don't show summary before accept of order if edit
IF $GET(PSORXED)&$GET(PSOEDDOS)
SET PSOCPXC=0
+6 IF $GET(PSOCPXB)<4
SET PSOCPXC=0
+7 if $GET(PSOEDIT)!$GET(PSOCOPY)!($GET(PSOFOERR))
WRITE @IOF
IF $PIECE($GET(^TMP($JOB,"PSOPDOSN","OUT",0)),"^")=-1
Begin DoDot:1
+8 DO HD
NEW X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
DO MESG
+9 SET X="Reason(s): "_$PIECE(^TMP($JOB,"PSOPDOSN","OUT",0),"^",2)
SET DIWL=1
SET DIWR=76
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+10 SET PSODELXF=0
FOR PSODELXR=0:0
SET PSODELXR=$ORDER(^UTILITY($JOB,"W",DIWL,PSODELXR))
if 'PSODELXR
QUIT
DO HD
if PSODELXF&('PSODLQT)
WRITE !
DO HD
if 'PSODLQT
WRITE " "_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
SET PSODELXF=1
+11 KILL ^UTILITY($JOB,"W")
End DoDot:1
SET PSODLFLG=0
SET PSODLOFF=1
GOTO END
+12 ;PSOCPXB = Number of Dosing Seq
+13 SET PSODLQT=0
KILL PSOCPXRR
+14 DO EN^PSODOSU2
END ;
+1 IF $GET(PSORX("DFLG"))
QUIT 0
+2 IF '$GET(PSODLALZ)
IF '$GET(PSODLFLG)
IF '$GET(PSODLERR)
IF '$GET(PSODLOFF)
QUIT 0
+3 IF '$GET(PSODLFLG)
WRITE !
+4 KILL PSODAILY,DIR,Y,PSODOSEX
+5 DO PROMPT
if $GET(PSORX("DFLG"))!$GET(PSOQTOUT)!$GET(PSODLQT)
QUIT 1
+6 IF '$GET(PSODLINS)&('$GET(PSODLINR))&('$GET(PSODLINX))
QUIT 0
+7 IF $DATA(^XUSEC("PSORPH",DUZ))
Begin DoDot:1
+8 SET DIR("B")="Y"
SET DIR(0)="Y"
SET DIR("A")="Do you want to Continue"
DO ^DIR
KILL DIR
End DoDot:1
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))!($GET(PSRX("DFLG")))
SET PSODOSEX=1
if $GET(PSOREINS)
SET PSOQUIT=1
QUIT 1
+9 IF '$GET(PSODLINS)&'$GET(PSODLINR)&('$GET(PSODLINX))
QUIT 0
+10 IF '$DATA(^XUSEC("PSORPH",DUZ))
QUIT 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
+11 WRITE !!,"Do you want to Process or Cancel medication?"
KILL DIR,Y
SET DIR("B")="P"
SET DIR(0)="SA^1:PROCESS MEDICATION;0:CANCEL MEDICATION"
+12 SET DIR("A")=$$GETGN^PSODOSUN(PSODRUG("IEN"))_": "
KILL ^TMP($JOB,"PSODOSUN GN")
+13 SET DIR("?",1)="Enter '1' or 'P' to Process medication"
SET DIR("?")=" '^' to EXIT"
SET DIR("?",2)=" '0' or 'C' to Cancel Medication"
+14 DO ^DIR
KILL DIR
+15 IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSODOSEX=1
if $GET(PSOREINS)
SET PSOQUIT=1
QUIT 1
+16 ;need to know if user cancelled or not
+17 IF Y=0
QUIT 3_"^"_$SELECT($GET(PSODLINS)&($GET(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$GET(PSODLINS):"MAX SINGLE DOSE",$GET(PSODLINR):"MAX DAILY DOSE",$GET(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
+18 KILL PSODOSEX
+19 SET PSOSIGC=0
SIG1 ;
+1 DO SIG^XUSESIG
+2 IF 'PSOSIGC&($GET(X1)="")
DO MSG1
SET PSOSIGC=PSOSIGC+1
GOTO SIG1
+3 IF $GET(X1)=""
DO MSG2
QUIT 1
END2 ;
+1 IF $GET(PSORX("DFLG"))
QUIT 0
+2 QUIT 2_"^"_$SELECT($GET(PSODLINS)&($GET(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$GET(PSODLINS):"MAX SINGLE DOSE",$GET(PSODLINR):"MAX DAILY DOSE",$GET(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
+3 ;
EVAL(PSODLINS,PSODLINR,PSODLINX) ;
+1 QUIT $SELECT($GET(PSODLINS)&($GET(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$GET(PSODLINS):"MAX SINGLE DOSE",$GET(PSODLINR):"MAX DAILY DOSE",$GET(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
+2 ;
DOSEX(PSODLXNT) ;Write Dose exceptions for order entry/edit
+1 NEW PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1
+2 NEW PSODLNN1,PSODLERX,PSODLQT,PSODELNX,PSODTYPE,PSODCONT,PSODSEQ,PSODOSX,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR
+3 WRITE @IOF
SET (PSODLERF,PSODLERZ,PSODLINS,PSODLINR,PSODLINX,PSODLQT,PSODCONT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0
SET PSODTYPE="E"
+4 ;don't show messages when simple order before accept of order during edits
IF $GET(PSOEDDOS)
if $GET(PSORXED("CONJUNCTION",1))=""
QUIT 0
+5 ;don't show summary before accept of order if edit
IF PSOCPXB>3
IF $GET(PSORXED)&$GET(PSOEDDOS)
SET PSOCPXC=0
+6 IF $PIECE($GET(^TMP($JOB,"PSOPDOSN","OUT",0)),"^")=-1
Begin DoDot:1
+7 DO HD
NEW X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
DO MESG
+8 SET X="Reason(s): "_$PIECE(^TMP($JOB,"PSOPDOSN","OUT",0),"^",2)
SET DIWL=1
SET DIWR=76
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+9 SET PSODELXF=0
FOR PSODELXR=0:0
SET PSODELXR=$ORDER(^UTILITY($JOB,"W",DIWL,PSODELXR))
if 'PSODELXR
QUIT
DO HD
if PSODELXF&('PSODLQT)
WRITE !
DO HD
if 'PSODLQT
WRITE " "_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
SET PSODELXF=1
+10 KILL ^UTILITY($JOB,"W")
End DoDot:1
SET PSODLFLG=0
SET PSODLOFF=1
GOTO ENDX
+11 DO EN^PSODOSU2
ENDX ;
+1 SET PSODOSX=1
+2 IF $GET(PSORX("DFLG"))
QUIT 0
+3 KILL PSOCPXRR
+4 IF '$GET(PSODLALZ)
IF '$GET(PSODLFLG)
IF '$GET(PSODLERR)
IF '$GET(PSODLOFF)
QUIT 0
+5 ;
+6 ;This "return to continue" occurs after the last dosing sequence for a complex order with 4 or more dosing sequences during an edit when finishing, placing a new order, copy or edit
+7 ;
+8 IF '$GET(PSOCKCON)&($GET(PSOFOERR))
Begin DoDot:1
+9 ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
if ($GET(PSODLFLG))&$DATA(^XUSEC("PSORPH",DUZ))
QUIT
+10 DO RETURN
End DoDot:1
IF $GET(PSOQTOUT)
QUIT 0
+11 if $GET(PSORX("DFLG"))!$GET(PSOQTOUT)!$GET(PSODLQT)
QUIT 1
+12 ;
+13 IF '$GET(PSOFOERR)
Begin DoDot:1
+14 if $GET(PSODLFLG)&$DATA(^XUSEC("PSORPH",DUZ))
QUIT
+15 IF '$GET(PSOEDIT)
if $GET(PSODOSNW)&'$GET(PSOCPXD)&'$GET(PSOCOPY)
QUIT
+16 if ($GET(PSOCOPY)!$GET(PSOEDIT))&'$GET(PSOCPXV)
QUIT
+17 if PSOCPXB>3&$GET(PSOCPXV)
QUIT
+18 DO RETURN
End DoDot:1
IF $GET(PSOQTOUT)
QUIT 0
+19 if $GET(PSORX("DFLG"))!$GET(PSOQTOUT)!$GET(PSODLQT)
QUIT 1
+20 ;
+21 IF '$GET(PSODLFLG)
WRITE !
+22 IF '$DATA(^XUSEC("PSORPH",DUZ))
IF $GET(PSODLINS)!($GET(PSODLINR))!($GET(PSODLINX))
IF $GET(PSODLFLG)
QUIT 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
+23 IF 'PSODCONT
if $GET(PSOCPXV)
QUIT 0
+24 IF $GET(PSODLBD4)&'$GET(PSODLINS)&'$GET(PSODLINR)&'$GET(PSODLINX)&('$GET(PSODLALZ))
SET Y=1
GOTO ENDX2
+25 KILL DIR,Y
IF $DATA(^XUSEC("PSORPH",DUZ))
SET DIR("B")="Y"
SET DIR(0)="Y"
SET DIR("A")="Do you want to Continue"
DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSODOSEX=1
if $GET(PSOREINS)
SET PSOQUIT=1
QUIT 1
ENDX2 ;
+1 KILL PSODOSEX
+2 WRITE !
+3 QUIT 0
DOSEZ() ;Write Dose output summary for complex orders
+1 ;don't show messages when simple order before accept of order during edits
IF $GET(PSOEDDOS)
if $GET(PSORXED("CONJUNCTION",1))=""
QUIT 0
+2 NEW PSOCPXF,PSOCPXC,PSOCPXRR,PSOCPXG,PSODLESM,PSODELNX,PSOCPXH,PSODTYPE,PSOLASTS,PSOLASTD,PSOQTOUT,PSOEDOUT,PSODSEQ
+3 NEW PSODLINS,PSODLINR,PSODLINX,PSODLERA,PSODLERB,PSODLERF,PSODLERZ,PSODLPL,PSODLP1,PSODLMSG,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,X1
+4 NEW PSODLNN1,PSODLERX,PSODLQT,PSODLEXR,PSODLECT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR
+5 IF '$GET(PSOTOF)
WRITE @IOF
+6 SET (PSODLERF,PSODLERZ,PSODLINS,PSODLINR,PSODLINX,PSOCPXF,PSODLQT,PSOCPXH,PSOLASTS,PSOLASTD,PSOQTOUT,PSOEDOUT,PSODLOFF,PSOINTRO,PSOEXCPT,PSOERROR)=0
SET PSODTYPE="C"
SET PSOCPXC=1
+7 IF $GET(PSORX("EDIT"))!($GET(PSORXED)&$GET(PSOEDDOS))!($GET(PSOCOPY)&$GET(PSODLBD4))
SET PSOEDOUT=1
+8 IF PSOCPXB>3
IF $GET(PSOEDOUT)
SET PSOCPXC=0
+9 ;I PSOCPXB>3,$G(PSOEDDOS) S PSOCPXC=0 ;don't show summary before accept of order if edit
+10 IF $GET(PSOCPXB)<4
SET PSOCPXC=0
+11 if $GET(PSOCPXB)<4&'$GET(PSOFOERR)&('$GET(PSODLFLG))
QUIT 0
+12 IF $PIECE($GET(^TMP($JOB,"PSOPDOSN","OUT",0)),"^")=-1
SET PSODLQT=1
Begin DoDot:1
+13 if PSOCPXC
DO HD
if 'PSODLQT&(PSOCPXC)
WRITE !!
NEW X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
DO MESG
+14 SET X="Reason(s): "_$PIECE(^TMP($JOB,"PSOPDOSN","OUT",0),"^",2)
SET DIWL=1
SET DIWR=76
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+15 SET PSODELXF=0
FOR PSODELXR=0:0
SET PSODELXR=$ORDER(^UTILITY($JOB,"W",DIWL,PSODELXR))
if 'PSODELXR
QUIT
if PSOCPXC
DO HD
if PSODELXF&('PSODLQT)&(PSOCPXC)
WRITE !
if PSOCPXC
DO HD
if 'PSODLQT&(PSOCPXC)
WRITE " "_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
SET PSODELXF=1
+16 KILL ^UTILITY($JOB,"W")
End DoDot:1
SET PSODLFLG=0
SET PSODLOFF=1
GOTO ENDZ
+17 DO EN^PSODOSU2
ENDZ ;
+1 IF $GET(PSORX("DFLG"))
QUIT 0
+2 KILL PSODAILY
+3 IF '$GET(PSODLALZ)
IF '$GET(PSODLFLG)
IF '$GET(PSODLERR)
IF '$GET(PSODLOFF)
QUIT 0
+4 DO PROMPT
if $GET(PSORX("DFLG"))!$GET(PSOQTOUT)!$GET(PSODLQT)
QUIT 0
+5 IF '$GET(PSODLINS)&('$GET(PSODLINR))&('$GET(PSODLINX))
QUIT 0
+6 IF '$GET(PSOCPXF)&(PSOLASTS'=PSOCPXB)
IF PSOEDOUT
QUIT 0
+7 KILL PSODOSEX
+8 IF $DATA(^XUSEC("PSORPH",DUZ))
Begin DoDot:1
+9 KILL DIR,Y
SET DIR("B")="Y"
SET DIR(0)="Y"
SET DIR("A")="Do you want to Continue"
DO ^DIR
KILL DIR
End DoDot:1
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))!($GET(PSRX("DFLG")))
SET PSODOSEX=1
if $GET(PSOREINS)
SET PSOQUIT=1
QUIT 1
ENDZC ;
+1 IF '$GET(PSODLINS)&('$GET(PSODLINR))&('$GET(PSODLINX))
QUIT 0
+2 IF '$DATA(^XUSEC("PSORPH",DUZ))
IF $GET(PSODLINS)!($GET(PSODLINR))!($GET(PSODLINX))
QUIT 2_"^"_$$EVAL(PSODLINS,PSODLINR,PSODLINX)
+3 if $GET(PSORX("EDIT"))!($GET(PSORXED)&$GET(PSOEDDOS))!($GET(PSOCOPY)&$GET(PSODLBD4))
GOTO ENDZ2
+4 WRITE !!,"Do you want to Process or Cancel medication?"
KILL DIR,Y
SET DIR("B")="P"
SET DIR(0)="SA^1:PROCESS MEDICATION;0:CANCEL MEDICATION"
+5 SET DIR("A")=$$GETGN(PSODRUG("IEN"))_": "
KILL ^TMP($JOB,"PSODOSUN GN")
+6 SET DIR("?",1)="Enter '1' or 'P' to Process medication"
SET DIR("?")=" '^' to EXIT"
SET DIR("?",2)=" '0' or 'C' to Cancel Medication"
+7 DO ^DIR
KILL DIR,PSODOSEX
+8 IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSODOSEX=1
if $GET(PSOREINS)
SET PSOQUIT=1
QUIT 1
+9 SET PSOSIGC=0
SIG2 ;
+1 DO SIG^XUSESIG
+2 IF 'PSOSIGC&($GET(X1)="")
DO MSG1
SET PSOSIGC=PSOSIGC+1
GOTO SIG2
+3 IF $GET(X1)=""
DO MSG2
QUIT 1
ENDZ2 ;
+1 IF $GET(PSORX("DFLG"))
QUIT 0
+2 QUIT 2_"^"_$SELECT($GET(PSODLINS)&($GET(PSODLINR)):"MAX SINGLE DOSE & MAX DAILY DOSE",$GET(PSODLINS):"MAX SINGLE DOSE",$GET(PSODLINR):"MAX DAILY DOSE",$GET(PSODLINX):"MAX SINGLE DOSE & MAX DAILY DOSE",1:"UNKNOWN")
HD ;
+1 IF PSODLQT!(($Y+5)'>IOSL)
QUIT
+2 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+3 IF $DATA(^XUSEC("PSORPH",DUZ))
Begin DoDot:1
+4 KILL DIR,Y
SET DIR("B")="Y"
SET DIR(0)="Y"
SET DIR("A")="Do you want to Continue"
DO ^DIR
KILL DIR
End DoDot:1
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSODOSEX=1
if $GET(PSOREINS)
SET PSOQUIT=1
SET PSORX("DFLG")=1
QUIT 1
+5 WRITE @IOF
WRITE !
+6 QUIT
MESG ;Write out System error heading
+1 IF 'PSODLQT
DO HD
WRITE !,"Dosing Checks could not be performed.",!
+2 QUIT
GETGN(PSODRIEN) ;get generic name
+1 KILL ^TMP($JOB,"PSODOSUN GN")
+2 DO DATA^PSS50(PSODRIEN,,,,,"PSODOSUN GN")
+3 QUIT $SELECT($DATA(^TMP($JOB,"PSODOSUN GN",PSODRIEN,.01)):^TMP($JOB,"PSODOSUN GN",PSODRIEN,.01),1:"")
+4 ;
PROMPT ;
+1 ;assumes that a previous check was made to verify that errors, exceptions or messages are present
+2 ;if only warnings (exceptions/errors) then display "Press return to continue"; otherwise display "Do you want to continue" prompt.
+3 ;FINISH and BACKDOOR are separated below in order keep to a mininum the vast number of scenarios to be tested
+4 IF $GET(PSODLOFF)&(($Y+5)>IOSL)
DO RETURN
QUIT
+5 ;FINISH
IF $GET(PSOFOERR)
Begin DoDot:1
+6 if $DATA(^XUSEC("PSORPH",DUZ))&('$GET(PSORENWD))
QUIT
+7 IF '$GET(PSODLFLG)
Begin DoDot:2
+8 ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
if '$GET(PSOEDOUT)&$DATA(^XUSEC("PSORPH",DUZ))&('$GET(PSORENWD))
QUIT
+9 IF '$GET(PSORENWD)
if PSOCPXB<4&('$GET(PSODOSX))
QUIT
+10 DO RETURN
End DoDot:2
End DoDot:1
+11 ;
+12 ;BACKDOOR
IF '$GET(PSOFOERR)&'$GET(PSODLFLG)
Begin DoDot:1
+13 ;messages need the "do you want to continue" prompt instead but need to evaluate here so that it doesn't show up for edits
if '$GET(PSOEDOUT)&$DATA(^XUSEC("PSORPH",DUZ))&('$GET(PSORENWD))
QUIT
+14 IF '$GET(PSORENWD)
IF ('$DATA(^XUSEC("PSORPH",DUZ))&'$GET(PSODCAN))
if PSOCPXB<4&('$GET(PSODOSX))
QUIT
+15 DO RETURN
End DoDot:1
+16 ;
+17 IF $GET(PSODLFLG)&'$DATA(^XUSEC("PSORPH",DUZ))
Begin DoDot:1
+18 IF '$GET(PSORENWD)
IF ('$DATA(^XUSEC("PSORPH",DUZ))&'$GET(PSODCAN))
if PSOCPXB<4&('$GET(PSODOSX))
QUIT
+19 DO RETURN
End DoDot:1
+20 QUIT
+21 ;
RETURN ;
+1 if '$DATA(^XUSEC("PSORPH",DUZ))&($Y<10)
QUIT
+2 WRITE !
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue,'^' to exit"
DO ^DIR
KILL DIR
if 'Y
SET PSODLQT=1
SET PSOQTOUT=1
SET PSORX("DFLG")=1
WRITE @IOF
+3 QUIT
+4 ;
HD3(PSOLINES,OVRRID) ;
+1 NEW X,Y,DTOUT,DUOUT,DIR
+2 if '$GET(PSODLQT)
SET PSODLQT=0
if '$GET(OVRRID)
SET OVRRID=0
if '$GET(PSOLINES)
SET PSOLINES=5
+3 IF '$GET(OVRRID)
IF $GET(PSODLQT)!(($Y+PSOLINES)<IOSL)
QUIT
+4 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
WRITE !
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press return to continue"
DO ^DIR
KILL DIR,PSOLINES,OVRRID
+5 IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
QUIT
+6 WRITE @IOF
+7 QUIT
+8 ;
MSG1 ;
+1 WRITE !!," *** You must enter your Current Signature Code. ***"
+2 QUIT
MSG2 ;
+1 WRITE !!," *** A Signature Code must be entered to continue with this order. ***",!
MSG3 ;
+1 NEW MSGX,DIR
+2 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press <Enter> to return to the order..."
DO ^DIR
+3 SET PSODLQT=1
SET PSOQTOUT=1
SET PSORX("DFLG")=1
+4 QUIT
+5 ;
