XTERPUR ;ISC-SF.SEA/JLI - DELETE ENTRIES FROM ERROR TRAP ;02/11/11
;;8.0;KERNEL;**243,431**;Jul 10, 1995;Build 35
;Per VHA Directive 2004-038, this routine should not be modified.
N I,X,XTDAT,XTDAT1,%DT
EN1 W !!,"To Remove ALL entries except the last N days, simply enter the number N at the"
W !,"prompt. OTHERWISE, enter return at the first prompt, and a DATE at the"
W !,"second prompt. If no ending date is entered at the third prompt, then only"
W !,"the date specified will be deleted. If an ending date is entered that range",!,"of dates INCLUSIVE will be deleted from the error log.",!!
;
W !!,"Number of days to leave in error trap: " R X:DTIME Q:'$T!(X[U) I X'="",X'=+X W:$E(X)'="?" $C(7)," ??" W !?5,"Enter a number (zero or greater) of days to be left in the Error Log.",!,"A RETURN will result in a request for dates" G EN1
I X=+X S X=$H-X D KRANGE(1,X) W !!?10,"DONE" D COUNT Q
;
EN2 R !,"Starting Date to DELETE ERRORS from: ",X:DTIME Q:'$T!(X[U)!(X="") S %DT="EQXP" D ^%DT G:Y'>0 EN2 S XTDAT=Y
R !,"Ending Date to DELETE ERRORS to: ",X:DTIME I '$T!(X[U) W $C(7)," ??" Q
S:X="" X=XTDAT,%DT="QXP" D ^%DT G:Y'>0 EN2 S XTDAT1=Y
S XTDAT=$$FMTH^XLFDT(XTDAT),XTDAT1=$$FMTH^XLFDT(XTDAT1) I XTDAT1<XTDAT W $C(7)," ?? CAN NOT BE EARLIER" Q
D KRANGE(XTDAT,XTDAT1),COUNT
Q
;
COUNT ;Update FM zero node counts
N I,X,XTDAT
S X=0,XTDAT=0 F I=0:0 S I=$O(^%ZTER(1,I)) Q:I'>0 S X=X+1,XTDAT=I
S $P(^%ZTER(1,0),U,3,4)=$S(X'>0:"",1:XTDAT_U_X)
F XTDAT=0:0 S XTDAT=$O(^%ZTER(1,"B",XTDAT)) Q:XTDAT'>0 I '$D(^%ZTER(1,XTDAT)) K ^%ZTER(1,"B",XTDAT)
Q
TYPE ;To purge a type of error.
N %DT,XTDAT,XTSTR,IX,Y,CNT
S %DT="AEX" D ^%DT Q:Y'>1 S XTDAT=+$$FMTH^XLFDT(Y)
R !,"ERROR STRING TO LOOK FOR: ",XTSTR:DTIME
Q:'$L(XTSTR)
S CNT=0 W !
F IX=0:0 S IX=$O(^%ZTER(1,XTDAT,1,IX)) Q:IX'>0 D
. I $G(^(IX,"ZE"))[XTSTR K ^%ZTER(1,XTDAT,1,IX) W "-" Q
. W "." S CNT=CNT+1 Q
;Full reference of ^(IX,"ZE") is ^%ZTER(1,XTDAT,1,IX,"ZE")
S $P(^%ZTER(1,XTDAT,0),"^",2)=CNT ;Reset count
Q
AUTO ;Auto clean of error over ZTQPARAM days ago.
N XTDT,XUSX
S XUSX=$P($G(^XTV(8989.3,1,"ZTER")),U,3)
;S:$G(ZTQPARAM)<1 ZTQPARAM=7
S:$G(XUSX)<1 XUSX=7
;S XTDT=$P($G(^XTV(8989.3,1,"ZTER"),"^^7"),U,3),XTDT=$H-$S(XTDT>ZTQPARAM:XTDT,1:ZTQPARAM)
S XTDT=$P($G(^XTV(8989.3,1,"ZTER"),"^^7"),U,3),XTDT=$H-$S(XTDT>XUSX:XTDT,1:XUSX)
D KRANGE(1,XTDT),PURGE^XTERSUM1
Q
;
KRANGE(XTST,XTDAT) ;Kill error trap before this date
N XTDH
I (XTDAT>$H)!('XTDAT) Q
S XTDH=+$G(XTST,1)-1
F S XTDH=$O(^%ZTER(1,XTDH)) Q:(XTDH'>0)!(XTDH'<XTDAT) D KILLDAY(XTDH)
Q
KILLDAY(%H) ;Kill all errors on one day
;L +^%ZTER(1):60 K ^%ZTER(1,%H),^%ZTER(1,"B",%H) L -^%ZTER(1)
N DIK,DA
L +^%ZTER(1,%H):60 S DIK="^%ZTER(1,",DA=%H D ^DIK L -^%ZTER(1,%H)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTERPUR 2798 printed Oct 16, 2024@18:41:26 Page 2
XTERPUR ;ISC-SF.SEA/JLI - DELETE ENTRIES FROM ERROR TRAP ;02/11/11
+1 ;;8.0;KERNEL;**243,431**;Jul 10, 1995;Build 35
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 NEW I,X,XTDAT,XTDAT1,%DT
EN1 WRITE !!,"To Remove ALL entries except the last N days, simply enter the number N at the"
+1 WRITE !,"prompt. OTHERWISE, enter return at the first prompt, and a DATE at the"
+2 WRITE !,"second prompt. If no ending date is entered at the third prompt, then only"
+3 WRITE !,"the date specified will be deleted. If an ending date is entered that range",!,"of dates INCLUSIVE will be deleted from the error log.",!!
+4 ;
+5 WRITE !!,"Number of days to leave in error trap: "
READ X:DTIME
if '$TEST!(X[U)
QUIT
IF X'=""
IF X'=+X
if $EXTRACT(X)'="?"
WRITE $CHAR(7)," ??"
WRITE !?5,"Enter a number (zero or greater) of days to be left in the Error Log.",!,"A RETURN will result in a request for dates"
GOTO EN1
+6 IF X=+X
SET X=$HOROLOG-X
DO KRANGE(1,X)
WRITE !!?10,"DONE"
DO COUNT
QUIT
+7 ;
EN2 READ !,"Starting Date to DELETE ERRORS from: ",X:DTIME
if '$TEST!(X[U)!(X="")
QUIT
SET %DT="EQXP"
DO ^%DT
if Y'>0
GOTO EN2
SET XTDAT=Y
+1 READ !,"Ending Date to DELETE ERRORS to: ",X:DTIME
IF '$TEST!(X[U)
WRITE $CHAR(7)," ??"
QUIT
+2 if X=""
SET X=XTDAT
SET %DT="QXP"
DO ^%DT
if Y'>0
GOTO EN2
SET XTDAT1=Y
+3 SET XTDAT=$$FMTH^XLFDT(XTDAT)
SET XTDAT1=$$FMTH^XLFDT(XTDAT1)
IF XTDAT1<XTDAT
WRITE $CHAR(7)," ?? CAN NOT BE EARLIER"
QUIT
+4 DO KRANGE(XTDAT,XTDAT1)
DO COUNT
+5 QUIT
+6 ;
COUNT ;Update FM zero node counts
+1 NEW I,X,XTDAT
+2 SET X=0
SET XTDAT=0
FOR I=0:0
SET I=$ORDER(^%ZTER(1,I))
if I'>0
QUIT
SET X=X+1
SET XTDAT=I
+3 SET $PIECE(^%ZTER(1,0),U,3,4)=$SELECT(X'>0:"",1:XTDAT_U_X)
+4 FOR XTDAT=0:0
SET XTDAT=$ORDER(^%ZTER(1,"B",XTDAT))
if XTDAT'>0
QUIT
IF '$DATA(^%ZTER(1,XTDAT))
KILL ^%ZTER(1,"B",XTDAT)
+5 QUIT
TYPE ;To purge a type of error.
+1 NEW %DT,XTDAT,XTSTR,IX,Y,CNT
+2 SET %DT="AEX"
DO ^%DT
if Y'>1
QUIT
SET XTDAT=+$$FMTH^XLFDT(Y)
+3 READ !,"ERROR STRING TO LOOK FOR: ",XTSTR:DTIME
+4 if '$LENGTH(XTSTR)
QUIT
+5 SET CNT=0
WRITE !
+6 FOR IX=0:0
SET IX=$ORDER(^%ZTER(1,XTDAT,1,IX))
if IX'>0
QUIT
Begin DoDot:1
+7 IF $GET(^(IX,"ZE"))[XTSTR
KILL ^%ZTER(1,XTDAT,1,IX)
WRITE "-"
QUIT
+8 WRITE "."
SET CNT=CNT+1
QUIT
End DoDot:1
+9 ;Full reference of ^(IX,"ZE") is ^%ZTER(1,XTDAT,1,IX,"ZE")
+10 ;Reset count
SET $PIECE(^%ZTER(1,XTDAT,0),"^",2)=CNT
+11 QUIT
AUTO ;Auto clean of error over ZTQPARAM days ago.
+1 NEW XTDT,XUSX
+2 SET XUSX=$PIECE($GET(^XTV(8989.3,1,"ZTER")),U,3)
+3 ;S:$G(ZTQPARAM)<1 ZTQPARAM=7
+4 if $GET(XUSX)<1
SET XUSX=7
+5 ;S XTDT=$P($G(^XTV(8989.3,1,"ZTER"),"^^7"),U,3),XTDT=$H-$S(XTDT>ZTQPARAM:XTDT,1:ZTQPARAM)
+6 SET XTDT=$PIECE($GET(^XTV(8989.3,1,"ZTER"),"^^7"),U,3)
SET XTDT=$HOROLOG-$SELECT(XTDT>XUSX:XTDT,1:XUSX)
+7 DO KRANGE(1,XTDT)
DO PURGE^XTERSUM1
+8 QUIT
+9 ;
KRANGE(XTST,XTDAT) ;Kill error trap before this date
+1 NEW XTDH
+2 IF (XTDAT>$HOROLOG)!('XTDAT)
QUIT
+3 SET XTDH=+$GET(XTST,1)-1
+4 FOR
SET XTDH=$ORDER(^%ZTER(1,XTDH))
if (XTDH'>0)!(XTDH'<XTDAT)
QUIT
DO KILLDAY(XTDH)
+5 QUIT
KILLDAY(%H) ;Kill all errors on one day
+1 ;L +^%ZTER(1):60 K ^%ZTER(1,%H),^%ZTER(1,"B",%H) L -^%ZTER(1)
+2 NEW DIK,DA
+3 LOCK +^%ZTER(1,%H):60
SET DIK="^%ZTER(1,"
SET DA=%H
DO ^DIK
LOCK -^%ZTER(1,%H)
+4 QUIT
+5 ;
