PSODOSUT ;BIR/RTR - PRE Dose Check Utility routine ;11/18/08
;;7.0;OUTPATIENT PHARMACY;**251,375,372,416,436,402,518**;DEC 1997;Build 3
;External reference to ^PSSDSAPI supported by DBIA 5425
;
;DOSE expect PSODLQT to be defined prior to calling it.
; PSODLQT=1 means no data will be written to the screen, but a value will be returned.
; PSODLQT=0 means data will be written to the screen and a value is returned
;
;EVAL(PSODLINS,PSODLINR) ;
;Q $S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & DAILY DOSE RANGE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"DAILY DOSE RANGE",1:"UNKNOWN")
;
SUMM ;
I 'PSODLQT W !," DOSING CHECK SUMMARY:",!!
S PSOCPXF=1
Q
;
SUB ;Write sub header; called from PSODOSUN
D HD^PSODOSU2 Q:$G(PSODLQTC) I 'PSODLQT,'$G(PSODLEXR) D
.I '$G(PSOINTRO),$G(PSODLEXR) W ! Q
.S PSODLEXR=1
I 'PSODLQT W " DOSE SEQ "_PSOCPXG_":"
S PSOCPXRR(PSOCPXG)=1
Q
;
DAILY ;
Q ;;removed for Mocha 2.1, might add back for 2.2
Q:'$G(PSOCPXC)
I 'PSODLQT W:'$G(PSORENW)!($G(PSOCOPY))!($G(PSORXED)) ! W " DAILY DOSE RANGE WARNING:"
S PSODAILY=1
Q
;
COMPLEX ;called from DOSEZ^PSODOSUN
I 'PSOCPXF&(PSOCPXC) S PSOCPXG=$P(PSODLNN1,";",4) D SUMM K PSODAILY S:PSOCPXC&(PSOCPXG=PSOCPXB) PSOCPXH=1
I PSOCPXC S PSOCPXG=$P(PSODLNN1,";",4) D HD D
.I $G(PSOCPXRR(PSOCPXG))&$P(PSODLNN1,";",5)'="" K PSODAILY
.I '$G(PSOCPXRR(PSOCPXG))&('$G(PSOCPXH)) D SUB I $G(PSOCOPY)!($G(PSORENW)) S:PSOCPXC&(PSOCPXG=PSOCPXB) PSOCPXH=1
.;I PSODLPL="2_RANGE"&PSODLINR&'$G(PSODAILY) D DAILY ;removed for Mocha 2.1, might add back for 2.2
.;I PSODLPL="1_SINGLE_RANGE"&PSODLINX&'$G(PSODAILY) D DAILY ;removed for Mocha 2.1, might add back for 2.2
.D HD W:'PSODLQT ! N X,DIWL,DIWR,DIWF S X=PSODLMSG,DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
.N PSODELXF,PSODELXR 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 HD I 'PSODLQT S PSODELNX=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1)) I '$P($G(PSODELNX),";",5)!($P($G(PSODELNX),";",4)'=PSOCPXG) W !
Q
;
HD ;
I $G(PSODLQT)!(($Y+5)<IOSL)!($G(PSORX("DFLG"))) Q
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR I 'Y!($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) S PSODLQT=1,PSONEW("DFLG")=1,PSORX("DFLG")=1 Q
W @IOF
Q
;
SFD ;
S PSODELXF=1 S:PSODLERX="TEXT" PSODLERZ=1
Q
;
SBAD ;Set Bad Drug flag just in case not set in enhanced check, possibly because Dosage edits are done first
N PSODLBD1,PSODLBD3
I PSODLERB["GCNSEQNO"!(PSODLERB["Drug not matched to NDF") D
.S PSODLBD1=$O(^TMP($J,"PSOPDOSA","OUT","EXCEPTIONS","DOSE",PSODSEQ,PSODLNN1,"")) I PSODLBD1 D
..S PSODLBD3=$P($G(^TMP($J,"PSOPDOSA","OUT","EXCEPTIONS","DOSE",PSODSEQ,PSODLNN1,PSODLBD1)),"^",3) I PSODLBD3 S PSODRUG("BAD",PSODLBD3)=1
Q
;
EXCEPT ;don't show "not matched to NDF" or "no GCNSEQNO" errors for dosing - when dosage is edited enhanced order checks are performed again so we don't want to display these type messages for dosing.
N PSODLER1,PSODLER2,PSODLER3
F PSODLER1=0:0 S PSODLER1=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLER1)) Q:'PSODLER1 D
.S PSODLER2=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLER1))
.I PSODLER2["Drug not matched to NDF"!(PSODLER2["GCNSEQNO") D
.. S PSODLER3="" F PSODLER3=PSODLER1-1:1:PSODLER1 K ^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLER3)
Q
;
FEED() ; Write Line feed after Exceptions if no message globals follow, and next order has no errors or exceptions, only a message
I PSODLQT Q 0
N PSODLNN2
I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE")) Q 0
S PSODLNN2=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1))
I PSODLNN2="" Q 0
I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN2,"ERROR")) Q 0
I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN2,"EXCEPTIONS")) Q 0
Q 1
;
DCHKN ;Called from PSOORNEW, PSOORNE1 & PSOORNEW; Dose Check for Copying an Order
N PSOGENF
S PSOGENF=0
F PSOCPXA=0:0 S PSOCPXA=$O(PSONEW("DOSE",PSOCPXA)) Q:'PSOCPXA S PSOCPXB=PSOCPXB+1
D FIN^PSODOSCL(.PSODLBS1,.PSONEW,.PSODRUG)
S PSODLNVL=$$DOSE^PSODOSUN K ^TMP($J,"PSOPDOSN") K ^TMP($J,"PSOPDOSA")
I $P($G(PSODLNVL),"^")=1 S PSORX("DFLG")=1 Q
I '$G(PSODLNVL) Q
I '$D(^XUSEC("PSORPH",DUZ)) S:$P($G(PSODLNVL),"^") ^TMP("PSODOSF",$J,0)=1 Q
S PSODLNVT=$P(PSODLNVL,"^",2)
I +PSODLNVL=3 S PSORX("DFLG")=1 Q
;I +PSODLNVL=3 D CANCEL(PSONEW("OIRXN")) Q ;CR2724
I +$G(PSOGENF) Q ;Do not do intervention on a single General Dose message.
I $$EN3^PSORXI(PSODLNVT) W !!,"Unable to log intervention, cannot find intervention type.",! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
;
DCHKR ;Renewal Dose Check; Called from PSORENW0
N PSOGENF
S PSOGENF=0
F PSOCPXA=0:0 S PSOCPXA=$O(PSORENW("DOSE",PSOCPXA)) Q:'PSOCPXA S PSOCPXB=PSOCPXB+1
D FIN^PSODOSCL(.PSODLBS1,.PSORENW,.PSODRUG)
S PSODLNVL=$$DOSE^PSODOSUN
I '$D(^XUSEC("PSORPH",DUZ)) S:$P($G(PSODLNVL),"^") ^TMP("PSODOSF",$J,0)=1
K ^TMP($J,"PSOPDOSN") K ^TMP($J,"PSOPDOSA") I $P($G(PSODLNVL),"^")=1 S PSORX("DFLG")=1 Q
D DOSIV
Q
;
DCHKC ;Dose Check on reinstate; Called from PSOCAN2
N PSODCAN,PSOGENF
S PSOGENF=0
I '$D(PSODRUG("IEN")) S:$D(PSORENW("OIRXN")) PSODRUG("IEN")=$$GET1^DIQ(52,PSORENW("OIRXN"),6,"I")
S PSOCPXB=0 F PSOCPXA=0:0 S PSOCPXA=$O(^PSRX(PSORENW("OIRXN"),6,PSOCPXA)) Q:'PSOCPXA I $P($G(^PSRX(PSORENW("OIRXN"),6,PSOCPXA,0)),"^")'="" S PSOCPXB=PSOCPXB+1
D RX^PSODOSCL(.PSODLBS1,PSORENW("OIRXN"))
S PSODLNNN=PSORENW("OIRXN"),PSODCAN=1
S PSODLNVL=$$DOSE^PSODOSUN K ^TMP($J,"PSOPDOSN"),^TMP($J,"PSOPDOSA")
I $P($G(PSODLNVL),"^")=1 S PSORX("DFLG")=1 Q
D DOSIV
I +PSODLNVL=3 S PSORX("DFLG")=1
Q
;
DCHK() ;Dose check after entering Null at the conjunction prompt
;For complex Dosing, they will eventually enter null too, so change to call if it was not a complex order, and null was entered
N PSODONOF S PSODONOF="" D DOSEOFF Q:'+PSODONOF 0
Q:$G(PSORX("DFLG")) 0
;D HD:(($Y+5)>IOSL) Q:$G(PSORX("DFLG")) 0
N PSODLNNN,PSODLENT,PSODLNVL,PSODLNVT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,PSODLBS1,PSODLENT,PSOCPXA,PSOCPXV,PSOTOF,PSOCPXB,PSOGENF,PSOEDDOS
S PSOGENF=0
I $G(PSOEDIT) S PSOEDDOS=1
;Need to make sure Drug Name is what you set in the API
;Either pass in name here, or set in PSODOSCL to array name that PSSDSAPD uses, which is still the .01 of File 50
I $$EXMT^PSSDSAPI(PSODRUG("IEN")) Q 0
I $G(PSODRUG("BAD",PSODRUG("IEN"))) Q 0
;Currently only one prospective drug at a time for Outpatient Dose Check
;S PSODLNNN="O;1;PROSPECTIVE;1"
K ^TMP("PSODOSF",$J)
K ^TMP($J,"PSOPDOSA") K ^TMP($J,"PSOPDOSN") S PSODLBS1(1)="PSOPDOSA",PSODLBS1(3)="PSOPDOSN"
D FIN^PSODOSCL(.PSODLBS1,.PSORXED,.PSODRUG)
S PSODLENT=ENT,PSOCPXV=1,PSOCPXB=0
S PSOCPXB=0 F PSOCPXA=0:0 S PSOCPXA=$O(PSORXED("DOSE",PSOCPXA)) Q:'PSOCPXA S PSOCPXB=PSOCPXB+1
S PSODLNVL=$$DOSEX^PSODOSUN(PSODLENT) S PSOTOF=1 I '$D(^XUSEC("PSORPH",DUZ)) S:$P($G(PSODLNVL),"^") ^TMP("PSODOSF",$J,0)=1
I $G(PSOEDDOS) D HD:(($Y+5)>IOSL) Q:$G(PSORX("DFLG")) 0
I $P($G(PSODLNVL),"^")=1 K ^TMP($J,"PSOPDOSA") K ^TMP($J,"PSOPDOSN") Q 1 ;turn of general dosing flag because Intervention is needed
DCHK2 ;Finishing of a complex order
N PSOCPXC,PSOCPXD
K PSODLNVL
S PSOCPXD=1 ;flag for MOCHA 2.0, used to not display enter to continue prompt after errors/exceptions list which displays just after last dose sequence. MOCHA 2.0 does not display errors or exceptions.
;S (PSOCPXB)=0 ;setting PSOCPXB=0 makes dosing summery not display when cycling through individual doses of a complex order. Dose summary should only show after accept of order.
S PSODLNVL=$$DOSEZ^PSODOSUN K ^TMP($J,"PSOPDOSA") K ^TMP($J,"PSOPDOSN")
I $G(PSOEDDOS) D HD:(($Y+5)>IOSL) Q:$G(PSORX("DFLG")) 0
I $P($G(PSODLNVL),"^")=1 Q 1
I '$D(^XUSEC("PSORPH",DUZ)) S:$P($G(PSODLNVL),"^")=2 ^TMP("PSODOSF",$J,0)=$$CONVMSG($P(PSODLNVL,"^",2)) W ! Q 0
I '$G(PSODLNVL) Q 0
S PSODLNVT=$P(PSODLNVL,"^",2)
I $D(PSORX("EDIT"))!($G(PSORXED)&$G(PSORXED)&$G(PSOEDDOS))!($G(PSOCOPY)&$G(PSODLBD4)) Q 0
I +$G(PSOGENF) Q 0 ;Do not do intervention on a single General Dose message.
I $$EN3^PSORXI(PSODLNVT) W !!,"Unable to log intervention, cannot find intervention type.",! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR
W !
Q 0
;
DCHK1 ;Dose check after entering a value at the Conjunction prompt
Q:$G(PSORX("DFLG"))!($G(PSODLQT))
N PSODONOF S PSODONOF="" D DOSEOFF Q:'+PSODONOF
;D HD:(($Y+5)>IOSL) Q:$G(PSORX("DFLG"))
N PSODLNNN,PSODLNVL,PSODLNVT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,PSODLBS1,PSODLENT,PSOCPXB,PSOGENF
S PSOGENF=0
;Need to make sure Drug Name is what you set in the API
;Either pass in name here, or set in PSODOSCL to array name that PSSDSAPD uses, which is still the .01 of File 50
I $$EXMT^PSSDSAPI(PSODRUG("IEN")) Q
I $G(PSODRUG("BAD",PSODRUG("IEN"))) Q
;Currently only one prospective drug at a time for Outpatient Dose Check
;S PSODLNNN="O;1;PROSPECTIVE;1"
K ^TMP($J,"PSOPDOSA") K ^TMP($J,"PSOPDOSN") S PSODLBS1(1)="PSOPDOSA",PSODLBS1(3)="PSOPDOSN"
D FIN^PSODOSCL(.PSODLBS1,.PSORXED,.PSODRUG)
S PSODLENT=ENT,PSOCPXB=0
F PSOCPXA=0:0 S PSOCPXA=$O(PSORXED("DOSE",PSOCPXA)) Q:'PSOCPXA S PSOCPXB=PSOCPXB+1
S PSODLNVL=$$DOSEX^PSODOSUN(PSODLENT)
D HD:(($Y+5)>IOSL) Q:$G(PSORX("DFLG"))
K ^TMP($J,"PSOPDOSA") K ^TMP($J,"PSOPDOSN") I $P($G(PSODLNVL),"^")=1 S PSORXED("DFLG")=1 Q
I '$G(PSODLNVL) Q
I '$D(^XUSEC("PSORPH",DUZ)) S:$P($G(PSODLNVL),"^")=2 ^TMP("PSODOSF",$J,0)=$$CONVMSG($P(PSODLNVL,"^",2)) W ! Q
S PSODLNVT=$P(PSODLNVL,"^",2)
I +$G(PSOGENF) Q ;Do not do intervention on a single General Dose message.
I $$EN3^PSORXI(PSODLNVT) W !!,"Unable to log intervention, cannot find intervention type.",! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR
W !
Q
;
CONVMSG(MESS) ;Convert DOSE CHECK message to numeric value for field 8 of ^PS(52.4
;For MOCHA 2.0, only returning "DOSAGE EXCEEDS MAX SINGLE DOSE" when a dosing error is present.
N PSODOSF
S MESS="DOSAGE EXCEEDS MAX SINGLE DOSE AND/OR MAX DAILY DOSE"
S PSODOSF=$S(MESS="DOSAGE EXCEEDS MAX SINGLE DOSE AND/OR MAX DAILY DOSE":4,MESS="MAX SINGLE DOSE & MAX DAILY DOSE":3,MESS="MAX SINGLE DOSE":2,MESS="MAX DAILY DOSE":1,1:"")
Q PSODOSF
;
DCHKV ;Dose check when verifying an order
N PSODOSF,PSOLINE,PSOVERFL,PSOVCAN,PSOGENF
S PSOVERFL=1
S PSOGENF=0
F PSOCPXA=0:0 S PSOCPXA=$O(^PSRX(PSONV,6,PSOCPXA)) Q:'PSOCPXA I $P($G(^PSRX(PSONV,6,PSOCPXA,0)),"^")'="" S PSOCPXB=PSOCPXB+1
D RX^PSODOSCL(.PSODLBS1,PSONV)
S $P(PSOLINE,"-",79)="-"
S PSODLNNN=PSONV
S PSODLNVL=$$DOSE^PSODOSUN K ^TMP($J,"PSOPDOSN") K ^TMP($J,"PSOPDOSA") I $P($G(PSODLNVL),"^")=1 S PSORX("DFLG")=1 Q
I '$D(^XUSEC("PSORPH",DUZ)) S:$P($G(PSODLNVL),"^")=2 ^TMP("PSODOSF",$J,0)=$$CONVMSG($P(PSODLNVL,"^",2))
I '$G(PSODLNVL) Q
I +PSODLNVL=3 D Q:PSOVCAN
. D SIG^XUSESIG I X1="" S (PSORX("DFLG"),PSVERFLG)=1 Q
. D NOOR^PSOCAN4
. I $G(DIRUT) D UPOUT^PSODGDG1,KILL^PSODGDG1 K PSONORR,PSORX("INTERVENE") Q
. S PSOVCAN=1
. S DA=PSONV D RXV^PSODGDG1 S DA=PSONV D INV^PSODGDG1 S DA=PSONV D PSDEL^PSODGDG1,DEL^PSODGDG1
. K DIK,LST,PSONOOR S PSVERFLG=1
S PSODLNVT=$P(PSODLNVL,"^",2),PSODOSF=1
I +PSODLNVL=3 S PSORX("DFLG")=1 Q
S DA=PSONV,RX=$G(^PSRX(PSONV,0)) D DOSIV ;CRI^PSODGDG1
Q
;
DOSIV ;DOSE INTERVENTION
I PSOFROM="C",'$D(^XUSEC("PSORPH",DUZ)) Q
I '$D(^XUSEC("PSORPH",DUZ)) S:$P($G(PSODLNVL),"^")=2 ^TMP("PSODOSF",$J,0)=$$CONVMSG($P(PSODLNVL,"^",2)) Q
I '$G(PSODLNVL) Q
S PSODLNVT=$P(PSODLNVL,"^",2)
DOSIV1 ;
I +$G(PSOGENF) Q ;Do not do intervention on a single General Dose message.
I $$EN3^PSORXI(PSODLNVT) D
. W !!,"Unable to log intervention, cannot find intervention type.",!
. K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
;
CANCEL(PSONV) ;CR2724 - where PSONV = RXIEN
D SIG^XUSESIG I X1="" S PSORX("DFLG")=1 Q
D NOOR^PSOCAN4
I $G(DIRUT) D UPOUT^PSODGDG1,KILL^PSODGDG1 K PSONORR,PSORX("INTERVENE") Q
S DA=PSONV D INV^PSODGDG1 S DA=PSONV D PSDEL^PSODGDG1,DEL^PSODGDG1
K DIK,LST,PSONOOR
Q
;
DOSCK(PSOFROM,MSG) ;
;D HD
N PSODONOF S PSODONOF="" D DOSEOFF Q:'+PSODONOF
I $G(PSORX("DFLG"))!($G(PSODOSD)) S PSORX("DFLG")=1 K PSODOSD Q
N PSODLNNN,PSODLNVL,PSODLNVT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,PSODLBS1,PSOCPXA,PSOCPXB,PSOCPXC
Q:$$EXMT^PSSDSAPI(PSODRUG("IEN"))
Q:$G(PSODRUG("BAD",PSODRUG("IEN")))
K ^TMP($J,"PSOPDOSN"),^TMP($J,"PSOPDOSA"),^TMP("PSODOSF",$J) S PSODLBS1(1)="PSOPDOSA",PSODLBS1(3)="PSOPDOSN"
I ($D(DTOUT))!($D(DUOUT))!($G(DIRUT))!($G(PSODLQT)) K PSODLQT,DTOUT,DUOUT,DIRUT,PSORX("DFLG") Q
;D CLEAR^VALM1
S PSOCPXB=0
I PSOFROM="V" D DCHKV Q ;PSOVER1 - verification
I PSOFROM="N" D DCHKN Q ;PSOORNE1 & PSOORNEW - new & copy
I PSOFROM="R" D DCHKR Q ;PSORENW0 - renewal
I PSOFROM="C" D DCHKC Q ;PSOCAN2 - cancel
Q
;
RCONVMS(MESS) ;Convert DOSE CHECK from numeric to alpha
N PSODOSF
S MESS=4 ;For MOCHA 2.0, only returning "DOSAGE EXCEEDS MAX SINGLE DOSE" when a dosing error is present.
S PSODOSF=$S(MESS=4:"DOSAGE EXCEEDS MAX SINGLE DOSE AND/OR MAX DAILY DOSE",MESS=3:"MAX SINGLE DOSE & DAILY DOSE RANGE",MESS=2:"MAX SINGLE DOSE",MESS=1:"DAILY DOSE RANGE",1:"")
Q PSODOSF
;
DOSEOFF ;
S PSODONOF=$$DS^PSSDSAPI
DOSEOFF2 ;
I $G(PSORX("DOSING OFF")),+PSODONOF K PSORX("DOSING OFF"),PSOREINF,PSOONOFC Q
Q:+PSODONOF
I ($G(PSOONOFC)!$G(PSOREINF)),'+PSODONOF S PSORX("DOSING OFF")=1 ;Reinstate news PSORX array so have to work around it
Q:$G(PSORX("DOSING OFF")) ;only display 'dosing off' message once per patient
N PSODOFFC
I '+PSODONOF&($P(PSODONOF,"^",2)'="") D
.S X=$P(PSODONOF,"^",2),DIWL=1,DIWR=73 K ^UTILITY($J,"W") D ^DIWP W !
.S PSODOFFC=0 F PSODOFFC=0:0 S PSODOFFC=$O(^UTILITY($J,"W",DIWL,PSODOFFC)) Q:'PSODOFFC W !?5,$G(^UTILITY($J,"W",DIWL,PSODOFFC,0))
.N DIR,DIRUT,DUOUT,X,Y S DIR(0)="E"
.S DIR("A")="Press Return to continue...",DIR("?")="Press Return to continue"
.W ! D ^DIR K DIRUT,DUOUT,DIR,X,Y W !
.K ^UTILITY($J,"W")
.S PSORX("DOSING OFF")=1 S:$G(PSOREINS) (PSOREINF,PSOONOFC)=1 ;set this flag to only display 'dosing off' message once per session.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODOSUT 14508 printed Sep 23, 2025@20:03:34 Page 2
PSODOSUT ;BIR/RTR - PRE Dose Check Utility routine ;11/18/08
+1 ;;7.0;OUTPATIENT PHARMACY;**251,375,372,416,436,402,518**;DEC 1997;Build 3
+2 ;External reference to ^PSSDSAPI supported by DBIA 5425
+3 ;
+4 ;DOSE expect PSODLQT to be defined prior to calling it.
+5 ; PSODLQT=1 means no data will be written to the screen, but a value will be returned.
+6 ; PSODLQT=0 means data will be written to the screen and a value is returned
+7 ;
+8 ;EVAL(PSODLINS,PSODLINR) ;
+9 ;Q $S($G(PSODLINS)&($G(PSODLINR)):"MAX SINGLE DOSE & DAILY DOSE RANGE",$G(PSODLINS):"MAX SINGLE DOSE",$G(PSODLINR):"DAILY DOSE RANGE",1:"UNKNOWN")
+10 ;
SUMM ;
+1 IF 'PSODLQT
WRITE !," DOSING CHECK SUMMARY:",!!
+2 SET PSOCPXF=1
+3 QUIT
+4 ;
SUB ;Write sub header; called from PSODOSUN
+1 DO HD^PSODOSU2
if $GET(PSODLQTC)
QUIT
IF 'PSODLQT
IF '$GET(PSODLEXR)
Begin DoDot:1
+2 IF '$GET(PSOINTRO)
IF $GET(PSODLEXR)
WRITE !
QUIT
+3 SET PSODLEXR=1
End DoDot:1
+4 IF 'PSODLQT
WRITE " DOSE SEQ "_PSOCPXG_":"
+5 SET PSOCPXRR(PSOCPXG)=1
+6 QUIT
+7 ;
DAILY ;
+1 ;;removed for Mocha 2.1, might add back for 2.2
QUIT
+2 if '$GET(PSOCPXC)
QUIT
+3 IF 'PSODLQT
if '$GET(PSORENW)!($GET(PSOCOPY))!($GET(PSORXED))
WRITE !
WRITE " DAILY DOSE RANGE WARNING:"
+4 SET PSODAILY=1
+5 QUIT
+6 ;
COMPLEX ;called from DOSEZ^PSODOSUN
+1 IF 'PSOCPXF&(PSOCPXC)
SET PSOCPXG=$PIECE(PSODLNN1,";",4)
DO SUMM
KILL PSODAILY
if PSOCPXC&(PSOCPXG=PSOCPXB)
SET PSOCPXH=1
+2 IF PSOCPXC
SET PSOCPXG=$PIECE(PSODLNN1,";",4)
DO HD
Begin DoDot:1
+3 IF $GET(PSOCPXRR(PSOCPXG))&$PIECE(PSODLNN1,";",5)'=""
KILL PSODAILY
+4 IF '$GET(PSOCPXRR(PSOCPXG))&('$GET(PSOCPXH))
DO SUB
IF $GET(PSOCOPY)!($GET(PSORENW))
if PSOCPXC&(PSOCPXG=PSOCPXB)
SET PSOCPXH=1
+5 ;I PSODLPL="2_RANGE"&PSODLINR&'$G(PSODAILY) D DAILY ;removed for Mocha 2.1, might add back for 2.2
+6 ;I PSODLPL="1_SINGLE_RANGE"&PSODLINX&'$G(PSODAILY) D DAILY ;removed for Mocha 2.1, might add back for 2.2
+7 DO HD
if 'PSODLQT
WRITE !
NEW X,DIWL,DIWR,DIWF
SET X=PSODLMSG
SET DIWL=1
SET DIWR=76
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+8 NEW PSODELXF,PSODELXR
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
+9 KILL ^UTILITY($JOB,"W")
+10 DO HD
IF 'PSODLQT
SET PSODELNX=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1))
IF '$PIECE($GET(PSODELNX),";",5)!($PIECE($GET(PSODELNX),";",4)'=PSOCPXG)
WRITE !
End DoDot:1
+11 QUIT
+12 ;
HD ;
+1 IF $GET(PSODLQT)!(($Y+5)<IOSL)!($GET(PSORX("DFLG")))
QUIT
+2 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+3 WRITE !
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue,'^' to exit"
DO ^DIR
KILL DIR
IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSONEW("DFLG")=1
SET PSORX("DFLG")=1
QUIT
+4 WRITE @IOF
+5 QUIT
+6 ;
SFD ;
+1 SET PSODELXF=1
if PSODLERX="TEXT"
SET PSODLERZ=1
+2 QUIT
+3 ;
SBAD ;Set Bad Drug flag just in case not set in enhanced check, possibly because Dosage edits are done first
+1 NEW PSODLBD1,PSODLBD3
+2 IF PSODLERB["GCNSEQNO"!(PSODLERB["Drug not matched to NDF")
Begin DoDot:1
+3 SET PSODLBD1=$ORDER(^TMP($JOB,"PSOPDOSA","OUT","EXCEPTIONS","DOSE",PSODSEQ,PSODLNN1,""))
IF PSODLBD1
Begin DoDot:2
+4 SET PSODLBD3=$PIECE($GET(^TMP($JOB,"PSOPDOSA","OUT","EXCEPTIONS","DOSE",PSODSEQ,PSODLNN1,PSODLBD1)),"^",3)
IF PSODLBD3
SET PSODRUG("BAD",PSODLBD3)=1
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
EXCEPT ;don't show "not matched to NDF" or "no GCNSEQNO" errors for dosing - when dosage is edited enhanced order checks are performed again so we don't want to display these type messages for dosing.
+1 NEW PSODLER1,PSODLER2,PSODLER3
+2 FOR PSODLER1=0:0
SET PSODLER1=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLER1))
if 'PSODLER1
QUIT
Begin DoDot:1
+3 SET PSODLER2=$GET(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLER1))
+4 IF PSODLER2["Drug not matched to NDF"!(PSODLER2["GCNSEQNO")
Begin DoDot:2
+5 SET PSODLER3=""
FOR PSODLER3=PSODLER1-1:1:PSODLER1
KILL ^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLER3)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
FEED() ; Write Line feed after Exceptions if no message globals follow, and next order has no errors or exceptions, only a message
+1 IF PSODLQT
QUIT 0
+2 NEW PSODLNN2
+3 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE"))
QUIT 0
+4 SET PSODLNN2=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1))
+5 IF PSODLNN2=""
QUIT 0
+6 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN2,"ERROR"))
QUIT 0
+7 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN2,"EXCEPTIONS"))
QUIT 0
+8 QUIT 1
+9 ;
DCHKN ;Called from PSOORNEW, PSOORNE1 & PSOORNEW; Dose Check for Copying an Order
+1 NEW PSOGENF
+2 SET PSOGENF=0
+3 FOR PSOCPXA=0:0
SET PSOCPXA=$ORDER(PSONEW("DOSE",PSOCPXA))
if 'PSOCPXA
QUIT
SET PSOCPXB=PSOCPXB+1
+4 DO FIN^PSODOSCL(.PSODLBS1,.PSONEW,.PSODRUG)
+5 SET PSODLNVL=$$DOSE^PSODOSUN
KILL ^TMP($JOB,"PSOPDOSN")
KILL ^TMP($JOB,"PSOPDOSA")
+6 IF $PIECE($GET(PSODLNVL),"^")=1
SET PSORX("DFLG")=1
QUIT
+7 IF '$GET(PSODLNVL)
QUIT
+8 IF '$DATA(^XUSEC("PSORPH",DUZ))
if $PIECE($GET(PSODLNVL),"^")
SET ^TMP("PSODOSF",$JOB,0)=1
QUIT
+9 SET PSODLNVT=$PIECE(PSODLNVL,"^",2)
+10 IF +PSODLNVL=3
SET PSORX("DFLG")=1
QUIT
+11 ;I +PSODLNVL=3 D CANCEL(PSONEW("OIRXN")) Q ;CR2724
+12 ;Do not do intervention on a single General Dose message.
IF +$GET(PSOGENF)
QUIT
+13 IF $$EN3^PSORXI(PSODLNVT)
WRITE !!,"Unable to log intervention, cannot find intervention type.",!
KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+14 QUIT
+15 ;
DCHKR ;Renewal Dose Check; Called from PSORENW0
+1 NEW PSOGENF
+2 SET PSOGENF=0
+3 FOR PSOCPXA=0:0
SET PSOCPXA=$ORDER(PSORENW("DOSE",PSOCPXA))
if 'PSOCPXA
QUIT
SET PSOCPXB=PSOCPXB+1
+4 DO FIN^PSODOSCL(.PSODLBS1,.PSORENW,.PSODRUG)
+5 SET PSODLNVL=$$DOSE^PSODOSUN
+6 IF '$DATA(^XUSEC("PSORPH",DUZ))
if $PIECE($GET(PSODLNVL),"^")
SET ^TMP("PSODOSF",$JOB,0)=1
+7 KILL ^TMP($JOB,"PSOPDOSN")
KILL ^TMP($JOB,"PSOPDOSA")
IF $PIECE($GET(PSODLNVL),"^")=1
SET PSORX("DFLG")=1
QUIT
+8 DO DOSIV
+9 QUIT
+10 ;
DCHKC ;Dose Check on reinstate; Called from PSOCAN2
+1 NEW PSODCAN,PSOGENF
+2 SET PSOGENF=0
+3 IF '$DATA(PSODRUG("IEN"))
if $DATA(PSORENW("OIRXN"))
SET PSODRUG("IEN")=$$GET1^DIQ(52,PSORENW("OIRXN"),6,"I")
+4 SET PSOCPXB=0
FOR PSOCPXA=0:0
SET PSOCPXA=$ORDER(^PSRX(PSORENW("OIRXN"),6,PSOCPXA))
if 'PSOCPXA
QUIT
IF $PIECE($GET(^PSRX(PSORENW("OIRXN"),6,PSOCPXA,0)),"^")'=""
SET PSOCPXB=PSOCPXB+1
+5 DO RX^PSODOSCL(.PSODLBS1,PSORENW("OIRXN"))
+6 SET PSODLNNN=PSORENW("OIRXN")
SET PSODCAN=1
+7 SET PSODLNVL=$$DOSE^PSODOSUN
KILL ^TMP($JOB,"PSOPDOSN"),^TMP($JOB,"PSOPDOSA")
+8 IF $PIECE($GET(PSODLNVL),"^")=1
SET PSORX("DFLG")=1
QUIT
+9 DO DOSIV
+10 IF +PSODLNVL=3
SET PSORX("DFLG")=1
+11 QUIT
+12 ;
DCHK() ;Dose check after entering Null at the conjunction prompt
+1 ;For complex Dosing, they will eventually enter null too, so change to call if it was not a complex order, and null was entered
+2 NEW PSODONOF
SET PSODONOF=""
DO DOSEOFF
if '+PSODONOF
QUIT 0
+3 if $GET(PSORX("DFLG"))
QUIT 0
+4 ;D HD:(($Y+5)>IOSL) Q:$G(PSORX("DFLG")) 0
+5 NEW PSODLNNN,PSODLENT,PSODLNVL,PSODLNVT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,PSODLBS1,PSODLENT,PSOCPXA,PSOCPXV,PSOTOF,PSOCPXB,PSOGENF,PSOEDDOS
+6 SET PSOGENF=0
+7 IF $GET(PSOEDIT)
SET PSOEDDOS=1
+8 ;Need to make sure Drug Name is what you set in the API
+9 ;Either pass in name here, or set in PSODOSCL to array name that PSSDSAPD uses, which is still the .01 of File 50
+10 IF $$EXMT^PSSDSAPI(PSODRUG("IEN"))
QUIT 0
+11 IF $GET(PSODRUG("BAD",PSODRUG("IEN")))
QUIT 0
+12 ;Currently only one prospective drug at a time for Outpatient Dose Check
+13 ;S PSODLNNN="O;1;PROSPECTIVE;1"
+14 KILL ^TMP("PSODOSF",$JOB)
+15 KILL ^TMP($JOB,"PSOPDOSA")
KILL ^TMP($JOB,"PSOPDOSN")
SET PSODLBS1(1)="PSOPDOSA"
SET PSODLBS1(3)="PSOPDOSN"
+16 DO FIN^PSODOSCL(.PSODLBS1,.PSORXED,.PSODRUG)
+17 SET PSODLENT=ENT
SET PSOCPXV=1
SET PSOCPXB=0
+18 SET PSOCPXB=0
FOR PSOCPXA=0:0
SET PSOCPXA=$ORDER(PSORXED("DOSE",PSOCPXA))
if 'PSOCPXA
QUIT
SET PSOCPXB=PSOCPXB+1
+19 SET PSODLNVL=$$DOSEX^PSODOSUN(PSODLENT)
SET PSOTOF=1
IF '$DATA(^XUSEC("PSORPH",DUZ))
if $PIECE($GET(PSODLNVL),"^")
SET ^TMP("PSODOSF",$JOB,0)=1
+20 IF $GET(PSOEDDOS)
if (($Y+5)>IOSL)
DO HD
if $GET(PSORX("DFLG"))
QUIT 0
+21 ;turn of general dosing flag because Intervention is needed
IF $PIECE($GET(PSODLNVL),"^")=1
KILL ^TMP($JOB,"PSOPDOSA")
KILL ^TMP($JOB,"PSOPDOSN")
QUIT 1
DCHK2 ;Finishing of a complex order
+1 NEW PSOCPXC,PSOCPXD
+2 KILL PSODLNVL
+3 ;flag for MOCHA 2.0, used to not display enter to continue prompt after errors/exceptions list which displays just after last dose sequence. MOCHA 2.0 does not display errors or exceptions.
SET PSOCPXD=1
+4 ;S (PSOCPXB)=0 ;setting PSOCPXB=0 makes dosing summery not display when cycling through individual doses of a complex order. Dose summary should only show after accept of order.
+5 SET PSODLNVL=$$DOSEZ^PSODOSUN
KILL ^TMP($JOB,"PSOPDOSA")
KILL ^TMP($JOB,"PSOPDOSN")
+6 IF $GET(PSOEDDOS)
if (($Y+5)>IOSL)
DO HD
if $GET(PSORX("DFLG"))
QUIT 0
+7 IF $PIECE($GET(PSODLNVL),"^")=1
QUIT 1
+8 IF '$DATA(^XUSEC("PSORPH",DUZ))
if $PIECE($GET(PSODLNVL),"^")=2
SET ^TMP("PSODOSF",$JOB,0)=$$CONVMSG($PIECE(PSODLNVL,"^",2))
WRITE !
QUIT 0
+9 IF '$GET(PSODLNVL)
QUIT 0
+10 SET PSODLNVT=$PIECE(PSODLNVL,"^",2)
+11 IF $DATA(PSORX("EDIT"))!($GET(PSORXED)&$GET(PSORXED)&$GET(PSOEDDOS))!($GET(PSOCOPY)&$GET(PSODLBD4))
QUIT 0
+12 ;Do not do intervention on a single General Dose message.
IF +$GET(PSOGENF)
QUIT 0
+13 IF $$EN3^PSORXI(PSODLNVT)
WRITE !!,"Unable to log intervention, cannot find intervention type.",!
KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+14 WRITE !
+15 QUIT 0
+16 ;
DCHK1 ;Dose check after entering a value at the Conjunction prompt
+1 if $GET(PSORX("DFLG"))!($GET(PSODLQT))
QUIT
+2 NEW PSODONOF
SET PSODONOF=""
DO DOSEOFF
if '+PSODONOF
QUIT
+3 ;D HD:(($Y+5)>IOSL) Q:$G(PSORX("DFLG"))
+4 NEW PSODLNNN,PSODLNVL,PSODLNVT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,PSODLBS1,PSODLENT,PSOCPXB,PSOGENF
+5 SET PSOGENF=0
+6 ;Need to make sure Drug Name is what you set in the API
+7 ;Either pass in name here, or set in PSODOSCL to array name that PSSDSAPD uses, which is still the .01 of File 50
+8 IF $$EXMT^PSSDSAPI(PSODRUG("IEN"))
QUIT
+9 IF $GET(PSODRUG("BAD",PSODRUG("IEN")))
QUIT
+10 ;Currently only one prospective drug at a time for Outpatient Dose Check
+11 ;S PSODLNNN="O;1;PROSPECTIVE;1"
+12 KILL ^TMP($JOB,"PSOPDOSA")
KILL ^TMP($JOB,"PSOPDOSN")
SET PSODLBS1(1)="PSOPDOSA"
SET PSODLBS1(3)="PSOPDOSN"
+13 DO FIN^PSODOSCL(.PSODLBS1,.PSORXED,.PSODRUG)
+14 SET PSODLENT=ENT
SET PSOCPXB=0
+15 FOR PSOCPXA=0:0
SET PSOCPXA=$ORDER(PSORXED("DOSE",PSOCPXA))
if 'PSOCPXA
QUIT
SET PSOCPXB=PSOCPXB+1
+16 SET PSODLNVL=$$DOSEX^PSODOSUN(PSODLENT)
+17 if (($Y+5)>IOSL)
DO HD
if $GET(PSORX("DFLG"))
QUIT
+18 KILL ^TMP($JOB,"PSOPDOSA")
KILL ^TMP($JOB,"PSOPDOSN")
IF $PIECE($GET(PSODLNVL),"^")=1
SET PSORXED("DFLG")=1
QUIT
+19 IF '$GET(PSODLNVL)
QUIT
+20 IF '$DATA(^XUSEC("PSORPH",DUZ))
if $PIECE($GET(PSODLNVL),"^")=2
SET ^TMP("PSODOSF",$JOB,0)=$$CONVMSG($PIECE(PSODLNVL,"^",2))
WRITE !
QUIT
+21 SET PSODLNVT=$PIECE(PSODLNVL,"^",2)
+22 ;Do not do intervention on a single General Dose message.
IF +$GET(PSOGENF)
QUIT
+23 IF $$EN3^PSORXI(PSODLNVT)
WRITE !!,"Unable to log intervention, cannot find intervention type.",!
KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+24 WRITE !
+25 QUIT
+26 ;
CONVMSG(MESS) ;Convert DOSE CHECK message to numeric value for field 8 of ^PS(52.4
+1 ;For MOCHA 2.0, only returning "DOSAGE EXCEEDS MAX SINGLE DOSE" when a dosing error is present.
+2 NEW PSODOSF
+3 SET MESS="DOSAGE EXCEEDS MAX SINGLE DOSE AND/OR MAX DAILY DOSE"
+4 SET PSODOSF=$SELECT(MESS="DOSAGE EXCEEDS MAX SINGLE DOSE AND/OR MAX DAILY DOSE":4,MESS="MAX SINGLE DOSE & MAX DAILY DOSE":3,MESS="MAX SINGLE DOSE":2,MESS="MAX DAILY DOSE":1,1:"")
+5 QUIT PSODOSF
+6 ;
DCHKV ;Dose check when verifying an order
+1 NEW PSODOSF,PSOLINE,PSOVERFL,PSOVCAN,PSOGENF
+2 SET PSOVERFL=1
+3 SET PSOGENF=0
+4 FOR PSOCPXA=0:0
SET PSOCPXA=$ORDER(^PSRX(PSONV,6,PSOCPXA))
if 'PSOCPXA
QUIT
IF $PIECE($GET(^PSRX(PSONV,6,PSOCPXA,0)),"^")'=""
SET PSOCPXB=PSOCPXB+1
+5 DO RX^PSODOSCL(.PSODLBS1,PSONV)
+6 SET $PIECE(PSOLINE,"-",79)="-"
+7 SET PSODLNNN=PSONV
+8 SET PSODLNVL=$$DOSE^PSODOSUN
KILL ^TMP($JOB,"PSOPDOSN")
KILL ^TMP($JOB,"PSOPDOSA")
IF $PIECE($GET(PSODLNVL),"^")=1
SET PSORX("DFLG")=1
QUIT
+9 IF '$DATA(^XUSEC("PSORPH",DUZ))
if $PIECE($GET(PSODLNVL),"^")=2
SET ^TMP("PSODOSF",$JOB,0)=$$CONVMSG($PIECE(PSODLNVL,"^",2))
+10 IF '$GET(PSODLNVL)
QUIT
+11 IF +PSODLNVL=3
Begin DoDot:1
+12 DO SIG^XUSESIG
IF X1=""
SET (PSORX("DFLG"),PSVERFLG)=1
QUIT
+13 DO NOOR^PSOCAN4
+14 IF $GET(DIRUT)
DO UPOUT^PSODGDG1
DO KILL^PSODGDG1
KILL PSONORR,PSORX("INTERVENE")
QUIT
+15 SET PSOVCAN=1
+16 SET DA=PSONV
DO RXV^PSODGDG1
SET DA=PSONV
DO INV^PSODGDG1
SET DA=PSONV
DO PSDEL^PSODGDG1
DO DEL^PSODGDG1
+17 KILL DIK,LST,PSONOOR
SET PSVERFLG=1
End DoDot:1
if PSOVCAN
QUIT
+18 SET PSODLNVT=$PIECE(PSODLNVL,"^",2)
SET PSODOSF=1
+19 IF +PSODLNVL=3
SET PSORX("DFLG")=1
QUIT
+20 ;CRI^PSODGDG1
SET DA=PSONV
SET RX=$GET(^PSRX(PSONV,0))
DO DOSIV
+21 QUIT
+22 ;
DOSIV ;DOSE INTERVENTION
+1 IF PSOFROM="C"
IF '$DATA(^XUSEC("PSORPH",DUZ))
QUIT
+2 IF '$DATA(^XUSEC("PSORPH",DUZ))
if $PIECE($GET(PSODLNVL),"^")=2
SET ^TMP("PSODOSF",$JOB,0)=$$CONVMSG($PIECE(PSODLNVL,"^",2))
QUIT
+3 IF '$GET(PSODLNVL)
QUIT
+4 SET PSODLNVT=$PIECE(PSODLNVL,"^",2)
DOSIV1 ;
+1 ;Do not do intervention on a single General Dose message.
IF +$GET(PSOGENF)
QUIT
+2 IF $$EN3^PSORXI(PSODLNVT)
Begin DoDot:1
+3 WRITE !!,"Unable to log intervention, cannot find intervention type.",!
+4 KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
+5 QUIT
+6 ;
CANCEL(PSONV) ;CR2724 - where PSONV = RXIEN
+1 DO SIG^XUSESIG
IF X1=""
SET PSORX("DFLG")=1
QUIT
+2 DO NOOR^PSOCAN4
+3 IF $GET(DIRUT)
DO UPOUT^PSODGDG1
DO KILL^PSODGDG1
KILL PSONORR,PSORX("INTERVENE")
QUIT
+4 SET DA=PSONV
DO INV^PSODGDG1
SET DA=PSONV
DO PSDEL^PSODGDG1
DO DEL^PSODGDG1
+5 KILL DIK,LST,PSONOOR
+6 QUIT
+7 ;
DOSCK(PSOFROM,MSG) ;
+1 ;D HD
+2 NEW PSODONOF
SET PSODONOF=""
DO DOSEOFF
if '+PSODONOF
QUIT
+3 IF $GET(PSORX("DFLG"))!($GET(PSODOSD))
SET PSORX("DFLG")=1
KILL PSODOSD
QUIT
+4 NEW PSODLNNN,PSODLNVL,PSODLNVT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,PSODLBS1,PSOCPXA,PSOCPXB,PSOCPXC
+5 if $$EXMT^PSSDSAPI(PSODRUG("IEN"))
QUIT
+6 if $GET(PSODRUG("BAD",PSODRUG("IEN")))
QUIT
+7 KILL ^TMP($JOB,"PSOPDOSN"),^TMP($JOB,"PSOPDOSA"),^TMP("PSODOSF",$JOB)
SET PSODLBS1(1)="PSOPDOSA"
SET PSODLBS1(3)="PSOPDOSN"
+8 IF ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))!($GET(PSODLQT))
KILL PSODLQT,DTOUT,DUOUT,DIRUT,PSORX("DFLG")
QUIT
+9 ;D CLEAR^VALM1
+10 SET PSOCPXB=0
+11 ;PSOVER1 - verification
IF PSOFROM="V"
DO DCHKV
QUIT
+12 ;PSOORNE1 & PSOORNEW - new & copy
IF PSOFROM="N"
DO DCHKN
QUIT
+13 ;PSORENW0 - renewal
IF PSOFROM="R"
DO DCHKR
QUIT
+14 ;PSOCAN2 - cancel
IF PSOFROM="C"
DO DCHKC
QUIT
+15 QUIT
+16 ;
RCONVMS(MESS) ;Convert DOSE CHECK from numeric to alpha
+1 NEW PSODOSF
+2 ;For MOCHA 2.0, only returning "DOSAGE EXCEEDS MAX SINGLE DOSE" when a dosing error is present.
SET MESS=4
+3 SET PSODOSF=$SELECT(MESS=4:"DOSAGE EXCEEDS MAX SINGLE DOSE AND/OR MAX DAILY DOSE",MESS=3:"MAX SINGLE DOSE & DAILY DOSE RANGE",MESS=2:"MAX SINGLE DOSE",MESS=1:"DAILY DOSE RANGE",1:"")
+4 QUIT PSODOSF
+5 ;
DOSEOFF ;
+1 SET PSODONOF=$$DS^PSSDSAPI
DOSEOFF2 ;
+1 IF $GET(PSORX("DOSING OFF"))
IF +PSODONOF
KILL PSORX("DOSING OFF"),PSOREINF,PSOONOFC
QUIT
+2 if +PSODONOF
QUIT
+3 ;Reinstate news PSORX array so have to work around it
IF ($GET(PSOONOFC)!$GET(PSOREINF))
IF '+PSODONOF
SET PSORX("DOSING OFF")=1
+4 ;only display 'dosing off' message once per patient
if $GET(PSORX("DOSING OFF"))
QUIT
+5 NEW PSODOFFC
+6 IF '+PSODONOF&($PIECE(PSODONOF,"^",2)'="")
Begin DoDot:1
+7 SET X=$PIECE(PSODONOF,"^",2)
SET DIWL=1
SET DIWR=73
KILL ^UTILITY($JOB,"W")
DO ^DIWP
WRITE !
+8 SET PSODOFFC=0
FOR PSODOFFC=0:0
SET PSODOFFC=$ORDER(^UTILITY($JOB,"W",DIWL,PSODOFFC))
if 'PSODOFFC
QUIT
WRITE !?5,$GET(^UTILITY($JOB,"W",DIWL,PSODOFFC,0))
+9 NEW DIR,DIRUT,DUOUT,X,Y
SET DIR(0)="E"
+10 SET DIR("A")="Press Return to continue..."
SET DIR("?")="Press Return to continue"
+11 WRITE !
DO ^DIR
KILL DIRUT,DUOUT,DIR,X,Y
WRITE !
+12 KILL ^UTILITY($JOB,"W")
+13 ;set this flag to only display 'dosing off' message once per session.
SET PSORX("DOSING OFF")=1
if $GET(PSOREINS)
SET (PSOREINF,PSOONOFC)=1
End DoDot:1
+14 QUIT
