- %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 Jan 18, 2025@03:17:07 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