BLRERRT2.m

BLRERRT2 ; IHS/MSC/MKK - IHS Lab ERRor Trap Report, Part 2 ; 17-Oct-2014 09:22 ; MKK

 ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88

 ;

EEP ; EP -- Ersatz Entry Point

 D EEP^BLRGMENU

 Q

 ;

PACKAGE ; EP - Package Error Counts

 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 ;

 Q:$$PACKAGEI()="Q"

 ;

 F  S PACKAGE=$O(^TMP("BLRERRTR",$J,"PACKAGE",PACKAGE))  Q:PACKAGE=""!(QFLG="Q")  D

 . S CNT=CNT+1

 . S ERROR=""

 . F  S ERROR=$O(^TMP("BLRERRTR",$J,"PACKAGE",PACKAGE,ERROR))  Q:ERROR=""!(QFLG="Q")  D PACKAGEL

 ;

 Q:QFLG="Q"

 ;

 W !!,?4,CNT," Packages With Errors"

 W:TOTAL !!,?9,TOTAL," Total Errors"

 D PRESSKEY^BLRGMENU($S(TOTAL:4,1:9))

 Q

 ;

PACKAGEI() ; EP - Initialization

 D SETBLRVS("PACKAGE")

 ;

 S HEADER(1)="Error Trap Report"

 S HEADER(2)="Package Errors"

 ;

 D HEADERDT^BLRGMENU

 D HEADONE^BLRGMENU(.HDRONE)

 ;

 D HEADDTRN(3)

 ;

 S HEADER(4)=" "

 S $E(HEADER(5),5)="Package"

 S $E(HEADER(5),40)="Error"

 S $E(HEADER(5),70)="# Errs"

 ;

 D ^%ZIS

 I POP Q $$BADSTUFQ("Device I/O Error.")

 U IO

 S MAXLINES=IOSL-4,LINES=MAXLINES+10

 S QFLG="NO"

 ;

 S (CNT,PG,TOTAL)=0

 S PACKAGE=""

 Q "OK"

 ;

PACKAGEL ; EP - Line of data

 I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)  Q:QFLG="Q"

 ;

 W ?4,PACKAGE

 W ?39,ERROR

 W ?69,$G(^TMP("BLRERRTR",$J,"PACKAGE",PACKAGE,ERROR))

 W !

 S LINES=LINES+1

 ;

 S TOTAL=TOTAL+$G(^TMP("BLRERRTR",$J,"ROUTINE",PACKAGE,ERROR))

 Q

 ;

ROUTINE ; EP - Routine Error Counts

 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 ;

 Q:$$ROUTINEI()="Q"

 ;

 F  S ROUTINE=$O(^TMP("BLRERRTR",$J,"ROUTINE",ROUTINE)) Q:ROUTINE=""!(QFLG="Q")  D

 . S ERROR=""

 . S CNT=CNT+1

 . F  S ERROR=$O(^TMP("BLRERRTR",$J,"ROUTINE",ROUTINE,ERROR))  Q:ERROR=""!(QFLG="Q")  D ROUTINEL

 ;

 Q:QFLG="Q"

 ;

 W !!,?4,CNT," Entries In Error Trap"

 W:TOTAL !!,?9,TOTAL," Total Errors"

 D PRESSKEY^BLRGMENU($S(TOTAL:4,1:9))

 Q

 ;

ROUTINEI() ; EP - Initialization

 D SETBLRVS("ROUTINE")

 ;

 S HEADER(1)="Error Trap Report"

 S HEADER(2)="Routine Errors"

 ;

 D HEADERDT^BLRGMENU

 D HEADONE^BLRGMENU(.HDRONE)

 ;

 D HEADDTRN(3)

 ;

 S HEADER(4)=" "

 S $E(HEADER(5),5)="Routine"

 S $E(HEADER(5),20)="Error"

 S $E(HEADER(5),70)="# Errs"

 ;

 D ^%ZIS

 I POP Q $$BADSTUFQ("Device I/O Error.")

 ;

 U IO

 S MAXLINES=IOSL-4,LINES=MAXLINES+10

 S QFLG="NO"

 ;

 S (CNT,PG,TOTAL)=0

 S ROUTINE=""

 ;

 Q "OK"

 ;

ROUTINEL ; EP - Line of Data

 I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)  Q:QFLG="Q"

 ;

 W ?4,ROUTINE

 W ?19,ERROR

 W ?69,$G(^TMP("BLRERRTR",$J,"ROUTINE",ROUTINE,ERROR))

 W !

 S LINES=LINES+1

 S TOTAL=TOTAL+$G(^TMP("BLRERRTR",$J,"ROUTINE",ROUTINE,ERROR))

 ;

 Q

 ;

 ; =============================== Utilities ===============================

 ;

 ;

SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)

 S BLRVERN=$P($P($T(+1),";")," ")

 S:$L(TWO) BLRVERN2=TWO

 Q

 ;

BADSTUFQ(STR,TAB) ; EP - BADSTUFF error message.  Ends with Q "Q"

 S TAB=$G(TAB,4)

 W !!,?TAB,STR,"  Routine Ends."

 D PRESSKEY^BLRGMENU(TAB+5)

 Q "Q"

 ;

HEADDTRN(HEDLINE) ; EP - Create Date Range HEADER node

 S ERRBEG=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-1)),"5DZ")

 S ERREND=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-2)),"5DZ")

 ;

 S HEADER(HEDLINE)=$$CJ^XLFSTR("Date Range: "_ERRBEG_" thru "_ERREND,IOM)

 Q

BLRERRT2  ; IHS/MSC/MKK - IHS Lab ERRor Trap Report, Part 2 ; 17-Oct-2014 09:22 ; MKK

 +1       ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88

 +2       ;

EEP       ; EP -- Ersatz Entry Point

 +1        DO EEP^BLRGMENU

 +2        QUIT 

 +3       ;

PACKAGE   ; EP - Package Error Counts

 +1        NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 +2       ;

 +3        IF $$PACKAGEI()="Q"

               QUIT 

 +4       ;

 +5        FOR 

               SET PACKAGE=$ORDER(^TMP("BLRERRTR",$JOB,"PACKAGE",PACKAGE))

               IF PACKAGE=""!(QFLG="Q")

                   QUIT 

               Begin DoDot:1

 +6                SET CNT=CNT+1

 +7                SET ERROR=""

 +8                FOR 

                       SET ERROR=$ORDER(^TMP("BLRERRTR",$JOB,"PACKAGE",PACKAGE,ERROR))

                       IF ERROR=""!(QFLG="Q")

                           QUIT 

                       DO PACKAGEL

               End DoDot:1

 +9       ;

 +10       IF QFLG="Q"

               QUIT 

 +11      ;

 +12       WRITE !!,?4,CNT," Packages With Errors"

 +13       IF TOTAL

               WRITE !!,?9,TOTAL," Total Errors"

 +14       DO PRESSKEY^BLRGMENU($SELECT(TOTAL:4,1:9))

 +15       QUIT 

 +16      ;

PACKAGEI() ; EP - Initialization

 +1        DO SETBLRVS("PACKAGE")

 +2       ;

 +3        SET HEADER(1)="Error Trap Report"

 +4        SET HEADER(2)="Package Errors"

 +5       ;

 +6        DO HEADERDT^BLRGMENU

 +7        DO HEADONE^BLRGMENU(.HDRONE)

 +8       ;

 +9        DO HEADDTRN(3)

 +10      ;

 +11       SET HEADER(4)=" "

 +12       SET $EXTRACT(HEADER(5),5)="Package"

 +13       SET $EXTRACT(HEADER(5),40)="Error"

 +14       SET $EXTRACT(HEADER(5),70)="# Errs"

 +15      ;

 +16       DO ^%ZIS

 +17       IF POP

               QUIT $$BADSTUFQ("Device I/O Error.")

 +18       USE IO

 +19       SET MAXLINES=IOSL-4

           SET LINES=MAXLINES+10

 +20       SET QFLG="NO"

 +21      ;

 +22       SET (CNT,PG,TOTAL)=0

 +23       SET PACKAGE=""

 +24       QUIT "OK"

 +25      ;

PACKAGEL  ; EP - Line of data

 +1        IF LINES>MAXLINES

               DO HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)

               IF QFLG="Q"

                   QUIT 

 +2       ;

 +3        WRITE ?4,PACKAGE

 +4        WRITE ?39,ERROR

 +5        WRITE ?69,$GET(^TMP("BLRERRTR",$JOB,"PACKAGE",PACKAGE,ERROR))

 +6        WRITE !

 +7        SET LINES=LINES+1

 +8       ;

 +9        SET TOTAL=TOTAL+$GET(^TMP("BLRERRTR",$JOB,"ROUTINE",PACKAGE,ERROR))

 +10       QUIT 

 +11      ;

ROUTINE   ; EP - Routine Error Counts

 +1        NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 +2       ;

 +3        IF $$ROUTINEI()="Q"

               QUIT 

 +4       ;

 +5        FOR 

               SET ROUTINE=$ORDER(^TMP("BLRERRTR",$JOB,"ROUTINE",ROUTINE))

               IF ROUTINE=""!(QFLG="Q")

                   QUIT 

               Begin DoDot:1

 +6                SET ERROR=""

 +7                SET CNT=CNT+1

 +8                FOR 

                       SET ERROR=$ORDER(^TMP("BLRERRTR",$JOB,"ROUTINE",ROUTINE,ERROR))

                       IF ERROR=""!(QFLG="Q")

                           QUIT 

                       DO ROUTINEL

               End DoDot:1

 +9       ;

 +10       IF QFLG="Q"

               QUIT 

 +11      ;

 +12       WRITE !!,?4,CNT," Entries In Error Trap"

 +13       IF TOTAL

               WRITE !!,?9,TOTAL," Total Errors"

 +14       DO PRESSKEY^BLRGMENU($SELECT(TOTAL:4,1:9))

 +15       QUIT 

 +16      ;

ROUTINEI() ; EP - Initialization

 +1        DO SETBLRVS("ROUTINE")

 +2       ;

 +3        SET HEADER(1)="Error Trap Report"

 +4        SET HEADER(2)="Routine Errors"

 +5       ;

 +6        DO HEADERDT^BLRGMENU

 +7        DO HEADONE^BLRGMENU(.HDRONE)

 +8       ;

 +9        DO HEADDTRN(3)

 +10      ;

 +11       SET HEADER(4)=" "

 +12       SET $EXTRACT(HEADER(5),5)="Routine"

 +13       SET $EXTRACT(HEADER(5),20)="Error"

 +14       SET $EXTRACT(HEADER(5),70)="# Errs"

 +15      ;

 +16       DO ^%ZIS

 +17       IF POP

               QUIT $$BADSTUFQ("Device I/O Error.")

 +18      ;

 +19       USE IO

 +20       SET MAXLINES=IOSL-4

           SET LINES=MAXLINES+10

 +21       SET QFLG="NO"

 +22      ;

 +23       SET (CNT,PG,TOTAL)=0

 +24       SET ROUTINE=""

 +25      ;

 +26       QUIT "OK"

 +27      ;

ROUTINEL  ; EP - Line of Data

 +1        IF LINES>MAXLINES

               DO HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)

               IF QFLG="Q"

                   QUIT 

 +2       ;

 +3        WRITE ?4,ROUTINE

 +4        WRITE ?19,ERROR

 +5        WRITE ?69,$GET(^TMP("BLRERRTR",$JOB,"ROUTINE",ROUTINE,ERROR))

 +6        WRITE !

 +7        SET LINES=LINES+1

 +8        SET TOTAL=TOTAL+$GET(^TMP("BLRERRTR",$JOB,"ROUTINE",ROUTINE,ERROR))

 +9       ;

 +10       QUIT 

 +11      ;

 +12      ; =============================== Utilities ===============================

 +13      ;

 +14      ;

SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)

 +1        SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")

 +2        IF $LENGTH(TWO)

               SET BLRVERN2=TWO

 +3        QUIT 

 +4       ;

BADSTUFQ(STR,TAB) ; EP - BADSTUFF error message.  Ends with Q "Q"

 +1        SET TAB=$GET(TAB,4)

 +2        WRITE !!,?TAB,STR,"  Routine Ends."

 +3        DO PRESSKEY^BLRGMENU(TAB+5)

 +4        QUIT "Q"

 +5       ;

HEADDTRN(HEDLINE) ; EP - Create Date Range HEADER node

 +1        SET ERRBEG=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-1)),"5DZ")

 +2        SET ERREND=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-2)),"5DZ")

 +3       ;

 +4        SET HEADER(HEDLINE)=$$CJ^XLFSTR("Date Range: "_ERRBEG_" thru "_ERREND,IOM)

 +5        QUIT