source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTER1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1XTER1 ;ISC-SF.SEA/JLI - Kernel Error Trap Display ;10/18/2005
2 ;;8.0;KERNEL;**8,392**;Jul 10, 1995;Build 5
3 S XTDV1=0
4WRT S XTOUT=0 S:'$D(XTBLNK) $P(XTBLNK," ",133)=" " S:'$D(C) C=0 K:C=0 ^TMP($J,"XTER")
5 D DV
6 I '$D(%XTZLIN) S %XTY=$P(%XTZE,","),%XTX=$P(%XTY,"^") S:%XTX[">" %XTX=$P(%XTX,">",2)
7 I '$D(%XTZLIN),%XTX'="" S X=$P($P(%XTY,"^",2),":") I X'="" X ^%ZOSF("TEST") I $T D
8 . N XCNP,DIF,%XTX,%XTY
9 . S XCNP=0,DIF="^TMP($J,""XTER1""," X ^%ZOSF("LOAD") S %XTY=$P(%XTX,"+",1) D
10 . . 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
11 . . I %XTY="" S X=+$P(%XTX,"+",2) Q:X'>0 S %XTZLIN=^TMP($J,"XTER1",X,0)
12 S:'$D(%XTZLIN) %XTZLIN="" K ^TMP($J,"XTER1")
13 I %XTZLIN'="" D ADD(""),ADD(%XTZLIN)
14 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)=""
15 I IO'=IO(0) S XTDV1=0 D DV
16 D:%XTZGR'="" ADD(""),ADD("Last Global Ref: "_%XTZGR) D:'$G(XTMES)&'$G(XTPRNT) WRITER^XTER1A I IO'="",IO'=IO(0)!$G(XTPRNT) U IO W @IOF S X="^L" G WRTA
17 I $G(XTMES) S X="^L" G WRTA
18 ;
19 K ^TMP($J,"XTER") S C=0
20 R !!,"Which symbol? > ",XTX:DTIME S:'$T!(XTX="") XTX="^"
21 S:$E(XTX,1)="^" XTX=$TR(XTX,"ilmpqr","ILMPQR") ;uppercase
22 G XTERR^XTER:XTX>0!(XTX="^"),END^XTER:XTX="^Q",MESG^XTER1A:XTX="^M",PRNT^XTER1A:XTX="^P" S X=XTX,XTX="",XTOUT=0
23 I X="^I" D EN^XTER1B G WRT
24 I X["?" S XTF="1,2,10,7,13,14,15,8,9" D HELP^XTER G WRT
25 I X="$" S XTDV1=0 D DV G WRT
26 I X="^R" G RESTOR^XTER2
27 ;
28WRTA ;Show All (^L)
29 D WRT1 S:'$D(XTX) XTX=""
30 Q:$G(XTMES)!$G(XTPRNT) G:IO=IO(0)&(XTX'="^Q")&(XTX'="^q") WRT
31 U IO(0) G END^XTER:XTX="^Q"!(XTX="^q"),XTERR^XTER
32 ;
33WRT1 ;
34 S:'$D(IOSL) IOSL=24 D ADD(""),ADD("")
35 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")
36 ;Find start by order thru B X-ref for Symbols, XTA=var name, XTB=var value
37WF S:'%XTYL %XTYL=IOSL-4
38 S (XTA,XTA1)=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV","B",XTA)) S XTI=$S(XTSYM="":1,XTA'="":$O(^(XTA,0)),1:0)
39 I XTA=""!(XTSYM'=""&($E(XTA,1,$L(XTSYM))'=XTSYM)) D:XTSYM'=""&XTC ADD("No such symbol") D:'$G(XTPRNT) MORE^XTER1A Q
40 D WV
41 ;Show the rest in order
42 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
43 Q
44WV ;Write a variable
45 S:'%XTYL %XTYL=IOSL-4
46 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 ***")
47 ;Check for long variables
48 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.**")
49 S XTC=0 S:'$G(XTMES)&'$G(XTPRNT) %XTYL=%XTYL-1
50 D:'%XTYL MORE^XTER1A Q:XTOUT D:'%XTYL ADD("")
51 S XTA1=XTA1_"=" K XTC1 I XTB?.PUNL,XTB'["\" S XTA1=XTA1_XTB,XTC1=""
52 ;Change control char to \027 format
53 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_"\"
54 D SET D:XTL>255 ADD("**")
55 Q
56 ;
57SET ;
58 I ($L(XTA1)+$L(XTC1))<246 S XTA1=XTA1_XTC1,XTC1="" D ADD(XTA1) Q
59 I $L(XTA1)>245 D ADD($E(XTA1,1,245)) S XTA1=$E(XTA1,246,$L(XTA1)) G SET
60 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
61 D ADD($E(XTC1,1,245)) S XTC1=$E(XTC1,246,$L(XTC1)) G SET
62 Q
63 ;
64ADD(STR) ;Add STR to TMP global
65 S C=C+1,^TMP($J,"XTER",C)=STR
66 Q
67 ;Header info
68DV I $D(XTDV1),XTDV1=1 G DV1
69 K %XTZLIN
70 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")
71 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)
72 F %XTI=1:1:9 S %XTZH(%XTI)=$P(%XTZH,"^",%XTI)
73 S %XTZH(3)=$P(%XTZH1,U,2)
74 S %XTUCI=$P(%XTJOB,U,4)
75 ;Build output
76 S X="Process ID: "_$P(%XTJOB,U,5)_" ("_$P(%XTJOB,U)_")",X=X_$E(XTBLNK,1,40-$L(X))_%XTZH(3)
77 D ADD(""),ADD(X)
78 S %XTZ="Username\Process Name\UCI/VOL\\$ZA\$ZB\Current $IO\Current $ZIO\CPU time\Page Faults\Direct I/O\Buffered I/O"
79 S %XTZ(1)=$P(%XTJOB,U,3),%XTZ(2)=$P(%XTJOB,U,2),%XTZ(3)=$S(%XTUCI]"":"["_%XTUCI_"]",1:"")
80 S %XTZ(4)="",%XTZ(5)=$J($P(%XTIO,U,2),3),%XTZ(6)=$J($P(%XTIO,U,3),3)
81 S %XTZ(7)=$P(%XTIO,U),%XTZ(8)=$P(%XTIO,U,4,99),%XTZ(9)=$J(%XTZH(1),6)
82 S %XTZ(10)=$J(%XTZH(4),10),%XTZ(11)=$J(%XTZH(7),10),%XTZ(12)=$J(%XTZH(8),10)
83 F %XTI=1:1:12 D
84 . I %XTI#2 S X=""
85 . S:%XTZ(%XTI)'?." " X=X_$P(%XTZ,"\",%XTI)_": "_%XTZ(%XTI) S:%XTI#2 X=$E(X_$E(XTBLNK,1,40),1,40)
86 . I '(%XTI#2),X'?." " D ADD(""),ADD(X)
87 . Q
88DV1 S XTDV1=1 D ADD(""),ADD("$ZE= "_%XTZE)
89 K X I $D(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZE2")) S X=^("ZE2")
90 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)
91 Q
92 ;
Note: See TracBrowser for help on using the repository browser.