- XTER1 ;ISC-SF.SEA/JLI - Kernel Error Trap Display ;09/27/10 15:31
- ;;8.0;KERNEL;**8,392,431**;Jul 10, 1995;Build 38
- ;Per VHA Directive 2004-038, this routine should not be modified.
- S XTDV1=0
- WRT S XTOUT=0 S:'$D(XTBLNK) $P(XTBLNK," ",133)=" " S:'$D(C) C=0 K:C=0 ^TMP($J,"XTER")
- D DV
- I '$D(%XTZLIN) S %XTY=$P(%XTZE,","),%XTX=$P(%XTY,"^") S:%XTX[">" %XTX=$P(%XTX,">",2)
- I '$D(%XTZLIN),%XTX'="" S X=$P($P(%XTY,"^",2),":") I X'="" X ^%ZOSF("TEST") I $T D
- . N XCNP,DIF
- . S XCNP=0,DIF="^TMP($J,""XTER1""," X ^%ZOSF("LOAD") S %XTY=$P(%XTX,"+",1) D
- . . I %XTY'="" F X=0:0 S X=$O(^TMP($J,"XTER1",X)) Q:X'>0 I $P(^(X,0)," ")=%XTY S X=X+$P(%XTX,"+",2),%XTZLIN=^TMP($J,"XTER1",X,0) Q
- . . I %XTY="" S X=+$P(%XTX,"+",2) Q:X'>0 S %XTZLIN=^TMP($J,"XTER1",X,0)
- S:'$D(%XTZLIN) %XTZLIN="" K ^TMP($J,"XTER1")
- I %XTZLIN'="" D ADD(""),ADD(%XTZLIN)
- ;I '$D(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B")) F XTI=0:0 S XTI=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI)) Q:XTI'>0 S XTSYM=^(XTI,0),^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTSYM,XTI)=""
- I '$D(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B")) D ;p431
- . F XTI=0:0 S XTI=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI)) Q:XTI'>0 S XTSYM=$P(^(XTI,0),"(") S:'$D(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTSYM)) ^(XTSYM,XTI)=""
- ;I IO'=IO(0) S XTDV1=0 D DV ;p431
- D:'$G(XTMES)&'$G(XTPRNT) WRITER^XTER1A
- I IO'="",IO'=IO(0)!$G(XTPRNT) U IO W:$E($G(IOST))="C" @IOF S X="^L" G WRTA
- I $G(XTMES) S X="^L" G WRTA
- ;
- K ^TMP($J,"XTER") S C=0
- R !!,"Which symbol? > ",XTX:DTIME S:'$T!(XTX="") XTX="^"
- S:$E(XTX,1)="^" XTX=$TR(XTX,"ilmpqr","ILMPQR") ;uppercase
- G XTERR^XTER:XTX>0!(XTX="^"),END^XTER:XTX="^Q",MESG^XTER1A:XTX="^M",PRNT^XTER1A:XTX="^P" S X=XTX,XTX="",XTOUT=0
- I X="^I" D EN^XTER1B G WRT
- I X["?" S XTF="1,2,10,7,13,14,15,8,9" D HELP^XTER G WRT
- I X="$" S XTDV1=0 D DV G WRT
- I X="^R" G RESTOR^XTER2
- ;
- WRTA ;Show All (^L)
- D WRT1 S:'$D(XTX) XTX=""
- Q:$G(XTMES)!$G(XTPRNT) G:IO=IO(0)&(XTX'="^Q")&(XTX'="^q") WRT
- U IO(0) G END^XTER:XTX="^Q"!(XTX="^q"),XTERR^XTER
- ;
- WRT1 ;
- S:'$D(IOSL) IOSL=24 D ADD(""),ADD("")
- S XTSYM=$S(X="^L":"",1:X),%XTYL=IOSL-4,XTI=0,XTC=1,X="",XTA=XTSYM,XTA=$S(XTA="":"",1:$E(XTA,1,$L(XTA)-1)_$C($A($E(XTA,$L(XTA)))-1)_"z")
- ;Find start by order thru B X-ref for Symbols, XTA=var name, XTB=var value
- WF S:'%XTYL %XTYL=IOSL-4
- ;S (XTA,XTA1)=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTA)) S XTI=$S(XTSYM="":1,XTA'="":$O(^(XTA,0)),1:0)
- S XTA=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTA)) S XTI=$S(XTSYM="":1,XTA'="":$O(^(XTA,0)),1:0) ;p431
- I XTA=""!(XTSYM'=""&($E(XTA,1,$L(XTSYM))'=XTSYM)) D:XTSYM'=""&XTC ADD("No such symbol") D:'$G(XTPRNT) MORE^XTER1A Q
- S (XTA,XTA1)=^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI,0) ;p431
- D WV
- ;Show the rest in order
- F S XTI=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI)) Q:'XTI!(XTOUT) S (XTA,XTA1)=^(XTI,0) Q:$E(XTA,1,$L(XTSYM))'=XTSYM D WV
- Q
- WV ;Write a variable
- S:'%XTYL %XTYL=IOSL-4
- S XTB=$S($D(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI,"D")):^("D"),1:"*** WARNING: this value was NOT recorded due to an ERROR WITHIN the TRAP ***")
- ;Check for long variables
- S XTL=$G(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI,"L")) I XTL>255 D ADD("**The following variables length is "_XTL_", only displaying first 255.**")
- S XTC=0 S:'$G(XTMES)&'$G(XTPRNT) %XTYL=%XTYL-1
- D:'%XTYL MORE^XTER1A Q:XTOUT D:'%XTYL ADD("")
- S XTA1=XTA1_"=" K XTC1 I XTB?.PUNL,XTB'["\" S XTA1=XTA1_XTB,XTC1=""
- ;Change control char to \027 format
- I '$D(XTC1) S XTC1="" I $P(XTA1," ",2)="" F XTK=1:1 S XTZ=$E(XTB,XTK) Q:XTZ="" S XTC1=XTC1_$S(XTZ'?1C:XTZ,1:"\"_$E($A(XTZ)+1000,2,4)) I XTZ="\" S XTC1=XTC1_"\"
- D SET D:XTL>255 ADD("**")
- Q
- ;
- SET ;
- I ($L(XTA1)+$L(XTC1))<246 S XTA1=XTA1_XTC1,XTC1="" D ADD(XTA1) Q
- I $L(XTA1)>245 D ADD($E(XTA1,1,245)) S XTA1=$E(XTA1,246,$L(XTA1)) G SET
- I $L(XTA1)>0 D ADD(XTA1_$E(XTC1,1,(245-$L(XTA1)))) S XTC1=$E(XTC1,(245-$L(XTA1)+1),$L(XTC1)) G SET
- D ADD($E(XTC1,1,245)) S XTC1=$E(XTC1,246,$L(XTC1)) G SET
- Q
- ;
- ADD(STR) ;Add STR to TMP global
- S C=C+1,^TMP($J,"XTER",C)=STR
- Q
- ;Header info
- DV I $D(XTDV1),XTDV1=1 G DV1
- K %XTZLIN
- S %XTZE=^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZE"),%XTJOB=$G(^("J")),%XTIO=$G(^("I")),%XTZH=$G(^("ZH")),%XTZH1=$G(^("H")),%XTZGR=$G(^("GR")) S:$D(^("LINE")) %XTZLIN=^("LINE")
- I %XTZH1>0 S %H=%XTZH1 D YMD^%DTC S Y=X_% D DD^%DT S $P(%XTZH1,"^",2)=$P(Y,"@",1)_" "_$P(Y,"@",2)
- F %XTI=1:1:9 S %XTZH(%XTI)=$P(%XTZH,"^",%XTI)
- S %XTZH(3)=$P(%XTZH1,U,2)
- S %XTUCI=$P(%XTJOB,U,4)
- ;Build output
- S X="Process ID: "_$P(%XTJOB,U,5)_" ("_$P(%XTJOB,U)_")",X=X_$E(XTBLNK,1,40-$L(X))_%XTZH(3)
- D ADD(""),ADD(X)
- S %XTZ="Username\Process Name\UCI/VOL\\$ZA\$ZB\Current $IO\Current $ZIO\CPU time\Page Faults\Direct I/O\Buffered I/O"
- S %XTZ(1)=$P(%XTJOB,U,3),%XTZ(2)=$P(%XTJOB,U,2),%XTZ(3)=$S(%XTUCI]"":"["_%XTUCI_"]",1:"")
- S %XTZ(4)="",%XTZ(5)=$J($P(%XTIO,U,2),3),%XTZ(6)=$J($P(%XTIO,U,3),3)
- S %XTZ(7)=$P(%XTIO,U),%XTZ(8)=$P(%XTIO,U,4,99),%XTZ(9)=$J(%XTZH(1),6)
- S %XTZ(10)=$J(%XTZH(4),10),%XTZ(11)=$J(%XTZH(7),10),%XTZ(12)=$J(%XTZH(8),10)
- F %XTI=1:1:12 D
- . I %XTI#2 S X=""
- . S:%XTZ(%XTI)'?." " X=X_$P(%XTZ,"\",%XTI)_": "_%XTZ(%XTI) S:%XTI#2 X=$E(X_$E(XTBLNK,1,40),1,40)
- . I '(%XTI#2),X'?." " D ADD(""),ADD(X)
- . Q
- DV1 S XTDV1=1 D ADD(""),ADD("$ZE= "_%XTZE)
- D:%XTZGR'="" ADD(""),ADD("Last Global Ref: "_%XTZGR) ;p431
- K X I $D(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZE2")) S X=^("ZE2")
- I $D(X) D ADD(""),ADD("%ZTER encountered an error while logging this error -- "),ADD("This may have caused some LOCAL VARIABLES to be lost."),ADD("This error was: "_X)
- Q
- ;
- XTER1 ;ISC-SF.SEA/JLI - Kernel Error Trap Display ;09/27/10 15:31
- +1 ;;8.0;KERNEL;**8,392,431**;Jul 10, 1995;Build 38
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 SET XTDV1=0
- WRT SET XTOUT=0
- IF '$DATA(XTBLNK)
- SET $PIECE(XTBLNK," ",133)=" "
- IF '$DATA(C)
- SET C=0
- IF C=0
- KILL ^TMP($JOB,"XTER")
- +1 DO DV
- +2 IF '$DATA(%XTZLIN)
- SET %XTY=$PIECE(%XTZE,",")
- SET %XTX=$PIECE(%XTY,"^")
- IF %XTX[">"
- SET %XTX=$PIECE(%XTX,">",2)
- +3 IF '$DATA(%XTZLIN)
- IF %XTX'=""
- SET X=$PIECE($PIECE(%XTY,"^",2),":")
- IF X'=""
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- Begin DoDot:1
- +4 NEW XCNP,DIF
- +5 SET XCNP=0
- SET DIF="^TMP($J,""XTER1"","
- XECUTE ^%ZOSF("LOAD")
- SET %XTY=$PIECE(%XTX,"+",1)
- Begin DoDot:2
- +6 IF %XTY'=""
- FOR X=0:0
- SET X=$ORDER(^TMP($JOB,"XTER1",X))
- IF X'>0
- QUIT
- IF $PIECE(^(X,0)," ")=%XTY
- SET X=X+$PIECE(%XTX,"+",2)
- SET %XTZLIN=^TMP($JOB,"XTER1",X,0)
- QUIT
- +7 IF %XTY=""
- SET X=+$PIECE(%XTX,"+",2)
- IF X'>0
- QUIT
- SET %XTZLIN=^TMP($JOB,"XTER1",X,0)
- End DoDot:2
- End DoDot:1
- +8 IF '$DATA(%XTZLIN)
- SET %XTZLIN=""
- KILL ^TMP($JOB,"XTER1")
- +9 IF %XTZLIN'=""
- DO ADD("")
- DO ADD(%XTZLIN)
- +10 ;I '$D(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B")) F XTI=0:0 S XTI=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI)) Q:XTI'>0 S XTSYM=^(XTI,0),^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTSYM,XTI)=""
- +11 ;p431
- IF '$DATA(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B"))
- Begin DoDot:1
- +12 FOR XTI=0:0
- SET XTI=$ORDER(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI))
- IF XTI'>0
- QUIT
- SET XTSYM=$PIECE(^(XTI,0),"(")
- IF '$DATA(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTSYM))
- SET ^(XTSYM,XTI)=""
- End DoDot:1
- +13 ;I IO'=IO(0) S XTDV1=0 D DV ;p431
- +14 IF '$GET(XTMES)&'$GET(XTPRNT)
- DO WRITER^XTER1A
- +15 IF IO'=""
- IF IO'=IO(0)!$GET(XTPRNT)
- USE IO
- IF $EXTRACT($GET(IOST))="C"
- WRITE @IOF
- SET X="^L"
- GOTO WRTA
- +16 IF $GET(XTMES)
- SET X="^L"
- GOTO WRTA
- +17 ;
- +18 KILL ^TMP($JOB,"XTER")
- SET C=0
- +19 READ !!,"Which symbol? > ",XTX:DTIME
- IF '$TEST!(XTX="")
- SET XTX="^"
- +20 ;uppercase
- IF $EXTRACT(XTX,1)="^"
- SET XTX=$TRANSLATE(XTX,"ilmpqr","ILMPQR")
- +21 IF XTX>0!(XTX="^")
- GOTO XTERR^XTER
- IF XTX="^Q"
- GOTO END^XTER
- IF XTX="^M"
- GOTO MESG^XTER1A
- IF XTX="^P"
- GOTO PRNT^XTER1A
- SET X=XTX
- SET XTX=""
- SET XTOUT=0
- +22 IF X="^I"
- DO EN^XTER1B
- GOTO WRT
- +23 IF X["?"
- SET XTF="1,2,10,7,13,14,15,8,9"
- DO HELP^XTER
- GOTO WRT
- +24 IF X="$"
- SET XTDV1=0
- DO DV
- GOTO WRT
- +25 IF X="^R"
- GOTO RESTOR^XTER2
- +26 ;
- WRTA ;Show All (^L)
- +1 DO WRT1
- IF '$DATA(XTX)
- SET XTX=""
- +2 IF $GET(XTMES)!$GET(XTPRNT)
- QUIT
- IF IO=IO(0)&(XTX'="^Q")&(XTX'="^q")
- GOTO WRT
- +3 USE IO(0)
- IF XTX="^Q"!(XTX="^q")
- GOTO END^XTER
- GOTO XTERR^XTER
- +4 ;
- WRT1 ;
- +1 IF '$DATA(IOSL)
- SET IOSL=24
- DO ADD("")
- DO ADD("")
- +2 SET XTSYM=$SELECT(X="^L":"",1:X)
- SET %XTYL=IOSL-4
- SET XTI=0
- SET XTC=1
- SET X=""
- SET XTA=XTSYM
- SET XTA=$SELECT(XTA="":"",1:$EXTRACT(XTA,1,$LENGTH(XTA)-1)_$CHAR($ASCII($EXTRACT(XTA,$LENGTH(XTA)))-1)_"z")
- +3 ;Find start by order thru B X-ref for Symbols, XTA=var name, XTB=var value
- WF IF '%XTYL
- SET %XTYL=IOSL-4
- +1 ;S (XTA,XTA1)=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTA)) S XTI=$S(XTSYM="":1,XTA'="":$O(^(XTA,0)),1:0)
- +2 ;p431
- SET XTA=$ORDER(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTA))
- SET XTI=$SELECT(XTSYM="":1,XTA'="":$ORDER(^(XTA,0)),1:0)
- +3 IF XTA=""!(XTSYM'=""&($EXTRACT(XTA,1,$LENGTH(XTSYM))'=XTSYM))
- IF XTSYM'=""&XTC
- DO ADD("No such symbol")
- IF '$GET(XTPRNT)
- DO MORE^XTER1A
- QUIT
- +4 ;p431
- SET (XTA,XTA1)=^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI,0)
- +5 DO WV
- +6 ;Show the rest in order
- +7 FOR
- SET XTI=$ORDER(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI))
- IF 'XTI!(XTOUT)
- QUIT
- SET (XTA,XTA1)=^(XTI,0)
- IF $EXTRACT(XTA,1,$LENGTH(XTSYM))'=XTSYM
- QUIT
- DO WV
- +8 QUIT
- WV ;Write a variable
- +1 IF '%XTYL
- SET %XTYL=IOSL-4
- +2 SET XTB=$SELECT($DATA(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI,"D")):^("D"),1:"*** WARNING: this value was NOT recorded due to an ERROR WITHIN the TRAP ***")
- +3 ;Check for long variables
- +4 SET XTL=$GET(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",XTI,"L"))
- IF XTL>255
- DO ADD("**The following variables length is "_XTL_", only displaying first 255.**")
- +5 SET XTC=0
- IF '$GET(XTMES)&'$GET(XTPRNT)
- SET %XTYL=%XTYL-1
- +6 IF '%XTYL
- DO MORE^XTER1A
- IF XTOUT
- QUIT
- IF '%XTYL
- DO ADD("")
- +7 SET XTA1=XTA1_"="
- KILL XTC1
- IF XTB?.PUNL
- IF XTB'["\"
- SET XTA1=XTA1_XTB
- SET XTC1=""
- +8 ;Change control char to \027 format
- +9 IF '$DATA(XTC1)
- SET XTC1=""
- IF $PIECE(XTA1," ",2)=""
- FOR XTK=1:1
- SET XTZ=$EXTRACT(XTB,XTK)
- IF XTZ=""
- QUIT
- SET XTC1=XTC1_$SELECT(XTZ'?1C:XTZ,1:"\"_$EXTRACT($ASCII(XTZ)+1000,2,4))
- IF XTZ="\"
- SET XTC1=XTC1_"\"
- +10 DO SET
- IF XTL>255
- DO ADD("**")
- +11 QUIT
- +12 ;
- SET ;
- +1 IF ($LENGTH(XTA1)+$LENGTH(XTC1))<246
- SET XTA1=XTA1_XTC1
- SET XTC1=""
- DO ADD(XTA1)
- QUIT
- +2 IF $LENGTH(XTA1)>245
- DO ADD($EXTRACT(XTA1,1,245))
- SET XTA1=$EXTRACT(XTA1,246,$LENGTH(XTA1))
- GOTO SET
- +3 IF $LENGTH(XTA1)>0
- DO ADD(XTA1_$EXTRACT(XTC1,1,(245-$LENGTH(XTA1))))
- SET XTC1=$EXTRACT(XTC1,(245-$LENGTH(XTA1)+1),$LENGTH(XTC1))
- GOTO SET
- +4 DO ADD($EXTRACT(XTC1,1,245))
- SET XTC1=$EXTRACT(XTC1,246,$LENGTH(XTC1))
- GOTO SET
- +5 QUIT
- +6 ;
- ADD(STR) ;Add STR to TMP global
- +1 SET C=C+1
- SET ^TMP($JOB,"XTER",C)=STR
- +2 QUIT
- +3 ;Header info
- DV IF $DATA(XTDV1)
- IF XTDV1=1
- GOTO DV1
- +1 KILL %XTZLIN
- +2 SET %XTZE=^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZE")
- SET %XTJOB=$GET(^("J"))
- SET %XTIO=$GET(^("I"))
- SET %XTZH=$GET(^("ZH"))
- SET %XTZH1=$GET(^("H"))
- SET %XTZGR=$GET(^("GR"))
- IF $DATA(^("LINE"))
- SET %XTZLIN=^("LINE")
- +3 IF %XTZH1>0
- SET %H=%XTZH1
- DO YMD^%DTC
- SET Y=X_%
- DO DD^%DT
- SET $PIECE(%XTZH1,"^",2)=$PIECE(Y,"@",1)_" "_$PIECE(Y,"@",2)
- +4 FOR %XTI=1:1:9
- SET %XTZH(%XTI)=$PIECE(%XTZH,"^",%XTI)
- +5 SET %XTZH(3)=$PIECE(%XTZH1,U,2)
- +6 SET %XTUCI=$PIECE(%XTJOB,U,4)
- +7 ;Build output
- +8 SET X="Process ID: "_$PIECE(%XTJOB,U,5)_" ("_$PIECE(%XTJOB,U)_")"
- SET X=X_$EXTRACT(XTBLNK,1,40-$LENGTH(X))_%XTZH(3)
- +9 DO ADD("")
- DO ADD(X)
- +10 SET %XTZ="Username\Process Name\UCI/VOL\\$ZA\$ZB\Current $IO\Current $ZIO\CPU time\Page Faults\Direct I/O\Buffered I/O"
- +11 SET %XTZ(1)=$PIECE(%XTJOB,U,3)
- SET %XTZ(2)=$PIECE(%XTJOB,U,2)
- SET %XTZ(3)=$SELECT(%XTUCI]"":"["_%XTUCI_"]",1:"")
- +12 SET %XTZ(4)=""
- SET %XTZ(5)=$JUSTIFY($PIECE(%XTIO,U,2),3)
- SET %XTZ(6)=$JUSTIFY($PIECE(%XTIO,U,3),3)
- +13 SET %XTZ(7)=$PIECE(%XTIO,U)
- SET %XTZ(8)=$PIECE(%XTIO,U,4,99)
- SET %XTZ(9)=$JUSTIFY(%XTZH(1),6)
- +14 SET %XTZ(10)=$JUSTIFY(%XTZH(4),10)
- SET %XTZ(11)=$JUSTIFY(%XTZH(7),10)
- SET %XTZ(12)=$JUSTIFY(%XTZH(8),10)
- +15 FOR %XTI=1:1:12
- Begin DoDot:1
- +16 IF %XTI#2
- SET X=""
- +17 IF %XTZ(%XTI)'?." "
- SET X=X_$PIECE(%XTZ,"\",%XTI)_": "_%XTZ(%XTI)
- IF %XTI#2
- SET X=$EXTRACT(X_$EXTRACT(XTBLNK,1,40),1,40)
- +18 IF '(%XTI#2)
- IF X'?." "
- DO ADD("")
- DO ADD(X)
- +19 QUIT
- End DoDot:1
- DV1 SET XTDV1=1
- DO ADD("")
- DO ADD("$ZE= "_%XTZE)
- +1 ;p431
- IF %XTZGR'=""
- DO ADD("")
- DO ADD("Last Global Ref: "_%XTZGR)
- +2 KILL X
- IF $DATA(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZE2"))
- SET X=^("ZE2")
- +3 IF $DATA(X)
- DO ADD("")
- DO ADD("%ZTER encountered an error while logging this error -- ")
- DO ADD("This may have caused some LOCAL VARIABLES to be lost.")
- DO ADD("This error was: "_X)
- +4 QUIT
- +5 ;
