- PSODOSU4 ;BIR/cmf - Dose Check Utility routine continued ;11/18/08
- ;;7.0;OUTPATIENT PHARMACY;**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
- ;
- WRITEXC ;format and write exception messages to the screen
- N PSORSNT1,PSORSNT3,PSORSNT4 S PSODLWW=0,DIWL=4,DIWR=76 K ^UTILITY($J,"W")
- I PSODLERB["Range Check Error Summary" S PSODLERS=1 I PSODLERZ W:'PSODLQT ! D HD Q:$G(PSODLQTC)
- I $G(PSODLERS),$L(PSODLERB)>76&($G(PSOCPXB)>1) S PSODLERB=$E(PSODLERB,14,999),DIWR=76,DIWL=17,DIWF="W" S PSODLERW=1
- S X=PSODLERB D:'PSODLQT ^DIWP D HD Q:$G(PSODLQTC)
- I '$G(PSODLERW) S (PSODELXF,PSORSNT1,PSORSNT3)=0 F PSODELXR=0:0 S PSODELXR=$O(^UTILITY($J,"W",DIWL,PSODELXR)) Q:'PSODELXR D
- .S PSORSNT1=PSORSNT1+1 I PSORSNT1=1 D SPAC
- .W:PSODELXF&('PSODLQT) ! D HD Q:$G(PSODLQTC) W:'PSODLQT $S(PSORSNT1>1&(PSORSNT3):PSORSNT4,1:" ")_$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) S (PSONFRNF,PSODELXF,PSODLERZ,PSODLEXR,PSOEXCPT)=1
- I $G(PSODLERW)&('PSODLQT) D ^DIWW K PSODLERW,PSODLERL S PSODLWW=1 S PSOLASTD(PSOLASTS)=2
- K ^UTILITY($J,"W")
- Q
- ;
- SPAC ; See if leading spaces need to be added after line 1
- N PSORSNT2,PSORSNT5
- S PSORSNT2=$G(^UTILITY($J,"W",DIWL,PSODELXR,0)) Q:$E(PSORSNT2)'=" "
- F PSORSNT3=1:1:$L(PSORSNT2) I $E(PSORSNT2,PSORSNT3)'=" " Q
- S:PSORSNT3'=$L(PSORSNT2) PSORSNT3=PSORSNT3+2 S PSORSNT4="" F PSORSNT5=1:1:PSORSNT3 S PSORSNT4=PSORSNT4_" "
- Q
- ;
- HD ;
- D HD^PSODOSU2 Q
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODOSU4 1608 printed Feb 18, 2025@23:53:42 Page 2
- PSODOSU4 ;BIR/cmf - Dose Check Utility routine continued ;11/18/08
- +1 ;;7.0;OUTPATIENT PHARMACY;**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 ;
- WRITEXC ;format and write exception messages to the screen
- +1 NEW PSORSNT1,PSORSNT3,PSORSNT4
- SET PSODLWW=0
- SET DIWL=4
- SET DIWR=76
- KILL ^UTILITY($JOB,"W")
- +2 IF PSODLERB["Range Check Error Summary"
- SET PSODLERS=1
- IF PSODLERZ
- if 'PSODLQT
- WRITE !
- DO HD
- if $GET(PSODLQTC)
- QUIT
- +3 IF $GET(PSODLERS)
- IF $LENGTH(PSODLERB)>76&($GET(PSOCPXB)>1)
- SET PSODLERB=$EXTRACT(PSODLERB,14,999)
- SET DIWR=76
- SET DIWL=17
- SET DIWF="W"
- SET PSODLERW=1
- +4 SET X=PSODLERB
- if 'PSODLQT
- DO ^DIWP
- DO HD
- if $GET(PSODLQTC)
- QUIT
- +5 IF '$GET(PSODLERW)
- SET (PSODELXF,PSORSNT1,PSORSNT3)=0
- FOR PSODELXR=0:0
- SET PSODELXR=$ORDER(^UTILITY($JOB,"W",DIWL,PSODELXR))
- if 'PSODELXR
- QUIT
- Begin DoDot:1
- +6 SET PSORSNT1=PSORSNT1+1
- IF PSORSNT1=1
- DO SPAC
- +7 if PSODELXF&('PSODLQT)
- WRITE !
- DO HD
- if $GET(PSODLQTC)
- QUIT
- if 'PSODLQT
- WRITE $SELECT(PSORSNT1>1&(PSORSNT3):PSORSNT4,1:" ")_$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
- SET (PSONFRNF,PSODELXF,PSODLERZ,PSODLEXR,PSOEXCPT)=1
- End DoDot:1
- +8 IF $GET(PSODLERW)&('PSODLQT)
- DO ^DIWW
- KILL PSODLERW,PSODLERL
- SET PSODLWW=1
- SET PSOLASTD(PSOLASTS)=2
- +9 KILL ^UTILITY($JOB,"W")
- +10 QUIT
- +11 ;
- SPAC ; See if leading spaces need to be added after line 1
- +1 NEW PSORSNT2,PSORSNT5
- +2 SET PSORSNT2=$GET(^UTILITY($JOB,"W",DIWL,PSODELXR,0))
- if $EXTRACT(PSORSNT2)'=" "
- QUIT
- +3 FOR PSORSNT3=1:1:$LENGTH(PSORSNT2)
- IF $EXTRACT(PSORSNT2,PSORSNT3)'=" "
- QUIT
- +4 if PSORSNT3'=$LENGTH(PSORSNT2)
- SET PSORSNT3=PSORSNT3+2
- SET PSORSNT4=""
- FOR PSORSNT5=1:1:PSORSNT3
- SET PSORSNT4=PSORSNT4_" "
- +5 QUIT
- +6 ;
- HD ;
- +1 DO HD^PSODOSU2
- QUIT
- +2 ;;
