Routine: XTER

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

E1 W !,$S(XTNE:XTNE,1:"No")," error",$S(XTNE>1:"s",1:"")," logged on ",XTDTE

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTER   4931     printed  Mar 13, 2025@21:45:46                                                                                                                                                                                                        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

XTER.m