- 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 Feb 18, 2025@23:53:43 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 ;