BLRERRTR ; IHS/MSC/MKK - IHS Lab ERRor Trap Report ; September 2, 2011
;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997
;
EEP ; EP -- Ersatz Entry Point
D EEP^BLRGMENU
Q
;
PEP ; EP
EP ; EP
NEW BLRMMENU,BLRVERN
;
D SETMENU
;
; Main Menu driver
D MENUDRFM^BLRGMENU("RPMS Lab Module","Error Trap Report Routines")
;
; The temp global data are deleted to prevent reports being
; generated by "old" data.
K ^TMP("BLRERRTR",$J)
Q
;
S BLRVERN=$P($P($T(+1),";")," ")
;
D ADDTMENU^BLRGMENU("COMPMENU^BLRERRTR","Compilation...")
D ADDTMENU^BLRGMENU("REPTMENU^BLRERRTR","Reports...")
;
Q
;
NEW BLRMMENU,BLRVERN,MENU3
;
D CSETMENU
;
; Main Menu driver
S MENU3=$$CJ^XLFSTR("Compilation of Data",IOM)
D MENUDRFM^BLRGMENU("RPMS Lab Module","Error Trap Routines",MENU3)
;
Q
;
S BLRVERN=$P($P($T(+1),";")," ")
;
D ADDTMENU^BLRGMENU("COMPILE^BLRERRTR","Compile ALL Errors For Reports")
D ADDTMENU^BLRGMENU("COMPDATE^BLRERRTR","Compile Date Range Errors For Reports")
Q
;
NEW BLRMMENU,BLRVERN,MENU3
;
D RSETMENU
;
; Main Menu driver
S MENU3=$$CJ^XLFSTR("Reports",IOM)
D MENUDRFM^BLRGMENU("RPMS Lab Module","Error Trap Routines",MENU3)
;
Q
;
S BLRVERN=$P($P($T(+1),";")," ")
;
D ADDTMENU^BLRGMENU("DETAILED^BLRERRTR","Date/Time Errors Report")
D ADDTMENU^BLRGMENU("NODATES^BLRERRTR","Non Date Specific Errors Report")
D ADDTMENU^BLRGMENU("LABDET^BLRERRTR","Lab Only Date/Time Errors Report")
D ADDTMENU^BLRGMENU("LNODATES^BLRERRTR","Lab Only Non Date Specific Errors Report")
Q
;
COMPILE ; EP - Compilation of data
NEW ERROR,ERRDATE,ERRDNUM,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,PKGIEN,PKGNAME,ROUTINE,STR
NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
;
D INITVARS
;
D HEADERDT^BLRGMENU
W !,?4
;
K ^TMP("BLRERRTR",$J)
;
F S HDT=$O(^%ZTER(1,HDT)) Q:HDT<1 D
. S:$G(^TMP("BLRERRTR",$J,-1))="" ^TMP("BLRERRTR",$J,-1)=HDT
. S ^TMP("BLRERRTR",$J,-2)=HDT
. D STORERRS
;
D PRESSKEY^BLRGMENU(4)
Q
;
INITVARS ; EP - Initialize variables
S (HDT,ERRDNUM)=0
S HEADER(1)="Error Trap Report"
S HEADER(2)="Compilation"
;
Q
;
STORERRS ; EP - Store Errors into ^TMP global
S ERRDNUM=0
F S ERRDNUM=$O(^%ZTER(1,HDT,1,ERRDNUM)) Q:ERRDNUM<1 D
. S STR=$P($G(^%ZTER(1,HDT,1,ERRDNUM,"ZE"))," ")
. W "." W:$X>74 !,?4
. Q:$L(STR)<1
. ;
. S ERROR=$P(STR,">")_">"
. S STR=$P(STR,">",2) ; Reset STR to make it more manageable
. S LINETAG=$P(STR,"^")
. S:$L(LINETAG)<1 LINETAG="<NO LINETAG>"
. S ROUTINE=$$TRIM^XLFSTR($P(STR,"^",2),"LR"," ")
. S:$L(ROUTINE)<1 ROUTINE="<UNK>"
. ;
. ; Get Package Name
. S PACKAGE=$$TRIM^XLFSTR($P($G(^ROUTINE(ROUTINE,0,2)),";",4),"LR"," ")
. I $L(PACKAGE)>0,$L(PACKAGE)<4 D
.. Q:ROUTINE["UNK"
.. S PKGIEN=+$O(^DIC(9.4,"C",PACKAGE,0))
.. I PKGIEN>0 S PKGNAME=$P($G(^DIC(9.4,PKGIEN,0)),"^")
.. S:$L(PKGNAME) PACKAGE=PKGNAME
. S:$L(PACKAGE)<1 PACKAGE="<NO PACKAGE>"
. ;
. ; Store data
. S ^TMP("BLRERRTR",$J,"NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE)=1+$G(^TMP("BLRERRTR",$J,"NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
. S ^TMP("BLRERRTR",$J,"DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE)=1+$G(^TMP("BLRERRTR",$J,"DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
. ;
. ; Store Lab data
. I $E(ROUTINE,1,2)="LR"!($E(ROUTINE,1,2)="LA")!($E(ROUTINE,1,3)="BLR") D
.. S ^TMP("BLRERRTR",$J,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE)=1+$G(^TMP("BLRERRTR",$J,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
.. S ^TMP("BLRERRTR",$J,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE)=1+$G(^TMP("BLRERRTR",$J,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
Q
;
COMPDATE ; EP - Compilation of data
NEW ERROR,ERRDATE,ERRDNUM,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR
NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
;
Q:$$DRINITVS()="Q"
;
D HEADERDT^BLRGMENU
W !,?4
;
S HDT=LRSDT-1
F S HDT=$O(^%ZTER(1,HDT)) Q:HDT<1!(HDT>LRLDT) D
. D STORERRS
;
D PRESSKEY^BLRGMENU(4)
Q
;
DRINITVS() ; EP - Initialize variables
S (HDT,ERRDNUM)=0
S HEADER(1)="Error Trap Report"
S HEADER(2)="Compilation"
;
D HEADERDT^BLRGMENU
D B^LRU
;
I +$G(LRSDT)<1!(+$G(LRLDT)<1) D Q "Q"
. W !,?4,"Invalid/No Date Range Entered. Compilation Ends.",!
. D PRESSKEY^BLRGMENU(9)
;
S HEADER(3)=$$CJ^XLFSTR("Date Range:"_$$FMTE^XLFDT(LRSDT,"2Z")_" thru "_$$FMTE^XLFDT(LRLDT,"2Z"),IOM)
;
S LRSDT=$P($$FMTH^XLFDT(LRSDT),",")
S LRLDT=$P($$FMTH^XLFDT(LRLDT),",")
;
K ^TMP("BLRERRTR",$J)
S ^TMP("BLRERRTR",$J,-1)=LRSDT
S ^TMP("BLRERRTR",$J,-2)=LRLDT
;
Q "OK"
;
DETAILED ; EP - Report
NEW ERROR,ERRDATE,ERRDNUM,ERRTOT,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR,TOTAL
NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
;
Q:$$ISDATA()="Q"
;
D DETVINIT
;
F S HDT=$O(^TMP("BLRERRTR",$J,"DETAILED",HDT),-1) Q:HDT<1!(QFLG="Q") D
. F S PACKAGE=$O(^TMP("BLRERRTR",$J,"DETAILED",HDT,PACKAGE)) Q:PACKAGE=""!(QFLG="Q") D
.. F S ERROR=$O(^TMP("BLRERRTR",$J,"DETAILED",HDT,PACKAGE,ERROR)) Q:ERROR=""!(QFLG="Q") D
... F S LINETAG=$O(^TMP("BLRERRTR",$J,"DETAILED",HDT,PACKAGE,ERROR,LINETAG)) Q:LINETAG=""!(QFLG="Q") D
.... F S ROUTINE=$O(^TMP("BLRERRTR",$J,"DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE)) Q:ROUTINE=""!(QFLG="Q") D
..... D DETLINER
;
W:QFLG'="Q" !!,?10,"Total Number of Errors = ",TOTAL,!!
;
D ^%ZISC
;
Q:QFLG="Q"
;
D PRESSKEY^BLRGMENU(4)
Q
;
ISDATA() ; EP - Report Data Exists
I $D(^TMP("BLRERRTR",$J))>0 Q "OK"
;
W !,?4,"No Data Exists. Need to compile first."
D PRESSKEY^BLRGMENU(9)
Q "Q"
;
DETVINIT ; EP - Report Variables Initialization
NEW BEGDT,ENDDT
;
K HEADER
S HEADER(1)="Error Trap Report"
;
S BEGDT=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-1)),"5DZ")
S ENDDT=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-2)),"5DZ")
;
S HEADER(2)="Date Range: "_BEGDT_" thru "_ENDDT
;
D OPENIO
;
S HEADER(3)=" "
S $E(HEADER(4),68)="Error"
S $E(HEADER(4),78)="#"
S HEADER(5)="Package"
S $E(HEADER(5),30)="Routine"
S $E(HEADER(5),40)="Error"
S $E(HEADER(5),55)="Line Tag"
S $E(HEADER(5),68)="Date"
S $E(HEADER(5),77)="Errs"
;
S (HDT,PACKAGE,HDT,ERROR,LINETAG,ROUTINE)=""
Q
;
DETLINER ; EP - Output line of data
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1) Q:QFLG="Q"
;
S ERRTOT=$G(^TMP("BLRERRTR",$J,"DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
S TOTAL=TOTAL+ERRTOT
;
W $E($$TRIM^XLFSTR(PACKAGE,"LR"," "),1,27)
W ?29,$E(ROUTINE,1,8)
W ?39,$E(ERROR,1,13)
W ?54,$E(LINETAG,1,11)
W ?67,$$HTE^XLFDT(HDT,"2DZ")
W ?77,$J(ERRTOT,3)
W !
S LINES=LINES+1
Q
;
OPENIO ; EP
D HEADERDT^BLRGMENU
D HEADONE(.HD1)
W !
;
D ^%ZIS
U IO
;
S MAXLINES=IOSL-4
S LINES=MAXLINES+10
S QFLG="NO"
S (HDT,PG,TOTAL)=0
S (PACKAGE,ERROR,LINETAG,ROUTINE)=""
;
Q
;
HEADONE(HD1) ; EP -- Asks if user wants only 1 header line
D ^XBFMK
S DIR("A")="One Header Line ONLY"
S DIR("B")="NO"
S DIR(0)="YO"
D ^DIR
S HD1=$S(+$G(Y)=1:"YES",1:"NO")
Q
;
NODATES ; EP - No Date Report
NEW ERROR,ERRDATE,ERRDNUM,ERRTOT,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR,TOTAL
NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
;
Q:$$ISDATA()="Q"
;
D NODVINIT
;
F S PACKAGE=$O(^TMP("BLRERRTR",$J,"NODETAIL",PACKAGE)) Q:PACKAGE=""!(QFLG="Q") D
. F S ERROR=$O(^TMP("BLRERRTR",$J,"NODETAIL",PACKAGE,ERROR)) Q:ERROR=""!(QFLG="Q") D
.. F S LINETAG=$O(^TMP("BLRERRTR",$J,"NODETAIL",PACKAGE,ERROR,LINETAG)) Q:LINETAG=""!(QFLG="Q") D
... F S ROUTINE=$O(^TMP("BLRERRTR",$J,"NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE)) Q:ROUTINE=""!(QFLG="Q") D
.... D NODLINER
;
W:QFLG'="Q" !!,?10,"Total Number of Errors = ",TOTAL,!!
;
D ^%ZISC
;
Q:QFLG="Q"
;
D PRESSKEY^BLRGMENU(4)
Q
;
NODVINIT ; EP - Report Variables Initialization
NEW BEGDT,ENDDT
;
K HEADER
S HEADER(1)="Error Trap Report"
;
S BEGDT=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-1)),"5DZ")
S ENDDT=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-2)),"5DZ")
;
S HEADER(2)="Date Range: "_BEGDT_" thru "_ENDDT
;
D OPENIO
;
S HEADER(3)=" "
S HEADER(4)="Package"
S $E(HEADER(4),30)="Routine"
S $E(HEADER(4),40)="Error"
S $E(HEADER(4),55)="Line Tag"
S $E(HEADER(4),75)="# Errs"
;
Q
;
NODLINER ; EP - Output line of data
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1) Q:QFLG="Q"
;
S ERRTOT=$G(^TMP("BLRERRTR",$J,"NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
S TOTAL=TOTAL+ERRTOT
;
W $E($$TRIM^XLFSTR(PACKAGE,"LR"," "),1,28)
W ?29,ROUTINE
W ?39,ERROR
W ?54,LINETAG
W ?74,$J(ERRTOT,6)
W !
S LINES=LINES+1
Q
;
LABDET ; EP - Lab Only Detailed Report
NEW ERROR,ERRDATE,ERRDNUM,ERRTOT,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR,TOTAL
NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
;
Q:$$ISDATA()="Q"
;
D LDETVINI
;
F S HDT=$O(^TMP("BLRERRTR",$J,"LAB","DETAILED",HDT),-1) Q:HDT<1!(QFLG="Q") D
. F S PACKAGE=$O(^TMP("BLRERRTR",$J,"LAB","DETAILED",HDT,PACKAGE)) Q:PACKAGE=""!(QFLG="Q") D
.. F S ERROR=$O(^TMP("BLRERRTR",$J,"LAB","DETAILED",HDT,PACKAGE,ERROR)) Q:ERROR=""!(QFLG="Q") D
... F S LINETAG=$O(^TMP("BLRERRTR",$J,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG)) Q:LINETAG=""!(QFLG="Q") D
.... F S ROUTINE=$O(^TMP("BLRERRTR",$J,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE)) Q:ROUTINE=""!(QFLG="Q") D
..... D LDETLINR
;
W:QFLG'="Q" !!,?10,"Total Number of Errors = ",TOTAL,!!
;
D ^%ZISC
;
Q:QFLG="Q"
;
D PRESSKEY^BLRGMENU(4)
Q
;
LDETVINI ; EP - Lab Only - Detailed Report Variables Initialization
NEW BEGDT,ENDDT
;
K HEADER
S HEADER(1)="Error Trap Report"
;
S BEGDT=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-1)),"5DZ")
S ENDDT=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-2)),"5DZ")
;
S HEADER(2)="Date Range: "_BEGDT_" thru "_ENDDT
S HEADER(3)=$$CJ^XLFSTR("LAB ONLY Errors",IOM)
;
D OPENIO
;
S $E(HEADER(4),68)="Error"
S $E(HEADER(4),78)="#"
S HEADER(5)="Package"
S $E(HEADER(5),30)="Routine"
S $E(HEADER(5),40)="Error"
S $E(HEADER(5),55)="Line Tag"
S $E(HEADER(5),68)="Date"
S $E(HEADER(5),77)="Errs"
;
S (HDT,PACKAGE,HDT,ERROR,LINETAG,ROUTINE)=""
Q
;
LDETLINR ; EP - Lab only - Output line of data
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1) Q:QFLG="Q"
;
S ERRTOT=$G(^TMP("BLRERRTR",$J,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
S TOTAL=TOTAL+ERRTOT
;
W $E($$TRIM^XLFSTR(PACKAGE,"LR"," "),1,27)
W ?29,ROUTINE
W ?39,ERROR
W ?54,LINETAG
W ?67,$$HTE^XLFDT(HDT,"2DZ")
W ?77,$J(ERRTOT,3)
W !
S LINES=LINES+1
Q
;
LNODATES ; EP - Lab Only - No Date Report
NEW ERROR,ERRDATE,ERRDNUM,ERRTOT,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR,TOTAL
NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
;
Q:$$ISDATA()="Q"
;
D LNODVINI
;
F S PACKAGE=$O(^TMP("BLRERRTR",$J,"LAB","NODETAIL",PACKAGE)) Q:PACKAGE=""!(QFLG="Q") D
. F S ERROR=$O(^TMP("BLRERRTR",$J,"LAB","NODETAIL",PACKAGE,ERROR)) Q:ERROR=""!(QFLG="Q") D
.. F S LINETAG=$O(^TMP("BLRERRTR",$J,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG)) Q:LINETAG=""!(QFLG="Q") D
... F S ROUTINE=$O(^TMP("BLRERRTR",$J,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE)) Q:ROUTINE=""!(QFLG="Q") D
.... D LNODLINR
;
W:QFLG'="Q" !!,?10,"Total Number of Errors = ",TOTAL,!!
;
D ^%ZISC
;
Q:QFLG="Q"
;
D PRESSKEY^BLRGMENU(4)
Q
;
LNODVINI ; EP - Lab Only - No Date - Report Variables Initialization
NEW BEGDT,ENDDT
;
K HEADER
S HEADER(1)="Error Trap Report"
;
S BEGDT=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-1)),"5DZ")
S ENDDT=$$HTE^XLFDT($G(^TMP("BLRERRTR",$J,-2)),"5DZ")
;
S HEADER(2)="Date Range: "_BEGDT_" thru "_ENDDT
S HEADER(3)=$$CJ^XLFSTR("LAB ONLY",IOM)
S HEADER(4)=" "
;
D HEADERDT^BLRGMENU
D HEADONE(.HD1)
;
S HEADER(5)="Package"
S $E(HEADER(5),30)="Routine"
S $E(HEADER(5),40)="Error"
S $E(HEADER(5),55)="Line Tag"
S $E(HEADER(5),75)="# Errs"
;
D ^%ZIS
U IO
S MAXLINES=IOSL-4
S LINES=MAXLINES+10
S QFLG="NO"
;
S (HDT,PG,TOTAL)=0
S (PACKAGE,ERROR,LINETAG,ROUTINE)=""
Q
;
LNODLINR ; EP - Output line of data
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1) Q:QFLG="Q"
;
S ERRTOT=$G(^TMP("BLRERRTR",$J,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
S TOTAL=TOTAL+ERRTOT
;
W $E($$TRIM^XLFSTR(PACKAGE,"LR"," "),1,28)
W ?29,ROUTINE
W ?39,ERROR
W ?54,LINETAG
W ?74,$J(ERRTOT,6)
W !
S LINES=LINES+1
Q
BLRERRTR ; IHS/MSC/MKK - IHS Lab ERRor Trap Report ; September 2, 2011
+1 ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997
+2 ;
EEP ; EP -- Ersatz Entry Point
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
PEP ; EP
EP ; EP
+1 NEW BLRMMENU,BLRVERN
+2 ;
+3 DO SETMENU
+4 ;
+5 ; Main Menu driver
+6 DO MENUDRFM^BLRGMENU("RPMS Lab Module","Error Trap Report Routines")
+7 ;
+8 ; The temp global data are deleted to prevent reports being
+9 ; generated by "old" data.
+10 KILL ^TMP("BLRERRTR",$JOB)
+11 QUIT
+12 ;
+1 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+2 ;
+3 DO ADDTMENU^BLRGMENU("COMPMENU^BLRERRTR","Compilation...")
+4 DO ADDTMENU^BLRGMENU("REPTMENU^BLRERRTR","Reports...")
+5 ;
+6 QUIT
+7 ;
+1 NEW BLRMMENU,BLRVERN,MENU3
+2 ;
+3 DO CSETMENU
+4 ;
+5 ; Main Menu driver
+6 SET MENU3=$$CJ^XLFSTR("Compilation of Data",IOM)
+7 DO MENUDRFM^BLRGMENU("RPMS Lab Module","Error Trap Routines",MENU3)
+8 ;
+9 QUIT
+10 ;
+1 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+2 ;
+3 DO ADDTMENU^BLRGMENU("COMPILE^BLRERRTR","Compile ALL Errors For Reports")
+4 DO ADDTMENU^BLRGMENU("COMPDATE^BLRERRTR","Compile Date Range Errors For Reports")
+5 QUIT
+6 ;
+1 NEW BLRMMENU,BLRVERN,MENU3
+2 ;
+3 DO RSETMENU
+4 ;
+5 ; Main Menu driver
+6 SET MENU3=$$CJ^XLFSTR("Reports",IOM)
+7 DO MENUDRFM^BLRGMENU("RPMS Lab Module","Error Trap Routines",MENU3)
+8 ;
+9 QUIT
+10 ;
+1 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+2 ;
+3 DO ADDTMENU^BLRGMENU("DETAILED^BLRERRTR","Date/Time Errors Report")
+4 DO ADDTMENU^BLRGMENU("NODATES^BLRERRTR","Non Date Specific Errors Report")
+5 DO ADDTMENU^BLRGMENU("LABDET^BLRERRTR","Lab Only Date/Time Errors Report")
+6 DO ADDTMENU^BLRGMENU("LNODATES^BLRERRTR","Lab Only Non Date Specific Errors Report")
+7 QUIT
+8 ;
COMPILE ; EP - Compilation of data
+1 NEW ERROR,ERRDATE,ERRDNUM,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,PKGIEN,PKGNAME,ROUTINE,STR
+2 NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
+3 ;
+4 DO INITVARS
+5 ;
+6 DO HEADERDT^BLRGMENU
+7 WRITE !,?4
+8 ;
+9 KILL ^TMP("BLRERRTR",$JOB)
+10 ;
+11 FOR
SET HDT=$ORDER(^%ZTER(1,HDT))
IF HDT<1
QUIT
Begin DoDot:1
+12 IF $GET(^TMP("BLRERRTR",$JOB,-1))=""
SET ^TMP("BLRERRTR",$JOB,-1)=HDT
+13 SET ^TMP("BLRERRTR",$JOB,-2)=HDT
+14 DO STORERRS
End DoDot:1
+15 ;
+16 DO PRESSKEY^BLRGMENU(4)
+17 QUIT
+18 ;
INITVARS ; EP - Initialize variables
+1 SET (HDT,ERRDNUM)=0
+2 SET HEADER(1)="Error Trap Report"
+3 SET HEADER(2)="Compilation"
+4 ;
+5 QUIT
+6 ;
STORERRS ; EP - Store Errors into ^TMP global
+1 SET ERRDNUM=0
+2 FOR
SET ERRDNUM=$ORDER(^%ZTER(1,HDT,1,ERRDNUM))
IF ERRDNUM<1
QUIT
Begin DoDot:1
+3 SET STR=$PIECE($GET(^%ZTER(1,HDT,1,ERRDNUM,"ZE"))," ")
+4 WRITE "."
IF $X>74
WRITE !,?4
+5 IF $LENGTH(STR)<1
QUIT
+6 ;
+7 SET ERROR=$PIECE(STR,">")_">"
+8 ; Reset STR to make it more manageable
SET STR=$PIECE(STR,">",2)
+9 SET LINETAG=$PIECE(STR,"^")
+10 IF $LENGTH(LINETAG)<1
SET LINETAG="<NO LINETAG>"
+11 SET ROUTINE=$$TRIM^XLFSTR($PIECE(STR,"^",2),"LR"," ")
+12 IF $LENGTH(ROUTINE)<1
SET ROUTINE="<UNK>"
+13 ;
+14 ; Get Package Name
+15 SET PACKAGE=$$TRIM^XLFSTR($PIECE($GET(^ROUTINE(ROUTINE,0,2)),";",4),"LR"," ")
+16 IF $LENGTH(PACKAGE)>0
IF $LENGTH(PACKAGE)<4
Begin DoDot:2
+17 IF ROUTINE["UNK"
QUIT
+18 SET PKGIEN=+$ORDER(^DIC(9.4,"C",PACKAGE,0))
+19 IF PKGIEN>0
SET PKGNAME=$PIECE($GET(^DIC(9.4,PKGIEN,0)),"^")
+20 IF $LENGTH(PKGNAME)
SET PACKAGE=PKGNAME
End DoDot:2
+21 IF $LENGTH(PACKAGE)<1
SET PACKAGE="<NO PACKAGE>"
+22 ;
+23 ; Store data
+24 SET ^TMP("BLRERRTR",$JOB,"NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE)=1+$GET(^TMP("BLRERRTR",$JOB,"NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
+25 SET ^TMP("BLRERRTR",$JOB,"DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE)=1+$GET(^TMP("BLRERRTR",$JOB,"DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
+26 ;
+27 ; Store Lab data
+28 IF $EXTRACT(ROUTINE,1,2)="LR"!($EXTRACT(ROUTINE,1,2)="LA")!($EXTRACT(ROUTINE,1,3)="BLR")
Begin DoDot:2
+29 SET ^TMP("BLRERRTR",$JOB,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE)=1+$GET(^TMP("BLRERRTR",$JOB,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
+30 SET ^TMP("BLRERRTR",$JOB,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE)=1+$GET(^TMP("BLRERRTR",$JOB,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
COMPDATE ; EP - Compilation of data
+1 NEW ERROR,ERRDATE,ERRDNUM,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR
+2 NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
+3 ;
+4 IF $$DRINITVS()="Q"
QUIT
+5 ;
+6 DO HEADERDT^BLRGMENU
+7 WRITE !,?4
+8 ;
+9 SET HDT=LRSDT-1
+10 FOR
SET HDT=$ORDER(^%ZTER(1,HDT))
IF HDT<1!(HDT>LRLDT)
QUIT
Begin DoDot:1
+11 DO STORERRS
End DoDot:1
+12 ;
+13 DO PRESSKEY^BLRGMENU(4)
+14 QUIT
+15 ;
DRINITVS() ; EP - Initialize variables
+1 SET (HDT,ERRDNUM)=0
+2 SET HEADER(1)="Error Trap Report"
+3 SET HEADER(2)="Compilation"
+4 ;
+5 DO HEADERDT^BLRGMENU
+6 DO B^LRU
+7 ;
+8 IF +$GET(LRSDT)<1!(+$GET(LRLDT)<1)
Begin DoDot:1
+9 WRITE !,?4,"Invalid/No Date Range Entered. Compilation Ends.",!
+10 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT "Q"
+11 ;
+12 SET HEADER(3)=$$CJ^XLFSTR("Date Range:"_$$FMTE^XLFDT(LRSDT,"2Z")_" thru "_$$FMTE^XLFDT(LRLDT,"2Z"),IOM)
+13 ;
+14 SET LRSDT=$PIECE($$FMTH^XLFDT(LRSDT),",")
+15 SET LRLDT=$PIECE($$FMTH^XLFDT(LRLDT),",")
+16 ;
+17 KILL ^TMP("BLRERRTR",$JOB)
+18 SET ^TMP("BLRERRTR",$JOB,-1)=LRSDT
+19 SET ^TMP("BLRERRTR",$JOB,-2)=LRLDT
+20 ;
+21 QUIT "OK"
+22 ;
DETAILED ; EP - Report
+1 NEW ERROR,ERRDATE,ERRDNUM,ERRTOT,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR,TOTAL
+2 NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
+3 ;
+4 IF $$ISDATA()="Q"
QUIT
+5 ;
+6 DO DETVINIT
+7 ;
+8 FOR
SET HDT=$ORDER(^TMP("BLRERRTR",$JOB,"DETAILED",HDT),-1)
IF HDT<1!(QFLG="Q")
QUIT
Begin DoDot:1
+9 FOR
SET PACKAGE=$ORDER(^TMP("BLRERRTR",$JOB,"DETAILED",HDT,PACKAGE))
IF PACKAGE=""!(QFLG="Q")
QUIT
Begin DoDot:2
+10 FOR
SET ERROR=$ORDER(^TMP("BLRERRTR",$JOB,"DETAILED",HDT,PACKAGE,ERROR))
IF ERROR=""!(QFLG="Q")
QUIT
Begin DoDot:3
+11 FOR
SET LINETAG=$ORDER(^TMP("BLRERRTR",$JOB,"DETAILED",HDT,PACKAGE,ERROR,LINETAG))
IF LINETAG=""!(QFLG="Q")
QUIT
Begin DoDot:4
+12 FOR
SET ROUTINE=$ORDER(^TMP("BLRERRTR",$JOB,"DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
IF ROUTINE=""!(QFLG="Q")
QUIT
Begin DoDot:5
+13 DO DETLINER
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 IF QFLG'="Q"
WRITE !!,?10,"Total Number of Errors = ",TOTAL,!!
+16 ;
+17 DO ^%ZISC
+18 ;
+19 IF QFLG="Q"
QUIT
+20 ;
+21 DO PRESSKEY^BLRGMENU(4)
+22 QUIT
+23 ;
ISDATA() ; EP - Report Data Exists
+1 IF $DATA(^TMP("BLRERRTR",$JOB))>0
QUIT "OK"
+2 ;
+3 WRITE !,?4,"No Data Exists. Need to compile first."
+4 DO PRESSKEY^BLRGMENU(9)
+5 QUIT "Q"
+6 ;
DETVINIT ; EP - Report Variables Initialization
+1 NEW BEGDT,ENDDT
+2 ;
+3 KILL HEADER
+4 SET HEADER(1)="Error Trap Report"
+5 ;
+6 SET BEGDT=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-1)),"5DZ")
+7 SET ENDDT=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-2)),"5DZ")
+8 ;
+9 SET HEADER(2)="Date Range: "_BEGDT_" thru "_ENDDT
+10 ;
+11 DO OPENIO
+12 ;
+13 SET HEADER(3)=" "
+14 SET $EXTRACT(HEADER(4),68)="Error"
+15 SET $EXTRACT(HEADER(4),78)="#"
+16 SET HEADER(5)="Package"
+17 SET $EXTRACT(HEADER(5),30)="Routine"
+18 SET $EXTRACT(HEADER(5),40)="Error"
+19 SET $EXTRACT(HEADER(5),55)="Line Tag"
+20 SET $EXTRACT(HEADER(5),68)="Date"
+21 SET $EXTRACT(HEADER(5),77)="Errs"
+22 ;
+23 SET (HDT,PACKAGE,HDT,ERROR,LINETAG,ROUTINE)=""
+24 QUIT
+25 ;
DETLINER ; EP - Output line of data
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HD1)
IF QFLG="Q"
QUIT
+2 ;
+3 SET ERRTOT=$GET(^TMP("BLRERRTR",$JOB,"DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
+4 SET TOTAL=TOTAL+ERRTOT
+5 ;
+6 WRITE $EXTRACT($$TRIM^XLFSTR(PACKAGE,"LR"," "),1,27)
+7 WRITE ?29,$EXTRACT(ROUTINE,1,8)
+8 WRITE ?39,$EXTRACT(ERROR,1,13)
+9 WRITE ?54,$EXTRACT(LINETAG,1,11)
+10 WRITE ?67,$$HTE^XLFDT(HDT,"2DZ")
+11 WRITE ?77,$JUSTIFY(ERRTOT,3)
+12 WRITE !
+13 SET LINES=LINES+1
+14 QUIT
+15 ;
OPENIO ; EP
+1 DO HEADERDT^BLRGMENU
+2 DO HEADONE(.HD1)
+3 WRITE !
+4 ;
+5 DO ^%ZIS
+6 USE IO
+7 ;
+8 SET MAXLINES=IOSL-4
+9 SET LINES=MAXLINES+10
+10 SET QFLG="NO"
+11 SET (HDT,PG,TOTAL)=0
+12 SET (PACKAGE,ERROR,LINETAG,ROUTINE)=""
+13 ;
+14 QUIT
+15 ;
HEADONE(HD1) ; EP -- Asks if user wants only 1 header line
+1 DO ^XBFMK
+2 SET DIR("A")="One Header Line ONLY"
+3 SET DIR("B")="NO"
+4 SET DIR(0)="YO"
+5 DO ^DIR
+6 SET HD1=$SELECT(+$GET(Y)=1:"YES",1:"NO")
+7 QUIT
+8 ;
NODATES ; EP - No Date Report
+1 NEW ERROR,ERRDATE,ERRDNUM,ERRTOT,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR,TOTAL
+2 NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
+3 ;
+4 IF $$ISDATA()="Q"
QUIT
+5 ;
+6 DO NODVINIT
+7 ;
+8 FOR
SET PACKAGE=$ORDER(^TMP("BLRERRTR",$JOB,"NODETAIL",PACKAGE))
IF PACKAGE=""!(QFLG="Q")
QUIT
Begin DoDot:1
+9 FOR
SET ERROR=$ORDER(^TMP("BLRERRTR",$JOB,"NODETAIL",PACKAGE,ERROR))
IF ERROR=""!(QFLG="Q")
QUIT
Begin DoDot:2
+10 FOR
SET LINETAG=$ORDER(^TMP("BLRERRTR",$JOB,"NODETAIL",PACKAGE,ERROR,LINETAG))
IF LINETAG=""!(QFLG="Q")
QUIT
Begin DoDot:3
+11 FOR
SET ROUTINE=$ORDER(^TMP("BLRERRTR",$JOB,"NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
IF ROUTINE=""!(QFLG="Q")
QUIT
Begin DoDot:4
+12 DO NODLINER
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 IF QFLG'="Q"
WRITE !!,?10,"Total Number of Errors = ",TOTAL,!!
+15 ;
+16 DO ^%ZISC
+17 ;
+18 IF QFLG="Q"
QUIT
+19 ;
+20 DO PRESSKEY^BLRGMENU(4)
+21 QUIT
+22 ;
NODVINIT ; EP - Report Variables Initialization
+1 NEW BEGDT,ENDDT
+2 ;
+3 KILL HEADER
+4 SET HEADER(1)="Error Trap Report"
+5 ;
+6 SET BEGDT=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-1)),"5DZ")
+7 SET ENDDT=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-2)),"5DZ")
+8 ;
+9 SET HEADER(2)="Date Range: "_BEGDT_" thru "_ENDDT
+10 ;
+11 DO OPENIO
+12 ;
+13 SET HEADER(3)=" "
+14 SET HEADER(4)="Package"
+15 SET $EXTRACT(HEADER(4),30)="Routine"
+16 SET $EXTRACT(HEADER(4),40)="Error"
+17 SET $EXTRACT(HEADER(4),55)="Line Tag"
+18 SET $EXTRACT(HEADER(4),75)="# Errs"
+19 ;
+20 QUIT
+21 ;
NODLINER ; EP - Output line of data
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HD1)
IF QFLG="Q"
QUIT
+2 ;
+3 SET ERRTOT=$GET(^TMP("BLRERRTR",$JOB,"NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
+4 SET TOTAL=TOTAL+ERRTOT
+5 ;
+6 WRITE $EXTRACT($$TRIM^XLFSTR(PACKAGE,"LR"," "),1,28)
+7 WRITE ?29,ROUTINE
+8 WRITE ?39,ERROR
+9 WRITE ?54,LINETAG
+10 WRITE ?74,$JUSTIFY(ERRTOT,6)
+11 WRITE !
+12 SET LINES=LINES+1
+13 QUIT
+14 ;
LABDET ; EP - Lab Only Detailed Report
+1 NEW ERROR,ERRDATE,ERRDNUM,ERRTOT,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR,TOTAL
+2 NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
+3 ;
+4 IF $$ISDATA()="Q"
QUIT
+5 ;
+6 DO LDETVINI
+7 ;
+8 FOR
SET HDT=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","DETAILED",HDT),-1)
IF HDT<1!(QFLG="Q")
QUIT
Begin DoDot:1
+9 FOR
SET PACKAGE=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","DETAILED",HDT,PACKAGE))
IF PACKAGE=""!(QFLG="Q")
QUIT
Begin DoDot:2
+10 FOR
SET ERROR=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","DETAILED",HDT,PACKAGE,ERROR))
IF ERROR=""!(QFLG="Q")
QUIT
Begin DoDot:3
+11 FOR
SET LINETAG=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG))
IF LINETAG=""!(QFLG="Q")
QUIT
Begin DoDot:4
+12 FOR
SET ROUTINE=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
IF ROUTINE=""!(QFLG="Q")
QUIT
Begin DoDot:5
+13 DO LDETLINR
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 IF QFLG'="Q"
WRITE !!,?10,"Total Number of Errors = ",TOTAL,!!
+16 ;
+17 DO ^%ZISC
+18 ;
+19 IF QFLG="Q"
QUIT
+20 ;
+21 DO PRESSKEY^BLRGMENU(4)
+22 QUIT
+23 ;
LDETVINI ; EP - Lab Only - Detailed Report Variables Initialization
+1 NEW BEGDT,ENDDT
+2 ;
+3 KILL HEADER
+4 SET HEADER(1)="Error Trap Report"
+5 ;
+6 SET BEGDT=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-1)),"5DZ")
+7 SET ENDDT=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-2)),"5DZ")
+8 ;
+9 SET HEADER(2)="Date Range: "_BEGDT_" thru "_ENDDT
+10 SET HEADER(3)=$$CJ^XLFSTR("LAB ONLY Errors",IOM)
+11 ;
+12 DO OPENIO
+13 ;
+14 SET $EXTRACT(HEADER(4),68)="Error"
+15 SET $EXTRACT(HEADER(4),78)="#"
+16 SET HEADER(5)="Package"
+17 SET $EXTRACT(HEADER(5),30)="Routine"
+18 SET $EXTRACT(HEADER(5),40)="Error"
+19 SET $EXTRACT(HEADER(5),55)="Line Tag"
+20 SET $EXTRACT(HEADER(5),68)="Date"
+21 SET $EXTRACT(HEADER(5),77)="Errs"
+22 ;
+23 SET (HDT,PACKAGE,HDT,ERROR,LINETAG,ROUTINE)=""
+24 QUIT
+25 ;
LDETLINR ; EP - Lab only - Output line of data
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HD1)
IF QFLG="Q"
QUIT
+2 ;
+3 SET ERRTOT=$GET(^TMP("BLRERRTR",$JOB,"LAB","DETAILED",HDT,PACKAGE,ERROR,LINETAG,ROUTINE))
+4 SET TOTAL=TOTAL+ERRTOT
+5 ;
+6 WRITE $EXTRACT($$TRIM^XLFSTR(PACKAGE,"LR"," "),1,27)
+7 WRITE ?29,ROUTINE
+8 WRITE ?39,ERROR
+9 WRITE ?54,LINETAG
+10 WRITE ?67,$$HTE^XLFDT(HDT,"2DZ")
+11 WRITE ?77,$JUSTIFY(ERRTOT,3)
+12 WRITE !
+13 SET LINES=LINES+1
+14 QUIT
+15 ;
LNODATES ; EP - Lab Only - No Date Report
+1 NEW ERROR,ERRDATE,ERRDNUM,ERRTOT,HDT,LINETAG,LRLDT,LRSDT,PACKAGE,ROUTINE,STR,TOTAL
+2 NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
+3 ;
+4 IF $$ISDATA()="Q"
QUIT
+5 ;
+6 DO LNODVINI
+7 ;
+8 FOR
SET PACKAGE=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","NODETAIL",PACKAGE))
IF PACKAGE=""!(QFLG="Q")
QUIT
Begin DoDot:1
+9 FOR
SET ERROR=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","NODETAIL",PACKAGE,ERROR))
IF ERROR=""!(QFLG="Q")
QUIT
Begin DoDot:2
+10 FOR
SET LINETAG=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG))
IF LINETAG=""!(QFLG="Q")
QUIT
Begin DoDot:3
+11 FOR
SET ROUTINE=$ORDER(^TMP("BLRERRTR",$JOB,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
IF ROUTINE=""!(QFLG="Q")
QUIT
Begin DoDot:4
+12 DO LNODLINR
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 IF QFLG'="Q"
WRITE !!,?10,"Total Number of Errors = ",TOTAL,!!
+15 ;
+16 DO ^%ZISC
+17 ;
+18 IF QFLG="Q"
QUIT
+19 ;
+20 DO PRESSKEY^BLRGMENU(4)
+21 QUIT
+22 ;
LNODVINI ; EP - Lab Only - No Date - Report Variables Initialization
+1 NEW BEGDT,ENDDT
+2 ;
+3 KILL HEADER
+4 SET HEADER(1)="Error Trap Report"
+5 ;
+6 SET BEGDT=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-1)),"5DZ")
+7 SET ENDDT=$$HTE^XLFDT($GET(^TMP("BLRERRTR",$JOB,-2)),"5DZ")
+8 ;
+9 SET HEADER(2)="Date Range: "_BEGDT_" thru "_ENDDT
+10 SET HEADER(3)=$$CJ^XLFSTR("LAB ONLY",IOM)
+11 SET HEADER(4)=" "
+12 ;
+13 DO HEADERDT^BLRGMENU
+14 DO HEADONE(.HD1)
+15 ;
+16 SET HEADER(5)="Package"
+17 SET $EXTRACT(HEADER(5),30)="Routine"
+18 SET $EXTRACT(HEADER(5),40)="Error"
+19 SET $EXTRACT(HEADER(5),55)="Line Tag"
+20 SET $EXTRACT(HEADER(5),75)="# Errs"
+21 ;
+22 DO ^%ZIS
+23 USE IO
+24 SET MAXLINES=IOSL-4
+25 SET LINES=MAXLINES+10
+26 SET QFLG="NO"
+27 ;
+28 SET (HDT,PG,TOTAL)=0
+29 SET (PACKAGE,ERROR,LINETAG,ROUTINE)=""
+30 QUIT
+31 ;
LNODLINR ; EP - Output line of data
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HD1)
IF QFLG="Q"
QUIT
+2 ;
+3 SET ERRTOT=$GET(^TMP("BLRERRTR",$JOB,"LAB","NODETAIL",PACKAGE,ERROR,LINETAG,ROUTINE))
+4 SET TOTAL=TOTAL+ERRTOT
+5 ;
+6 WRITE $EXTRACT($$TRIM^XLFSTR(PACKAGE,"LR"," "),1,28)
+7 WRITE ?29,ROUTINE
+8 WRITE ?39,ERROR
+9 WRITE ?54,LINETAG
+10 WRITE ?74,$JUSTIFY(ERRTOT,6)
+11 WRITE !
+12 SET LINES=LINES+1
+13 QUIT
