Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSODOSU2

PSODOSU2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Called from PSODOSUT. The variable PSODTYPE is expected to be defined.
  1. ; 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
  1. ;
  1. EN ;new order, copy, renew, and verify orders
  1. N PSODLERW,PSODLERL,PSODLERS,PSODLERH,PSOCPXRR,PSODLWW,PSODOSER,PSONFRNF,PSOWMSG,PSODLQTC,PSOOFL,PSOOCNT
  1. N PSODMESE,PSODMESX,PSODMESG,PSODMEST,PSODMESH,PSODMESM,PSORLNF
  1. S (PSODLERF,PSODSEQ,PSODLWW,PSOOFL,PSORLNF)="",PSOOCNT=0
  1. F S PSODSEQ=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ)) Q:PSODSEQ=""!($G(PSORX("DFLG")))!($G(PSODLQTC)) S PSODLNN1="" D D HD Q:$G(PSODLQTC)
  1. .S:PSODTYPE'="N" PSODLQT=0 S PSOLASTS=PSODSEQ
  1. .I PSODTYPE="C" K PSOCPXRR
  1. .F S PSODLNN1=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1)) Q:PSODLNN1=""!($G(PSORX("DFLG")))!($G(PSODLQTC)) D
  1. ..S:PSODTYPE'="E" PSODLECT=0
  1. ..I PSODTYPE="E" Q:$P(PSODLNN1,";",4)'=PSODLXNT
  1. ..S PSOOCNT=PSOOCNT+1 I PSOOCNT>1,PSOCPXB=2!(PSOCPXB=3) W !
  1. ..D EXCEPT^PSODOSUT,SETV
  1. ..D ERROR Q:$G(PSODLQTC) I PSODLERZ,'PSODMESX,'PSODMESM W ! I PSODTYPE'="E" W !
  1. ..D EXCEPT Q:$G(PSODLQTC) I PSODLERZ,'PSODMESM W ! I PSODTYPE'="E" W !
  1. ..D MESSAGE Q:$G(PSODLQTC)
  1. .K PSODLWW
  1. Q
  1. ;
  1. ERROR ;format and write dosing error
  1. I PSODTYPE'="E" S PSODLECT=0
  1. F PSODLERA=0:0 S PSODLERA=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR",PSODLERA)) Q:'PSODLERA!($G(PSORX("DFLG"))) D
  1. .S:PSODTYPE'="E" PSODLECT=PSODLECT+1
  1. .S:PSODTYPE'="N" PSODLQT=0
  1. .F PSODLERX="MSG","TEXT" S PSODLERB=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR",PSODLERA,PSODLERX)) D K ^UTILITY($J,"W")
  1. ..S PSODLERZ=0 Q:PSODLERB=""
  1. ..I PSODTYPE="C"&(PSOCPXB>3) D ERRCOM Q
  1. ..I PSODTYPE="E" D ERREDIT Q
  1. ..I PSODTYPE="N"&(PSOCPXB>3) D ERRNEW Q
  1. ..Q:PSODTYPE="C"&(PSOCPXB<4)
  1. ..D ERRNEW
  1. I PSODTYPE="E",PSODMESG W !
  1. Q
  1. ;
  1. ERRCOM ;write dosing errors for complex dose summary after accept of an order
  1. I PSOCPXC D HD Q:$G(PSODLQTC) I PSODLERF,PSODLERX="MSG" W:'PSODLQT ! D HD Q:$G(PSODLQTC)
  1. I 'PSODLERF,PSOCPXB<4 W:'PSODLQT&(PSOCPXC) !
  1. S PSODLERF=1 D:PSOCPXC HD I PSODLERZ W:'PSODLQT&(PSOCPXC) !
  1. D:PSOCPXC
  1. .D HD Q:$G(PSODLQTC) W:'PSODLQT&(PSODLECT>1) !
  1. .N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
  1. .D:PSOCPXC HD D:'PSOCPXF&(PSOCPXC)
  1. ..Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
  1. .D:PSOCPXC HD S PSOCPXG=$P(PSODLNN1,";",4) I PSOCPXC&('$G(PSOCPXRR(PSOCPXG))) D PSOORI,SUB^PSODOSUT W:'PSODLQT&('PSODLERZ) !
  1. .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
  1. .S PSODELXF=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D:PSOCPXC HD W:PSODELXF&('PSODLQT) ! D
  1. ..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
  1. .S PSOLASTD(PSOLASTS)=1,PSONFRNF=1
  1. Q
  1. ;
  1. ERREDIT ;write dosing errors for edits or display during complex dose entry
  1. I 'PSODLERF,PSOCPXB<4 W:'PSODLQT !
  1. D HD Q:$G(PSODLQTC) I PSODLERF,PSODLERX="MSG" W:'PSODLQT ! D HD Q:$G(PSODLQTC) I 'PSODLERF W:'PSODLQT !
  1. S PSODLERF=1 D HD Q:$G(PSODLQTC) I PSODLERZ W:'PSODLQT !
  1. D HD Q:$G(PSODLQTC) W:'PSODLQT !
  1. 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
  1. 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
  1. .W:'PSODLQT $S(PSODLERX="MSG":" ",1:" ")_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S (PSODLERR,PSODOSER,PSODLEXR,PSOERROR)=1 D SFD
  1. S PSOLASTD(PSOLASTS)=1,PSONFRNF=1
  1. Q
  1. ;
  1. ERRNEW ;write dosing errors for finish, new, copy, renewal and verify
  1. D HD Q:$G(PSODLQTC) I PSODLERF,PSODLERX="MSG" W:'PSODLQT ! D HD Q:$G(PSODLQTC)
  1. I $L(PSODLERB)>76&(PSOCPXB>1) S PSODLERL=1
  1. I 'PSODLERF,PSOCPXB<4 W:'PSODLQT !
  1. S PSODLERF=1 D HD Q:$G(PSODLQTC) I PSODLERZ W:'PSODLQT !
  1. D HD Q:$G(PSODLQTC) W:'PSODLQT&(PSODLECT>1) ! N X,DIWL,DIWR,DIWF,PSODELXR,PSODELXF
  1. D:PSOCPXC HD D:'PSOCPXF&(PSOCPXC)
  1. .Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
  1. D HD Q:$G(PSODLQTC) S PSOCPXG=$P(PSODLNN1,";",4) I '$G(PSOCPXRR(PSOCPXG))&(PSOCPXB>1) D PSOORI,SUB^PSODOSUT W:'PSODLQT&('PSODLERZ) !
  1. 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
  1. 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
  1. .W:'PSODLQT $S(PSODLERX="MSG":" ",1:" ")_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S (PSODLERR,PSODOSER,PSODLEXR,PSOERROR)=1 D SFD
  1. S PSOLASTD(PSOLASTS)=1,PSONFRNF=1
  1. Q
  1. ;
  1. SFD ;
  1. S PSODELXF=1 S:PSODLERX="TEXT" PSODLERZ=1
  1. Q
  1. ;
  1. EXCEPT ;format and write exceptions
  1. I PSODTYPE="E" S (PSODLERZ)=0
  1. I $G(PSODOSER),PSODTYPE="N",PSODMESX,PSODMESG W !
  1. I $G(PSODOSER) K PSODOSER I PSODMESX,'PSODMESG W ! ;line feed between error and exceptions
  1. I PSODTYPE="N" D HD Q:$G(PSODLQTC) W:PSODLERF&('PSODLQT)&('PSODMESX)&('PSODMESM) ! S PSODLERZ=0
  1. I PSODTYPE="C" D:PSOCPXC HD W:PSODLERF&(PSOCPXC)&('PSODLQT)&('PSODMESX)&('PSODMESM)&('$G(PSODLWW)) ! S (PSODLERZ,PSODLESM)=0
  1. F PSODLERA=0:0 S PSODLERA=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLERA)) Q:'PSODLERA D
  1. .S PSODLERB=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS",PSODLERA))
  1. .I PSODTYPE="N" D SBAD^PSODOSUT
  1. .I PSODTYPE="E"!(PSODTYPE="C") D SBAD^PSODOSUT:PSODLERB'=""
  1. .Q:PSODLERB="" I PSODTYPE'="C" D HD Q:$G(PSODLQTC)
  1. .S (PSODLERF,PSODLALZ)=1
  1. .;write exceptions for new, copy, renew, verify
  1. .I PSODTYPE="N" D Q
  1. ..D HD Q:$G(PSODLQTC) I 'PSOCPXF&(PSOCPXC) D
  1. ...Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
  1. ..I 'PSODLERF W:'PSODLQT&('$G(PSODLWW)) ! D HD Q:$G(PSODLQTC) S PSODLWW=0
  1. ..S PSOCPXG=$P(PSODLNN1,";",4)
  1. ..I '$G(PSOCPXRR(PSOCPXG)),PSOCPXB>1 W:'PSODLQT&(PSODLERZ) ! D PSOORI,SUB^PSODOSUT
  1. ..D HD Q:$G(PSODLQTC) W:'PSODLQT&('$G(PSODLWW)) ! S PSODLWW=0
  1. ..D WRITEXC
  1. .;write dosing exceptions for edits or display during complex dose entry
  1. .I PSODTYPE="E" D
  1. ..I PSODLERB["please complete a manual check for appropriate Dosing" S PSODCONT=1
  1. ..D HD Q:$G(PSODLQTC) W:'PSODLQT&('$G(PSODLWW)) ! S PSODLWW=0
  1. ..D WRITEXC
  1. .;write exceptions for complex orders
  1. .I PSODTYPE="C"&(PSOCPXB>3) D
  1. ..D:PSOCPXC HD I 'PSODLERF&('$G(PSODLWW)) W:'PSODLQT&(PSOCPXC) !
  1. ..D:PSOCPXC
  1. ...D HD Q:$G(PSODLQTC) I 'PSOCPXF&(PSOCPXC) D
  1. ....Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
  1. ...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
  1. ...S PSODLESM=1 D HD Q:$G(PSODLQTC) W:'PSODLQT&('$G(PSODLWW)) !
  1. ...D:PSOCPXC WRITEXC
  1. Q
  1. ;
  1. WRITEXC ;format and write exception messages to the screen
  1. D WRITEXC^PSODOSU4 Q
  1. ;
  1. MESSAGE ;format and write messages
  1. I PSODTYPE="N",$$FEED^PSODOSUT D HD Q:$G(PSODLQTC) W:'PSODLQT !
  1. I $G(PSODLERZ)&('PSODLQT)&(PSODTYPE'="N") W ! ;line feed for transition between exceptions to messages
  1. I PSODTYPE="C" I $$FEED^PSODOSUT&(PSOCPXC) D HD Q:$G(PSODLQTC) W:'PSODLQT !
  1. S PSODLPL="" F S PSODLPL=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL)) Q:PSODLPL="" D
  1. .;Add a line feed if there are just Single and General dosing messages
  1. .I PSODLPL="3_GENERAL" D
  1. ..I PSODTYPE="N" D Q
  1. ...I PSODLINS,'PSODLINR,'PSODLINX W ! Q
  1. ...I 'PSODLINS,'PSODLINR,'PSODLINX W !!
  1. ..W !
  1. .I PSODLPL=".1_INTRO" D
  1. ..S PSOINTRO="1^"_$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",".1_INTRO"))
  1. ..I $P(PSOINTRO,U,2)="" S PSOINTRO=0
  1. .F PSODLP1=0:0 S PSODLP1=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1)) Q:'PSODLP1 D
  1. ..I PSODTYPE'="C",PSODLPL="3_GENERAL" D GENERAL Q
  1. ..S PSODLMSG=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1))
  1. ..Q:PSODLMSG=""
  1. ..I 'PSODLERF W:'PSODLQT&('$G(PSODLWW)) ! D HD Q:$G(PSODLQTC)
  1. ..S PSODLERF=1
  1. ..I PSODTYPE'="C" D HD Q:$G(PSODLQTC) I 'PSODLQT,'$G(PSODLWW),$G(PSODLERR),'PSORLNF W ! S PSORLNF=1
  1. ..I PSODTYPE="C" D Q:'PSODLQT&(PSOCPXC)&(PSODLESM) I PSOCPXF&(PSOCPXC) K PSODAILY
  1. ...D:PSOCPXC HD I '$G(PSODLFLG) W:'PSODLQT&(PSOCPXC)&(PSOCPXF)&('$G(PSODLWW)) !
  1. ...S PSODLFLG=1 S PSODLEXR=0
  1. ..I PSODTYPE'="E" S PSODLEXR=0
  1. ..S PSODLFLG=1 S:PSODLPL="1_SINGLE" PSODLINS=1 S:PSODLPL="2_RANGE" PSODLINR=1 S:PSODLPL="1_SINGLE_RANGE" PSODLINX=1
  1. ..I PSODTYPE="N" S PSODLFLG=1 D MSGN
  1. ..I PSODTYPE="E" S PSODLFLG=1 D WRITMSG
  1. ..I PSODTYPE="C"&(PSOCPXB>3) D MSGC
  1. .I PSODLPL="4_TRAIL",PSODTYPE="E"!(PSODTYPE="N") D
  1. ..S PSODLMSG=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","4_TRAIL"))
  1. ..D WRITMSG
  1. Q
  1. ;
  1. MSGN ;write dosing message for new, copy, renew, and verify
  1. I 'PSOCPXF&(PSOCPXC)&($G(PSOCPXB)>3) S PSOCPXG=$P(PSODLNN1,";",4) D K PSODAILY S:PSOCPXC&(PSOCPXG=PSOCPXB) PSOCPXH=1
  1. .Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
  1. S PSOCPXG=$P(PSODLNN1,";",4) D HD Q:$G(PSODLQTC) D:'$G(PSOCPXRR(PSOCPXG))&(PSOCPXB>1) PSOORI,SUB^PSODOSUT D
  1. .I $G(PSOCPXRR(PSOCPXG))&$P(PSODLNN1,";",5)'="" K PSODAILY
  1. .I PSODLPL="2_RANGE",'$G(PSODAILY) D DAILY^PSODOSUT I PSOCPXG'=PSOCPXB K PSODAILY
  1. .I PSODLPL="1_SINGLE_RANGE",'$G(PSODAILY) D DAILY^PSODOSUT I PSOCPXG'=PSOCPXB K PSODAILY
  1. .D HD Q:$G(PSODLQTC) D WRITMSG,HD Q:$G(PSODLQTC)
  1. Q
  1. ;
  1. MSGC ;write dosing message for edits or display during complex dose entry
  1. Q:'PSODLQT&(PSOCPXC)&(PSODLESM) I PSOCPXF&(PSOCPXC) K PSODAILY
  1. D:PSOCPXC HD Q:$G(PSODLQTC)
  1. I 'PSOCPXF&(PSOCPXC) S PSOCPXG=$P(PSODLNN1,";",4) D K PSODAILY S:PSOCPXC&(PSOCPXG=PSOCPXB) PSOCPXH=1
  1. .Q:$G(PSORENWD)&(PSOCPXB<4) D SUMM^PSODOSUT
  1. I PSOCPXC S PSOCPXG=$P(PSODLNN1,";",4) D HD Q:$G(PSODLQTC) D
  1. .I $G(PSOCPXRR(PSOCPXG))&$P(PSODLNN1,";",5)'="" K PSODAILY
  1. .I '$G(PSOCPXRR(PSOCPXG))&('$G(PSOCPXH)) D PSOORI,SUB^PSODOSUT I $G(PSOCOPY)!($G(PSORENW)) S:PSOCPXC&(PSOCPXG=PSOCPXB) PSOCPXH=1
  1. .I PSODLPL="2_RANGE"&PSODLINR&'$G(PSODAILY) D DAILY^PSODOSUT
  1. .I PSODLPL="1_SINGLE_RANGE"&PSODLINX&'$G(PSODAILY) D DAILY^PSODOSUT
  1. .D WRITMSG
  1. Q
  1. ;
  1. WRITMSG ;
  1. W:'PSODLQT&('$G(PSODLWW)) ! S PSODLWW=0
  1. N X,DIWL,DIWR,DIWF
  1. IF +$G(PSOINTRO),'$G(PSOOFL) D
  1. .S X=$P(PSOINTRO,U,2),DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
  1. .D WRITMSG1
  1. .W !
  1. .S $P(PSOINTRO,U)=0
  1. S X=PSODLMSG,DIWL=1,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
  1. D WRITMSG1
  1. K ^UTILITY($J,"W") D HD Q:$G(PSODLQTC)
  1. I PSODTYPE="E",'PSODLQT S PSODELNX=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1)) I '$P($G(PSODELNX),";",5) W !
  1. I PSODTYPE="C"!(PSODTYPE="N"),'PSODLQT D
  1. .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
  1. Q
  1. ;
  1. WRITMSG1 ;
  1. N PSODELXR,PSODELXF,PSOSPACE
  1. S PSODELXF=0
  1. S PSOSPACE=" "
  1. I +$G(PSOINTRO),'$G(PSOOFL) S PSOSPACE=""
  1. F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D
  1. .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
  1. I $G(PSODLFLG)&($G(PSOCPXC))&($G(PSOCPXB)>3)!(PSODTYPE="C"&(PSOCPXB>3)) W !
  1. Q
  1. ;
  1. WRTINTRO ;
  1. N PSODELXR
  1. F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR!($G(PSODLQTC)) D
  1. .D HD Q:$G(PSODLQTC) W $G(^UTILITY($J,"W",DIWL,PSODELXR,0))
  1. .I PSODLPL'="3_GENERAL" W !
  1. .S $P(PSOINTRO,U)=0
  1. Q
  1. ;
  1. GENERAL ;general dosing range information
  1. N PSODLERC,PSODLP2
  1. I +$G(PSOINTRO) D
  1. .S X=$P(PSOINTRO,U,2),DIWL=4,DIWR=76 K ^UTILITY($J,"W") D ^DIWP
  1. .D WRTINTRO
  1. F PSODLP2=0:0 S PSODLP2=$O(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1,PSODLP2)) Q:'PSODLP2!($G(PSORX("DFLG"))) D
  1. .S PSODLERC="",PSODLERC=$G(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE",PSODLPL,PSODLP1,PSODLP2))
  1. .Q:PSODLERC=""
  1. .D HD Q:$G(PSODLQTC)
  1. .;I 'PSODLQT,'$G(PSOEDIT) W !
  1. .N X,DIWL,DIWR,DIWF,DIWL,PSODELXR,PSODELXF S PSODLEXR=1
  1. .S DIWL=4,DIWR=76 K ^UTILITY($J,"W")
  1. .S X=PSODLERC D ^DIWP
  1. .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
  1. .S PSOLASTD(PSOLASTS)=3
  1. .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
  1. ..I +$G(PSOEXCPT)!(+$G(PSOERROR)) S PSOGENF=1
  1. .K ^UTILITY($J,"W")
  1. .W !
  1. Q
  1. ;
  1. HD ;
  1. S:'$G(PSODLQT) PSODLQT=""
  1. I PSODLQT!(($Y+3)<IOSL)!($G(PSORX("DFLG"))) Q
  1. W:$G(PSORENWD) !
  1. HD2 ;
  1. N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
  1. K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR
  1. I $G(PSOCPXC)&($D(DIRUT)!($D(DUOUT))) S PSODLQTC=1 W @IOF W ! Q ;user ^'s
  1. I 'Y!($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) S PSODLQT=1,PSORX("DFLG")=1 Q
  1. W @IOF W !
  1. S PSOOFL="" D:$G(PSODELXR) PSOORI W:$G(PSOOFL) !
  1. Q
  1. ;
  1. PSOORI ;**writes per orifice intro text to the screen for dosing check summary**
  1. I +$G(PSOINTRO),'$G(PSOOFL) D
  1. .W ?3,$P(PSOINTRO,U,2),!
  1. .S $P(PSOINTRO,U)=0,PSOOFL=1
  1. Q
  1. ;
  1. SETV ; Set variables indicating what messages exist
  1. S (PSODMESE,PSODMESX,PSODMESG,PSODMEST,PSODMESH,PSODMESM)=0
  1. I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"ERROR")) S PSODMESE=1
  1. I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"EXCEPTIONS")) S PSODMESX=1
  1. I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE")) S PSODMESM=1
  1. I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","3_GENERAL")) S PSODMESG=1
  1. I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","4_TRAIL")) S PSODMEST=1
  1. D
  1. .I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE")) S PSODMESH=1 Q
  1. .I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","2_RANGE")) S PSODMESH=1 Q
  1. .I $D(^TMP($J,"PSOPDOSN","OUT",PSODSEQ,PSODLNN1,"MESSAGE","1_SINGLE_RANGE")) S PSODMESH=1
  1. Q