Routine: INHZET

%ET ; cmi/flag/maw - CHEM, JC Hrubovcak, Tools 26 Oct 2000 20:38 DSM/MSM error handler ; [ 05/22/2002  2:53 PM ]

 ;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001

 ;;v4.604 ; 27 October 2000

 ;COPYRIGHT 2000 SAIC

 ; shipped as ZETDVX, installed as %ET and %ZET

 ; Set $ZTRAP="INT^%ZET" to trap without message

 ;Format:

 ; ^%ET(-$h) = n

 ; ^%ET(-$h,n)       = $ZERROR

 ; ^%ET(-$h,n,"$I")  = $IO, $ZA, $ZB, $ZIO

 ; ^%ET(-$h,n,"$J")  = $JOB, Process name, Username, Nodename

 ; ^%ET(-$h,n,"$ZH") = $ZHOROLOG

 ; ^%ET(-$h,n,"$ZU") = UCI info

 ; ^%ET(-$h,n,"$ZR") = $ZREFERENCE

 ; ^%ET(-$h,n,#) #   = 1...n (for n variables in the symbol table)

 ; ^%ET(-$h,n,#,"V") = local variable

 ; ^%ET(-$h,n,#,"D") = datum of the local variable

 I $ZE="" Q:$QUIT "" Q

 D INT U $P W !!," An error has occurred."_$C(7)

 S %="The error is: "_$ZE_"." F  Q:'$L(%)  W !," "_$E(%,1,79) S %=$E(%,80,$L(%)) Q:'$L(%)

 W !," Please contact your site manager.",!

 Q:$QUIT "" Q

INT ;  Entry point for trap without message

 S $ZTRAP="ERROR^"_$T(+0) ; Trap internal errors

 ;S $ZWATCH(9)="A>"_$ZREFERENCE ; Save naked ref.

 L:$ZE["-LCKERR"   ; lock limit exceeded?

 ; exclusive access to trap, set ^%ET to -$H, if % defined, save it & descendants

 L +^%ET(0) S ^%ET=-$H,^%ET(^%ET)=$G(^%ET(^%ET))+1,^%ET(^%ET,^%ET(^%ET))=$ZE M:$D(%) ^%ET(^%ET,^%ET(^%ET),"~","%")=% K % S %(0)=^%ET,%(1)=^%ET(%(0)) L -^%ET(0)

 ; %(0)=-$H, %(1)=error #

 ;S ^%ET(%(0),%(1),"$ZH")=$ZHOROLOG,^("$ZR")=$P($ZWATCH(9),"A>",2,99) K $ZWATCH(9)

 ; save job info

 ;S ^%ET(%(0),%(1),"$J")=$J_$C(255)_$ZC(%GETJPI,0,"PRCNAM")_$C(255)_$ZC(%GETJPI,0,"USERNAME")_$C(255)_$ZC(%GETSYI,"NODENAME")

 ;S ^%ET(%(0),%(1),"$I")=$IO_$C(255)_$ZA_$C(255)_$ZB_$C(255)_$ZIO,^("$ZU")=$&ZLIB.%UCI(),%(2)=1

 ; Save symbol table, %(2)=symbol counter

 D:$D(^%ET(%(0),%(1),"~"))   ; get % variable data, if there

 .I $D(^%ET(%(0),%(1),"~","%"))'[0 S %(9)=^("%") D DV(%(9),"%")

 .F  S %(9)=$Q(^%ET(%(0),%(1),"~","%")) Q:%(9)'["~"  D DV(@%(9),"%("_$P(%(9),",""%"",",2,999)) K @%(9)

 S %(8)="%"   ; save local vars. & descendants

 F  S %(8)=$ZSORT(@%(8)) Q:%(8)=""  D:$D(@%(8))'[0 DV(@%(8),%(8)) S %(9)=%(8) F  S %(9)=$Q(@%(9)) Q:%(9)=""  D DV(@%(9),%(9))

 D STACK  ; save stack information

EXIT ; Exit, error in this routine comes here

 L -^%ET(0)   ; in case of internal error

 ; CHCS customization

 K %,IO("DEVICE OPEN") I $G(ZISPL),$D(^%ZISPJS(ZISPL)) D SETSTAT^%ZISAPI3(ZISPL,"T")

 I $ZE["-ENDOFILE",$G(DTIME)=1,$G(XQM),$L($T(NOTSK^XQTASK)) D NOTSK^XQTASK  ; option that wasn't to be tasked

 Q:$QUIT "" Q

 ; DV saves datum D for variable V and increments count in %(2)

DV(D,V) S ^%ET(%(0),%(1),%(2),"D")=D,^("V")=V,%(2)=%(2)+1 Q

STACK ; save stack info

 N C,S S C=1 F S=0:1:$ST(-1) S ^%ET(%(0),%(1),"%STACK",C)=" Context Level:"_$J(S,3)_"  Type: "_$ST(S)_"  Place: "_$ST(S,"PLACE"),^(C+1)="        M code: "_$ST(S,"MCODE"),C=C+2

 S $EC="" Q   ; erase stack info for error

ERROR ; Handle internal error

 S ^%ET(-$H,$G(^%ET(-$H))+1)="%DSM-E-ET, Error in ^"_$T(+0)_", "_$ZE

 U $P G EXIT

%ET       ; cmi/flag/maw - CHEM, JC Hrubovcak, Tools 26 Oct 2000 20:38 DSM/MSM error handler ; [ 05/22/2002  2:53 PM ]

 +1       ;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001

 +2       ;;v4.604 ; 27 October 2000

 +3       ;COPYRIGHT 2000 SAIC

 +4       ; shipped as ZETDVX, installed as %ET and %ZET

 +5       ; Set $ZTRAP="INT^%ZET" to trap without message

 +6       ;Format:

 +7       ; ^%ET(-$h) = n

 +8       ; ^%ET(-$h,n)       = $ZERROR

 +9       ; ^%ET(-$h,n,"$I")  = $IO, $ZA, $ZB, $ZIO

 +10      ; ^%ET(-$h,n,"$J")  = $JOB, Process name, Username, Nodename

 +11      ; ^%ET(-$h,n,"$ZH") = $ZHOROLOG

 +12      ; ^%ET(-$h,n,"$ZU") = UCI info

 +13      ; ^%ET(-$h,n,"$ZR") = $ZREFERENCE

 +14      ; ^%ET(-$h,n,#) #   = 1...n (for n variables in the symbol table)

 +15      ; ^%ET(-$h,n,#,"V") = local variable

 +16      ; ^%ET(-$h,n,#,"D") = datum of the local variable

 +17      ;

 +18       IF $ZE=""

               IF $QUIT

                   QUIT ""

               QUIT

 +19       DO INT

           USE $PRINCIPAL

           WRITE !!," An error has occurred."_$CHAR(7)

 +20       SET %="The error is: "_$ZE_"."

FOR

               IF '$LENGTH(%)

                   QUIT

               WRITE !," "_$EXTRACT(%,1,79)

               SET %=$EXTRACT(%,80,$LENGTH(%))

               IF '$LENGTH(%)

                   QUIT

 +21       WRITE !," Please contact your site manager.",!

 +22       IF $QUIT

               QUIT ""

           QUIT

INT       ;  Entry point for trap without message

 +1       ; Trap internal errors

           SET $ZTRAP="ERROR^"_$TEXT(+0)

 +2       ;S $ZWATCH(9)="A>"_$ZREFERENCE ; Save naked ref.

 +3       ; lock limit exceeded?

           IF $ZE["-LCKERR"

               LOCK

 +4       ; exclusive access to trap, set ^%ET to -$H, if % defined, save it & descendants

 +5        LOCK +^%ET(0)

           SET ^%ET=-$HOROLOG

           SET ^%ET(^%ET)=$GET(^%ET(^%ET))+1

           SET ^%ET(^%ET,^%ET(^%ET))=$ZE

           IF $DATA(%)

               MERGE ^%ET(^%ET,^%ET(^%ET),"~","%")=%

           KILL %

           SET %(0)=^%ET

           SET %(1)=^%ET(%(0))

           LOCK -^%ET(0)

 +6       ; %(0)=-$H, %(1)=error #

 +7       ;S ^%ET(%(0),%(1),"$ZH")=$ZHOROLOG,^("$ZR")=$P($ZWATCH(9),"A>",2,99) K $ZWATCH(9)

 +8       ; save job info

 +9       ;S ^%ET(%(0),%(1),"$J")=$J_$C(255)_$ZC(%GETJPI,0,"PRCNAM")_$C(255)_$ZC(%GETJPI,0,"USERNAME")_$C(255)_$ZC(%GETSYI,"NODENAME")

 +10      ;S ^%ET(%(0),%(1),"$I")=$IO_$C(255)_$ZA_$C(255)_$ZB_$C(255)_$ZIO,^("$ZU")=$&ZLIB.%UCI(),%(2)=1

 +11      ; Save symbol table, %(2)=symbol counter

 +12      ; get % variable data, if there

           IF $DATA(^%ET(%(0),%(1),"~"))

               Begin DoDot:1

 +13               IF $DATA(^%ET(%(0),%(1),"~","%"))'[0

                       SET %(9)=^("%")

                       DO DV(%(9),"%")

 +14               FOR

                       SET %(9)=$QUERY(^%ET(%(0),%(1),"~","%"))

                       IF %(9)'["~"

                           QUIT

                       DO DV(@%(9),"%("_$PIECE(%(9),",""%"",",2,999))

                       KILL @%(9)

               End DoDot:1

 +15      ; save local vars. & descendants

           SET %(8)="%"

 +16       FOR

               SET %(8)=$ZSORT(@%(8))

               IF %(8)=""

                   QUIT

               IF $DATA(@%(8))'[0

                   DO DV(@%(8),%(8))

               SET %(9)=%(8)

FOR

                   SET %(9)=$QUERY(@%(9))

                   IF %(9)=""

                       QUIT

                   DO DV(@%(9),%(9))

 +17      ; save stack information

           DO STACK

EXIT      ; Exit, error in this routine comes here

 +1       ; in case of internal error

           LOCK -^%ET(0)

 +2       ; CHCS customization

 +3        KILL %,IO("DEVICE OPEN")

           IF $GET(ZISPL)

               IF $DATA(^%ZISPJS(ZISPL))

                   DO SETSTAT^%ZISAPI3(ZISPL,"T")

 +4       ; option that wasn't to be tasked

           IF $ZE["-ENDOFILE"

               IF $GET(DTIME)=1

                   IF $GET(XQM)

                       IF $LENGTH($TEXT(NOTSK^XQTASK))

                           DO NOTSK^XQTASK

 +5        IF $QUIT

               QUIT ""

           QUIT

 +6       ;

 +7       ; DV saves datum D for variable V and increments count in %(2)

DV(D,V)    SET ^%ET(%(0),%(1),%(2),"D")=D

           SET ^("V")=V

           SET %(2)=%(2)+1

           QUIT

 +1       ;

STACK     ; save stack info

 +1        NEW C,S

           SET C=1

           FOR S=0:1:$STACK(-1)

               SET ^%ET(%(0),%(1),"%STACK">STACK",C)=" Context Level:"_$JUSTIFY(S,3)_"  Type: "_$STACK">STACK(S)_"  Place: "_$STACK">STACK(S,"PLACE")

               SET ^(C+1)="        M code: "_$STACK(S,"MCODE")

               SET C=C+2

 +2       ; erase stack info for error

           SET $ECODE=""

           QUIT

 +3       ;

ERROR     ; Handle internal error

 +1        SET ^%ET(-$HOROLOG,$GET(^%ET(-$HOROLOG))+1)="%DSM-E-ET, Error in ^"_$TEXT(+0)_", "_$ZE

 +2        USE $PRINCIPAL

           GOTO EXIT

 +3       ;

INHZET.m