XTERSUM1 ;ISF/RCR,RWF - Error Trap Summary Utilities ;08/25/10 14:23
;;8.0;KERNEL;**431**;Jul 10, 1995;Build 38
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;Utilities for XTERSUM
;No public entry points in this routine.
; =========
; The one input is the $H day to list the errors for. Defaults to today
TSTSTK(%H) ; Use this entry point to test the GETSTK entry point
N I,J,U,X
S U="^"
S %H=$G(%H,$H)
;S:%H="" %H=+$H
F I=1:1 S X=$J(I,3)_":"_$$GETSTK^XTERSUM(%H,I) Q:X[":[]" D
. W !
. F J=1:80:$L(X) W $E(X,J,J+79),!
.QUIT
QUIT
; =========
LOCATE() ; Return the Environment and CPU Name
N CPU,NM,Y
S U="^"
D GETENV^%ZOSV
S CPU=$P(Y,U,3)
S NM=$P(Y,U,4)
S NM=$TR($P(NM,CPU),":",";")_";"_CPU
I NM="" S NM=$$KSP^XUPARAM("INST")
QUIT NM
; =========
; >W $$DEFDAT^XTERSUM1("T"[,"NOW"]) - Generate FileMan Date for
; Process Returns>>YYMMDD.HHMMSS^$TR($H,",","^")^DOW
; Good for dates and times which span 1868 through 2699. If the
; upper date becomes a problem, I promise to come back and modify
; the code.
; X - Incoming date specifier
; Y - The Return Value
; Z - Optional Default
DEFDAT(X,Z) ; Find the Default Date
N %DT,%H,%T,%Y,Y
S X=$G(X)
S Z=$G(Z) ;1410000 = 31Dec, 1840 @ 235959+.00000001
S:X="" X=Z
S:X="" X=$H
I X>10000,X<1410000 S X=$$HTFM^XLFDT(X) ; Library Function
S %DT="TS" ; Time in Seconds
D ^%DT
D:Y
. S X=Y
. D H^%DTC
. QUIT
QUIT Y_"^"_%H_"^"_%T_"^"_%Y
; =========
;
PURGE ;Clean-up the Error Summary data
N DT30,DT90,DH90,XTDAT,X,IX1,IX2,DA,DIK
S X=$P($G(^XTV(8989.3,1,"ZTER")),U,4),X=$S('X:90,1:X) ;Get keep days
S DT30=$$HTFM^XLFDT($H-30),DH90=$H-X,DT90=$$HTFM^XLFDT(DH90)
S IX1=0
;Remove entry if last seen > 90 days ago. Remove Error Event > 30 days ago.
F S IX1=$O(^%ZTER(3.077,IX1)),IX2=0 Q:'IX1 S X=$G(^(IX1,0)) D
. I $P(X,U)="" S DA=IX1,DIK="^%ZTER(3.077," D ^DIK Q ;Missing error
. S X=$P(X,U,3) I X,X<DT90 S DA=IX1,DIK="^%ZTER(3.077," D ^DIK Q
. ;If no last seen date give it one.
. I X="" S $P(^%ZTER(3.077,IX1,0),U,3)=$$HTFM^XLFDT($H)
. F S IX2=$O(^%ZTER(3.077,IX1,1,IX2)) Q:'IX2 S X=$G(^(IX2,0)) D
. . I $P(X,U,2)>DT30 Q ;Keep Error events for 30 days
. . S DA=IX2,DA(1)=IX1,DIK="^%ZTER(3.077,DA(1),1," D ^DIK K DA
. . Q
. S IX2=0 ;Remove Frequency Distribution
. F S IX2=$O(^%ZTER(3.077,IX1,4,IX2)) Q:'IX2 I IX2<DH90 S DA=IX2,DA(1)=IX1,DIK="^%ZTER(3.077,DA(1),4," D ^DIK K DA
. Q
Q
;
POST ;Post-init for patch XU*8*431
N FDA,%D,%S,SCR,ZTOS,IEN,%ZT
S FDA(8989.3,"1,",520.1)=10,FDA(8989.3,"1,",520.2)=0 ;Give site defaults
S FDA(8989.3,"1,",520.3)=7,FDA(8989.3,"1,",520.4)=90 ;More defaults
D FILE^DIE("","FDA")
D PATCH^ZTMGRSET(431)
I $E($RE(^XMB("NETNAME")),1,6)="VOG.AV" D VA ;Only setup for VA sites.
;Get a baseline of the last 30 days.
D ADD^XTERSUM
Q
;
VA ;
S IEN=$$FIND1^DIC(3.8,,"X","XTER SUMMARY LOAD")_","
Q:IEN'>0
S FDA(3.812,"?+1,"_IEN,.01)="S.XTER SUMMARY LOAD@FORUM.VA.GOV"
D UPDATE^DIE("","FDA") I $D(^TMP("DIERR",$J)) S %ZT($NA(^TMP("DIERR",$J)))="" D ^%ZTER
K FDA S FDA(8989.3,"1,",520.2)=1
D UPDATE^DIE("","FDA") I $D(^TMP("DIERR",$J)) S %ZT($NA(^TMP("DIERR",$J)))="" D ^%ZTER
Q
XTERSUM1 ;ISF/RCR,RWF - Error Trap Summary Utilities ;08/25/10 14:23
+1 ;;8.0;KERNEL;**431**;Jul 10, 1995;Build 38
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;Utilities for XTERSUM
+5 ;No public entry points in this routine.
+6 ; =========
+7 ; The one input is the $H day to list the errors for. Defaults to today
TSTSTK(%H) ; Use this entry point to test the GETSTK entry point
+1 NEW I,J,U,X
+2 SET U="^"
+3 SET %H=$GET(%H,$HOROLOG)
+4 ;S:%H="" %H=+$H
+5 FOR I=1:1
SET X=$JUSTIFY(I,3)_":"_$$GETSTK^XTERSUM(%H,I)
IF X["
QUIT
Begin DoDot:1
+6 WRITE !
+7 FOR J=1:80:$LENGTH(X)
WRITE $EXTRACT(X,J,J+79),!
+8 QUIT
End DoDot:1
+9 QUIT
+10 ; =========
LOCATE() ; Return the Environment and CPU Name
+1 NEW CPU,NM,Y
+2 SET U="^"
+3 DO GETENV^%ZOSV
+4 SET CPU=$PIECE(Y,U,3)
+5 SET NM=$PIECE(Y,U,4)
+6 SET NM=$TRANSLATE($PIECE(NM,CPU),":",";")_";"_CPU
+7 IF NM=""
SET NM=$$KSP^XUPARAM("INST")
+8 QUIT NM
+9 ; =========
+10 ; >W $$DEFDAT^XTERSUM1("T"[,"NOW"]) - Generate FileMan Date for
+11 ; Process Returns>>YYMMDD.HHMMSS^$TR($H,",","^")^DOW
+12 ; Good for dates and times which span 1868 through 2699. If the
+13 ; upper date becomes a problem, I promise to come back and modify
+14 ; the code.
+15 ; X - Incoming date specifier
+16 ; Y - The Return Value
+17 ; Z - Optional Default
DEFDAT(X,Z) ; Find the Default Date
+1 NEW %DT,%H,%T,%Y,Y
+2 SET X=$GET(X)
+3 ;1410000 = 31Dec, 1840 @ 235959+.00000001
SET Z=$GET(Z)
+4 IF X=""
SET X=Z
+5 IF X=""
SET X=$HOROLOG
+6 ; Library Function
IF X>10000
IF X<1410000
SET X=$$HTFM^XLFDT(X)
+7 ; Time in Seconds
SET %DT="TS"
+8 DO ^%DT
+9 IF Y
Begin DoDot:1
+10 SET X=Y
+11 DO H^%DTC
+12 QUIT
End DoDot:1
+13 QUIT Y_"^"_%H_"^"_%T_"^"_%Y
+14 ; =========
+15 ;
PURGE ;Clean-up the Error Summary data
+1 NEW DT30,DT90,DH90,XTDAT,X,IX1,IX2,DA,DIK
+2 ;Get keep days
SET X=$PIECE($GET(^XTV(8989.3,1,"ZTER")),U,4)
SET X=$SELECT('X:90,1:X)
+3 SET DT30=$$HTFM^XLFDT($HOROLOG-30)
SET DH90=$HOROLOG-X
SET DT90=$$HTFM^XLFDT(DH90)
+4 SET IX1=0
+5 ;Remove entry if last seen > 90 days ago. Remove Error Event > 30 days ago.
+6 FOR
SET IX1=$ORDER(^%ZTER(3.077,IX1))
SET IX2=0
IF 'IX1
QUIT
SET X=$GET(^(IX1,0))
Begin DoDot:1
+7 ;Missing error
IF $PIECE(X,U)=""
SET DA=IX1
SET DIK="^%ZTER(3.077,"
DO ^DIK
QUIT
+8 SET X=$PIECE(X,U,3)
IF X
IF X<DT90
SET DA=IX1
SET DIK="^%ZTER(3.077,"
DO ^DIK
QUIT
+9 ;If no last seen date give it one.
+10 IF X=""
SET $PIECE(^%ZTER(3.077,IX1,0),U,3)=$$HTFM^XLFDT($HOROLOG)
+11 FOR
SET IX2=$ORDER(^%ZTER(3.077,IX1,1,IX2))
IF 'IX2
QUIT
SET X=$GET(^(IX2,0))
Begin DoDot:2
+12 ;Keep Error events for 30 days
IF $PIECE(X,U,2)>DT30
QUIT
+13 SET DA=IX2
SET DA(1)=IX1
SET DIK="^%ZTER(3.077,DA(1),1,"
DO ^DIK
KILL DA
+14 QUIT
End DoDot:2
+15 ;Remove Frequency Distribution
SET IX2=0
+16 FOR
SET IX2=$ORDER(^%ZTER(3.077,IX1,4,IX2))
IF 'IX2
QUIT
IF IX2<DH90
SET DA=IX2
SET DA(1)=IX1
SET DIK="^%ZTER(3.077,DA(1),4,"
DO ^DIK
KILL DA
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
POST ;Post-init for patch XU*8*431
+1 NEW FDA,%D,%S,SCR,ZTOS,IEN,%ZT
+2 ;Give site defaults
SET FDA(8989.3,"1,",520.1)=10
SET FDA(8989.3,"1,",520.2)=0
+3 ;More defaults
SET FDA(8989.3,"1,",520.3)=7
SET FDA(8989.3,"1,",520.4)=90
+4 DO FILE^DIE("","FDA")
+5 DO PATCH^ZTMGRSET(431)
+6 ;Only setup for VA sites.
IF $EXTRACT($REVERSE(^XMB("NETNAME")),1,6)="VOG.AV"
DO VA
+7 ;Get a baseline of the last 30 days.
+8 DO ADD^XTERSUM
+9 QUIT
+10 ;
VA ;
+1 SET IEN=$$FIND1^DIC(3.8,,"X","XTER SUMMARY LOAD")_","
+2 IF IEN'>0
QUIT
+3 SET FDA(3.812,"?+1,"_IEN,.01)="S.XTER SUMMARY LOAD@FORUM.VA.GOV"
+4 DO UPDATE^DIE("","FDA")
IF $DATA(^TMP("DIERR",$JOB))
SET %ZT($NAME(^TMP("DIERR",$JOB)))=""
DO ^%ZTER
+5 KILL FDA
SET FDA(8989.3,"1,",520.2)=1
+6 DO UPDATE^DIE("","FDA")
IF $DATA(^TMP("DIERR",$JOB))
SET %ZT($NAME(^TMP("DIERR",$JOB)))=""
DO ^%ZTER
+7 QUIT
