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
