XTER ;ISC-SF.SEA/JLI - Error Trap Display option [XUERTRAP] ;16 Jul 2003 10:15 am
;;8.0;KERNEL;**63,275**;Jul 10, 1995
;
N %,%XTZDAT,XTX,XTPRNT,XTOUT,XTMES,DIR,I
K XTX,^TMP($J,"XTER"),^TMP($J,"XTERSCR"),XTPRNT,XTMES
S U="^"
F I=0:0 S I=$O(^%ZTER(2,"AC",1,I)) Q:I'>0 S %=$P(^%ZTER(2,I,0),U),%=$S($G(^(2))]"":^(2),1:%),^TMP($J,"XTERSCR",%)=""
S U="^",IOP="HOME" D ^%ZIS K IOP S:'$D(DTIME) DTIME=9999 S XTOUT=0
W !!,"In response to the DATE prompt you can enter:" S XTF="" D 11 W !!
;
%XTZDAT U IO(0) S XTOUT=0 S:'($D(XTX)#2) XTX="T" S:XTX="^" XTX="" I 1 R:XTX="" !!,"Which date? > ",XTX:300 G END:'$T!(XTX="^")!(XTX=""),END:XTX="^Q"!(XTX="^q") S X=XTX,XTX="" G:X["?" DIS
I "Ss"[X D SLIST^XTER2 G %XTZDAT
S %XTZDAT=X D UDD^XTER2 I $D(XTERR),XTERR=1 D IR G %XTZDAT
S %XTZDAT=$S(XTDTH<0:-XTDTH,1:XTDTH) K XTDTH G DO
DIS W !,"Errors have been logged on: "
S XTFST=0,XTH=+$H,X=""
S XTJJ=$O(^%ZTER(1,0)) Q:XTJJ'>0 F XTJ=$H:-1 Q:XTJJ>XTJ I $D(^%ZTER(1,XTJ,0)) W $S(XTFST:", ",1:""),"T" S XTFST=1 W:XTJ'=XTH "-",XTH-XTJ W "(",$P(^%ZTER(1,XTJ,0),U,2),")"
S XTF="3,4,11" D HELP
G %XTZDAT
DO S XTNE=$D(^%ZTER(1,%XTZDAT)) I 'XTNE D E1 G %XTZDAT
S XTNE=$P($G(^%ZTER(1,%XTZDAT,0)),U,2) D E1 S XTX="??"
XTERR S:'($D(XTX)#2) XTX="" S:XTX="^" XTX="" I 1 R:XTX="" !!,"Which error? > ",XTX:300 G END:'$T!(XTX="^Q")!(XTX="^q"),%XTZDAT:XTX'?1N.N&($E(XTX)'="?") S X=XTX,XTX=""
I X?1"???".E S XTD=0 D LST^XTER1A G XTERR
I X?1"??".E S XTD=1 D LST^XTER1A G XTERR
I X="?" D E1 S XTF="1,2,6,5,12,16" D HELP G XTERR
I (X="?L")!(X="?l") D ALL^XUTMKE1 G XTERR
I X'?1N.N D E1,IR G XTERR
S %XTZNUM=X
K %XTZLIN I '($D(^%ZTER(1,%XTZDAT,1,%XTZNUM,0))#2) W !,"Error not on File." W:%XTZNUM>$P(^%ZTER(1,%XTZDAT,0),U,2) " Last error logged is ",$P(^%ZTER(1,%XTZDAT,0),U,2),"." G XTERR
G ^XTER1
IR W !!,"Incorrect response - enter '?' for more information" Q
HELP ;
W !!,"Enter:" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
1 W !?5,"^Q to EXIT" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
2 W !?5,"'^' to return to the last question" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
3 W !?5,"'^Q' or '^' or <RETURN> to quit" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
4 W !?5,"Date as 'DD' or 'MM/DD' or 'MM/DD/YY' or 'T' or 'T-1'",!?15,"(note: 'T' as in Today)" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
12 W !?5,"??? to list all errors with $ZE, $I, $J, and Time" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
6 W !?5,"Number of error desired" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
7 W !?5,"^L to obtain a list of all symbols" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
8 X ^%ZOSF("PROGMODE") W:Y !?5,"^R to restore the symbol table and ... and enter direct mode" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
9 W !?5,"$ to get a display of the $ system variables" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
10 W !?5,"Leading character(s) of symbol(s) you wish to examine" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
11 W !?5,"'S' to specify text to be matched in error or routine name" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
5 W !?5,"?? to list only those errors which are NOT SCREENED with $ZE, $I, $J,",!?15,"and Time" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
13 W !?5,"^P to select a printer and print this error" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
14 W !?5,"^M to capture the current error in a mail message" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
15 W !?5,"^I to obtain information on key package variables" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
16 W !?5,"?L to obtain a list of error screens that are in place" S XTFI=$P(XTF,","),XTF=$P(XTF,",",2,99) G:XTFI="" EHELP G @XTFI
EHELP K XTF,XTFI
Q
E1 W !,$S(XTNE:XTNE,1:"No")," error",$S(XTNE>1:"s",1:"")," logged on ",XTDTE
Q
END D ^%ZISC
K %XT,%XTZE,%XTZ,%XTJOB,%XTZH,%XTIO,%XTUCI,%XTERR,%XTZDAT,%XTZNUM,%XTZLIN,%XTZO,XTA,XTB,XTC,XTD,%XTX,%XTY,XTFST,XTH,%XTZGR,XTJJ,%,%H
K %XTA,%XTB,%XTC,%XTF,%XTG,%XTI,%XTJ,%XTL,%XTD,%XTM,%XTN,XTI,XTJ,XTK,XTDTE,XTOUT,XTX,XTNE,XTP,XTQ,XTSYM,XTZ,%XTZZZ,XTERR,X,Y,%XTYL,%XTZH1,C,XTBLNK,XTDV1,XTA1,XTC1,XTMES,XTPRNT
; GT.M doesn't have a vendor-specific error trap lister
N XTROU S XTROU=$G(^%ZOSF("OS")) Q:XTROU="" Q:XTROU["GT.M"
I XTROU["OpenM" W !,"Use SYSLOG in the %SYS namespace" Q
W !! S DIR(0)="Y",DIR("A")="Do you want to check the OPERATING SYSTEM ERROR TRAP too",DIR("B")="NO" D ^DIR K DIR Q:'Y
S XTROU=U_$S(XTROU["DTM":"%errdump",1:"%ER") D:XTROU'="" @XTROU
Q
;
MORE S XTOUT=0 I $D(IOST)#2,IOST["C-" R !?15,"Enter '^' to quit listing, <RETURN> to continue...",XTX:DTIME S:'$T XTX="^" I XTX="^" S XTOUT=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTER 4931 printed Apr 09, 2024@21:45:05 Page 2
XTER ;ISC-SF.SEA/JLI - Error Trap Display option [XUERTRAP] ;16 Jul 2003 10:15 am
+1 ;;8.0;KERNEL;**63,275**;Jul 10, 1995
+2 ;
+3 NEW %,%XTZDAT,XTX,XTPRNT,XTOUT,XTMES,DIR,I
+4 KILL XTX,^TMP($JOB,"XTER"),^TMP($JOB,"XTERSCR"),XTPRNT,XTMES
+5 SET U="^"
+6 FOR I=0:0
SET I=$ORDER(^%ZTER(2,"AC",1,I))
if I'>0
QUIT
SET %=$PIECE(^%ZTER(2,I,0),U)
SET %=$SELECT($GET(^(2))]"":^(2),1:%)
SET ^TMP($JOB,"XTERSCR",%)=""
+7 SET U="^"
SET IOP="HOME"
DO ^%ZIS
KILL IOP
if '$DATA(DTIME)
SET DTIME=9999
SET XTOUT=0
+8 WRITE !!,"In response to the DATE prompt you can enter:"
SET XTF=""
DO 11
WRITE !!
+9 ;
%XTZDAT USE IO(0)
SET XTOUT=0
if '($DATA(XTX)#2)
SET XTX="T"
if XTX="^"
SET XTX=""
IF 1
if XTX=""
READ !!,"Which date? > ",XTX:300
if '$TEST!(XTX="^")!(XTX="")
GOTO END
if XTX="^Q"!(XTX="^q")
GOTO END
SET X=XTX
SET XTX=""
if X["?"
GOTO DIS
+1 IF "Ss"[X
DO SLIST^XTER2
GOTO %XTZDAT
+2 SET %XTZDAT=X
DO UDD^XTER2
IF $DATA(XTERR)
IF XTERR=1
DO IR
GOTO %XTZDAT
+3 SET %XTZDAT=$SELECT(XTDTH<0:-XTDTH,1:XTDTH)
KILL XTDTH
GOTO DO
DIS WRITE !,"Errors have been logged on: "
+1 SET XTFST=0
SET XTH=+$HOROLOG
SET X=""
+2 SET XTJJ=$ORDER(^%ZTER(1,0))
if XTJJ'>0
QUIT
FOR XTJ=$HOROLOG:-1
if XTJJ>XTJ
QUIT
IF $DATA(^%ZTER(1,XTJ,0))
WRITE $SELECT(XTFST:", ",1:""),"T"
SET XTFST=1
if XTJ'=XTH
WRITE "-",XTH-XTJ
WRITE "(",$PIECE(^%ZTER(1,XTJ,0),U,2),")"
+3 SET XTF="3,4,11"
DO HELP
+4 GOTO %XTZDAT
DO SET XTNE=$DATA(^%ZTER(1,%XTZDAT))
IF 'XTNE
DO E1
GOTO %XTZDAT
+1 SET XTNE=$PIECE($GET(^%ZTER(1,%XTZDAT,0)),U,2)
DO E1
SET XTX="??"
XTERR if '($DATA(XTX)#2)
SET XTX=""
if XTX="^"
SET XTX=""
IF 1
if XTX=""
READ !!,"Which error? > ",XTX:300
if '$TEST!(XTX="^Q")!(XTX="^q")
GOTO END
if XTX'?1N.N&($EXTRACT(XTX)'="?")
GOTO %XTZDAT
SET X=XTX
SET XTX=""
+1 IF X?1"???".E
SET XTD=0
DO LST^XTER1A
GOTO XTERR
+2 IF X?1"??".E
SET XTD=1
DO LST^XTER1A
GOTO XTERR
+3 IF X="?"
DO E1
SET XTF="1,2,6,5,12,16"
DO HELP
GOTO XTERR
+4 IF (X="?L")!(X="?l")
DO ALL^XUTMKE1
GOTO XTERR
+5 IF X'?1N.N
DO E1
DO IR
GOTO XTERR
+6 SET %XTZNUM=X
+7 KILL %XTZLIN
IF '($DATA(^%ZTER(1,%XTZDAT,1,%XTZNUM,0))#2)
WRITE !,"Error not on File."
if %XTZNUM>$PIECE(^%ZTER(1,%XTZDAT,0),U,2)
WRITE " Last error logged is ",$PIECE(^%ZTER(1,%XTZDAT,0),U,2),"."
GOTO XTERR
+8 GOTO ^XTER1
IR WRITE !!,"Incorrect response - enter '?' for more information"
QUIT
HELP ;
+1 WRITE !!,"Enter:"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
1 WRITE !?5,"^Q to EXIT"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
2 WRITE !?5,"'^' to return to the last question"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
3 WRITE !?5,"'^Q' or '^' or <RETURN> to quit"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
4 WRITE !?5,"Date as 'DD' or 'MM/DD' or 'MM/DD/YY' or 'T' or 'T-1'",!?15,"(note: 'T' as in Today)"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
12 WRITE !?5,"??? to list all errors with $ZE, $I, $J, and Time"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
6 WRITE !?5,"Number of error desired"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
7 WRITE !?5,"^L to obtain a list of all symbols"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
8 XECUTE ^%ZOSF("PROGMODE")
if Y
WRITE !?5,"^R to restore the symbol table and ... and enter direct mode"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
9 WRITE !?5,"$ to get a display of the $ system variables"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
10 WRITE !?5,"Leading character(s) of symbol(s) you wish to examine"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
11 WRITE !?5,"'S' to specify text to be matched in error or routine name"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
5 WRITE !?5,"?? to list only those errors which are NOT SCREENED with $ZE, $I, $J,",!?15,"and Time"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
13 WRITE !?5,"^P to select a printer and print this error"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
14 WRITE !?5,"^M to capture the current error in a mail message"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
15 WRITE !?5,"^I to obtain information on key package variables"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
16 WRITE !?5,"?L to obtain a list of error screens that are in place"
SET XTFI=$PIECE(XTF,",")
SET XTF=$PIECE(XTF,",",2,99)
if XTFI=""
GOTO EHELP
GOTO @XTFI
EHELP KILL XTF,XTFI
+1 QUIT
E1 WRITE !,$SELECT(XTNE:XTNE,1:"No")," error",$SELECT(XTNE>1:"s",1:"")," logged on ",XTDTE
+1 QUIT
END DO ^%ZISC
+1 KILL %XT,%XTZE,%XTZ,%XTJOB,%XTZH,%XTIO,%XTUCI,%XTERR,%XTZDAT,%XTZNUM,%XTZLIN,%XTZO,XTA,XTB,XTC,XTD,%XTX,%XTY,XTFST,XTH,%XTZGR,XTJJ,%,%H
+2 KILL %XTA,%XTB,%XTC,%XTF,%XTG,%XTI,%XTJ,%XTL,%XTD,%XTM,%XTN,XTI,XTJ,XTK,XTDTE,XTOUT,XTX,XTNE,XTP,XTQ,XTSYM,XTZ,%XTZZZ,XTERR,X,Y,%XTYL,%XTZH1,C,XTBLNK,XTDV1,XTA1,XTC1,XTMES,XTPRNT
+3 ; GT.M doesn't have a vendor-specific error trap lister
+4 NEW XTROU
SET XTROU=$GET(^%ZOSF("OS"))
if XTROU=""
QUIT
if XTROU["GT.M"
QUIT
+5 IF XTROU["OpenM"
WRITE !,"Use SYSLOG in the %SYS namespace"
QUIT
+6 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to check the OPERATING SYSTEM ERROR TRAP too"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if 'Y
QUIT
+7 SET XTROU=U_$SELECT(XTROU["DTM":"%errdump",1:"%ER")
if XTROU'=""
DO @XTROU
+8 QUIT
+9 ;
MORE SET XTOUT=0
IF $DATA(IOST)#2
IF IOST["C-"
READ !?15,"Enter '^' to quit listing, <RETURN> to continue...",XTX:DTIME
if '$TEST
SET XTX="^"
IF XTX="^"
SET XTOUT=1
QUIT
+1 QUIT
