- XUTMKE ;SEA/RDS - Taskman: Option, XUTME LOG* ;09/30/98 10:18 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;8.0;KERNEL;**86**;Jul 10, 1995
- ;
- QUIT ;This Routine Contains Subroutines For Options
- Q
- ;
- PRINT ;LIST Subroutine to Print An Error Log Entry
- N %H S %H=+$H
- Q:$D(^%ZTSCH("ER",ZT2,ZT3))[0
- S ZTE=^%ZTSCH("ER",ZT2,ZT3)
- S %="" F S %=$O(^TMP($J,"XUTM",%)) Q:%="" Q:ZTE[%
- I %'="" S XUSCR=XUSCR+1 Q
- S %=$$HTE^XLFDT(ZT2_","_ZT3)
- I %H-ZT2<2 W !,$S('(ZT2-%H):"TODAY",1:"YESTERDAY")," ",$P(%,"@",2)
- E W !,$P(%,",")," ",$P(%,"@",2)
- F ZT=0:0 Q:ZTE="" W ?20,$E(ZTE,1,60) S ZTE=$E(ZTE,61,999) W !
- S ZTE1=$S($D(^%ZTSCH("ER",ZT2,ZT3,1))[0:"Context unknown.",1:^(1))
- W ?20,"[",ZTE1,"]"
- Q
- ;
- LIST ;Show Error Log
- D HOME^%ZIS:$S($D(IOSL)[0:1,IOSL="":1,$D(IOF)[0:1,1:IOF="")
- N %,%1,%2,%3,I,DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,X3,XUSCR,ZTE,ZTF,ZTI,ZTJ,ZTY
- K ^TMP($J,"XUTM") F I=0:0 S I=$O(^%ZTER(2,"AC",1,I)) Q:I'>0 S %=$S($G(^%ZTER(2,I,2))]"":^(2),1:$P(^(0),U)),^TMP($J,"XUTM",%)=""
- S ZTY=IOSL-3 W @IOF
- I $O(^%ZTSCH("ER",""))="" W !!,"The TaskMan error log is empty." H 1 S Y=1 Q
- W !!!,"Timestamp",?20,"Error Message",!,"-------------------",?20,"------------------------------------------------------------"
- S ZTC=0,ZT2="",XUSCR=0
- F S ZT2=$O(^%ZTSCH("ER",ZT2),-1),ZT3="" Q:ZT2="" D Q:$D(DIRUT)
- . F S ZT3=$O(^%ZTSCH("ER",ZT2,ZT3),-1) Q:ZT3="" D Q:$D(DIRUT)
- . . S ZTC=ZTC+1 D PRINT I $Y>ZTY S DIR(0)="E" D ^DIR Q:$D(DIRUT) W @IOF
- L0 W:ZT2="" !!,?5,"Number Of Entries: ",ZTC,", ",XUSCR," Screened Entries."
- I $D(DTOUT) W $C(7)
- I '$D(DIRUT) W ! S DIR(0)="E",DIR("A")="End of listing. Press RETURN to continue",DIR("?")=" Enter either RETURN or '^'" D ^DIR
- S Y='$D(DUOUT)
- Q
- ;
- KILL ;Delete Error Log
- K ^%ZTSCH("ER") W !,"Done." Q
- ;
- RANGE ;Clean Error Log Over Range Of Dates
- K DIR S %H=$O(^%ZTSCH("ER",""))
- I '%H!'$D(^%ZTSCH("ER")) W $C(7),!!,"Taskman's error log is empty!" S DIR(0)="E",DIR("A")="Press return to continue",DIR("?")=" Press RETURN to exit the option" D ^DIR W:$D(DTOUT) $C(7) K DIR,DIRUT,DTOUT,DUOUT Q
- D YMD^%DTC S Y=X D DD^%DT
- S DIR(0)="D^::AEX"
- S DIR("A")="First date to purge",DIR("B")=Y
- S DIR("?")=" Answer must be a date",DIR("??")="^W ! D HELP^%DTC"
- D ^DIR
- I $D(DTOUT) W $C(7)
- I $D(DIRUT) W !!?5,"NO log entries deleted!" K DIR,DIRUT,DTOUT,DUOUT Q
- K DIR,DIRUT,DTOUT,DUOUT
- ;
- S X=Y D H^%DTC S ZTR1=%H
- D NOW^%DTC S Y=X D DD^%DT
- S DIR(0)="D^::AEX",DIR("A")="Final date to purge",DIR("B")=Y
- D ^DIR
- I $D(DTOUT) W $C(7)
- I $D(DIRUT) W !!?5,"NO log entries deleted!" K DIR,DIRUT,DTOUT,DUOUT Q
- K DIR,DIRUT,DTOUT,DUOUT
- ;
- S X=Y D H^%DTC S ZTR2=%H
- W !!?5,"Entries removed: ",$$PURGE(ZTR1,ZTR2,"")
- W ! S DIR(0)="E",DIR("A")="Press RETURN to continue",DIR("?")=" Press RETURN to exit option" D ^DIR I $D(DTOUT) W $C(7)
- K %,%H,%I,%T,%Y,DIR,DIRUT,DTOUT,DUOUT,X,Y,ZT,ZTR1,ZTR2,ZTX Q
- ;
- PURGE(XUR1,XUR2,CHK) ;PURGE OVER THE RANGE FROM XUR1 TO XUR2
- N ZT1,ZT2,ZT3,ZTC S ZT1="ER",ZT2="",ZTC=0
- F ZT=0:0 S ZT2=$O(^%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2=""!(ZT2>XUR2) I ZT2'<XUR1 D
- . F ZT=0:0 S ZT3=$O(^%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $G(^(ZT3))[CHK K ^%ZTSCH(ZT1,ZT2,ZT3) S ZTC=ZTC+1 W:'$D(ZTQUEUED) "."
- Q ZTC
- TYPE ;Purge Error Log Of Type Of Error
- K DIR I '$O(^%ZTSCH("ER","")) W $C(7),!!,"Taskman's error log is empty!",! S DIR(0)="E",DIR("A")="Press RETURN to continue",DIR("?")="Press RETURN to exit option" D ^DIR W:$D(DTOUT) $C(7) K DIR,DIRUT,DTOUT,DUOUT Q
- F ZTA=0:0 R !,"Type of error to remove: ",X:$S($D(DTIME)#2:DTIME,1:60) S Y=X Q:$L(X)<201&(X'="?")&(X'="??") W !!,?5,"Answer must be a string.",!?5,"Taskman will remove every error that contains that string.",!
- I '$T S DTOUT=1,DIRUT=1 W $C(7),"**TIMEOUT**"
- I X="^" S DUOUT=1,DIRUT=1
- I Y=""!$D(DIRUT) W !!?5,"NO error log entries deleted!" K DIRUT,DTOUT,DUOUT Q
- W !!?5,"Entries removed: ",$$PURGE(0,+$H,Y)
- W ! S DIR(0)="E",DIR("A")="Press RETURN to continue",DIR("?")=" Press RETURN to exit option" D ^DIR K DIR I $D(DTOUT) W $C(7)
- K DIRUT,DTOUT,DUOUT,ZT,ZT1,ZT2,ZT3,ZTC,ZTX Q
- ;
- XUTMKE ;SEA/RDS - Taskman: Option, XUTME LOG* ;09/30/98 10:18 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;**86**;Jul 10, 1995
- +3 ;
- QUIT ;This Routine Contains Subroutines For Options
- +1 QUIT
- +2 ;
- PRINT ;LIST Subroutine to Print An Error Log Entry
- +1 NEW %H
- SET %H=+$HOROLOG
- +2 IF $DATA(^%ZTSCH("ER",ZT2,ZT3))[0
- QUIT
- +3 SET ZTE=^%ZTSCH("ER",ZT2,ZT3)
- +4 SET %=""
- FOR
- SET %=$ORDER(^TMP($JOB,"XUTM",%))
- IF %=""
- QUIT
- IF ZTE[%
- QUIT
- +5 IF %'=""
- SET XUSCR=XUSCR+1
- QUIT
- +6 SET %=$$HTE^XLFDT(ZT2_","_ZT3)
- +7 IF %H-ZT2<2
- WRITE !,$SELECT('(ZT2-%H):"TODAY",1:"YESTERDAY")," ",$PIECE(%,"@",2)
- +8 IF '$TEST
- WRITE !,$PIECE(%,",")," ",$PIECE(%,"@",2)
- +9 FOR ZT=0:0
- IF ZTE=""
- QUIT
- WRITE ?20,$EXTRACT(ZTE,1,60)
- SET ZTE=$EXTRACT(ZTE,61,999)
- WRITE !
- +10 SET ZTE1=$SELECT($DATA(^%ZTSCH("ER",ZT2,ZT3,1))[0:"Context unknown.",1:^(1))
- +11 WRITE ?20,"[",ZTE1,"]"
- +12 QUIT
- +13 ;
- LIST ;Show Error Log
- +1 IF $SELECT($DATA(IOSL)[0:1,IOSL="":1,$DATA(IOF)[0:1,1:IOF="")
- DO HOME^%ZIS
- +2 NEW %,%1,%2,%3,I,DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,X3,XUSCR,ZTE,ZTF,ZTI,ZTJ,ZTY
- +3 KILL ^TMP($JOB,"XUTM")
- FOR I=0:0
- SET I=$ORDER(^%ZTER(2,"AC",1,I))
- IF I'>0
- QUIT
- SET %=$SELECT($GET(^%ZTER(2,I,2))]"":^(2),1:$PIECE(^(0),U))
- SET ^TMP($JOB,"XUTM",%)=""
- +4 SET ZTY=IOSL-3
- WRITE @IOF
- +5 IF $ORDER(^%ZTSCH("ER",""))=""
- WRITE !!,"The TaskMan error log is empty."
- HANG 1
- SET Y=1
- QUIT
- +6 WRITE !!!,"Timestamp",?20,"Error Message",!,"-------------------",?20,"------------------------------------------------------------"
- +7 SET ZTC=0
- SET ZT2=""
- SET XUSCR=0
- +8 FOR
- SET ZT2=$ORDER(^%ZTSCH("ER",ZT2),-1)
- SET ZT3=""
- IF ZT2=""
- QUIT
- Begin DoDot:1
- +9 FOR
- SET ZT3=$ORDER(^%ZTSCH("ER",ZT2,ZT3),-1)
- IF ZT3=""
- QUIT
- Begin DoDot:2
- +10 SET ZTC=ZTC+1
- DO PRINT
- IF $Y>ZTY
- SET DIR(0)="E"
- DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- WRITE @IOF
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- L0 IF ZT2=""
- WRITE !!,?5,"Number Of Entries: ",ZTC,", ",XUSCR," Screened Entries."
- +1 IF $DATA(DTOUT)
- WRITE $CHAR(7)
- +2 IF '$DATA(DIRUT)
- WRITE !
- SET DIR(0)="E"
- SET DIR("A")="End of listing. Press RETURN to continue"
- SET DIR("?")=" Enter either RETURN or '^'"
- DO ^DIR
- +3 SET Y='$DATA(DUOUT)
- +4 QUIT
- +5 ;
- KILL ;Delete Error Log
- +1 KILL ^%ZTSCH("ER")
- WRITE !,"Done."
- QUIT
- +2 ;
- RANGE ;Clean Error Log Over Range Of Dates
- +1 KILL DIR
- SET %H=$ORDER(^%ZTSCH("ER",""))
- +2 IF '%H!'$DATA(^%ZTSCH("ER"))
- WRITE $CHAR(7),!!,"Taskman's error log is empty!"
- SET DIR(0)="E"
- SET DIR("A")="Press return to continue"
- SET DIR("?")=" Press RETURN to exit the option"
- DO ^DIR
- IF $DATA(DTOUT)
- WRITE $CHAR(7)
- KILL DIR,DIRUT,DTOUT,DUOUT
- QUIT
- +3 DO YMD^%DTC
- SET Y=X
- DO DD^%DT
- +4 SET DIR(0)="D^::AEX"
- +5 SET DIR("A")="First date to purge"
- SET DIR("B")=Y
- +6 SET DIR("?")=" Answer must be a date"
- SET DIR("??")="^W ! D HELP^%DTC"
- +7 DO ^DIR
- +8 IF $DATA(DTOUT)
- WRITE $CHAR(7)
- +9 IF $DATA(DIRUT)
- WRITE !!?5,"NO log entries deleted!"
- KILL DIR,DIRUT,DTOUT,DUOUT
- QUIT
- +10 KILL DIR,DIRUT,DTOUT,DUOUT
- +11 ;
- +12 SET X=Y
- DO H^%DTC
- SET ZTR1=%H
- +13 DO NOW^%DTC
- SET Y=X
- DO DD^%DT
- +14 SET DIR(0)="D^::AEX"
- SET DIR("A")="Final date to purge"
- SET DIR("B")=Y
- +15 DO ^DIR
- +16 IF $DATA(DTOUT)
- WRITE $CHAR(7)
- +17 IF $DATA(DIRUT)
- WRITE !!?5,"NO log entries deleted!"
- KILL DIR,DIRUT,DTOUT,DUOUT
- QUIT
- +18 KILL DIR,DIRUT,DTOUT,DUOUT
- +19 ;
- +20 SET X=Y
- DO H^%DTC
- SET ZTR2=%H
- +21 WRITE !!?5,"Entries removed: ",$$PURGE(ZTR1,ZTR2,"")
- +22 WRITE !
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- SET DIR("?")=" Press RETURN to exit option"
- DO ^DIR
- IF $DATA(DTOUT)
- WRITE $CHAR(7)
- +23 KILL %,%H,%I,%T,%Y,DIR,DIRUT,DTOUT,DUOUT,X,Y,ZT,ZTR1,ZTR2,ZTX
- QUIT
- +24 ;
- PURGE(XUR1,XUR2,CHK) ;PURGE OVER THE RANGE FROM XUR1 TO XUR2
- +1 NEW ZT1,ZT2,ZT3,ZTC
- SET ZT1="ER"
- SET ZT2=""
- SET ZTC=0
- +2 FOR ZT=0:0
- SET ZT2=$ORDER(^%ZTSCH(ZT1,ZT2))
- SET ZT3=""
- IF ZT2=""!(ZT2>XUR2)
- QUIT
- IF ZT2'<XUR1
- Begin DoDot:1
- +3 FOR ZT=0:0
- SET ZT3=$ORDER(^%ZTSCH(ZT1,ZT2,ZT3))
- IF ZT3=""
- QUIT
- IF $GET(^(ZT3))[CHK
- KILL ^%ZTSCH(ZT1,ZT2,ZT3)
- SET ZTC=ZTC+1
- IF '$DATA(ZTQUEUED)
- WRITE "."
- End DoDot:1
- +4 QUIT ZTC
- TYPE ;Purge Error Log Of Type Of Error
- +1 KILL DIR
- IF '$ORDER(^%ZTSCH("ER",""))
- WRITE $CHAR(7),!!,"Taskman's error log is empty!",!
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- SET DIR("?")="Press RETURN to exit option"
- DO ^DIR
- IF $DATA(DTOUT)
- WRITE $CHAR(7)
- KILL DIR,DIRUT,DTOUT,DUOUT
- QUIT
- +2 FOR ZTA=0:0
- READ !,"Type of error to remove: ",X:$SELECT($DATA(DTIME)#2:DTIME,1:60)
- SET Y=X
- IF $LENGTH(X)<201&(X'="?")&(X'="??")
- QUIT
- WRITE !!,?5,"Answer must be a string.",!?5,"Taskman will remove every error that contains that string.",!
- +3 IF '$TEST
- SET DTOUT=1
- SET DIRUT=1
- WRITE $CHAR(7),"**TIMEOUT**"
- +4 IF X="^"
- SET DUOUT=1
- SET DIRUT=1
- +5 IF Y=""!$DATA(DIRUT)
- WRITE !!?5,"NO error log entries deleted!"
- KILL DIRUT,DTOUT,DUOUT
- QUIT
- +6 WRITE !!?5,"Entries removed: ",$$PURGE(0,+$HOROLOG,Y)
- +7 WRITE !
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- SET DIR("?")=" Press RETURN to exit option"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)
- WRITE $CHAR(7)
- +8 KILL DIRUT,DTOUT,DUOUT,ZT,ZT1,ZT2,ZT3,ZTC,ZTX
- QUIT
- +9 ;
