- XTERPUR ;ISC-SF.SEA/JLI - DELETE ENTRIES FROM ERROR TRAP ;02/11/11
- ;;8.0;KERNEL;**243,431**;Jul 10, 1995;Build 38
- ;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
- ;
- XTERPUR ;ISC-SF.SEA/JLI - DELETE ENTRIES FROM ERROR TRAP ;02/11/11
- +1 ;;8.0;KERNEL;**243,431**;Jul 10, 1995;Build 38
- +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 ;
