XUTMKE ;SEA/RDS - Taskman: Option, XUTME LOG* ;09/30/98 10:18
;;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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMKE 4045 printed Nov 22, 2024@17:23:28 Page 2
XUTMKE ;SEA/RDS - Taskman: Option, XUTME LOG* ;09/30/98 10:18
+1 ;;8.0;KERNEL;**86**;Jul 10, 1995
+2 ;
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 ;
