- 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 Jan 18, 2025@03:28:26 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