XUTMK ;SEA/RDS - Taskman: Option, ZTMCLEAN/ZTMQCLEAN ;11/1/07 14:44
;;8.0;KERNEL;**49,67,118,169,222,275,446**;Jul 10, 1995;Build 35
;
SETUP ;Setup Variables And Synchronize ^%ZTSK With ^%ZTSCH
S ZTDTH=0
F S ZTDTH=$O(^%ZTSCH(ZTDTH)) Q:'ZTDTH F ZTS=0:0 S ZTS=$O(^%ZTSCH(ZTDTH,ZTS)) Q:'ZTS D
. L +^%ZTSK(ZTS):2 Q:'$T K:$D(^%ZTSK(ZTS,0))[0 ^%ZTSK(ZTS),^%ZTSCH(ZTDTH,ZTS)
. S:$D(^%ZTSK(ZTS,0))#2 $P(^(0),U,6)=$$H0^%ZTM(ZTDTH)
. L -^%ZTSK(ZTS) Q
I $D(ZTKEEP)#2 G SX
S ZTKEEP="",ZTV=^%ZOSF("VOL"),ZTI=$O(^%ZIS(14.5,"B",ZTV,""))
I ZTI]"",$D(^%ZIS(14.5,ZTI,0))#2 S ZTKEEP=$P(^(0),U,9)
SX S:ZTKEEP="" ZTKEEP=7 S ZTKEEP=$H-ZTKEEP,ZTCNT=0,ZTMAX=100,ZTS=.9
;
CLEAN ;Delete Obsolete Entries
I '(ZTCNT#20),$$S^%ZTLOAD S ZTSTOP=1 Q
S ZTS=$O(^%ZTSK(ZTS)) I 'ZTS G FINAL
S ZTMAX=ZTS,ZTCNT=ZTCNT+1
L +^%ZTSK(ZTS):0 I '$T G CLEAN
I $D(^%ZTSK(ZTS,0))[0 K ^%ZTSK(ZTS) W:'$D(ZTQUEUED) "." G NEXT
;
1 ;keep active tasks
I $D(^%ZTSCH("TASK",ZTS)) G NEXT
S ZTREC=^%ZTSK(ZTS,0),ZTDTH=$P(ZTREC,U,6) I ZTDTH="" G 2
S:ZTDTH'["," ZTDTH=$$H0^%ZTM(ZTDTH) S ZTDTH3=$$H3^%ZTM(ZTDTH)
I $D(^%ZTSCH(ZTDTH3,ZTS)) G NEXT
I $D(^%ZTSCH("JOB",ZTDTH3,ZTS)) G NEXT
S ZTCNTPU=$P(ZTREC,U,14),ZTIO=$P($G(^%ZTSK(ZTS,.2)),U,2)
I ZTCNTPU]"",$D(^%ZTSCH("LINK",ZTCNTPU,ZTDTH3,ZTS)) G NEXT
I ZTIO]"",$D(^%ZTSCH("IO",ZTIO,ZTDTH3,ZTS)) G NEXT
;
2 ;keep young inactive tasks
S Z1=$G(^%ZTSK(ZTS,.1))
I Z1]"",$P(Z1,U,8),$H'>$P(Z1,U,8) G NEXT ;Remember Until
S ZTF=$S($P(Z1,U)="":0,"135AG"[$P(Z1,U):0,1:$P(Z1,U,2)'<ZTKEEP) ;Last status update
S ZTF=$S(ZTF:ZTF,ZTDTH="":0,1:ZTDTH'<+ZTKEEP) ;Run time
S ZTF=$S(ZTF:ZTF,$P(ZTREC,U,5)="":0,1:$P(ZTREC,U,5)'<+ZTKEEP) ;creation date
I ZTF G NEXT
;
3 ;delete old inactive tasks
K ^%ZTSK(ZTS) W:'$D(ZTQUEUED) "."
;
NEXT L -^%ZTSK(ZTS)
G CLEAN
;
FINAL ;Final Steps.
L +^%ZTSK(-1) ;lock top
S $P(^%ZTSK(0),"^",3,4)=ZTMAX_"^"_ZTCNT
I ^%ZTSK(-1)>9000000 S ^%ZTSK(-1)=100
L -^%ZTSK(-1)
D CLIST,TASK,SUB,CLEARIO,MONITOR
;Call TM error purge
S %=$$PURGE^XUTMKE(0,ZTKEEP,"")
;Clear bad time
K ^%ZTSCH(0)
K ZT,ZTDTH,ZTF,ZTI,ZTKEEP,ZTS,ZTV
Q
;
CLIST ;Clean up the C list
S ZT1=""
F S ZT1=$O(^%ZTSCH("C",ZT1)),ZT2="" Q:ZT1="" F S ZT2=$O(^%ZTSCH("C",ZT1,ZT2)),ZT3="" Q:ZT2="" D
. F S ZT3=$O(^%ZTSCH("C",ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^%ZTSK(ZT3,0))[0 K ^%ZTSCH("C",ZT1,ZT2,ZT3)
. Q
Q
TASK ;Clean the TASK nodes.
N ZT1,ZT2
F ZT1=0:0 S ZT1=$O(^%ZTSCH("TASK",ZT1)) Q:ZT1'>0 D
. L +^%ZTSCH("TASK",ZT1):0 Q:'$T
. S ZT2=$G(^%ZTSCH("TASK",ZT1)),$P(ZT2,U,5)=$G(^(ZT1,1))
. L -^%ZTSCH("TASK",ZT1)
. I ZT2="^^^^" K ^%ZTSCH("TASK",ZT1) Q
. I $D(^%ZTSCH("TASK",ZT1,"P")) Q ;Persistent tasks
. I "^XMAD^"[(U_$E($P(ZT2,U,2),1,4)_U) Q
. I $H-$P(ZT2,U,5)>4 K ^%ZTSCH("TASK",ZT1)
. Q
Q
;
SUB ;Sync the SUB nodes
D SUBCHK^%ZTMS5($G(DILOCKTM,2))
Q
CLEARIO ;Clear any empty IO lists
L +^%ZTSCH("IO"):5 Q:'$T
S ^%ZTSCH("WAIT","MGR")="XUTMK",^%ZTSCH("WAIT","SUB")="XUTMK"
L -^%ZTSCH("IO")
N %ZTIO,%ZTPAIR S %ZTIO="" H 10 ;Let jobs see flag
F S %ZTIO=$O(^%ZTSCH("IO",%ZTIO)) Q:%ZTIO="" D
. I $D(^%ZTSCH("IO",%ZTIO))=1 D
. . K ^%ZTSCH("DEVTRY",%ZTIO)
. . I $G(^%ZTSCH("IO",%ZTIO))="RES" Q ;Leave Resource devices
. . K ^%ZTSCH("IO",%ZTIO)
. Q
;Now Clear and empty "C" lists
S %ZTPAIR=""
F S %ZTPAIR=$O(^%ZTSCH("C",%ZTPAIR)) Q:%ZTPAIR="" D
. I $O(^%ZTSCH("C",%ZTPAIR,0))="" K ^%ZTSCH("C",%ZTPAIR)
. Q
K ^%ZTSCH("WAIT","MGR"),^%ZTSCH("WAIT","SUB")
Q
;
MONITOR ;Move any Monitor data,
N ZT1,ZT2,ZR,ZR2,IEN,ZFDA,X,DA,DIK
I '($D(^%ZIS(14.71,0))#2) S ^%ZIS(14.71,0)="TASKMAN MONITOR^14.71D^"
S ZT1="",IEN=0,ZR=$NA(^%ZTSCH("MON"))
F S ZT1=$O(@ZR@(ZT1)),ZT2=0 Q:ZT1="" D
. F S ZT2=$O(@ZR@(ZT1,ZT2)) Q:ZT2="" D
. . S IEN=IEN+1,ZR2=$NA(ZFDA(14.71,"+"_IEN_","))
. . S Y=@ZR@(ZT1,ZT2)
. . S @ZR2@(.01)=$$HTFM^XLFDT(ZT2),@ZR2@(2)=ZT1
. . F I=3:1:26 S @ZR2@(I)=$P(Y,U,I-2)
. . D UPDATE^DIE("","ZFDA")
. . K @ZR@(ZT1,ZT2),ZFDA ;Clear Global and Local.
. . Q
. Q
;Remove old data
S ZT1=0,ZR2=$$HTFM^XLFDT($H-365)
F S ZT1=$O(^%ZIS(14.71,ZT1)) Q:'ZT1 S ZT2=$G(^(ZT1,0)) Q:$P(ZT2,U)>ZR2 D
. S DA=ZT1,DIK="^%ZIS(14.71," D ^DIK
. Q
Q
;
OPTION ;Entry Point For ZTMCLEAN Option
W !!,"This option queues a task to clean up the Task file."
W !,"All tasks that have been inactive for a certain number of days are deleted.",!
;
ZTKEEP ;ask user how long to keep inactive tasks
S DIR(0)="NA^0:365",DIR("A")="Number of days to save inactive tasks: ",DIR("B")=""
S ZTV=^%ZOSF("VOL"),ZTI=$O(^%ZIS(14.5,"B",ZTV,""))
I ZTI]"",$D(^%ZIS(14.5,ZTI,0))#2 S DIR("B")=$P(^(0),U,9)
I DIR("B")="" S DIR("B")=7
S DIR("?")=" Answer must be an integer between 0 and 365",DIR("??")="^D HELP1^XUTMK"
D ^DIR W:$D(DTOUT) $C(7)
K DIR,DIRUT,DTOUT,DUOUT,ZTI,ZTV
I Y'=0&'Y K %,X,Y D NOTQED Q
S ZTKEEP=Y
;
ZTDTH ;ask user when to start the cleanup
S DIR(0)="DA^::AERSX",DIR("A")="Start time for cleanup task: ",DIR("B")="NOW"
S DIR("?")=" Answer must be a date and time",DIR("??")="^D HELP2^XUTMK"
D ^DIR W:$D(DTOUT) $C(7)
K DIR,DIRUT,DTOUT,DUOUT
I 'Y K %,X,Y D NOTQED Q
S ZTDTH=Y
;
QUEUE ;queue the cleanup task
S ZTRTN="XUTMK",ZTIO="",ZTDESC="TaskMan: clean the Task file",ZTSAVE("ZTKEEP")=""
D ^%ZTLOAD
W !!?5,"Task file cleanup queued!" H 1
K ZTSK Q
;
HELP1 ;ZTKEEP--?? help for first prompt
W !!?5,"Answer how many days inactive tasks should be kept."
W !?5,"Any task currently scheduled, waiting, or running is still active."
Q
;
HELP2 ;ZTDTH--?? help for second prompt
W !!?5,"Answer exactly when the task should begin the cleanup."
Q
;
NOTQED ;OPTION--feedback when task is canceled
W !!?5,"Task file cleanup NOT queued!" H 1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMK 5764 printed Oct 16, 2024@18:14:06 Page 2
XUTMK ;SEA/RDS - Taskman: Option, ZTMCLEAN/ZTMQCLEAN ;11/1/07 14:44
+1 ;;8.0;KERNEL;**49,67,118,169,222,275,446**;Jul 10, 1995;Build 35
+2 ;
SETUP ;Setup Variables And Synchronize ^%ZTSK With ^%ZTSCH
+1 SET ZTDTH=0
+2 FOR
SET ZTDTH=$ORDER(^%ZTSCH(ZTDTH))
if 'ZTDTH
QUIT
FOR ZTS=0:0
SET ZTS=$ORDER(^%ZTSCH(ZTDTH,ZTS))
if 'ZTS
QUIT
Begin DoDot:1
+3 LOCK +^%ZTSK(ZTS):2
if '$TEST
QUIT
if $DATA(^%ZTSK(ZTS,0))[0
KILL ^%ZTSK(ZTS),^%ZTSCH(ZTDTH,ZTS)
+4 if $DATA(^%ZTSK(ZTS,0))#2
SET $PIECE(^(0),U,6)=$$H0^%ZTM(ZTDTH)
+5 LOCK -^%ZTSK(ZTS)
QUIT
End DoDot:1
+6 IF $DATA(ZTKEEP)#2
GOTO SX
+7 SET ZTKEEP=""
SET ZTV=^%ZOSF("VOL")
SET ZTI=$ORDER(^%ZIS(14.5,"B",ZTV,""))
+8 IF ZTI]""
IF $DATA(^%ZIS(14.5,ZTI,0))#2
SET ZTKEEP=$PIECE(^(0),U,9)
SX if ZTKEEP=""
SET ZTKEEP=7
SET ZTKEEP=$HOROLOG-ZTKEEP
SET ZTCNT=0
SET ZTMAX=100
SET ZTS=.9
+1 ;
CLEAN ;Delete Obsolete Entries
+1 IF '(ZTCNT#20)
IF $$S^%ZTLOAD
SET ZTSTOP=1
QUIT
+2 SET ZTS=$ORDER(^%ZTSK(ZTS))
IF 'ZTS
GOTO FINAL
+3 SET ZTMAX=ZTS
SET ZTCNT=ZTCNT+1
+4 LOCK +^%ZTSK(ZTS):0
IF '$TEST
GOTO CLEAN
+5 IF $DATA(^%ZTSK(ZTS,0))[0
KILL ^%ZTSK(ZTS)
if '$DATA(ZTQUEUED)
WRITE "."
GOTO NEXT
+6 ;
1 ;keep active tasks
+1 IF $DATA(^%ZTSCH("TASK",ZTS))
GOTO NEXT
+2 SET ZTREC=^%ZTSK(ZTS,0)
SET ZTDTH=$PIECE(ZTREC,U,6)
IF ZTDTH=""
GOTO 2
+3 if ZTDTH'[","
SET ZTDTH=$$H0^%ZTM(ZTDTH)
SET ZTDTH3=$$H3^%ZTM(ZTDTH)
+4 IF $DATA(^%ZTSCH(ZTDTH3,ZTS))
GOTO NEXT
+5 IF $DATA(^%ZTSCH("JOB",ZTDTH3,ZTS))
GOTO NEXT
+6 SET ZTCNTPU=$PIECE(ZTREC,U,14)
SET ZTIO=$PIECE($GET(^%ZTSK(ZTS,.2)),U,2)
+7 IF ZTCNTPU]""
IF $DATA(^%ZTSCH("LINK",ZTCNTPU,ZTDTH3,ZTS))
GOTO NEXT
+8 IF ZTIO]""
IF $DATA(^%ZTSCH("IO",ZTIO,ZTDTH3,ZTS))
GOTO NEXT
+9 ;
2 ;keep young inactive tasks
+1 SET Z1=$GET(^%ZTSK(ZTS,.1))
+2 ;Remember Until
IF Z1]""
IF $PIECE(Z1,U,8)
IF $HOROLOG'>$PIECE(Z1,U,8)
GOTO NEXT
+3 ;Last status update
SET ZTF=$SELECT($PIECE(Z1,U)="":0,"135AG"[$PIECE(Z1,U):0,1:$PIECE(Z1,U,2)'<ZTKEEP)
+4 ;Run time
SET ZTF=$SELECT(ZTF:ZTF,ZTDTH="":0,1:ZTDTH'<+ZTKEEP)
+5 ;creation date
SET ZTF=$SELECT(ZTF:ZTF,$PIECE(ZTREC,U,5)="":0,1:$PIECE(ZTREC,U,5)'<+ZTKEEP)
+6 IF ZTF
GOTO NEXT
+7 ;
3 ;delete old inactive tasks
+1 KILL ^%ZTSK(ZTS)
if '$DATA(ZTQUEUED)
WRITE "."
+2 ;
NEXT LOCK -^%ZTSK(ZTS)
+1 GOTO CLEAN
+2 ;
FINAL ;Final Steps.
+1 ;lock top
LOCK +^%ZTSK(-1)
+2 SET $PIECE(^%ZTSK(0),"^",3,4)=ZTMAX_"^"_ZTCNT
+3 IF ^%ZTSK(-1)>9000000
SET ^%ZTSK(-1)=100
+4 LOCK -^%ZTSK(-1)
+5 DO CLIST
DO TASK
DO SUB
DO CLEARIO
DO MONITOR
+6 ;Call TM error purge
+7 SET %=$$PURGE^XUTMKE(0,ZTKEEP,"")
+8 ;Clear bad time
+9 KILL ^%ZTSCH(0)
+10 KILL ZT,ZTDTH,ZTF,ZTI,ZTKEEP,ZTS,ZTV
+11 QUIT
+12 ;
CLIST ;Clean up the C list
+1 SET ZT1=""
+2 FOR
SET ZT1=$ORDER(^%ZTSCH("C",ZT1))
SET ZT2=""
if ZT1=""
QUIT
FOR
SET ZT2=$ORDER(^%ZTSCH("C",ZT1,ZT2))
SET ZT3=""
if ZT2=""
QUIT
Begin DoDot:1
+3 FOR
SET ZT3=$ORDER(^%ZTSCH("C",ZT1,ZT2,ZT3))
if ZT3=""
QUIT
IF $DATA(^%ZTSK(ZT3,0))[0
KILL ^%ZTSCH("C",ZT1,ZT2,ZT3)
+4 QUIT
End DoDot:1
+5 QUIT
TASK ;Clean the TASK nodes.
+1 NEW ZT1,ZT2
+2 FOR ZT1=0:0
SET ZT1=$ORDER(^%ZTSCH("TASK",ZT1))
if ZT1'>0
QUIT
Begin DoDot:1
+3 LOCK +^%ZTSCH("TASK",ZT1):0
if '$TEST
QUIT
+4 SET ZT2=$GET(^%ZTSCH("TASK",ZT1))
SET $PIECE(ZT2,U,5)=$GET(^(ZT1,1))
+5 LOCK -^%ZTSCH("TASK",ZT1)
+6 IF ZT2="^^^^"
KILL ^%ZTSCH("TASK",ZT1)
QUIT
+7 ;Persistent tasks
IF $DATA(^%ZTSCH("TASK",ZT1,"P"))
QUIT
+8 IF "^XMAD^"[(U_$EXTRACT($PIECE(ZT2,U,2),1,4)_U)
QUIT
+9 IF $HOROLOG-$PIECE(ZT2,U,5)>4
KILL ^%ZTSCH("TASK",ZT1)
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
SUB ;Sync the SUB nodes
+1 DO SUBCHK^%ZTMS5($GET(DILOCKTM,2))
+2 QUIT
CLEARIO ;Clear any empty IO lists
+1 LOCK +^%ZTSCH("IO"):5
if '$TEST
QUIT
+2 SET ^%ZTSCH("WAIT","MGR")="XUTMK"
SET ^%ZTSCH("WAIT","SUB")="XUTMK"
+3 LOCK -^%ZTSCH("IO")
+4 ;Let jobs see flag
NEW %ZTIO,%ZTPAIR
SET %ZTIO=""
HANG 10
+5 FOR
SET %ZTIO=$ORDER(^%ZTSCH("IO",%ZTIO))
if %ZTIO=""
QUIT
Begin DoDot:1
+6 IF $DATA(^%ZTSCH("IO",%ZTIO))=1
Begin DoDot:2
+7 KILL ^%ZTSCH("DEVTRY",%ZTIO)
+8 ;Leave Resource devices
IF $GET(^%ZTSCH("IO",%ZTIO))="RES"
QUIT
+9 KILL ^%ZTSCH("IO",%ZTIO)
End DoDot:2
+10 QUIT
End DoDot:1
+11 ;Now Clear and empty "C" lists
+12 SET %ZTPAIR=""
+13 FOR
SET %ZTPAIR=$ORDER(^%ZTSCH("C",%ZTPAIR))
if %ZTPAIR=""
QUIT
Begin DoDot:1
+14 IF $ORDER(^%ZTSCH("C",%ZTPAIR,0))=""
KILL ^%ZTSCH("C",%ZTPAIR)
+15 QUIT
End DoDot:1
+16 KILL ^%ZTSCH("WAIT","MGR"),^%ZTSCH("WAIT","SUB")
+17 QUIT
+18 ;
MONITOR ;Move any Monitor data,
+1 NEW ZT1,ZT2,ZR,ZR2,IEN,ZFDA,X,DA,DIK
+2 IF '($DATA(^%ZIS(14.71,0))#2)
SET ^%ZIS(14.71,0)="TASKMAN MONITOR^14.71D^"
+3 SET ZT1=""
SET IEN=0
SET ZR=$NAME(^%ZTSCH("MON"))
+4 FOR
SET ZT1=$ORDER(@ZR@(ZT1))
SET ZT2=0
if ZT1=""
QUIT
Begin DoDot:1
+5 FOR
SET ZT2=$ORDER(@ZR@(ZT1,ZT2))
if ZT2=""
QUIT
Begin DoDot:2
+6 SET IEN=IEN+1
SET ZR2=$NAME(ZFDA(14.71,"+"_IEN_","))
+7 SET Y=@ZR@(ZT1,ZT2)
+8 SET @ZR2@(.01)=$$HTFM^XLFDT(ZT2)
SET @ZR2@(2)=ZT1
+9 FOR I=3:1:26
SET @ZR2@(I)=$PIECE(Y,U,I-2)
+10 DO UPDATE^DIE("","ZFDA")
+11 ;Clear Global and Local.
KILL @ZR@(ZT1,ZT2),ZFDA
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 ;Remove old data
+15 SET ZT1=0
SET ZR2=$$HTFM^XLFDT($HOROLOG-365)
+16 FOR
SET ZT1=$ORDER(^%ZIS(14.71,ZT1))
if 'ZT1
QUIT
SET ZT2=$GET(^(ZT1,0))
if $PIECE(ZT2,U)>ZR2
QUIT
Begin DoDot:1
+17 SET DA=ZT1
SET DIK="^%ZIS(14.71,"
DO ^DIK
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
OPTION ;Entry Point For ZTMCLEAN Option
+1 WRITE !!,"This option queues a task to clean up the Task file."
+2 WRITE !,"All tasks that have been inactive for a certain number of days are deleted.",!
+3 ;
ZTKEEP ;ask user how long to keep inactive tasks
+1 SET DIR(0)="NA^0:365"
SET DIR("A")="Number of days to save inactive tasks: "
SET DIR("B")=""
+2 SET ZTV=^%ZOSF("VOL")
SET ZTI=$ORDER(^%ZIS(14.5,"B",ZTV,""))
+3 IF ZTI]""
IF $DATA(^%ZIS(14.5,ZTI,0))#2
SET DIR("B")=$PIECE(^(0),U,9)
+4 IF DIR("B")=""
SET DIR("B")=7
+5 SET DIR("?")=" Answer must be an integer between 0 and 365"
SET DIR("??")="^D HELP1^XUTMK"
+6 DO ^DIR
if $DATA(DTOUT)
WRITE $CHAR(7)
+7 KILL DIR,DIRUT,DTOUT,DUOUT,ZTI,ZTV
+8 IF Y'=0&'Y
KILL %,X,Y
DO NOTQED
QUIT
+9 SET ZTKEEP=Y
+10 ;
ZTDTH ;ask user when to start the cleanup
+1 SET DIR(0)="DA^::AERSX"
SET DIR("A")="Start time for cleanup task: "
SET DIR("B")="NOW"
+2 SET DIR("?")=" Answer must be a date and time"
SET DIR("??")="^D HELP2^XUTMK"
+3 DO ^DIR
if $DATA(DTOUT)
WRITE $CHAR(7)
+4 KILL DIR,DIRUT,DTOUT,DUOUT
+5 IF 'Y
KILL %,X,Y
DO NOTQED
QUIT
+6 SET ZTDTH=Y
+7 ;
QUEUE ;queue the cleanup task
+1 SET ZTRTN="XUTMK"
SET ZTIO=""
SET ZTDESC="TaskMan: clean the Task file"
SET ZTSAVE("ZTKEEP")=""
+2 DO ^%ZTLOAD
+3 WRITE !!?5,"Task file cleanup queued!"
HANG 1
+4 KILL ZTSK
QUIT
+5 ;
HELP1 ;ZTKEEP--?? help for first prompt
+1 WRITE !!?5,"Answer how many days inactive tasks should be kept."
+2 WRITE !?5,"Any task currently scheduled, waiting, or running is still active."
+3 QUIT
+4 ;
HELP2 ;ZTDTH--?? help for second prompt
+1 WRITE !!?5,"Answer exactly when the task should begin the cleanup."
+2 QUIT
+3 ;
NOTQED ;OPTION--feedback when task is canceled
+1 WRITE !!?5,"Task file cleanup NOT queued!"
HANG 1
+2 QUIT
+3 ;
