PSODOSU4.m

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 ---PSODOSU4   1608     printed  Apr 09, 2024@21:27:13                                                                                                                                                                                                    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       ;;