PSODOSU2 ;BIR/RTR - Dose Check Utility routine continued ;11/18/08
;;7.0;OUTPATIENT PHARMACY;**251,375,372,436,402,518**;DEC 1997;Build 3
;
;Called from PSODOSUT. The variable PSODTYPE is expected to be defined.
; PSODTYPE values can be N for dosing for new order, copy, and renews, E for edited and display of individual complex doses, and C for complex orders
;
EN ;new order, copy, renew, and verify orders
N PSODLERW,PSODLERL,PSODLERS,PSODLERH,PSOCPXRR,PSODLWW,PSODOSER,PSONFRNF,PSOWMSG,PSODLQTC,PSOOFL,PSOOCNT
N PSODMESE,PSODMESX,PSODMESG,PSODMEST,PSODMESH,PSODMESM,PSORLNF
S (PSODLERF,PSODSEQ,PSODLWW,PSOOFL,PSORLNF)="",PSOOCNT=0
F S PSODSEQ=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ)) Q:PSODSEQ=""!($G(PSORX("DFLG")))!($G(PSODLQTC)) S PSODLNN1="" D D HD Q:$G(PSODLQTC)
.S:PSODTYPE'="N" PSODLQT=0 S PSOLASTS=PSODSEQ
.I PSODTYPE="C" K PSOCPXRR
.F S PSODLNN1=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1)) Q:PSODLNN1=""!($G(PSORX("DFLG")))!($G(PSODLQTC)) D
..S:PSODTYPE'="E" PSODLECT=0
..I PSODTYPE="E" Q:$P(PSODLNN1,";",4)'=PSODLXNT
..S PSOOCNT=PSOOCNT+1 I PSOOCNT>1,PSOCPXB=2!(PSOCPXB=3) W !
..D EXCEPT^PSODOSUT,SETV
..D ERROR Q:$G(PSODLQTC) I PSODLERZ,'PSODMESX,'PSODMESM W ! I PSODTYPE'="E" W !
..D EXCEPT Q:$G(PSODLQTC) I PSODLERZ,'PSODMESM W ! I PSODTYPE'="E" W !
..D MESSAGE Q:$G(PSODLQTC)
.K PSODLWW
Q
;
ERROR ;format and write dosing error
I PSODTYPE'="E" S PSODLECT=0
F PSODLERA=0:0 S PSODLERA=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR",PSODLERA)) Q:'PSODLERA!($G(PSORX("DFLG"))) D
.S:PSODTYPE'="E" PSODLECT=PSODLECT+1
.S:PSODTYPE'="N" PSODLQT=0
.F PSODLERX="MSG","TEXT" S PSODLERB=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR",PSODLERA,PSODLERX)) D K ^UTILITY($J,"W")
..S PSODLERZ=0 Q:PSODLERB=""
..I PSODTYPE="C"&(PSOCPXB>3) D ERRCOM Q
..I PSODTYPE="E" D ERREDIT Q
..I PSODTYPE="N"&(PSOCPXB>3) D ERRNEW Q
..Q:PSODTYPE="C"&(PSOCPXB<4)
..D ERRNEW
I PSODTYPE="E",PSODMESG W !
Q
;
ERRCOM ;write dosing errors for complex dose summary after accept of an order
I PSOCPXC D HD Q:$G(PSODLQTC) I PSODLERF,PSODLERX="MSG" W:'PSODLQT ! D HD Q:$G(PSODLQTC)
I 'PSODLERF,PSOCPXB<4 W:'PSODLQT&(PSOCPXC) !
S PSODLERF=1 D:PSOCPXC HD I PSODLERZ W:'PSODLQT&(PSOCPXC) !
D:PSOCPXC
.D HD Q:$G(PSODLQTC) W:'PSODLQT&(PSODLECT>1) !
.N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
.D:PSOCPXC HD D:'PSOCPXF&(PSOCPXC)
..Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
.D:PSOCPXC HD S PSOCPXG=$P(PSODLNN1,";",4) I PSOCPXC&('$G(PSOCPXRR(PSOCPXG))) D PSOORI,SUB^PSODOSUT W:'PSODLQT&('PSODLERZ) !
.D:PSOCPXC HD W:'PSODLQT&(PSODLECT'>1)&(PSODLERX="TEXT")&(PSOCPXC) ! S X=PSODLERB,DIWL=1,DIWR=$S(PSODLERX="MSG":76,1:74) 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) ! D
..D:PSOCPXC HD W:'$G(PSODLQT) $S(PSODLERX="MSG":" ",1:" ")_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S (PSODLERR,PSODOSER,PSODLEXR,PSOERROR)=1 D SFD
.S PSOLASTD(PSOLASTS)=1,PSONFRNF=1
Q
;
ERREDIT ;write dosing errors for edits or display during complex dose entry
I 'PSODLERF,PSOCPXB<4 W:'PSODLQT !
D HD Q:$G(PSODLQTC) I PSODLERF,PSODLERX="MSG" W:'PSODLQT ! D HD Q:$G(PSODLQTC) I 'PSODLERF W:'PSODLQT !
S PSODLERF=1 D HD Q:$G(PSODLQTC) I PSODLERZ W:'PSODLQT !
D HD Q:$G(PSODLQTC) W:'PSODLQT !
N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF S X=PSODLERB,DIWL=1,DIWR=$S(PSODLERX="MSG":76,1:74) 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 Q:$G(PSODLQTC) W:PSODELXF&('PSODLQT) ! D HD Q:$G(PSODLQTC) D
.W:'PSODLQT $S(PSODLERX="MSG":" ",1:" ")_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S (PSODLERR,PSODOSER,PSODLEXR,PSOERROR)=1 D SFD
S PSOLASTD(PSOLASTS)=1,PSONFRNF=1
Q
;
ERRNEW ;write dosing errors for finish, new, copy, renewal and verify
D HD Q:$G(PSODLQTC) I PSODLERF,PSODLERX="MSG" W:'PSODLQT ! D HD Q:$G(PSODLQTC)
I $L(PSODLERB)>76&(PSOCPXB>1) S PSODLERL=1
I 'PSODLERF,PSOCPXB<4 W:'PSODLQT !
S PSODLERF=1 D HD Q:$G(PSODLQTC) I PSODLERZ W:'PSODLQT !
D HD Q:$G(PSODLQTC) W:'PSODLQT&(PSODLECT>1) ! N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
D:PSOCPXC HD D:'PSOCPXF&(PSOCPXC)
.Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
D HD Q:$G(PSODLQTC) S PSOCPXG=$P(PSODLNN1,";",4) I '$G(PSOCPXRR(PSOCPXG))&(PSOCPXB>1) D PSOORI,SUB^PSODOSUT W:'PSODLQT&('PSODLERZ) !
D HD Q:$G(PSODLQTC) W:'PSODLQT&(PSODLECT'>1)&(PSODLERX="TEXT") ! S X=PSODLERB,DIWL=1,DIWR=$S(PSODLERX="MSG":76,1:74) 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 Q:$G(PSODLQTC) W:PSODELXF&('PSODLQT) ! D HD Q:$G(PSODLQTC) D
.W:'PSODLQT $S(PSODLERX="MSG":" ",1:" ")_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S (PSODLERR,PSODOSER,PSODLEXR,PSOERROR)=1 D SFD
S PSOLASTD(PSOLASTS)=1,PSONFRNF=1
Q
;
SFD ;
S PSODELXF=1 S:PSODLERX="TEXT" PSODLERZ=1
Q
;
EXCEPT ;format and write exceptions
I PSODTYPE="E" S (PSODLERZ)=0
I $G(PSODOSER),PSODTYPE="N",PSODMESX,PSODMESG W !
I $G(PSODOSER) K PSODOSER I PSODMESX,'PSODMESG W ! ;line feed between error and exceptions
I PSODTYPE="N" D HD Q:$G(PSODLQTC) W:PSODLERF&('PSODLQT)&('PSODMESX)&('PSODMESM) ! S PSODLERZ=0
I PSODTYPE="C" D:PSOCPXC HD W:PSODLERF&(PSOCPXC)&('PSODLQT)&('PSODMESX)&('PSODMESM)&('$G(PSODLWW)) ! S (PSODLERZ,PSODLESM)=0
F PSODLERA=0:0 S PSODLERA=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLERA)) Q:'PSODLERA D
.S PSODLERB=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLERA))
.I PSODTYPE="N" D SBAD^PSODOSUT
.I PSODTYPE="E"!(PSODTYPE="C") D SBAD^PSODOSUT:PSODLERB'=""
.Q:PSODLERB="" I PSODTYPE'="C" D HD Q:$G(PSODLQTC)
.S (PSODLERF,PSODLALZ)=1
.;write exceptions for new, copy, renew, verify
.I PSODTYPE="N" D Q
..D HD Q:$G(PSODLQTC) I 'PSOCPXF&(PSOCPXC) D
...Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
..I 'PSODLERF W:'PSODLQT&('$G(PSODLWW)) ! D HD Q:$G(PSODLQTC) S PSODLWW=0
..S PSOCPXG=$P(PSODLNN1,";",4)
..I '$G(PSOCPXRR(PSOCPXG)),PSOCPXB>1 W:'PSODLQT&(PSODLERZ) ! D PSOORI,SUB^PSODOSUT
..D HD Q:$G(PSODLQTC) W:'PSODLQT&('$G(PSODLWW)) ! S PSODLWW=0
..D WRITEXC
.;write dosing exceptions for edits or display during complex dose entry
.I PSODTYPE="E" D
..I PSODLERB["please complete a manual check for appropriate Dosing" S PSODCONT=1
..D HD Q:$G(PSODLQTC) W:'PSODLQT&('$G(PSODLWW)) ! S PSODLWW=0
..D WRITEXC
.;write exceptions for complex orders
.I PSODTYPE="C"&(PSOCPXB>3) D
..D:PSOCPXC HD I 'PSODLERF&('$G(PSODLWW)) W:'PSODLQT&(PSOCPXC) !
..D:PSOCPXC
...D HD Q:$G(PSODLQTC) I 'PSOCPXF&(PSOCPXC) D
....Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
...S PSOCPXG=$P(PSODLNN1,";",4) I PSOCPXC&('$G(PSOCPXRR(PSOCPXG))) D HD Q:$G(PSODLQTC) W:'PSODLQT&(PSOCPXC)&(PSODLESM)&('$G(PSODLWW)) ! D PSOORI,SUB^PSODOSUT
...S PSODLESM=1 D HD Q:$G(PSODLQTC) W:'PSODLQT&('$G(PSODLWW)) !
...D:PSOCPXC WRITEXC
Q
;
WRITEXC ;format and write exception messages to the screen
D WRITEXC^PSODOSU4 Q
;
MESSAGE ;format and write messages
I PSODTYPE="N",$$FEED^PSODOSUT D HD Q:$G(PSODLQTC) W:'PSODLQT !
I $G(PSODLERZ)&('PSODLQT)&(PSODTYPE'="N") W ! ;line feed for transition between exceptions to messages
I PSODTYPE="C" I $$FEED^PSODOSUT&(PSOCPXC) D HD Q:$G(PSODLQTC) W:'PSODLQT !
S PSODLPL="" F S PSODLPL=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL)) Q:PSODLPL="" D
.;Add a line feed if there are just Single and General dosing messages
.I PSODLPL="3_GENERAL" D
..I PSODTYPE="N" D Q
...I PSODLINS,'PSODLINR,'PSODLINX W ! Q
...I 'PSODLINS,'PSODLINR,'PSODLINX W !!
..W !
.I PSODLPL=".1_INTRO" D
..S PSOINTRO="1^"_$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",".1_INTRO"))
..I $P(PSOINTRO,U,2)="" S PSOINTRO=0
.F PSODLP1=0:0 S PSODLP1=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1)) Q:'PSODLP1 D
..I PSODTYPE'="C",PSODLPL="3_GENERAL" D GENERAL Q
..S PSODLMSG=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1))
..Q:PSODLMSG=""
..I 'PSODLERF W:'PSODLQT&('$G(PSODLWW)) ! D HD Q:$G(PSODLQTC)
..S PSODLERF=1
..I PSODTYPE'="C" D HD Q:$G(PSODLQTC) I 'PSODLQT,'$G(PSODLWW),$G(PSODLERR),'PSORLNF W ! S PSORLNF=1
..I PSODTYPE="C" D Q:'PSODLQT&(PSOCPXC)&(PSODLESM) I PSOCPXF&(PSOCPXC) K PSODAILY
...D:PSOCPXC HD I '$G(PSODLFLG) W:'PSODLQT&(PSOCPXC)&(PSOCPXF)&('$G(PSODLWW)) !
...S PSODLFLG=1 S PSODLEXR=0
..I PSODTYPE'="E" S PSODLEXR=0
..S PSODLFLG=1 S:PSODLPL="1_SINGLE" PSODLINS=1 S:PSODLPL="2_RANGE" PSODLINR=1 S:PSODLPL="1_SINGLE_RANGE" PSODLINX=1
..I PSODTYPE="N" S PSODLFLG=1 D MSGN
..I PSODTYPE="E" S PSODLFLG=1 D WRITMSG
..I PSODTYPE="C"&(PSOCPXB>3) D MSGC
.I PSODLPL="4_TRAIL",PSODTYPE="E"!(PSODTYPE="N") D
..S PSODLMSG=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","4_TRAIL"))
..D WRITMSG
Q
;
MSGN ;write dosing message for new, copy, renew, and verify
I 'PSOCPXF&(PSOCPXC)&($G(PSOCPXB)>3) S PSOCPXG=$P(PSODLNN1,";",4) D K PSODAILY S:PSOCPXC&(PSOCPXG=PSOCPXB) PSOCPXH=1
.Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
S PSOCPXG=$P(PSODLNN1,";",4) D HD Q:$G(PSODLQTC) D:'$G(PSOCPXRR(PSOCPXG))&(PSOCPXB>1) PSOORI,SUB^PSODOSUT D
.I $G(PSOCPXRR(PSOCPXG))&$P(PSODLNN1,";",5)'="" K PSODAILY
.I PSODLPL="2_RANGE",'$G(PSODAILY) D DAILY^PSODOSUT I PSOCPXG'=PSOCPXB K PSODAILY
.I PSODLPL="1_SINGLE_RANGE",'$G(PSODAILY) D DAILY^PSODOSUT I PSOCPXG'=PSOCPXB K PSODAILY
.D HD Q:$G(PSODLQTC) D WRITMSG,HD Q:$G(PSODLQTC)
Q
;
MSGC ;write dosing message for edits or display during complex dose entry
Q:'PSODLQT&(PSOCPXC)&(PSODLESM) I PSOCPXF&(PSOCPXC) K PSODAILY
D:PSOCPXC HD Q:$G(PSODLQTC)
I 'PSOCPXF&(PSOCPXC) S PSOCPXG=$P(PSODLNN1,";",4) D K PSODAILY S:PSOCPXC&(PSOCPXG=PSOCPXB) PSOCPXH=1
.Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
I PSOCPXC S PSOCPXG=$P(PSODLNN1,";",4) D HD Q:$G(PSODLQTC) D
.I $G(PSOCPXRR(PSOCPXG))&$P(PSODLNN1,";",5)'="" K PSODAILY
.I '$G(PSOCPXRR(PSOCPXG))&('$G(PSOCPXH)) D PSOORI,SUB^PSODOSUT I $G(PSOCOPY)!($G(PSORENW)) S:PSOCPXC&(PSOCPXG=PSOCPXB) PSOCPXH=1
.I PSODLPL="2_RANGE"&PSODLINR&'$G(PSODAILY) D DAILY^PSODOSUT
.I PSODLPL="1_SINGLE_RANGE"&PSODLINX&'$G(PSODAILY) D DAILY^PSODOSUT
.D WRITMSG
Q
;
WRITMSG ;
W:'PSODLQT&('$G(PSODLWW)) ! S PSODLWW=0
N X,DIWL,DIWR,DIWF
IF +$G(PSOINTRO),'$G(PSOOFL) D
.S X=$P(PSOINTRO,U,2),DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
.D WRITMSG1
.W !
.S $P(PSOINTRO,U)=0
S X=PSODLMSG,DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
D WRITMSG1
K ^UTILITY($J,"W") D HD Q:$G(PSODLQTC)
I PSODTYPE="E",'PSODLQT S PSODELNX=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1)) I '$P($G(PSODELNX),";",5) W !
I PSODTYPE="C"!(PSODTYPE="N"),'PSODLQT D
.D HD Q:$G(PSODLQTC) S PSODELNX=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1)) I '$P($G(PSODELNX),";",5)!($P($G(PSODELNX),";",4)'=PSOCPXG) W ! S PSOLASTD(PSOLASTS)=3
Q
;
WRITMSG1 ;
N PSODELXR,PSODELXF,PSOSPACE
S PSODELXF=0
S PSOSPACE=" "
I +$G(PSOINTRO),'$G(PSOOFL) S PSOSPACE=""
F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D
.D HD Q:$G(PSODLQTC) W:PSODELXF&('PSODLQT) ! W:'PSODLQT PSOSPACE_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S (PSODLFLG,PSODELXF,PSONFRNF,PSOWMSG,PSODLEXR)=1
I $G(PSODLFLG)&($G(PSOCPXC))&($G(PSOCPXB)>3)!(PSODTYPE="C"&(PSOCPXB>3)) W !
Q
;
WRTINTRO ;
N PSODELXR
F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR!($G(PSODLQTC)) D
.D HD Q:$G(PSODLQTC) W $G(^UTILITY($J,"W",DIWL,PSODELXR,0))
.I PSODLPL'="3_GENERAL" W !
.S $P(PSOINTRO,U)=0
Q
;
GENERAL ;general dosing range information
N PSODLERC,PSODLP2
I +$G(PSOINTRO) D
.S X=$P(PSOINTRO,U,2),DIWL=4,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
.D WRTINTRO
F PSODLP2=0:0 S PSODLP2=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1,PSODLP2)) Q:'PSODLP2!($G(PSORX("DFLG"))) D
.S PSODLERC="",PSODLERC=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1,PSODLP2))
.Q:PSODLERC=""
.D HD Q:$G(PSODLQTC)
.;I 'PSODLQT,'$G(PSOEDIT) W !
.N X,DIWL,DIWR,DIWF,DIWL,PSODELXR,PSODELXF S PSODLEXR=1
.S DIWL=4,DIWR=76 K ^UTILITY($J,"W")
.S X=PSODLERC D ^DIWP
.S PSODELXF=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D HD Q:$G(PSODLQTC) W:PSODELXF&('PSODLQT) ! D HD Q:$G(PSODLQTC) W:'PSODLQT " "_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S (PSODELXF,PSODLERZ,PSONFRNF)=1
.S PSOLASTD(PSOLASTS)=3
.I '$D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE")),'$D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","2_RANGE")),'$D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE_RANGE")) D
..I +$G(PSOEXCPT)!(+$G(PSOERROR)) S PSOGENF=1
.K ^UTILITY($J,"W")
.W !
Q
;
HD ;
S:'$G(PSODLQT) PSODLQT=""
I PSODLQT!(($Y+3)<IOSL)!($G(PSORX("DFLG"))) Q
W:$G(PSORENWD) !
HD2 ;
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR
I $G(PSOCPXC)&($D(DIRUT)!($D(DUOUT))) S PSODLQTC=1 W @IOF W ! Q ;user ^'s
I 'Y!($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) S PSODLQT=1,PSORX("DFLG")=1 Q
W @IOF W !
S PSOOFL="" D:$G(PSODELXR) PSOORI W:$G(PSOOFL) !
Q
;
PSOORI ;**writes per orifice intro text to the screen for dosing check summary**
I +$G(PSOINTRO),'$G(PSOOFL) D
.W ?3,$P(PSOINTRO,U,2),!
.S $P(PSOINTRO,U)=0,PSOOFL=1
Q
;
SETV ; Set variables indicating what messages exist
S (PSODMESE,PSODMESX,PSODMESG,PSODMEST,PSODMESH,PSODMESM)=0
I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR")) S PSODMESE=1
I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS")) S PSODMESX=1
I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE")) S PSODMESM=1
I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","3_GENERAL")) S PSODMESG=1
I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","4_TRAIL")) S PSODMEST=1
D
.I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE")) S PSODMESH=1 Q
.I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","2_RANGE")) S PSODMESH=1 Q
.I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE_RANGE")) S PSODMESH=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODOSU2 14236 printed Dec 13, 2024@02:27:14 Page 2
PSODOSU2 ;BIR/RTR - Dose Check Utility routine continued ;11/18/08
+1 ;;7.0;OUTPATIENT PHARMACY;**251,375,372,436,402,518**;DEC 1997;Build 3
+2 ;
+3 ;Called from PSODOSUT. The variable PSODTYPE is expected to be defined.
+4 ; PSODTYPE values can be N for dosing for new order, copy, and renews, E for edited and display of individual complex doses, and C for complex orders
+5 ;
EN ;new order, copy, renew, and verify orders
+1 NEW PSODLERW,PSODLERL,PSODLERS,PSODLERH,PSOCPXRR,PSODLWW,PSODOSER,PSONFRNF,PSOWMSG,PSODLQTC,PSOOFL,PSOOCNT
+2 NEW PSODMESE,PSODMESX,PSODMESG,PSODMEST,PSODMESH,PSODMESM,PSORLNF
+3 SET (PSODLERF,PSODSEQ,PSODLWW,PSOOFL,PSORLNF)=""
SET PSOOCNT=0
+4 FOR
SET PSODSEQ=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ))
if PSODSEQ=""!($GET(PSORX("DFLG")))!($GET(PSODLQTC))
QUIT
SET PSODLNN1=""
Begin DoDot:1
+5 if PSODTYPE'="N"
SET PSODLQT=0
SET PSOLASTS=PSODSEQ
+6 IF PSODTYPE="C"
KILL PSOCPXRR
+7 FOR
SET PSODLNN1=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1))
if PSODLNN1=""!($GET(PSORX("DFLG")))!($GET(PSODLQTC))
QUIT
Begin DoDot:2
+8 if PSODTYPE'="E"
SET PSODLECT=0
+9 IF PSODTYPE="E"
if $PIECE(PSODLNN1,";",4)'=PSODLXNT
QUIT
+10 SET PSOOCNT=PSOOCNT+1
IF PSOOCNT>1
IF PSOCPXB=2!(PSOCPXB=3)
WRITE !
+11 DO EXCEPT^PSODOSUT
DO SETV
+12 DO ERROR
if $GET(PSODLQTC)
QUIT
IF PSODLERZ
IF 'PSODMESX
IF 'PSODMESM
WRITE !
IF PSODTYPE'="E"
WRITE !
+13 DO EXCEPT
if $GET(PSODLQTC)
QUIT
IF PSODLERZ
IF 'PSODMESM
WRITE !
IF PSODTYPE'="E"
WRITE !
+14 DO MESSAGE
if $GET(PSODLQTC)
QUIT
End DoDot:2
+15 KILL PSODLWW
End DoDot:1
DO HD
if $GET(PSODLQTC)
QUIT
+16 QUIT
+17 ;
ERROR ;format and write dosing error
+1 IF PSODTYPE'="E"
SET PSODLECT=0
+2 FOR PSODLERA=0:0
SET PSODLERA=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR",PSODLERA))
if 'PSODLERA!($GET(PSORX("DFLG")))
QUIT
Begin DoDot:1
+3 if PSODTYPE'="E"
SET PSODLECT=PSODLECT+1
+4 if PSODTYPE'="N"
SET PSODLQT=0
+5 FOR PSODLERX="MSG","TEXT"
SET PSODLERB=$GET(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR",PSODLERA,PSODLERX))
Begin DoDot:2
+6 SET PSODLERZ=0
if PSODLERB=""
QUIT
+7 IF PSODTYPE="C"&(PSOCPXB>3)
DO ERRCOM
QUIT
+8 IF PSODTYPE="E"
DO ERREDIT
QUIT
+9 IF PSODTYPE="N"&(PSOCPXB>3)
DO ERRNEW
QUIT
+10 if PSODTYPE="C"&(PSOCPXB<4)
QUIT
+11 DO ERRNEW
End DoDot:2
KILL ^UTILITY($JOB,"W")
End DoDot:1
+12 IF PSODTYPE="E"
IF PSODMESG
WRITE !
+13 QUIT
+14 ;
ERRCOM ;write dosing errors for complex dose summary after accept of an order
+1 IF PSOCPXC
DO HD
if $GET(PSODLQTC)
QUIT
IF PSODLERF
IF PSODLERX="MSG"
if 'PSODLQT
WRITE !
DO HD
if $GET(PSODLQTC)
QUIT
+2 IF 'PSODLERF
IF PSOCPXB<4
if 'PSODLQT&(PSOCPXC)
WRITE !
+3 SET PSODLERF=1
if PSOCPXC
DO HD
IF PSODLERZ
if 'PSODLQT&(PSOCPXC)
WRITE !
+4 if PSOCPXC
Begin DoDot:1
+5 DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT&(PSODLECT>1)
WRITE !
+6 NEW X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
+7 if PSOCPXC
DO HD
if 'PSOCPXF&(PSOCPXC)
Begin DoDot:2
+8 if $GET(PSORENWD)&(PSOCPXB<4)
QUIT
DO SUMM^PSODOSUT
End DoDot:2
+9 if PSOCPXC
DO HD
SET PSOCPXG=$PIECE(PSODLNN1,";",4)
IF PSOCPXC&('$GET(PSOCPXRR(PSOCPXG)))
DO PSOORI
DO SUB^PSODOSUT
if 'PSODLQT&('PSODLERZ)
WRITE !
+10 if PSOCPXC
DO HD
if 'PSODLQT&(PSODLECT'>1)&(PSODLERX="TEXT")&(PSOCPXC)
WRITE !
SET X=PSODLERB
SET DIWL=1
SET DIWR=$SELECT(PSODLERX="MSG":76,1:74)
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+11 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)
WRITE !
Begin DoDot:2
+12 if PSOCPXC
DO HD
if '$GET(PSODLQT)
WRITE $SELECT(PSODLERX="MSG":" ",1:" ")_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
SET (PSODLERR,PSODOSER,PSODLEXR,PSOERROR)=1
DO SFD
End DoDot:2
+13 SET PSOLASTD(PSOLASTS)=1
SET PSONFRNF=1
End DoDot:1
+14 QUIT
+15 ;
ERREDIT ;write dosing errors for edits or display during complex dose entry
+1 IF 'PSODLERF
IF PSOCPXB<4
if 'PSODLQT
WRITE !
+2 DO HD
if $GET(PSODLQTC)
QUIT
IF PSODLERF
IF PSODLERX="MSG"
if 'PSODLQT
WRITE !
DO HD
if $GET(PSODLQTC)
QUIT
IF 'PSODLERF
if 'PSODLQT
WRITE !
+3 SET PSODLERF=1
DO HD
if $GET(PSODLQTC)
QUIT
IF PSODLERZ
if 'PSODLQT
WRITE !
+4 DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT
WRITE !
+5 NEW X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
SET X=PSODLERB
SET DIWL=1
SET DIWR=$SELECT(PSODLERX="MSG":76,1:74)
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+6 SET PSODELXF=0
FOR PSODELXR=0:0
SET PSODELXR=$ORDER(^UTILITY($JOB,"W",DIWL,PSODELXR))
if 'PSODELXR
QUIT
DO HD
if $GET(PSODLQTC)
QUIT
if PSODELXF&('PSODLQT)
WRITE !
DO HD
if $GET(PSODLQTC)
QUIT
Begin DoDot:1
+7 if 'PSODLQT
WRITE $SELECT(PSODLERX="MSG":" ",1:" ")_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
SET (PSODLERR,PSODOSER,PSODLEXR,PSOERROR)=1
DO SFD
End DoDot:1
+8 SET PSOLASTD(PSOLASTS)=1
SET PSONFRNF=1
+9 QUIT
+10 ;
ERRNEW ;write dosing errors for finish, new, copy, renewal and verify
+1 DO HD
if $GET(PSODLQTC)
QUIT
IF PSODLERF
IF PSODLERX="MSG"
if 'PSODLQT
WRITE !
DO HD
if $GET(PSODLQTC)
QUIT
+2 IF $LENGTH(PSODLERB)>76&(PSOCPXB>1)
SET PSODLERL=1
+3 IF 'PSODLERF
IF PSOCPXB<4
if 'PSODLQT
WRITE !
+4 SET PSODLERF=1
DO HD
if $GET(PSODLQTC)
QUIT
IF PSODLERZ
if 'PSODLQT
WRITE !
+5 DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT&(PSODLECT>1)
WRITE !
NEW X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
+6 if PSOCPXC
DO HD
if 'PSOCPXF&(PSOCPXC)
Begin DoDot:1
+7 if $GET(PSORENWD)&(PSOCPXB<4)
QUIT
DO SUMM^PSODOSUT
End DoDot:1
+8 DO HD
if $GET(PSODLQTC)
QUIT
SET PSOCPXG=$PIECE(PSODLNN1,";",4)
IF '$GET(PSOCPXRR(PSOCPXG))&(PSOCPXB>1)
DO PSOORI
DO SUB^PSODOSUT
if 'PSODLQT&('PSODLERZ)
WRITE !
+9 DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT&(PSODLECT'>1)&(PSODLERX="TEXT")
WRITE !
SET X=PSODLERB
SET DIWL=1
SET DIWR=$SELECT(PSODLERX="MSG":76,1:74)
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 $GET(PSODLQTC)
QUIT
if PSODELXF&('PSODLQT)
WRITE !
DO HD
if $GET(PSODLQTC)
QUIT
Begin DoDot:1
+11 if 'PSODLQT
WRITE $SELECT(PSODLERX="MSG":" ",1:" ")_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
SET (PSODLERR,PSODOSER,PSODLEXR,PSOERROR)=1
DO SFD
End DoDot:1
+12 SET PSOLASTD(PSOLASTS)=1
SET PSONFRNF=1
+13 QUIT
+14 ;
SFD ;
+1 SET PSODELXF=1
if PSODLERX="TEXT"
SET PSODLERZ=1
+2 QUIT
+3 ;
EXCEPT ;format and write exceptions
+1 IF PSODTYPE="E"
SET (PSODLERZ)=0
+2 IF $GET(PSODOSER)
IF PSODTYPE="N"
IF PSODMESX
IF PSODMESG
WRITE !
+3 ;line feed between error and exceptions
IF $GET(PSODOSER)
KILL PSODOSER
IF PSODMESX
IF 'PSODMESG
WRITE !
+4 IF PSODTYPE="N"
DO HD
if $GET(PSODLQTC)
QUIT
if PSODLERF&('PSODLQT)&('PSODMESX)&('PSODMESM)
WRITE !
SET PSODLERZ=0
+5 IF PSODTYPE="C"
if PSOCPXC
DO HD
if PSODLERF&(PSOCPXC)&('PSODLQT)&('PSODMESX)&('PSODMESM)&('$GET(PSODLWW))
WRITE !
SET (PSODLERZ,PSODLESM)=0
+6 FOR PSODLERA=0:0
SET PSODLERA=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLERA))
if 'PSODLERA
QUIT
Begin DoDot:1
+7 SET PSODLERB=$GET(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLERA))
+8 IF PSODTYPE="N"
DO SBAD^PSODOSUT
+9 IF PSODTYPE="E"!(PSODTYPE="C")
if PSODLERB'=""
DO SBAD^PSODOSUT
+10 if PSODLERB=""
QUIT
IF PSODTYPE'="C"
DO HD
if $GET(PSODLQTC)
QUIT
+11 SET (PSODLERF,PSODLALZ)=1
+12 ;write exceptions for new, copy, renew, verify
+13 IF PSODTYPE="N"
Begin DoDot:2
+14 DO HD
if $GET(PSODLQTC)
QUIT
IF 'PSOCPXF&(PSOCPXC)
Begin DoDot:3
+15 if $GET(PSORENWD)&(PSOCPXB<4)
QUIT
DO SUMM^PSODOSUT
End DoDot:3
+16 IF 'PSODLERF
if 'PSODLQT&('$GET(PSODLWW))
WRITE !
DO HD
if $GET(PSODLQTC)
QUIT
SET PSODLWW=0
+17 SET PSOCPXG=$PIECE(PSODLNN1,";",4)
+18 IF '$GET(PSOCPXRR(PSOCPXG))
IF PSOCPXB>1
if 'PSODLQT&(PSODLERZ)
WRITE !
DO PSOORI
DO SUB^PSODOSUT
+19 DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT&('$GET(PSODLWW))
WRITE !
SET PSODLWW=0
+20 DO WRITEXC
End DoDot:2
QUIT
+21 ;write dosing exceptions for edits or display during complex dose entry
+22 IF PSODTYPE="E"
Begin DoDot:2
+23 IF PSODLERB["please complete a manual check for appropriate Dosing"
SET PSODCONT=1
+24 DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT&('$GET(PSODLWW))
WRITE !
SET PSODLWW=0
+25 DO WRITEXC
End DoDot:2
+26 ;write exceptions for complex orders
+27 IF PSODTYPE="C"&(PSOCPXB>3)
Begin DoDot:2
+28 if PSOCPXC
DO HD
IF 'PSODLERF&('$GET(PSODLWW))
if 'PSODLQT&(PSOCPXC)
WRITE !
+29 if PSOCPXC
Begin DoDot:3
+30 DO HD
if $GET(PSODLQTC)
QUIT
IF 'PSOCPXF&(PSOCPXC)
Begin DoDot:4
+31 if $GET(PSORENWD)&(PSOCPXB<4)
QUIT
DO SUMM^PSODOSUT
End DoDot:4
+32 SET PSOCPXG=$PIECE(PSODLNN1,";",4)
IF PSOCPXC&('$GET(PSOCPXRR(PSOCPXG)))
DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT&(PSOCPXC)&(PSODLESM)&('$GET(PSODLWW))
WRITE !
DO PSOORI
DO SUB^PSODOSUT
+33 SET PSODLESM=1
DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT&('$GET(PSODLWW))
WRITE !
+34 if PSOCPXC
DO WRITEXC
End DoDot:3
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
WRITEXC ;format and write exception messages to the screen
+1 DO WRITEXC^PSODOSU4
QUIT
+2 ;
MESSAGE ;format and write messages
+1 IF PSODTYPE="N"
IF $$FEED^PSODOSUT
DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT
WRITE !
+2 ;line feed for transition between exceptions to messages
IF $GET(PSODLERZ)&('PSODLQT)&(PSODTYPE'="N")
WRITE !
+3 IF PSODTYPE="C"
IF $$FEED^PSODOSUT&(PSOCPXC)
DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT
WRITE !
+4 SET PSODLPL=""
FOR
SET PSODLPL=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL))
if PSODLPL=""
QUIT
Begin DoDot:1
+5 ;Add a line feed if there are just Single and General dosing messages
+6 IF PSODLPL="3_GENERAL"
Begin DoDot:2
+7 IF PSODTYPE="N"
Begin DoDot:3
+8 IF PSODLINS
IF 'PSODLINR
IF 'PSODLINX
WRITE !
QUIT
+9 IF 'PSODLINS
IF 'PSODLINR
IF 'PSODLINX
WRITE !!
End DoDot:3
QUIT
+10 WRITE !
End DoDot:2
+11 IF PSODLPL=".1_INTRO"
Begin DoDot:2
+12 SET PSOINTRO="1^"_$GET(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",".1_INTRO"))
+13 IF $PIECE(PSOINTRO,U,2)=""
SET PSOINTRO=0
End DoDot:2
+14 FOR PSODLP1=0:0
SET PSODLP1=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1))
if 'PSODLP1
QUIT
Begin DoDot:2
+15 IF PSODTYPE'="C"
IF PSODLPL="3_GENERAL"
DO GENERAL
QUIT
+16 SET PSODLMSG=$GET(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1))
+17 if PSODLMSG=""
QUIT
+18 IF 'PSODLERF
if 'PSODLQT&('$GET(PSODLWW))
WRITE !
DO HD
if $GET(PSODLQTC)
QUIT
+19 SET PSODLERF=1
+20 IF PSODTYPE'="C"
DO HD
if $GET(PSODLQTC)
QUIT
IF 'PSODLQT
IF '$GET(PSODLWW)
IF $GET(PSODLERR)
IF 'PSORLNF
WRITE !
SET PSORLNF=1
+21 IF PSODTYPE="C"
Begin DoDot:3
+22 if PSOCPXC
DO HD
IF '$GET(PSODLFLG)
if 'PSODLQT&(PSOCPXC)&(PSOCPXF)&('$GET(PSODLWW))
WRITE !
+23 SET PSODLFLG=1
SET PSODLEXR=0
End DoDot:3
if 'PSODLQT&(PSOCPXC)&(PSODLESM)
QUIT
IF PSOCPXF&(PSOCPXC)
KILL PSODAILY
+24 IF PSODTYPE'="E"
SET PSODLEXR=0
+25 SET PSODLFLG=1
if PSODLPL="1_SINGLE"
SET PSODLINS=1
if PSODLPL="2_RANGE"
SET PSODLINR=1
if PSODLPL="1_SINGLE_RANGE"
SET PSODLINX=1
+26 IF PSODTYPE="N"
SET PSODLFLG=1
DO MSGN
+27 IF PSODTYPE="E"
SET PSODLFLG=1
DO WRITMSG
+28 IF PSODTYPE="C"&(PSOCPXB>3)
DO MSGC
End DoDot:2
+29 IF PSODLPL="4_TRAIL"
IF PSODTYPE="E"!(PSODTYPE="N")
Begin DoDot:2
+30 SET PSODLMSG=$GET(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","4_TRAIL"))
+31 DO WRITMSG
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
MSGN ;write dosing message for new, copy, renew, and verify
+1 IF 'PSOCPXF&(PSOCPXC)&($GET(PSOCPXB)>3)
SET PSOCPXG=$PIECE(PSODLNN1,";",4)
Begin DoDot:1
+2 if $GET(PSORENWD)&(PSOCPXB<4)
QUIT
DO SUMM^PSODOSUT
End DoDot:1
KILL PSODAILY
if PSOCPXC&(PSOCPXG=PSOCPXB)
SET PSOCPXH=1
+3 SET PSOCPXG=$PIECE(PSODLNN1,";",4)
DO HD
if $GET(PSODLQTC)
QUIT
if '$GET(PSOCPXRR(PSOCPXG))&(PSOCPXB>1)
DO PSOORI
DO SUB^PSODOSUT
Begin DoDot:1
+4 IF $GET(PSOCPXRR(PSOCPXG))&$PIECE(PSODLNN1,";",5)'=""
KILL PSODAILY
+5 IF PSODLPL="2_RANGE"
IF '$GET(PSODAILY)
DO DAILY^PSODOSUT
IF PSOCPXG'=PSOCPXB
KILL PSODAILY
+6 IF PSODLPL="1_SINGLE_RANGE"
IF '$GET(PSODAILY)
DO DAILY^PSODOSUT
IF PSOCPXG'=PSOCPXB
KILL PSODAILY
+7 DO HD
if $GET(PSODLQTC)
QUIT
DO WRITMSG
DO HD
if $GET(PSODLQTC)
QUIT
End DoDot:1
+8 QUIT
+9 ;
MSGC ;write dosing message for edits or display during complex dose entry
+1 if 'PSODLQT&(PSOCPXC)&(PSODLESM)
QUIT
IF PSOCPXF&(PSOCPXC)
KILL PSODAILY
+2 if PSOCPXC
DO HD
if $GET(PSODLQTC)
QUIT
+3 IF 'PSOCPXF&(PSOCPXC)
SET PSOCPXG=$PIECE(PSODLNN1,";",4)
Begin DoDot:1
+4 if $GET(PSORENWD)&(PSOCPXB<4)
QUIT
DO SUMM^PSODOSUT
End DoDot:1
KILL PSODAILY
if PSOCPXC&(PSOCPXG=PSOCPXB)
SET PSOCPXH=1
+5 IF PSOCPXC
SET PSOCPXG=$PIECE(PSODLNN1,";",4)
DO HD
if $GET(PSODLQTC)
QUIT
Begin DoDot:1
+6 IF $GET(PSOCPXRR(PSOCPXG))&$PIECE(PSODLNN1,";",5)'=""
KILL PSODAILY
+7 IF '$GET(PSOCPXRR(PSOCPXG))&('$GET(PSOCPXH))
DO PSOORI
DO SUB^PSODOSUT
IF $GET(PSOCOPY)!($GET(PSORENW))
if PSOCPXC&(PSOCPXG=PSOCPXB)
SET PSOCPXH=1
+8 IF PSODLPL="2_RANGE"&PSODLINR&'$GET(PSODAILY)
DO DAILY^PSODOSUT
+9 IF PSODLPL="1_SINGLE_RANGE"&PSODLINX&'$GET(PSODAILY)
DO DAILY^PSODOSUT
+10 DO WRITMSG
End DoDot:1
+11 QUIT
+12 ;
WRITMSG ;
+1 if 'PSODLQT&('$GET(PSODLWW))
WRITE !
SET PSODLWW=0
+2 NEW X,DIWL,DIWR,DIWF
+3 IF +$GET(PSOINTRO)
IF '$GET(PSOOFL)
Begin DoDot:1
+4 SET X=$PIECE(PSOINTRO,U,2)
SET DIWL=1
SET DIWR=76
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+5 DO WRITMSG1
+6 WRITE !
+7 SET $PIECE(PSOINTRO,U)=0
End DoDot:1
+8 SET X=PSODLMSG
SET DIWL=1
SET DIWR=76
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+9 DO WRITMSG1
+10 KILL ^UTILITY($JOB,"W")
DO HD
if $GET(PSODLQTC)
QUIT
+11 IF PSODTYPE="E"
IF 'PSODLQT
SET PSODELNX=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1))
IF '$PIECE($GET(PSODELNX),";",5)
WRITE !
+12 IF PSODTYPE="C"!(PSODTYPE="N")
IF 'PSODLQT
Begin DoDot:1
+13 DO HD
if $GET(PSODLQTC)
QUIT
SET PSODELNX=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1))
IF '$PIECE($GET(PSODELNX),";",5)!($PIECE($GET(PSODELNX),";",4)'=PSOCPXG)
WRITE !
SET PSOLASTD(PSOLASTS)=3
End DoDot:1
+14 QUIT
+15 ;
WRITMSG1 ;
+1 NEW PSODELXR,PSODELXF,PSOSPACE
+2 SET PSODELXF=0
+3 SET PSOSPACE=" "
+4 IF +$GET(PSOINTRO)
IF '$GET(PSOOFL)
SET PSOSPACE=""
+5 FOR PSODELXR=0:0
SET PSODELXR=$ORDER(^UTILITY($JOB,"W",DIWL,PSODELXR))
if 'PSODELXR
QUIT
Begin DoDot:1
+6 DO HD
if $GET(PSODLQTC)
QUIT
if PSODELXF&('PSODLQT)
WRITE !
if 'PSODLQT
WRITE PSOSPACE_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
SET (PSODLFLG,PSODELXF,PSONFRNF,PSOWMSG,PSODLEXR)=1
End DoDot:1
+7 IF $GET(PSODLFLG)&($GET(PSOCPXC))&($GET(PSOCPXB)>3)!(PSODTYPE="C"&(PSOCPXB>3))
WRITE !
+8 QUIT
+9 ;
WRTINTRO ;
+1 NEW PSODELXR
+2 FOR PSODELXR=0:0
SET PSODELXR=$ORDER(^UTILITY($JOB,"W",DIWL,PSODELXR))
if 'PSODELXR!($GET(PSODLQTC))
QUIT
Begin DoDot:1
+3 DO HD
if $GET(PSODLQTC)
QUIT
WRITE $GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
+4 IF PSODLPL'="3_GENERAL"
WRITE !
+5 SET $PIECE(PSOINTRO,U)=0
End DoDot:1
+6 QUIT
+7 ;
GENERAL ;general dosing range information
+1 NEW PSODLERC,PSODLP2
+2 IF +$GET(PSOINTRO)
Begin DoDot:1
+3 SET X=$PIECE(PSOINTRO,U,2)
SET DIWL=4
SET DIWR=76
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+4 DO WRTINTRO
End DoDot:1
+5 FOR PSODLP2=0:0
SET PSODLP2=$ORDER(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1,PSODLP2))
if 'PSODLP2!($GET(PSORX("DFLG")))
QUIT
Begin DoDot:1
+6 SET PSODLERC=""
SET PSODLERC=$GET(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1,PSODLP2))
+7 if PSODLERC=""
QUIT
+8 DO HD
if $GET(PSODLQTC)
QUIT
+9 ;I 'PSODLQT,'$G(PSOEDIT) W !
+10 NEW X,DIWL,DIWR,DIWF,DIWL,PSODELXR,PSODELXF
SET PSODLEXR=1
+11 SET DIWL=4
SET DIWR=76
KILL ^UTILITY($JOB,"W")
+12 SET X=PSODLERC
DO ^DIWP
+13 SET PSODELXF=0
FOR PSODELXR=0:0
SET PSODELXR=$ORDER(^UTILITY($JOB,"W",DIWL,PSODELXR))
if 'PSODELXR
QUIT
DO HD
if $GET(PSODLQTC)
QUIT
if PSODELXF&('PSODLQT)
WRITE !
DO HD
if $GET(PSODLQTC)
QUIT
if 'PSODLQT
WRITE " "_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
SET (PSODELXF,PSODLERZ,PSONFRNF)=1
+14 SET PSOLASTD(PSOLASTS)=3
+15 IF '$DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE"))
IF '$DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","2_RANGE"))
IF '$DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE_RANGE"))
Begin DoDot:2
+16 IF +$GET(PSOEXCPT)!(+$GET(PSOERROR))
SET PSOGENF=1
End DoDot:2
+17 KILL ^UTILITY($JOB,"W")
+18 WRITE !
End DoDot:1
+19 QUIT
+20 ;
HD ;
+1 if '$GET(PSODLQT)
SET PSODLQT=""
+2 IF PSODLQT!(($Y+3)<IOSL)!($GET(PSORX("DFLG")))
QUIT
+3 if $GET(PSORENWD)
WRITE !
HD2 ;
+1 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+2 KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue,'^' to exit"
DO ^DIR
KILL DIR
+3 ;user ^'s
IF $GET(PSOCPXC)&($DATA(DIRUT)!($DATA(DUOUT)))
SET PSODLQTC=1
WRITE @IOF
WRITE !
QUIT
+4 IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
QUIT
+5 WRITE @IOF
WRITE !
+6 SET PSOOFL=""
if $GET(PSODELXR)
DO PSOORI
if $GET(PSOOFL)
WRITE !
+7 QUIT
+8 ;
PSOORI ;**writes per orifice intro text to the screen for dosing check summary**
+1 IF +$GET(PSOINTRO)
IF '$GET(PSOOFL)
Begin DoDot:1
+2 WRITE ?3,$PIECE(PSOINTRO,U,2),!
+3 SET $PIECE(PSOINTRO,U)=0
SET PSOOFL=1
End DoDot:1
+4 QUIT
+5 ;
SETV ; Set variables indicating what messages exist
+1 SET (PSODMESE,PSODMESX,PSODMESG,PSODMEST,PSODMESH,PSODMESM)=0
+2 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR"))
SET PSODMESE=1
+3 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS"))
SET PSODMESX=1
+4 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE"))
SET PSODMESM=1
+5 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","3_GENERAL"))
SET PSODMESG=1
+6 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","4_TRAIL"))
SET PSODMEST=1
+7 Begin DoDot:1
+8 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE"))
SET PSODMESH=1
QUIT
+9 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","2_RANGE"))
SET PSODMESH=1
QUIT
+10 IF $DATA(^TMP($JOB,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE_RANGE"))
SET PSODMESH=1
End DoDot:1
+11 QUIT
