XUTMHR ;ISF/RWF - Taskman Hourly checkup routine. ;10/20/10 17:13
;;8.0;KERNEL;**446,534,554**;Jul 10, 1995;Build 4
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
HOUR ;Work to do each hour
D SCAN ;Look for scheduled task that have dropped there schedule.
D DEVREJ() ;Check for tasks re-scheduled for unavailable device.
Q
;
SCAN ;Scan the Scheduled Tasks file. Merge with XUTMCS sometime.
N D0,OLD,NOW,X,X1,X2,Z0,Z4,Z5,TK
;Make NOW 10 minute in the past
S U="^",D0=0,NOW=$$HTFM^XLFDT($$HADD^XLFDT($H,,,-10)),OLD=$$HTFM^XLFDT($H-1)
F S D0=$O(^DIC(19.2,D0)) Q:'D0 D L -^DIC(19.2,D0)
. L +^DIC(19.2,D0):2 I '$T Q
. S X=$G(^DIC(19.2,D0,0)),X1=+$G(^(1)) ;X1 is the task #.
. ;Check that the Option still exists.
. I '($D(^DIC(19,+X,0))#2) D REMOVE(D0) Q
. I $P(X,U,2)="" Q ;No Scheduled time.
. ;Lock the Task
. L +^%ZTSK(X1):5 I $T D L -^%ZTSK(X1)
. . ;I $P(X,U,9)["S" Q ;Start-up.
. . I $P(X,U,2)>NOW,$D(^%ZTSK(X1)) Q ;Scheduled for future
. . ;ToDo Check if Device OK.
. . I X1,'$D(^%ZTSK(X1)) D FIX(D0,X) Q ;%ZTSK entry missing
. . S TK=$G(^%ZTSK(X1,0))
. . I $P(X,U,2)>OLD,$L($P(X,U,6)) D FIX(D0,X,$P(TK,U,3)) Q ;
. . Q
. Q
S ZTREQ="@"
Q
;
FIX(DA,X,USER) ;Reschedule
N FDA,IEN,Y,DUZ
S Y=$$APFIND^XUSAP("TASKMAN,PROXY USER")
S DUZ=$S($G(USER):USER,Y>0:Y,1:.5)
S Y=$$SCH^XLFDT($P(X,U,6),$P(X,U,2),1),IEN=DA_"," Q:'Y
S FDA(19.2,IEN,2)=Y
D FILE^DIE("K","FDA")
Q
;
REMOVE(DA) ;Remove if pointed to option is missing
N DIK
S DIK="^DIC(19.2," D ^DIK
Q
;
DEVREJ(SKIP) ;Rejected Device cleanup
N ZTSK,ZTDTH,CNT,VOL,Y,TRY,X,Z,XMB,XMY
D GETENV^%ZOSV S VOL=$P(Y,U,2),Y=$O(^%ZIS(14.5,"B",VOL,0)) Q:'Y
S TRY=$P(^%ZIS(14.5,Y,0),U,12),SKIP=$G(SKIP) Q:'TRY
S ZTDTH=0
F S ZTDTH=$O(^%ZTSCH(ZTDTH)),ZTSK=0 Q:'ZTDTH F S ZTSK=$O(^%ZTSCH(ZTDTH,ZTSK)) Q:'ZTSK D
. L +^%ZTSK(ZTSK):5 Q:'$T D ;Catch next time. p554
. . Q:'$D(^%ZTSK(ZTSK,0))
. . S Z=^%ZTSK(ZTSK,0),Y=$G(^%ZTSK(ZTSK,.2)),X=$P(Y,U,8)
. . I X>TRY D UNSCH(ZTSK,$P(Z,U,3),$S($L($P(Y,U,6)):$P(Y,U,6),1:$P(Y,U)),SKIP)
. . Q
. L -^%ZTSK(ZTSK)
. Q
Q
;
UNSCH(ZTSK,DZ,DEV,SKIP) ;Unschedule Task and send alert
N XQA,XQAMSG,XQADATA,XQAROU
D DQ^%ZTLOAD
S XQA(DZ)="",XQAMSG="Your task #"_ZTSK_" was unscheduled, because it could not get device "_DEV,XQADATA=ZTSK,XQAROU="XQA^XUTMUTL"
I 'SKIP D SETUP^XQALERT Q
W !,XQAMSG
Q
;
EN(ZTQPARAM) ;So can job it to run.
;
SNAP ;Snapshot ZTMON data into the TASKMAN SNAPSHOT file.
S U="^"
N %,FDA,I2,I3,IEN,NOWH3,R2,R3,SI,X,ZT1,ZT2,ZT3,ZT4,ZT5,ZTC,ZTC2,ZTQ1,ZTQ2
S ZTQPARAM=$G(ZTQPARAM,"60,60") ;Default run for 60 minutes, snap every minute
S ZTQ1=+ZTQPARAM*60 ;Convert minutes to seconds.
S:ZTQ1>480 ZTQ1=480 ;Max 8 hours
S ZTQ2=+$P(ZTQPARAM,",",2)
S ZTQ2=$S(ZTQ2<2:2,ZTQ2>ZTQ1:ZTQ1,1:ZTQ2) ;See in bounds
;
F D SN2 S ZTQ1=ZTQ1-ZTQ2 Q:'ZTQ1 H ZTQ2
Q
;
SN2 ;Do the snapshot
K IEN,FDA,%,R2,R3,SI,I2,I3
S IEN="+1,",NOWH3=$$H3^%ZTM($H)
S FDA(14.72,IEN,.01)=$$NOW^XLFDT
S FDA(14.72,IEN,2)=$$TM^ZTLOAD
S ZT1="",ZT2=0,SI=101,R2=14.72101
;Get the Manager status data
F S ZT1=$O(^%ZTSCH("STATUS",ZT1)) Q:ZT1="" S X=^(ZT1) D
. S ZT2=ZT2+1,I2="+"_SI_","_IEN,SI=SI+1
. S FDA(R2,I2,.01)=ZT1,FDA(R2,I2,2)=$P(X,U),FDA(R2,I2,3)=$P(X,U,2)
. S FDA(R2,I2,4)=$P(X,U,3),FDA(R2,I2,5)=$P(X,U,4)
. Q
S FDA(14.72,IEN,3)=ZT2
;Check and get the LOAD Balance data
S %=$G(^%ZTSCH("LOAD")),FDA(14.72,IEN,4)=$P(%,U),FDA(14.72,IEN,5)=$P(%,U,2)
;S ZT1=$O(^%ZTSCH(1)),FDA(14.72,IEN,8)=$$LATE(ZT1,NOWH3)
S ZT1=1,ZT2=0,ZT3=0,ZTC=0,ZTC2=0,ZT5=0
;Look at the task schedule list
;ZT3 late amount, ZT5 is current time late, ZTC2 is count of late tasks.
F S ZT1=$O(^%ZTSCH(ZT1)),ZT2=0 Q:'ZT1 S ZT5=$$LATE(ZT1,NOWH3) S:'ZT3 ZT3=ZT5 D
. F S ZT2=$O(^%ZTSCH(ZT1,ZT2)) Q:'ZT2 S ZTC=ZTC+1 S:ZT5 ZTC2=ZTC2+1
S FDA(14.72,IEN,7)=ZTC,FDA(14.72,IEN,8)=ZT3,FDA(14.72,IEN,9)=ZTC2
;Look at the IO list
S ZT1="",ZTC=0
F S ZT1=$O(^%ZTSCH("IO",ZT1)) Q:ZT1="" S:$O(^%ZTSCH("IO",ZT1,0)) ZTC=ZTC+1
S FDA(14.72,IEN,10)=ZTC
S ZT1="",ZT2=0,ZT3=0,ZT4=0,ZTC=0
F S ZT1=$O(^%ZTSCH("IO",ZT1)),ZT2=0 Q:'ZT1 F S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)),ZT3=0 Q:'ZT2 S:'ZT4 ZT4=ZT2 F S ZT3=$O(^%ZTSCH("IO",ZT1,ZT2,ZT3)) Q:ZT3="" S ZTC=ZTC+1
S FDA(14.72,IEN,11)=ZTC,FDA(14.72,IEN,12)=ZT4
;Look at the JOB list
S ZT1=0,ZT2=0,ZT3=0,ZTC=0
F S ZT1=$O(^%ZTSCH("JOB",ZT1)),ZT2=0 Q:'ZT1 F S ZT2=$O(^%ZTSCH("JOB",ZT1,ZT2)) Q:'ZT2 S ZTC=ZTC+1
;Look at the C list
S ZT1="",ZT2=0,ZT3=0
F S ZT1=$O(^%ZTSCH("C",ZT1)),ZT2=0 Q:ZT1="" F S ZT2=$O(^%ZTSCH("C",ZT1,ZT2)),ZT3=0 Q:ZT2="" F S ZT3=$O(^%ZTSCH("C",ZT1,ZT2,ZT3)) Q:ZT3="" S ZTC=ZTC+1
S FDA(14.72,IEN,15)=ZTC
S FDA(14.72,IEN,16)=$$LATE($O(^%ZTSCH("JOB",1)),NOWH3)
;Look at the running Task list
S ZT1=0,ZT2=0,ZT3=0,ZTC=0
F S ZT1=$O(^%ZTSCH("TASK",ZT1)) Q:'ZT1 S ZTC=ZTC+1
S FDA(14.72,IEN,20)=ZTC
;Look at the SUB-Managers
S ZT1=0,ZT2=0,ZT3=0,ZTC=0,R3=14.72201,SI=201
F S ZT1=$O(^%ZTSCH("SUB",ZT1)),ZT2=0 Q:'$L(ZT1) F S ZT2=$O(^%ZTSCH("SUB",ZT1,ZT2)) Q:'ZT2 S X=^(ZT2) D
. S ZTC=ZTC+1,I3="+"_SI_","_IEN,SI=SI+1
. S FDA(R3,I3,.01)=ZT2,FDA(R3,I3,2)=$P(X,U),FDA(R3,I3,3)=$P(X,U,2),FDA(R3,I3,4)=$P(X,U,3),FDA(R3,I3,5)=ZT1
. Q
S FDA(14.72,IEN,19)=ZTC
S FDA(14.72,IEN,22)=$$ACTJ^%ZOSV() ;Total jobs
;Now save the data.
L +^%ZIS(14.72,0):10 D UPDATE^DIE("S","FDA") L -^%ZIS(14.72,0)
I $D(^TMP("DIERR",$J)) D ^%ZTER
Q
;
LATE(T1,NOW) ;Return if a H3 time is Late
S:T1["," T1=$$H3^%ZTM(T1)
Q $S(T1<1:0,T1<NOW:NOW-T1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMHR 5578 printed Sep 23, 2025@19:49:32 Page 2
XUTMHR ;ISF/RWF - Taskman Hourly checkup routine. ;10/20/10 17:13
+1 ;;8.0;KERNEL;**446,534,554**;Jul 10, 1995;Build 4
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
HOUR ;Work to do each hour
+1 ;Look for scheduled task that have dropped there schedule.
DO SCAN
+2 ;Check for tasks re-scheduled for unavailable device.
DO DEVREJ()
+3 QUIT
+4 ;
SCAN ;Scan the Scheduled Tasks file. Merge with XUTMCS sometime.
+1 NEW D0,OLD,NOW,X,X1,X2,Z0,Z4,Z5,TK
+2 ;Make NOW 10 minute in the past
+3 SET U="^"
SET D0=0
SET NOW=$$HTFM^XLFDT($$HADD^XLFDT($HOROLOG,,,-10))
SET OLD=$$HTFM^XLFDT($HOROLOG-1)
+4 FOR
SET D0=$ORDER(^DIC(19.2,D0))
if 'D0
QUIT
Begin DoDot:1
+5 LOCK +^DIC(19.2,D0):2
IF '$TEST
QUIT
+6 ;X1 is the task #.
SET X=$GET(^DIC(19.2,D0,0))
SET X1=+$GET(^(1))
+7 ;Check that the Option still exists.
+8 IF '($DATA(^DIC(19,+X,0))#2)
DO REMOVE(D0)
QUIT
+9 ;No Scheduled time.
IF $PIECE(X,U,2)=""
QUIT
+10 ;Lock the Task
+11 LOCK +^%ZTSK(X1):5
IF $TEST
Begin DoDot:2
+12 ;I $P(X,U,9)["S" Q ;Start-up.
+13 ;Scheduled for future
IF $PIECE(X,U,2)>NOW
IF $DATA(^%ZTSK(X1))
QUIT
+14 ;ToDo Check if Device OK.
+15 ;%ZTSK entry missing
IF X1
IF '$DATA(^%ZTSK(X1))
DO FIX(D0,X)
QUIT
+16 SET TK=$GET(^%ZTSK(X1,0))
+17 ;
IF $PIECE(X,U,2)>OLD
IF $LENGTH($PIECE(X,U,6))
DO FIX(D0,X,$PIECE(TK,U,3))
QUIT
+18 QUIT
End DoDot:2
LOCK -^%ZTSK(X1)
+19 QUIT
End DoDot:1
LOCK -^DIC(19.2,D0)
+20 SET ZTREQ="@"
+21 QUIT
+22 ;
FIX(DA,X,USER) ;Reschedule
+1 NEW FDA,IEN,Y,DUZ
+2 SET Y=$$APFIND^XUSAP("TASKMAN,PROXY USER")
+3 SET DUZ=$SELECT($GET(USER):USER,Y>0:Y,1:.5)
+4 SET Y=$$SCH^XLFDT($PIECE(X,U,6),$PIECE(X,U,2),1)
SET IEN=DA_","
if 'Y
QUIT
+5 SET FDA(19.2,IEN,2)=Y
+6 DO FILE^DIE("K","FDA")
+7 QUIT
+8 ;
REMOVE(DA) ;Remove if pointed to option is missing
+1 NEW DIK
+2 SET DIK="^DIC(19.2,"
DO ^DIK
+3 QUIT
+4 ;
DEVREJ(SKIP) ;Rejected Device cleanup
+1 NEW ZTSK,ZTDTH,CNT,VOL,Y,TRY,X,Z,XMB,XMY
+2 DO GETENV^%ZOSV
SET VOL=$PIECE(Y,U,2)
SET Y=$ORDER(^%ZIS(14.5,"B",VOL,0))
if 'Y
QUIT
+3 SET TRY=$PIECE(^%ZIS(14.5,Y,0),U,12)
SET SKIP=$GET(SKIP)
if 'TRY
QUIT
+4 SET ZTDTH=0
+5 FOR
SET ZTDTH=$ORDER(^%ZTSCH(ZTDTH))
SET ZTSK=0
if 'ZTDTH
QUIT
FOR
SET ZTSK=$ORDER(^%ZTSCH(ZTDTH,ZTSK))
if 'ZTSK
QUIT
Begin DoDot:1
+6 ;Catch next time. p554
LOCK +^%ZTSK(ZTSK):5
if '$TEST
QUIT
Begin DoDot:2
+7 if '$DATA(^%ZTSK(ZTSK,0))
QUIT
+8 SET Z=^%ZTSK(ZTSK,0)
SET Y=$GET(^%ZTSK(ZTSK,.2))
SET X=$PIECE(Y,U,8)
+9 IF X>TRY
DO UNSCH(ZTSK,$PIECE(Z,U,3),$SELECT($LENGTH($PIECE(Y,U,6)):$PIECE(Y,U,6),1:$PIECE(Y,U)),SKIP)
+10 QUIT
End DoDot:2
+11 LOCK -^%ZTSK(ZTSK)
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
UNSCH(ZTSK,DZ,DEV,SKIP) ;Unschedule Task and send alert
+1 NEW XQA,XQAMSG,XQADATA,XQAROU
+2 DO DQ^%ZTLOAD
+3 SET XQA(DZ)=""
SET XQAMSG="Your task #"_ZTSK_" was unscheduled, because it could not get device "_DEV
SET XQADATA=ZTSK
SET XQAROU="XQA^XUTMUTL"
+4 IF 'SKIP
DO SETUP^XQALERT
QUIT
+5 WRITE !,XQAMSG
+6 QUIT
+7 ;
EN(ZTQPARAM) ;So can job it to run.
+1 ;
SNAP ;Snapshot ZTMON data into the TASKMAN SNAPSHOT file.
+1 SET U="^"
+2 NEW %,FDA,I2,I3,IEN,NOWH3,R2,R3,SI,X,ZT1,ZT2,ZT3,ZT4,ZT5,ZTC,ZTC2,ZTQ1,ZTQ2
+3 ;Default run for 60 minutes, snap every minute
SET ZTQPARAM=$GET(ZTQPARAM,"60,60")
+4 ;Convert minutes to seconds.
SET ZTQ1=+ZTQPARAM*60
+5 ;Max 8 hours
if ZTQ1>480
SET ZTQ1=480
+6 SET ZTQ2=+$PIECE(ZTQPARAM,",",2)
+7 ;See in bounds
SET ZTQ2=$SELECT(ZTQ2<2:2,ZTQ2>ZTQ1:ZTQ1,1:ZTQ2)
+8 ;
+9 FOR
DO SN2
SET ZTQ1=ZTQ1-ZTQ2
if 'ZTQ1
QUIT
HANG ZTQ2
+10 QUIT
+11 ;
SN2 ;Do the snapshot
+1 KILL IEN,FDA,%,R2,R3,SI,I2,I3
+2 SET IEN="+1,"
SET NOWH3=$$H3^%ZTM($HOROLOG)
+3 SET FDA(14.72,IEN,.01)=$$NOW^XLFDT
+4 SET FDA(14.72,IEN,2)=$$TM^ZTLOAD
+5 SET ZT1=""
SET ZT2=0
SET SI=101
SET R2=14.72101
+6 ;Get the Manager status data
+7 FOR
SET ZT1=$ORDER(^%ZTSCH("STATUS",ZT1))
if ZT1=""
QUIT
SET X=^(ZT1)
Begin DoDot:1
+8 SET ZT2=ZT2+1
SET I2="+"_SI_","_IEN
SET SI=SI+1
+9 SET FDA(R2,I2,.01)=ZT1
SET FDA(R2,I2,2)=$PIECE(X,U)
SET FDA(R2,I2,3)=$PIECE(X,U,2)
+10 SET FDA(R2,I2,4)=$PIECE(X,U,3)
SET FDA(R2,I2,5)=$PIECE(X,U,4)
+11 QUIT
End DoDot:1
+12 SET FDA(14.72,IEN,3)=ZT2
+13 ;Check and get the LOAD Balance data
+14 SET %=$GET(^%ZTSCH("LOAD"))
SET FDA(14.72,IEN,4)=$PIECE(%,U)
SET FDA(14.72,IEN,5)=$PIECE(%,U,2)
+15 ;S ZT1=$O(^%ZTSCH(1)),FDA(14.72,IEN,8)=$$LATE(ZT1,NOWH3)
+16 SET ZT1=1
SET ZT2=0
SET ZT3=0
SET ZTC=0
SET ZTC2=0
SET ZT5=0
+17 ;Look at the task schedule list
+18 ;ZT3 late amount, ZT5 is current time late, ZTC2 is count of late tasks.
+19 FOR
SET ZT1=$ORDER(^%ZTSCH(ZT1))
SET ZT2=0
if 'ZT1
QUIT
SET ZT5=$$LATE(ZT1,NOWH3)
if 'ZT3
SET ZT3=ZT5
Begin DoDot:1
+20 FOR
SET ZT2=$ORDER(^%ZTSCH(ZT1,ZT2))
if 'ZT2
QUIT
SET ZTC=ZTC+1
if ZT5
SET ZTC2=ZTC2+1
End DoDot:1
+21 SET FDA(14.72,IEN,7)=ZTC
SET FDA(14.72,IEN,8)=ZT3
SET FDA(14.72,IEN,9)=ZTC2
+22 ;Look at the IO list
+23 SET ZT1=""
SET ZTC=0
+24 FOR
SET ZT1=$ORDER(^%ZTSCH("IO",ZT1))
if ZT1=""
QUIT
if $ORDER(^%ZTSCH("IO",ZT1,0))
SET ZTC=ZTC+1
+25 SET FDA(14.72,IEN,10)=ZTC
+26 SET ZT1=""
SET ZT2=0
SET ZT3=0
SET ZT4=0
SET ZTC=0
+27 FOR
SET ZT1=$ORDER(^%ZTSCH("IO",ZT1))
SET ZT2=0
if 'ZT1
QUIT
FOR
SET ZT2=$ORDER(^%ZTSCH("IO",ZT1,ZT2))
SET ZT3=0
if 'ZT2
QUIT
if 'ZT4
SET ZT4=ZT2
FOR
SET ZT3=$ORDER(^%ZTSCH("IO",ZT1,ZT2,ZT3))
if ZT3=""
QUIT
SET ZTC=ZTC+1
+28 SET FDA(14.72,IEN,11)=ZTC
SET FDA(14.72,IEN,12)=ZT4
+29 ;Look at the JOB list
+30 SET ZT1=0
SET ZT2=0
SET ZT3=0
SET ZTC=0
+31 FOR
SET ZT1=$ORDER(^%ZTSCH("JOB",ZT1))
SET ZT2=0
if 'ZT1
QUIT
FOR
SET ZT2=$ORDER(^%ZTSCH("JOB",ZT1,ZT2))
if 'ZT2
QUIT
SET ZTC=ZTC+1
+32 ;Look at the C list
+33 SET ZT1=""
SET ZT2=0
SET ZT3=0
+34 FOR
SET ZT1=$ORDER(^%ZTSCH("C",ZT1))
SET ZT2=0
if ZT1=""
QUIT
FOR
SET ZT2=$ORDER(^%ZTSCH("C",ZT1,ZT2))
SET ZT3=0
if ZT2=""
QUIT
FOR
SET ZT3=$ORDER(^%ZTSCH("C",ZT1,ZT2,ZT3))
if ZT3=""
QUIT
SET ZTC=ZTC+1
+35 SET FDA(14.72,IEN,15)=ZTC
+36 SET FDA(14.72,IEN,16)=$$LATE($ORDER(^%ZTSCH("JOB",1)),NOWH3)
+37 ;Look at the running Task list
+38 SET ZT1=0
SET ZT2=0
SET ZT3=0
SET ZTC=0
+39 FOR
SET ZT1=$ORDER(^%ZTSCH("TASK",ZT1))
if 'ZT1
QUIT
SET ZTC=ZTC+1
+40 SET FDA(14.72,IEN,20)=ZTC
+41 ;Look at the SUB-Managers
+42 SET ZT1=0
SET ZT2=0
SET ZT3=0
SET ZTC=0
SET R3=14.72201
SET SI=201
+43 FOR
SET ZT1=$ORDER(^%ZTSCH("SUB",ZT1))
SET ZT2=0
if '$LENGTH(ZT1)
QUIT
FOR
SET ZT2=$ORDER(^%ZTSCH("SUB",ZT1,ZT2))
if 'ZT2
QUIT
SET X=^(ZT2)
Begin DoDot:1
+44 SET ZTC=ZTC+1
SET I3="+"_SI_","_IEN
SET SI=SI+1
+45 SET FDA(R3,I3,.01)=ZT2
SET FDA(R3,I3,2)=$PIECE(X,U)
SET FDA(R3,I3,3)=$PIECE(X,U,2)
SET FDA(R3,I3,4)=$PIECE(X,U,3)
SET FDA(R3,I3,5)=ZT1
+46 QUIT
End DoDot:1
+47 SET FDA(14.72,IEN,19)=ZTC
+48 ;Total jobs
SET FDA(14.72,IEN,22)=$$ACTJ^%ZOSV()
+49 ;Now save the data.
+50 LOCK +^%ZIS(14.72,0):10
DO UPDATE^DIE("S","FDA")
LOCK -^%ZIS(14.72,0)
+51 IF $DATA(^TMP("DIERR",$JOB))
DO ^%ZTER
+52 QUIT
+53 ;
LATE(T1,NOW) ;Return if a H3 time is Late
+1 if T1[","
SET T1=$$H3^%ZTM(T1)
+2 QUIT $SELECT(T1<1:0,T1<NOW:NOW-T1,1:0)
