%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 ;
