source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUTMK.m@ 1800

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1XUTMK ;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 ;
4SETUP ;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)
13SX S:ZTKEEP="" ZTKEEP=7 S ZTKEEP=$H-ZTKEEP,ZTCNT=0,ZTMAX=100,ZTS=.9
14 ;
15CLEAN ;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 ;
221 ;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 ;
322 ;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 ;
403 ;delete old inactive tasks
41 K ^%ZTSK(ZTS) W:'$D(ZTQUEUED) "."
42 ;
43NEXT L -^%ZTSK(ZTS)
44 G CLEAN
45 ;
46FINAL ;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 ;
59CLIST ;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
65TASK ;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 ;
78SUB ;Sync the SUB nodes
79 D SUBCHK^%ZTMS5
80 Q
81CLEARIO ;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 ;
100MONITOR ;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 ;
115OPTION ;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 ;
119ZTKEEP ;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 ;
130ZTDTH ;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 ;
138QUEUE ;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 ;
144HELP1 ;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 ;
149HELP2 ;ZTDTH--?? help for second prompt
150 W !!?5,"Answer exactly when the task should begin the cleanup."
151 Q
152 ;
153NOTQED ;OPTION--feedback when task is canceled
154 W !!?5,"Task file cleanup NOT queued!" H 1
155 Q
156 ;
Note: See TracBrowser for help on using the repository browser.