Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTERSUM

XTERSUM.m

Go to the documentation of this file. 
XTERSUM ;ISF/RCR,RWF - Error Trap Summary Utilities ;03/25/09  11:12

 ;;8.0;KERNEL;**431**;Jul 10, 1995;Build 38

 ;Per VHA Directive 2004-038, this routine should not be modified.

 QUIT

 ;     ; All code is accessed by alternate entry points.

 ; >D ADD^XTERSUM  ; Will gather the latest Error Traps and drop into FM

 ; >D SCAN^XTERSUM("T-30","NOW","UNDEF") - Generate Selected Error

 ;        Argument list for Start Date (def:first date on file),

 ;        Stop Date (def:last date recorded for an error),

 ;        An optional select string (def:"")

 ; Alternate Entry Point to invoke the collection from the error trap.

 ; Requires no inputs and defaults to thiry days ago, now, and no

 ;  selection criteria (everything is selected to be added).

ALL ; Include all errors in the history - Probably only run at a New Site.

 D SCAN("t-900","NOW","")

 QUIT

 ;  =========

 ; Actually, now the invocation can be shortened to D SCAN^XTERSUM("T-30")

ADD ; Include all errors in the last 30 days

 D SCAN("t-30","NOW","")

 QUIT

 ;  =========

TODAY ;  Just do Today.  Was added when there was concern for performance

 D SCAN("t","NOW","")

 QUIT

 ;  =========

 ; Call as >D REL^XTERSUM("t-1")

REL(X) ; Process from the starting time/date (in X) and NOW.

 D SCAN($G(X,"T"),"NOW","")

 QUIT

 ;  =========

 ;

 ; %D1, %D2 Optional Start (%D1) and End (%D2) Dates

 ; %TY  - Optional Type of Error to Scan For and Return

 ; Sample Call: D SCAN^XTERSUM("T-3","NOW","UNDEF")

SCAN(%D1,%D2,%TY) ; Alternative Entry Point for Demand Runs

 S %D1=$G(%D1),%D2=$G(%D2),%TY=$G(%TY)

 S:'$L(%D1) %D1=$O(^%ZTER(1,0)) S:'$L(%D2) %D2="NOW"

 N %AR,%EN,%LOC,%ZE1,%ZE2,%K,%K1,%K2,%RT,%T1,%T2,%Y1,%Y2

 N %CD,%GR,%H,%I,%J,%ST,%ZE,%ZH,%TS,%EC,%MC,%PL

 N %DUZ,%VTQUED,%XQY,%XQY0,%XUENV,%XWBTBF,%XWBTBUF,%ZTSK,%ZTQUED

 S U="^"

 S %LOC="9999"

 S %K=$$LOCATE^XTERSUM1()

 I $L(%K)  S %LOC=%K

 S %Y1=$$DEFDAT^XTERSUM1(%D1,"")

 S %Y2=$$DEFDAT^XTERSUM1(%D2,"NOW")

 S %K1=$P(%Y1,"^",2),%T1=$P(%Y1,"^",3)

 S %K2=$P(%Y2,"^",2),%T2=$P(%Y2,"^",3)

 S %K=%K1

 F  D  S %K=$O(^%ZTER(1,%K))           Q:%K>%K2    Q:%K'?1.7N

 . S %EN=0

 . F   S %EN=$O(^%ZTER(1,%K,1,%EN))     Q:%EN'?1.N  D

 . . D:$$GETER(%EN,%TY)  ; Load the new Error

 . . . N D0

 . . . D COMPILE ;      ; Set the Extracted Values into the Output Array

 . . . S D0=$$INCR(%ZE) ; Create a new record in ^%ZTER(3.077,

 . . . D:D0

 . . . . L +^%ZTER(3.077,D0):5 ; Small Lock Window, Grab, Do, Release

 . . . . D PLACERR ;      ; To build the XTERSUM Record

 . . . . L -^%ZTER(3.077,D0)

 . . . .QUIT

 . . .QUIT

 . .QUIT

 .QUIT

 ;See if need to Send summary to consolidation site.

 I $P($G(^XTV(8989.3,1,"ZTER")),U,2) D SEND^XTERSUM3

 QUIT

 ;  =========

 ; Need to get %D1 and %D2 into Fileman Standard Time/Date

 ; Then Verify the %TYpe for Identification, "" is default.

 ;  Search ^%ZTER(1,+$H,1,%EN,"GR")    ; Last Global Reference,

 ;  Search ^%ZTER(1,+$H,1,%EN,"H")     ; Date/Time Stamp of the Error,

 ;  Search ^%ZTER(1,+$H,1,%EN,"I")     ; The Current Device Used,

 ;  Search ^%ZTER(1,+$H,1,%EN,"LINE")  ; Last Line of Code

 ;  Search ^%ZTER(1,+$H,1,%EN,"ZE")    ; Error Encountered

 ;  Search ^%ZTER(1,+$H,1,%EN,"ZK")    ; System Time and Utilization Sig.

 ;  Scan for the "ZV" for %STACK to trace the activity? (Later)

 ; Inputs

 ;  %K  - Which Day's Errors to Examine, SYMBOL TABLE

 ;  D0  - %EN, points to the error for the day in %K

 ;  %SR - Search String = %TY.   Usually Null

 ; Outputs

 ;  %TS Returned as 1 = Success, and 0 = Failed to find the search string

 ;  %CD = Code with Error

 ;  %GR = Last Global Reference

 ;  %H  = Horolog date and time that the Error Occurred

 ;  %I  = Current Device Used

 ;  %J  = Job Identifier

 ;  %ST = Stack Frames

 ;  %ZE = Error Description

 ;  %ZH = System time and Utilization Signature

 ; ................

GETER(K1,%SR) ; Extract the data needed for the next Error Analysis

 N %TS

 S %CD=$G(^%ZTER(1,%K,1,K1,"LINE"))

 S %GR=$TR($G(^%ZTER(1,%K,1,K1,"GR")),"^","~")

 S %H=$G(^%ZTER(1,%K,1,K1,"H"))

 S %I=$G(^%ZTER(1,%K,1,K1,"I"))

 S %J=$G(^%ZTER(1,%K,1,K1,"J"))

 S %ZE=$G(^%ZTER(1,%K,1,K1,"ZE"))

 S %ZH=$TR($G(^%ZTER(1,%K,1,K1,"ZH")),"^",",")

 S %ST=$TR($$GETSTK(%K,K1),"^","~")

 S %TS=(%ZH_%CD[%SR) ; Separate because of String Length Problem

 S:%H %H=$$HTFM^XLFDT(%H)

 S %TS=%TS!(%GR_%H_%I_%J[%SR)

 S %TS=%TS!(%ST[%SR)

 I '%TS   K %CD,%GR,%H,%I,%J,%ST

 QUIT %TS

 ;  =========

COMPILE ; Compile the information from ^%ZTER into the Output Array, %AR

 N A,B,C1,C2,C3,C4,D

 S A=$TR($E($P(%ZE,", ",1,2),1,63),"^","~")

 ; For Cache, Strip Out the Name of the Routine and Label

 S:A["<"&($P(A,"<",2)[">") A=$P(A,">",2)_", "_$P(A,">")_">"

 Q:A=""

 ;

 S B="",D=0

 S D=$O(^%ZTER(3.077,"B",$E(A,1,30),""))

 S:D B=$G(^%ZTER(3.077,D,0))

 S C1=$P(B,"^"),C2=$P(B,"^",2),C3=$P(B,"^",3),C4=$P(B,"^",4)

 S:C2="" C2=%H

 S:C2>%H C2=%H

 S:C3="" C3=%H

 S:C3<%H C3=%H

 S:C4="" C4=$P($P(%ZE,":"),"^",2)

 S:C4="" C4="[Unknown Xecute]"

 S %AR(0)=C1_U_C2_U_C3_U_C4

 S %AR(2)=%CD ;line

 S %AR(3)=%GR ;global

 S %AR(6)=%ST ;stack

 QUIT

 ;  =========

 ; All of the parts are known at this point, now we need to find out

 ;  if they are already recorded.  Call FMT to get the error in a standard

 ;  format.

INCR(V) ; Build a New Record in ^%ZTER(3.077,

 N C,D0,RTN,T,DO,DD,DIC,X,Y

 I $G(V)=""     Q 0   ; Input Value missing

 ;

 S V=$$FMT(V) ;Get V in standard form

 S RTN=$P($G(%AR(0)),"^",4)

 S:RTN="" RTN="[No RTN]"  ;  Error is in an Execute, so no routine

 S D0=$O(^%ZTER(3.077,"B",$E(V,1,30),""))

 ;  Need a 0 in D0 to create a new entry (New Error in New Location)

 ;          in this file (3.077)

 D:'D0

 . S $P(%AR(0),U)=V

 . L +^%ZTER(3.077,0):15

 . S DIC="^%ZTER(3.077,",DIC(0)="FL",X=V

 . D FILE^DICN S D0=+Y

 . L -^%ZTER(3.077,0)

 . QUIT

 ;%ZTER placed the .01, See if need to set the rest of the data

 D:'$D(^%ZTER(3.077,D0,2))

 . S ^%ZTER(3.077,D0,0)=%AR(0)

 . S ^%ZTER(3.077,D0,1,0)="^3.07701^^"

 . S ^%ZTER(3.077,D0,2)=%AR(2)

 . S ^%ZTER(3.077,D0,3)=%AR(3)

 . S:$G(%AR(6))'="" ^%ZTER(3.077,D0,6)=%AR(6)

 . D XREF(D0)

 .QUIT

 QUIT D0

 ;

XREF(DA) ;Set other X-refs because %ZTER set the entry

 N DIK,D0

 S DIK="^%ZTER(3.077,",DIK(1)=.01 D EN1^DIK

 Q

 ;  =========

 ; First, we need to fix the various errors that are generated and make

 ;  sure that they are consistant with our standard error representations.

 ; Some additional work might be needed here to reflect the differences of

 ;  other MUMPS implementations which do not follow the DSM error format.

FMT(V) ;Format the error string

 S V=$$FMT^%ZTER(V)

 S V=$TR($E($P(V,", ",1,2),1,63),"^","~")

 ; Adjustment for Cache  - MTZ/RCR 23MAR2005

 ; Move the error description

 ;I V["<"&($P(V,"<",2)[">") S V=$P(V,">",2)_", "_$P(V,">")_">"

 Q V

 ;  =========

 ; Inputs are collected from the Error Trap

 ; Everything has been collected; Now Create the SubRecord in

 ;  ^%ZTER(3.077, But first check to see if the entity has not already

 ;  been collected.  If found;

 ;  Returns the subIEN for the entity (D1 level).

 ;  If NOT found, Return 0

PLACERR ;

 N %L,D1,KEY,T,T1,T2

 S T=$G(^%ZTER(3.077,D0,0))

 S KEY=%K_":"_%LOC ;_":"_%EN

 S D1=$O(^%ZTER(3.077,D0,1,"B",KEY,""))

 D:'D1  ; Skip if already created

 . S:'$D(^%ZTER(3.077,D0,1,0)) ^%ZTER(3.077,D0,1,0)="^3.07701^"

 . S D1=$P(^%ZTER(3.077,D0,1,0),U,3)+1

 . S $P(^%ZTER(3.077,D0,1,0),U,3,4)=D1_U_D1

 . S ^%ZTER(3.077,D0,1,"B",KEY,D1)=""

 . S ^%ZTER(3.077,D0,1,D1,0)=KEY_U_%H_U_%ZH_U_$G(%DUZ)

 . S:%CD'=$G(^%ZTER(3.077,D0,2)) ^%ZTER(3.077,D0,1,D1,1)=%CD ;line

 . S:%GR'=$G(^%ZTER(3.077,D0,3)) ^%ZTER(3.077,D0,1,D1,2)=%GR ;global

 . F  S %L=$L(%XUENV,"^")  Q:%L=3  D

 . . S %XUENV=$P(%XUENV,"^",1,3)

 . . I %L<3   S $P(%XUENV,U,3)="[?]"

 . .QUIT

 . I "^^[?]"[%XUENV  S %XUENV="^^"

 . S ^%ZTER(3.077,D0,1,D1,3)=%DUZ_U_%XQY_U_%XQY0_U_%ZTSK_U_%XUENV_U_%XWBTBF

 . S:%ST'=$G(^%ZTER(3.077,D0,6)) ^%ZTER(3.077,D0,1,D1,6)=%ST ;stack

 . S %AR(0)=$G(%AR(0))

 . S T1=$P(T,U,2,4),T2=$P($G(%AR(0)),U,2,4)

 . S:T1'=T2 $P(^%ZTER(3.077,D0,0),U,2,4)=T2

 .QUIT

 QUIT

 ;  =========

 ; Build a data structure to reflect the Stack and the code at

 ;  different stack levels of the error trap capture.  Store in

 ;  the %ST string for transfer to the record.

 ; While scanning the symbols, pick up the following symbols if

 ;  available; from symbol table;

 ;  Output

 ;  %DUZ    << DUZ     = The User Identifier

 ;  %ZTSK   << ZTSK    = The TASK Pointer being performed

 ;  %XQY    << XQY     = The OPTION being performed

 ;  %XQY0   << XQY0    = The Name of the OPTION

 ;  %ZTQUED << ZTQUEUED  = 0 means Submanager, .5 Subman in Cleanup

 ;                          other number = Task Being Performed.

 ;  %XUENV  << XUENV   = Operational Environment and CPU of the Problem

 ;     piece 1 = Global Volume

 ;     piece 2 = Routine Volume

 ;     piece 3 = CPU Used

 ; %XWBTBUF << XWBTBUF = RPC Broker Action

GETSTK(X1,X2) ; Build the Stack String

 N BF,BFD,ST,T,T0,V0

 S (V0,T0)=0,ST=""

 S (%DUZ,%VTQUED,%XQY,%XQY0,%XWBTBF,%ZTSK)="",%XUENV="^^"

 F   S V0=$O(^%ZTER(1,X1,1,X2,"ZV",V0))   Q:V0'>0   D

 . S BF=$G(^(V0,0))

 . S BFD=$G(^("D"))

 . D:BF["$STACK("

 . . I BF[",""ECODE"")"   S %EC=BFD  Q

 . . I BF[",""MCODE"")"   S %MC=BFD  Q

 . . I BF[",""PLACE"")"   D          Q

 . . . S %PL=BFD

 . . . S %PL=$P(%PL," ")_":"_$E($P(%PL," ",2),2,999)

 . . . S:%EC'="" %PL="*"_%PL

 . . . S ST=ST_">"_%PL

 . . . S:$L(ST)>240 ST=$P(ST,">",1,5)_"> ... >"_$P(ST,">",8,999)

 . . .QUIT

 . .QUIT

 . I BF="DUZ"      S %DUZ=BFD Q

 . I BF="ZTQUED"   S %ZTQUED=BFD Q

 . I BF="XQY"      S %XQY=BFD Q

 . I BF="XQY0"     S %XQY0=$P(BFD,U,2) Q

 . I BF="XUENV"    S %XUENV=$P(BFD,U,1,3) Q

 . I BF="XWBTBUF"  S %XWBTBUF=$P(BFD,U) Q

 . I BF="ZTSK"     S %ZTSK=BFD Q

 .QUIT

 QUIT "["_$E(ST,2,999)_"]"

 ;  =========

 ;

 ; Check the Cross References for the expected data

 ;  But first check to see if the entity has not already been collected.

 ;  If FOUND,       Returns the IEN for the entity.

 ;  If Not fOUND,   Return 0.

 ;  Need a 0 to create a new entry in this file (3.077)

CHKXRF(XX,K1,K2) ;

 N KEY

 S KEY=+$G(K2)

 S:XX="" XX="B"

 S K1=$G(K1)

 I K1="" Q 0 ; Bad Second Argument

 ;

 I '$D(^%ZTER(3.077,XX,K1,KEY)) S KEY=$O(^%ZTER(3.077,XX,K1,KEY))

 S:KEY="" KEY=0

 QUIT KEY

 ;  =========