source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUTMKE.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1XUTMKE ;SEA/RDS - Taskman: Option, XUTME LOG* ;09/30/98 10:18
2 ;;8.0;KERNEL;**86**;Jul 10, 1995
3 ;
4QUIT ;This Routine Contains Subroutines For Options
5 Q
6 ;
7PRINT ;LIST Subroutine to Print An Error Log Entry
8 N %H S %H=+$H
9 Q:$D(^%ZTSCH("ER",ZT2,ZT3))[0
10 S ZTE=^%ZTSCH("ER",ZT2,ZT3)
11 S %="" F S %=$O(^TMP($J,"XUTM",%)) Q:%="" Q:ZTE[%
12 I %'="" S XUSCR=XUSCR+1 Q
13 S %=$$HTE^XLFDT(ZT2_","_ZT3)
14 I %H-ZT2<2 W !,$S('(ZT2-%H):"TODAY",1:"YESTERDAY")," ",$P(%,"@",2)
15 E W !,$P(%,",")," ",$P(%,"@",2)
16 F ZT=0:0 Q:ZTE="" W ?20,$E(ZTE,1,60) S ZTE=$E(ZTE,61,999) W !
17 S ZTE1=$S($D(^%ZTSCH("ER",ZT2,ZT3,1))[0:"Context unknown.",1:^(1))
18 W ?20,"[",ZTE1,"]"
19 Q
20 ;
21LIST ;Show Error Log
22 D HOME^%ZIS:$S($D(IOSL)[0:1,IOSL="":1,$D(IOF)[0:1,1:IOF="")
23 N %,%1,%2,%3,I,DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,X3,XUSCR,ZTE,ZTF,ZTI,ZTJ,ZTY
24 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",%)=""
25 S ZTY=IOSL-3 W @IOF
26 I $O(^%ZTSCH("ER",""))="" W !!,"The TaskMan error log is empty." H 1 S Y=1 Q
27 W !!!,"Timestamp",?20,"Error Message",!,"-------------------",?20,"------------------------------------------------------------"
28 S ZTC=0,ZT2="",XUSCR=0
29 F S ZT2=$O(^%ZTSCH("ER",ZT2),-1),ZT3="" Q:ZT2="" D Q:$D(DIRUT)
30 . F S ZT3=$O(^%ZTSCH("ER",ZT2,ZT3),-1) Q:ZT3="" D Q:$D(DIRUT)
31 . . S ZTC=ZTC+1 D PRINT I $Y>ZTY S DIR(0)="E" D ^DIR Q:$D(DIRUT) W @IOF
32L0 W:ZT2="" !!,?5,"Number Of Entries: ",ZTC,", ",XUSCR," Screened Entries."
33 I $D(DTOUT) W $C(7)
34 I '$D(DIRUT) W ! S DIR(0)="E",DIR("A")="End of listing. Press RETURN to continue",DIR("?")=" Enter either RETURN or '^'" D ^DIR
35 S Y='$D(DUOUT)
36 Q
37 ;
38KILL ;Delete Error Log
39 K ^%ZTSCH("ER") W !,"Done." Q
40 ;
41RANGE ;Clean Error Log Over Range Of Dates
42 K DIR S %H=$O(^%ZTSCH("ER",""))
43 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
44 D YMD^%DTC S Y=X D DD^%DT
45 S DIR(0)="D^::AEX"
46 S DIR("A")="First date to purge",DIR("B")=Y
47 S DIR("?")=" Answer must be a date",DIR("??")="^W ! D HELP^%DTC"
48 D ^DIR
49 I $D(DTOUT) W $C(7)
50 I $D(DIRUT) W !!?5,"NO log entries deleted!" K DIR,DIRUT,DTOUT,DUOUT Q
51 K DIR,DIRUT,DTOUT,DUOUT
52 ;
53 S X=Y D H^%DTC S ZTR1=%H
54 D NOW^%DTC S Y=X D DD^%DT
55 S DIR(0)="D^::AEX",DIR("A")="Final date to purge",DIR("B")=Y
56 D ^DIR
57 I $D(DTOUT) W $C(7)
58 I $D(DIRUT) W !!?5,"NO log entries deleted!" K DIR,DIRUT,DTOUT,DUOUT Q
59 K DIR,DIRUT,DTOUT,DUOUT
60 ;
61 S X=Y D H^%DTC S ZTR2=%H
62 W !!?5,"Entries removed: ",$$PURGE(ZTR1,ZTR2,"")
63 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)
64 K %,%H,%I,%T,%Y,DIR,DIRUT,DTOUT,DUOUT,X,Y,ZT,ZTR1,ZTR2,ZTX Q
65 ;
66PURGE(XUR1,XUR2,CHK) ;PURGE OVER THE RANGE FROM XUR1 TO XUR2
67 N ZT1,ZT2,ZT3,ZTC S ZT1="ER",ZT2="",ZTC=0
68 F ZT=0:0 S ZT2=$O(^%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2=""!(ZT2>XUR2) I ZT2'<XUR1 D
69 . 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) "."
70 Q ZTC
71TYPE ;Purge Error Log Of Type Of Error
72 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
73 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.",!
74 I '$T S DTOUT=1,DIRUT=1 W $C(7),"**TIMEOUT**"
75 I X="^" S DUOUT=1,DIRUT=1
76 I Y=""!$D(DIRUT) W !!?5,"NO error log entries deleted!" K DIRUT,DTOUT,DUOUT Q
77 W !!?5,"Entries removed: ",$$PURGE(0,+$H,Y)
78 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)
79 K DIRUT,DTOUT,DUOUT,ZT,ZT1,ZT2,ZT3,ZTC,ZTX Q
80 ;
Note: See TracBrowser for help on using the repository browser.