%ZTER1 ;ISC-SF.SEA/JLI - ERROR TRAP TO LOG ERRORS (VAX LOCAL SYMBOL TABLE) ;11/23/2005
;;8.0;KERNEL;**18,24,36,49,112,162,275,392**;JUL 10, 1995;Build 5
VXD ;Record VAX DSM variables
S @%ZTERRT@("J")=$J_"^"_$ZC(%GETJPI,0,"PRCNAM")_"^"_$ZC(%GETJPI,0,"USERNAME")_"^"_%ZTER11I_"^"_$ZC(%SYSFAO,"!XL",$J),@%ZTERRT@("I")=$IO_"^"_$ZA_"^"_$ZB_"^"_$ZIO K %ZTER11I
S @%ZTERRT@("ZH")=$TR($ZH,",","^")
S %ZTER111="%" F D S %ZTER111=$ZSORT(@%ZTER111) Q:%ZTER111="" ;Code from DEC
. Q:$E(%ZTER111,1,5)="%ZTER"
. I $D(@%ZTER111)#2 D VNXT2
. I $D(@%ZTER111)>9 D VNXT3
. Q
Q
;
VNXT2 S %ZTERCNT=%ZTERCNT+1,@%ZTERRT@("ZV",%ZTERCNT,0)=%ZTER111,^("D")=$E(@%ZTER111,1,255)
Q
VNXT3 S %ZTER11Q=%ZTER111
F S %ZTER11Q=$Q(@%ZTER11Q) Q:%ZTER11Q="" S %ZTERCNT=%ZTERCNT+1,@%ZTERRT@("ZV",%ZTERCNT,0)=%ZTER11Q,^("D")=$E(@%ZTER11Q,1,255)
Q
;
STACK ;Record the new $STACK variable
I $ECODE]"" S $ZE=""
N %ZTER35 S %ZTER35=$S($D(^TMP("$ZE",$J,2)):^(2),1:$ETRAP)
D SAVE("$DEVICE",$DEVICE)
D SAVE("$ECODE",$E($ECODE,1,255))
D SAVE("$ESTACK",$ESTACK)
D SAVE("$ETRAP",%ZTER35)
D SAVE("$QUIT",$QUIT)
D SAVE("$STACK",$STACK)
N %,%1,%2 S %2=$ST
F %=0:1:$ST S %1=$E(1000+%,2,4) Q:$ST(%,"PLACE")["^%ZTER" D
. D SAVE("$STACK("_%1_")",$STACK(%))
. D SAVE("$STACK("_%1_",""ECODE"")",$STACK(%,"ECODE"))
. D SAVE("$STACK("_%1_",""PLACE"")",$STACK(%,"PLACE"))
. D SAVE("$STACK("_%1_",""MCODE"")",$STACK(%,"MCODE"))
. S:$STACK(%,"ECODE")]"" %2=%
S @%ZTERRT@("LINE")=$STACK(%2,"MCODE")
S $ECODE=""
Q
;
SAVE(%n,%v) ;Save name and value into global, use special variables
S %ZTERCNT=%ZTERCNT+1,@%ZTERRT@("ZV",%ZTERCNT,0)=%n
S @%ZTERRT@("ZV",%ZTERCNT,"D")=%v
Q
;
VERR ;
S @%ZTERRT@("ZE2")="%DSM-E-ET, Error occurred in %ZTER, "_$ECODE
HALT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTER1 1776 printed Oct 16, 2024@18:16:43 Page 2
%ZTER1 ;ISC-SF.SEA/JLI - ERROR TRAP TO LOG ERRORS (VAX LOCAL SYMBOL TABLE) ;11/23/2005
+1 ;;8.0;KERNEL;**18,24,36,49,112,162,275,392**;JUL 10, 1995;Build 5
VXD ;Record VAX DSM variables
+1 SET @%ZTERRT@("J")=$JOB_"^"_$ZC(%GETJPI,0,"PRCNAM")_"^"_$ZC(%GETJPI,0,"USERNAME")_"^"_%ZTER11I_"^"_$ZC(%SYSFAO,"!XL",$JOB)
SET @%ZTERRT@("I")=$IO_"^"_$ZA_"^"_$ZB_"^"_$ZIO
KILL %ZTER11I
+2 SET @%ZTERRT@("ZH")=$TRANSLATE($ZH,",","^")
+3 ;Code from DEC
SET %ZTER111="%"
FOR
Begin DoDot:1
+4 if $EXTRACT(%ZTER111,1,5)="%ZTER"
QUIT
+5 IF $DATA(@%ZTER111)#2
DO VNXT2
+6 IF $DATA(@%ZTER111)>9
DO VNXT3
+7 QUIT
End DoDot:1
SET %ZTER111=$ZSORT(@%ZTER111)
if %ZTER111=""
QUIT
+8 QUIT
+9 ;
VNXT2 SET %ZTERCNT=%ZTERCNT+1
SET @%ZTERRT@("ZV",%ZTERCNT,0)=%ZTER111
SET ^("D")=$EXTRACT(@%ZTER111,1,255)
+1 QUIT
VNXT3 SET %ZTER11Q=%ZTER111
+1 FOR
SET %ZTER11Q=$QUERY(@%ZTER11Q)
if %ZTER11Q=""
QUIT
SET %ZTERCNT=%ZTERCNT+1
SET @%ZTERRT@("ZV",%ZTERCNT,0)=%ZTER11Q
SET ^("D")=$EXTRACT(@%ZTER11Q,1,255)
+2 QUIT
+3 ;
STACK ;Record the new $STACK variable
+1 IF $ECODE]""
SET $ZE=""
+2 NEW %ZTER35
SET %ZTER35=$SELECT($DATA(^TMP("$ZE",$JOB,2)):^(2),1:$ETRAP)
+3 DO SAVE("$DEVICE",$DEVICE)
+4 DO SAVE("$ECODE",$EXTRACT($ECODE,1,255))
+5 DO SAVE("$ESTACK",$ESTACK)
+6 DO SAVE("$ETRAP",%ZTER35)
+7 DO SAVE("$QUIT",$QUIT)
+8 DO SAVE("$STACK",$STACK)
+9 NEW %,%1,%2
SET %2=$STACK
+10 FOR %=0:1:$STACK
SET %1=$EXTRACT(1000+%,2,4)
if $STACK(%,"PLACE")["^%ZTER"
QUIT
Begin DoDot:1
+11 DO SAVE("$STACK("_%1_")",$STACK(%))
+12 DO SAVE("$STACK("_%1_",""ECODE"")",$STACK(%,"ECODE"))
+13 DO SAVE("$STACK("_%1_",""PLACE"")",$STACK(%,"PLACE"))
+14 DO SAVE("$STACK("_%1_",""MCODE"")",$STACK(%,"MCODE"))
+15 if $STACK(%,"ECODE")]""
SET %2=%
End DoDot:1
+16 SET @%ZTERRT@("LINE")=$STACK(%2,"MCODE")
+17 SET $ECODE=""
+18 QUIT
+19 ;
SAVE(%n,%v) ;Save name and value into global, use special variables
+1 SET %ZTERCNT=%ZTERCNT+1
SET @%ZTERRT@("ZV",%ZTERCNT,0)=%n
+2 SET @%ZTERRT@("ZV",%ZTERCNT,"D")=%v
+3 QUIT
+4 ;
VERR ;
+1 SET @%ZTERRT@("ZE2")="%DSM-E-ET, Error occurred in %ZTER, "_$ECODE
+2 HALT
