- XTERSUM1 ;ISF/RCR,RWF - Error Trap Summary Utilities ;08/25/10 14:23
- ;;8.0;KERNEL;**431**;Jul 10, 1995;Build 35
- ;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@DOMAIN.EXT"
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTERSUM1 3268 printed Jan 18, 2025@03:41:58 Page 2
- XTERSUM1 ;ISF/RCR,RWF - Error Trap Summary Utilities ;08/25/10 14:23
- +1 ;;8.0;KERNEL;**431**;Jul 10, 1995;Build 35
- +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@DOMAIN.EXT"
- +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