1 | XUTMK ;SEA/RDS - Taskman: Option, ZTMCLEAN/ZTMQCLEAN ;01/13/2004 16:39
|
---|
2 | ;;8.0;KERNEL;**49,67,118,169,222,275**;Jul 10, 1995
|
---|
3 | ;
|
---|
4 | SETUP ;Setup Variables And Synchronize ^%ZTSK With ^%ZTSCH
|
---|
5 | S ZTDTH=0
|
---|
6 | F S ZTDTH=$O(^%ZTSCH(ZTDTH)) Q:'ZTDTH F ZTS=0:0 S ZTS=$O(^%ZTSCH(ZTDTH,ZTS)) Q:'ZTS D
|
---|
7 | . L +^%ZTSK(ZTS):2 Q:'$T K:$D(^%ZTSK(ZTS,0))[0 ^%ZTSK(ZTS),^%ZTSCH(ZTDTH,ZTS)
|
---|
8 | . S:$D(^%ZTSK(ZTS,0))#2 $P(^(0),U,6)=$$H0^%ZTM(ZTDTH)
|
---|
9 | . L -^%ZTSK(ZTS) Q
|
---|
10 | I $D(ZTKEEP)#2 G SX
|
---|
11 | S ZTKEEP="",ZTV=^%ZOSF("VOL"),ZTI=$O(^%ZIS(14.5,"B",ZTV,""))
|
---|
12 | I ZTI]"",$D(^%ZIS(14.5,ZTI,0))#2 S ZTKEEP=$P(^(0),U,9)
|
---|
13 | SX S:ZTKEEP="" ZTKEEP=7 S ZTKEEP=$H-ZTKEEP,ZTCNT=0,ZTMAX=100,ZTS=.9
|
---|
14 | ;
|
---|
15 | CLEAN ;Delete Obsolete Entries
|
---|
16 | I '(ZTCNT#20),$$S^%ZTLOAD S ZTSTOP=1 Q
|
---|
17 | S ZTS=$O(^%ZTSK(ZTS)) I 'ZTS G FINAL
|
---|
18 | S ZTMAX=ZTS,ZTCNT=ZTCNT+1
|
---|
19 | L +^%ZTSK(ZTS):0 I '$T G CLEAN
|
---|
20 | I $D(^%ZTSK(ZTS,0))[0 K ^%ZTSK(ZTS) W:'$D(ZTQUEUED) "." G NEXT
|
---|
21 | ;
|
---|
22 | 1 ;keep active tasks
|
---|
23 | I $D(^%ZTSCH("TASK",ZTS)) G NEXT
|
---|
24 | S ZTREC=^%ZTSK(ZTS,0),ZTDTH=$P(ZTREC,U,6) I ZTDTH="" G 2
|
---|
25 | S:ZTDTH'["," ZTDTH=$$H0^%ZTM(ZTDTH) S ZTDTH3=$$H3^%ZTM(ZTDTH)
|
---|
26 | I $D(^%ZTSCH(ZTDTH3,ZTS)) G NEXT
|
---|
27 | I $D(^%ZTSCH("JOB",ZTDTH3,ZTS)) G NEXT
|
---|
28 | S ZTCNTPU=$P(ZTREC,U,14),ZTIO=$P($G(^%ZTSK(ZTS,.2)),U,2)
|
---|
29 | I ZTCNTPU]"",$D(^%ZTSCH("LINK",ZTCNTPU,ZTDTH3,ZTS)) G NEXT
|
---|
30 | I ZTIO]"",$D(^%ZTSCH("IO",ZTIO,ZTDTH3,ZTS)) G NEXT
|
---|
31 | ;
|
---|
32 | 2 ;keep young inactive tasks
|
---|
33 | S Z1=$G(^%ZTSK(ZTS,.1))
|
---|
34 | I Z1]"",$P(Z1,U,8),$H'>$P(Z1,U,8) G NEXT ;Remember Until
|
---|
35 | S ZTF=$S($P(Z1,U)="":0,"135AG"[$P(Z1,U):0,1:$P(Z1,U,2)'<ZTKEEP) ;Last status update
|
---|
36 | S ZTF=$S(ZTF:ZTF,ZTDTH="":0,1:ZTDTH'<+ZTKEEP) ;Run time
|
---|
37 | S ZTF=$S(ZTF:ZTF,$P(ZTREC,U,5)="":0,1:$P(ZTREC,U,5)'<+ZTKEEP) ;creation date
|
---|
38 | I ZTF G NEXT
|
---|
39 | ;
|
---|
40 | 3 ;delete old inactive tasks
|
---|
41 | K ^%ZTSK(ZTS) W:'$D(ZTQUEUED) "."
|
---|
42 | ;
|
---|
43 | NEXT L -^%ZTSK(ZTS)
|
---|
44 | G CLEAN
|
---|
45 | ;
|
---|
46 | FINAL ;Final Steps.
|
---|
47 | L +^%ZTSK(-1) ;lock top
|
---|
48 | S $P(^%ZTSK(0),"^",3,4)=ZTMAX_"^"_ZTCNT
|
---|
49 | I ^%ZTSK(-1)>9000000 S ^%ZTSK(-1)=100
|
---|
50 | L -^%ZTSK(-1)
|
---|
51 | D CLIST,TASK,SUB,CLEARIO,MONITOR
|
---|
52 | ;Call TM error purge
|
---|
53 | S %=$$PURGE^XUTMKE(0,ZTKEEP,"")
|
---|
54 | ;Clear bad time
|
---|
55 | K ^%ZTSCH(0)
|
---|
56 | K ZT,ZTDTH,ZTF,ZTI,ZTKEEP,ZTS,ZTV
|
---|
57 | Q
|
---|
58 | ;
|
---|
59 | CLIST ;Clean up the C list
|
---|
60 | S ZT1=""
|
---|
61 | F S ZT1=$O(^%ZTSCH("C",ZT1)),ZT2="" Q:ZT1="" F S ZT2=$O(^%ZTSCH("C",ZT1,ZT2)),ZT3="" Q:ZT2="" D
|
---|
62 | . F S ZT3=$O(^%ZTSCH("C",ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^%ZTSK(ZT3,0))[0 K ^%ZTSCH("C",ZT1,ZT2,ZT3)
|
---|
63 | . Q
|
---|
64 | Q
|
---|
65 | TASK ;Clean the TASK nodes.
|
---|
66 | N ZT1,ZT2
|
---|
67 | F ZT1=0:0 S ZT1=$O(^%ZTSCH("TASK",ZT1)) Q:ZT1'>0 D
|
---|
68 | . L +^%ZTSCH("TASK",ZT1):0 Q:'$T
|
---|
69 | . S ZT2=$G(^%ZTSCH("TASK",ZT1)),$P(ZT2,U,5)=$G(^(ZT1,1))
|
---|
70 | . L -^%ZTSCH("TASK",ZT1)
|
---|
71 | . I ZT2="^^^^" K ^%ZTSCH("TASK",ZT1) Q
|
---|
72 | . I $D(^%ZTSCH("TASK",ZT1,"P")) Q ;Persistent tasks
|
---|
73 | . I "^XMAD^"[(U_$E($P(ZT2,U,2),1,4)_U) Q
|
---|
74 | . I $H-$P(ZT2,U,5)>4 K ^%ZTSCH("TASK",ZT1)
|
---|
75 | . Q
|
---|
76 | Q
|
---|
77 | ;
|
---|
78 | SUB ;Sync the SUB nodes
|
---|
79 | D SUBCHK^%ZTMS5
|
---|
80 | Q
|
---|
81 | CLEARIO ;Clear any empty IO lists
|
---|
82 | L +^%ZTSCH("IO"):2 Q:'$T
|
---|
83 | S ^%ZTSCH("WAIT","MGR")="XUTMK",^%ZTSCH("WAIT","SUB")="XUTMK"
|
---|
84 | L -^%ZTSCH("IO")
|
---|
85 | N %ZTIO,%ZTPAIR S %ZTIO="" H 10 ;Let jobs see flag
|
---|
86 | F S %ZTIO=$O(^%ZTSCH("IO",%ZTIO)) Q:%ZTIO="" D
|
---|
87 | . I $D(^%ZTSCH("IO",%ZTIO))=1 D
|
---|
88 | . . K ^%ZTSCH("DEVTRY",%ZTIO)
|
---|
89 | . . I $G(^%ZTSCH("IO",%ZTIO))="RES" Q ;Leave Resource devices
|
---|
90 | . . K ^%ZTSCH("IO",%ZTIO)
|
---|
91 | . Q
|
---|
92 | ;Now Clear and empty "C" lists
|
---|
93 | S %ZTPAIR=""
|
---|
94 | F S %ZTPAIR=$O(^%ZTSCH("C",%ZTPAIR)) Q:%ZTPAIR="" D
|
---|
95 | . I $O(^%ZTSCH("C",%ZTPAIR,0))="" K ^%ZTSCH("C",%ZTPAIR)
|
---|
96 | . Q
|
---|
97 | K ^%ZTSCH("WAIT","MGR"),^%ZTSCH("WAIT","SUB")
|
---|
98 | Q
|
---|
99 | ;
|
---|
100 | MONITOR ;Move any Monitor data,
|
---|
101 | N ZT1,ZT2,ZR,ZR2,IEN,ZFDA,X
|
---|
102 | S ZT1="",IEN=0,ZR=$NA(^%ZTSCH("MON"))
|
---|
103 | F S ZT1=$O(@ZR@(ZT1)),ZT2=0 Q:ZT1="" D
|
---|
104 | . F S ZT2=$O(@ZR@(ZT1,ZT2)) Q:ZT2="" D
|
---|
105 | . . S IEN=IEN+1,ZR2=$NA(ZFDA(14.71,"+"_IEN_","))
|
---|
106 | . . S Y=@ZR@(ZT1,ZT2)
|
---|
107 | . . S @ZR2@(.01)=$$HTFM^XLFDT(ZT2),@ZR2@(2)=ZT1
|
---|
108 | . . F I=3:1:26 S @ZR2@(I)=$P(Y,U,I-2)
|
---|
109 | . . D UPDATE^DIE("","ZFDA")
|
---|
110 | . . K @ZR@(ZT1,ZT2),ZFDA ;Clear Global and Local.
|
---|
111 | . . Q
|
---|
112 | . Q
|
---|
113 | Q
|
---|
114 | ;
|
---|
115 | OPTION ;Entry Point For ZTMCLEAN Option
|
---|
116 | W !!,"This option queues a task to clean up the Task file."
|
---|
117 | W !,"All tasks that have been inactive for a certain number of days are deleted.",!
|
---|
118 | ;
|
---|
119 | ZTKEEP ;ask user how long to keep inactive tasks
|
---|
120 | S DIR(0)="NA^0:365",DIR("A")="Number of days to save inactive tasks: ",DIR("B")=""
|
---|
121 | S ZTV=^%ZOSF("VOL"),ZTI=$O(^%ZIS(14.5,"B",ZTV,""))
|
---|
122 | I ZTI]"",$D(^%ZIS(14.5,ZTI,0))#2 S DIR("B")=$P(^(0),U,9)
|
---|
123 | I DIR("B")="" S DIR("B")=7
|
---|
124 | S DIR("?")=" Answer must be an integer between 0 and 365",DIR("??")="^D HELP1^XUTMK"
|
---|
125 | D ^DIR W:$D(DTOUT) $C(7)
|
---|
126 | K DIR,DIRUT,DTOUT,DUOUT,ZTI,ZTV
|
---|
127 | I Y'=0&'Y K %,X,Y D NOTQED Q
|
---|
128 | S ZTKEEP=Y
|
---|
129 | ;
|
---|
130 | ZTDTH ;ask user when to start the cleanup
|
---|
131 | S DIR(0)="DA^::AERSX",DIR("A")="Start time for cleanup task: ",DIR("B")="NOW"
|
---|
132 | S DIR("?")=" Answer must be a date and time",DIR("??")="^D HELP2^XUTMK"
|
---|
133 | D ^DIR W:$D(DTOUT) $C(7)
|
---|
134 | K DIR,DIRUT,DTOUT,DUOUT
|
---|
135 | I 'Y K %,X,Y D NOTQED Q
|
---|
136 | S ZTDTH=Y
|
---|
137 | ;
|
---|
138 | QUEUE ;queue the cleanup task
|
---|
139 | S ZTRTN="XUTMK",ZTIO="",ZTDESC="TaskMan: clean the Task file",ZTSAVE("ZTKEEP")=""
|
---|
140 | D ^%ZTLOAD
|
---|
141 | W !!?5,"Task file cleanup queued!" H 1
|
---|
142 | K ZTSK Q
|
---|
143 | ;
|
---|
144 | HELP1 ;ZTKEEP--?? help for first prompt
|
---|
145 | W !!?5,"Answer how many days inactive tasks should be kept."
|
---|
146 | W !?5,"Any task currently scheduled, waiting, or running is still active."
|
---|
147 | Q
|
---|
148 | ;
|
---|
149 | HELP2 ;ZTDTH--?? help for second prompt
|
---|
150 | W !!?5,"Answer exactly when the task should begin the cleanup."
|
---|
151 | Q
|
---|
152 | ;
|
---|
153 | NOTQED ;OPTION--feedback when task is canceled
|
---|
154 | W !!?5,"Task file cleanup NOT queued!" H 1
|
---|
155 | Q
|
---|
156 | ;
|
---|