ZTMON2 ;SEA/RDS-TaskMan: Option, ZTMON, Part 1 (Main Loop) ;2/19/08 13:36
;;8.0;KERNEL;**446**;Jul 10, 1995;Build 35
;Per VHA Directive 2004-038, this routine should not be modified.
;
ENV ;Main Entry Point For Taskman Status Monitor
S U="^"
N %,%H,X,Y,Z,ZT,ZT1,ZT2,ZT3,ZT4,ZTC,ZTCO,ZTD,ZTENV,ZTH,ZTR,ZTUCI,ZTX,ZTY
D HOME^%ZIS
X ^%ZOSF("UCI") S ZTUCI=Y W @IOF
;
RUN ;Evaluate RUN-Node
W @IOF,!,"Checking Taskman."
S ZTH=$H,ZTR=$G(^%ZTSCH("RUN"))
I ZTR>0 S ZTD=$$DIFF^%ZTM(ZTH,ZTR,0)
S ZTY=$S(ZTR="":0,ZTD>15:0,1:1)
W ?20,"Current $H=",ZTH," (",$$HTE^%ZTLOAD7(ZTH),")"
W !,?22,"RUN NODE=",$S(ZTR]"":ZTR,1:"<Undefined>") I ZTR]"" W " (",$$HTE^%ZTLOAD7(ZTR),")"
W !,"Taskman is ",$S(ZTY:"current.",ZTR]"":"late by "_(ZTD-15)_" seconds."_$C(7),$D(^%ZTSCH("STATUS")):"shutting down.",1:"not running."_$C(7))
;
STATUS ;Evaluate Status List
K ZTC S ZT="",ZTH=$$H3^%ZTM($H)
L +^%ZTSCH("LOAD"):0 E W !,"Did not get a LOCK on ^%ZTSCH(""LOAD"")"
F S ZT=$O(^%ZTSCH("LOADA",ZT)) Q:ZT="" S ZTC=^(ZT),ZTC($P(ZTC,U,4))=ZTC
L -^%ZTSCH("LOAD")
W !,"Checking the Status List:",!," Taskman $J status",?22,"time",?33,"weight node"
S ZT1="" F ZT=0:1 S ZT1=$O(^%ZTSCH("STATUS",ZT1)) Q:ZT1="" S %=^(ZT1) D
. W !?2,ZT1 W ?13,$P(%,U,2),?22,$$STIME($P(%,U)) W:$D(ZTC(ZT1)) ?32," ",$J($P(ZTC(ZT1),U,2),4) W ?39," ",$P(%,U,3)
. Q
I 'ZT W !?5,"The Status List is ",$S(ZTY:"temporarily ",1:""),"empty."
;
SCHQ ;Evaluate Schedule List
W !!,"Checking the Schedule List:"
S ZT1=$O(^%ZTSCH(0)),ZTH=$$H3^%ZTM($H)
D OVERDUE(ZT1)
S ZT1=0,ZTCO=0,ZTC=0
F ZT=0:0 S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 D
. L +^%ZTSCH(ZT1):0 W:'$T !,?5,"^%ZTSCH(",ZT1,") is locked" L -^%ZTSCH(ZT1)
. F ZT2=0:0 S ZT2=$O(^%ZTSCH(ZT1,ZT2)) Q:ZT2="" S ZTC=ZTC+1 I $$DIFF^%ZTM(ZTH,ZT1,1)>0 S ZTCO=ZTCO+1
W !?5,"Taskman has ",$S('ZTC:"no",1:ZTC)," task",$S(ZTC'=1:"s",1:"")," scheduled."
I ZTC=1 W !?5,"It is ",$S('ZTCO:"not ",1:""),"overdue."
I ZTC>1 W !?5,$S('ZTCO:"None",ZTCO=ZTC&(ZTCO=2):"Both",ZTCO=ZTC:"All",1:ZTCO)," of them ",$S(ZTCO=1:"is",1:"are")," overdue." W:ZTCO>10 *7
;
CONT ;Continued
D JOB,SUB
G DONE
;
OVERDUE(X1) ;Write how overdue the oldest task is
N ZTH S ZTH=$$H3^%ZTM($H)
I X1>0,X1<ZTH S ZTH=ZTH-X1 W:ZTH>10 " Overdue by ",ZTH
Q
;
JOB ;Evaluate Job List
W !!,"Checking the Job List:"
S ZT1=$O(^%ZTSCH("JOB",0)) D OVERDUE(ZT1)
L +^%ZTSCH("JOBQ"):0 I '$T D
. W !," Did not get the 'JOBQ' lock."
. Q
S ZTC=0,ZT1="" F ZT=0:0 S ZT1=$O(^%ZTSCH("JOB",ZT1)),ZT2=0 Q:ZT1="" F ZT=0:0 S ZT2=$O(^%ZTSCH("JOB",ZT1,ZT2)) Q:'ZT2 S ZTC=ZTC+1
W !?5,"There ",$S(ZTC=0:"are no tasks",ZTC=1:"is 1 task",1:"are "_ZTC_" tasks")," waiting for ",$S(ZTC'=1:"partitions.",1:"a partition.") W:ZTC>20 $C(7)
L -^%ZTSCH("JOBQ")
;
C ;Evaluate Cross CPU list
S ZT1=""
F S ZT1=$O(^%ZTSCH("C",ZT1)) Q:ZT1="" S ZTC=+$G(^(ZT1)) D
. S ZTCO=0,ZT2=""
. F S ZT2=$O(^%ZTSCH("C",ZT1,ZT2)),ZT3=0 Q:ZT2="" F S ZT3=$O(^%ZTSCH("C",ZT1,ZT2,ZT3)) Q:ZT3="" S ZTCO=ZTCO+1
. W !?5,"For ",ZT1," there ",$S(ZTCO=1:"is ",1:"are "),ZTCO," tasks. "
. W $S(ZTC>8:"Not responding",$$OOS^%ZTM(ZT1):"Out Of Service",'$D(^%ZIS(14.7,"B",ZT1)):"Not defined",1:"")
. Q
TASK ;Evaluate Task List
W !!,"Checking the Task List:"
S ZTC=0 F ZT1=0:0 S ZT1=$O(^%ZTSCH("TASK",ZT1)) Q:'ZT1 S ZTC=ZTC+1
W !?5,"There ",$S(ZTC=0:"are no tasks",ZTC=1:"is 1 task",1:"are "_ZTC_" tasks")," currently running."
Q
;
SUB ;Look for idle submanagers
N %,%N,ZT1,ZT2,ZT3,ZT4,ZT5
W !!,"Sub-manager wait detail:"
S %N="",ZT3=$$H3($H)
F S %N=$O(^%ZTSCH("SUB",%N)) Q:%N="" D
. W !,"Node: ",%N
. L +^%ZTSCH("SUB",%N):3 W:'$T !,"Did not get the ^%ZTSCH(""SUB"",",%N,") lock."
. S %=0,ZT1=0,ZT4=$G(^%ZTSCH("LOADA",%N))
. ;W " Weight: ",$P(ZT4,U,2)
. F S ZT1=$O(^%ZTSCH("SUB",%N,ZT1)) Q:ZT1'>0 D
. . W !,?5,"Job: ",ZT1
. . L +^%ZTSCH("SUBLK",%N,ZT1):1 I $T D Q
. . . L -^%ZTSCH("SUBLK",%N,ZT1) Q:'$D(^%ZTSCH("SUB",%N,ZT1))
. . . K ^%ZTSCH("SUB",%N,ZT1)
. . . W " Didn't hold the lock, Removed from table."
. . . Q
. . S ZT5=$G(^(ZT1)),ZT2=$$H3($P(ZT5,U)),ZT3=$$H3($H),ZT5=$P(ZT5,U,2,4)
. . I (ZT2+30)<ZT3 W " Last timestamp >30 sec old, Removed." K ^%ZTSCH("SUB",%N,ZT1) Q
. . S %=%+1 W " ",ZT2-ZT3," ",$S($L(ZT5):" Status: "_ZT5,1:" Looks good.")
. S ^%ZTSCH("SUB",%N)=%
. W !?5,"On node ",%N," there ",$S('%:"are no",%=1:"is 1",1:"are "_$J(%,2))," free Sub-Manager(s)."
. W " ",$S(+ZT4:"Wait",1:"Run")
. I $G(^%ZTSCH("SUB",%N,0))>5 W !?10,"SUB-MANAGERS ARE NOT STARTING."
. L -^%ZTSCH("SUB",%N)
. Q
Q
;
DONE ;Prompt to Quit Or Continue
W !!,"Enter monitor action: UPDATE// "
R ZTR:$S($D(DTIME)#2:DTIME,1:60) S:ZTR="" ZTR="U"
I "Ee"[$E(ZTR) Q:$$CALL("LIST^XUTMKE") G DONE
I "Ss"[$E(ZTR) W @IOF X ^%ZOSF("SS") G DONE
I "Pp"[$E(ZTR) W @IOF D PARAMS^ZTMCHK G DONE
I "Ll"[$E(ZTR) W !! D LIST G DONE
I "Dd"[$E(ZTR) K ^%ZTSCH("UPDATE"),^%ZTSCH("STATUS") W !!,"OK" H 2
I ZTR="^"!(ZTR="@") Q
I ZTR'["?" G RUN^ZTMON2
I ZTR="??" Q:$$CALL("SELECT^XUTMONH") G RUN^ZTMON2
W !!?5,"Enter <RETURN> to update the monitor screen."
W !?5,"Enter ^ to exit the monitor."
W !?5,"Enter E to inspect the TaskMan Error file."
W !?5,"Enter L to see task's in JOB pending status"
W !?5,"Enter P to see Taskman parameters"
W !?5,"Enter S to see a system status listing."
W !?5,"Enter D to cause Taskman to ReRead it parameters."
W !?5,"Enter ? to see this message."
W !?5,"Enter ?? to inspect the tasks in the monitor's lists."
G DONE
;
H3(%) ;Convert $H to seconds.
Q 86400*%+$P(%,",",2)
;
CALL(RTN) ;Check for called routine
N DUOUT
I $D(^DIC(19,0))[0 W !,"In the wrong account." Q 0
D @RTN Q $D(DUOUT)
;
LIST ;Check for tasks in stat 3.
N ZT1,ZT2
S ZT1=0
F S ZT1=$O(^%ZTSK(ZT1)) Q:'ZT1 I 3=+$G(^%ZTSK(ZT1,.1),0) D
. D EN^XUTMTP(ZT1)
W "Done",!
Q
;
STIME(%H) ;Status time
I +$H=+%H Q "T@"_$P($$HTE^%ZTLOAD7(%H),"@",2)
Q "T-"_($H-%H)_"@"_$P($$HTE^%ZTLOAD7(%H),"@",2)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTMON2 5999 printed Sep 23, 2025@19:52:44 Page 2
ZTMON2 ;SEA/RDS-TaskMan: Option, ZTMON, Part 1 (Main Loop) ;2/19/08 13:36
+1 ;;8.0;KERNEL;**446**;Jul 10, 1995;Build 35
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
ENV ;Main Entry Point For Taskman Status Monitor
+1 SET U="^"
+2 NEW %,%H,X,Y,Z,ZT,ZT1,ZT2,ZT3,ZT4,ZTC,ZTCO,ZTD,ZTENV,ZTH,ZTR,ZTUCI,ZTX,ZTY
+3 DO HOME^%ZIS
+4 XECUTE ^%ZOSF("UCI")
SET ZTUCI=Y
WRITE @IOF
+5 ;
RUN ;Evaluate RUN-Node
+1 WRITE @IOF,!,"Checking Taskman."
+2 SET ZTH=$HOROLOG
SET ZTR=$GET(^%ZTSCH("RUN"))
+3 IF ZTR>0
SET ZTD=$$DIFF^%ZTM(ZTH,ZTR,0)
+4 SET ZTY=$SELECT(ZTR="":0,ZTD>15:0,1:1)
+5 WRITE ?20,"Current $H=",ZTH," (",$$HTE^%ZTLOAD7(ZTH),")"
+6 WRITE !,?22,"RUN NODE=",$SELECT(ZTR]"":ZTR,1:"<Undefined>")
IF ZTR]""
WRITE " (",$$HTE^%ZTLOAD7(ZTR),")"
+7 WRITE !,"Taskman is ",$SELECT(ZTY:"current.",ZTR]"":"late by "_(ZTD-15)_" seconds."_$CHAR(7),$DATA(^%ZTSCH("STATUS")):"shutting down.",1:"not running."_$CHAR(7))
+8 ;
STATUS ;Evaluate Status List
+1 KILL ZTC
SET ZT=""
SET ZTH=$$H3^%ZTM($HOROLOG)
+2 LOCK +^%ZTSCH("LOAD"):0
IF '$TEST
WRITE !,"Did not get a LOCK on ^%ZTSCH(""LOAD"")"
+3 FOR
SET ZT=$ORDER(^%ZTSCH("LOADA",ZT))
if ZT=""
QUIT
SET ZTC=^(ZT)
SET ZTC($PIECE(ZTC,U,4))=ZTC
+4 LOCK -^%ZTSCH("LOAD")
+5 WRITE !,"Checking the Status List:",!," Taskman $J status",?22,"time",?33,"weight node"
+6 SET ZT1=""
FOR ZT=0:1
SET ZT1=$ORDER(^%ZTSCH("STATUS",ZT1))
if ZT1=""
QUIT
SET %=^(ZT1)
Begin DoDot:1
+7 WRITE !?2,ZT1
WRITE ?13,$PIECE(%,U,2),?22,$$STIME($PIECE(%,U))
if $DATA(ZTC(ZT1))
WRITE ?32," ",$JUSTIFY($PIECE(ZTC(ZT1),U,2),4)
WRITE ?39," ",$PIECE(%,U,3)
+8 QUIT
End DoDot:1
+9 IF 'ZT
WRITE !?5,"The Status List is ",$SELECT(ZTY:"temporarily ",1:""),"empty."
+10 ;
SCHQ ;Evaluate Schedule List
+1 WRITE !!,"Checking the Schedule List:"
+2 SET ZT1=$ORDER(^%ZTSCH(0))
SET ZTH=$$H3^%ZTM($HOROLOG)
+3 DO OVERDUE(ZT1)
+4 SET ZT1=0
SET ZTCO=0
SET ZTC=0
+5 FOR ZT=0:0
SET ZT1=$ORDER(^%ZTSCH(ZT1))
if 'ZT1
QUIT
Begin DoDot:1
+6 LOCK +^%ZTSCH(ZT1):0
if '$TEST
WRITE !,?5,"^%ZTSCH(",ZT1,") is locked"
LOCK -^%ZTSCH(ZT1)
+7 FOR ZT2=0:0
SET ZT2=$ORDER(^%ZTSCH(ZT1,ZT2))
if ZT2=""
QUIT
SET ZTC=ZTC+1
IF $$DIFF^%ZTM(ZTH,ZT1,1)>0
SET ZTCO=ZTCO+1
End DoDot:1
+8 WRITE !?5,"Taskman has ",$SELECT('ZTC:"no",1:ZTC)," task",$SELECT(ZTC'=1:"s",1:"")," scheduled."
+9 IF ZTC=1
WRITE !?5,"It is ",$SELECT('ZTCO:"not ",1:""),"overdue."
+10 IF ZTC>1
WRITE !?5,$SELECT('ZTCO:"None",ZTCO=ZTC&(ZTCO=2):"Both",ZTCO=ZTC:"All",1:ZTCO)," of them ",$SELECT(ZTCO=1:"is",1:"are")," overdue."
if ZTCO>10
WRITE *7
+11 ;
CONT ;Continued
+1 DO JOB
DO SUB
+2 GOTO DONE
+3 ;
OVERDUE(X1) ;Write how overdue the oldest task is
+1 NEW ZTH
SET ZTH=$$H3^%ZTM($HOROLOG)
+2 IF X1>0
IF X1<ZTH
SET ZTH=ZTH-X1
if ZTH>10
WRITE " Overdue by ",ZTH
+3 QUIT
+4 ;
JOB ;Evaluate Job List
+1 WRITE !!,"Checking the Job List:"
+2 SET ZT1=$ORDER(^%ZTSCH("JOB",0))
DO OVERDUE(ZT1)
+3 LOCK +^%ZTSCH("JOBQ"):0
IF '$TEST
Begin DoDot:1
+4 WRITE !," Did not get the 'JOBQ' lock."
+5 QUIT
End DoDot:1
+6 SET ZTC=0
SET ZT1=""
FOR ZT=0:0
SET ZT1=$ORDER(^%ZTSCH("JOB",ZT1))
SET ZT2=0
if ZT1=""
QUIT
FOR ZT=0:0
SET ZT2=$ORDER(^%ZTSCH("JOB",ZT1,ZT2))
if 'ZT2
QUIT
SET ZTC=ZTC+1
+7 WRITE !?5,"There ",$SELECT(ZTC=0:"are no tasks",ZTC=1:"is 1 task",1:"are "_ZTC_" tasks")," waiting for ",$SELECT(ZTC'=1:"partitions.",1:"a partition.")
if ZTC>20
WRITE $CHAR(7)
+8 LOCK -^%ZTSCH("JOBQ")
+9 ;
C ;Evaluate Cross CPU list
+1 SET ZT1=""
+2 FOR
SET ZT1=$ORDER(^%ZTSCH("C",ZT1))
if ZT1=""
QUIT
SET ZTC=+$GET(^(ZT1))
Begin DoDot:1
+3 SET ZTCO=0
SET ZT2=""
+4 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 ZTCO=ZTCO+1
+5 WRITE !?5,"For ",ZT1," there ",$SELECT(ZTCO=1:"is ",1:"are "),ZTCO," tasks. "
+6 WRITE $SELECT(ZTC>8:"Not responding",$$OOS^%ZTM(ZT1):"Out Of Service",'$DATA(^%ZIS(14.7,"B",ZT1)):"Not defined",1:"")
+7 QUIT
End DoDot:1
TASK ;Evaluate Task List
+1 WRITE !!,"Checking the Task List:"
+2 SET ZTC=0
FOR ZT1=0:0
SET ZT1=$ORDER(^%ZTSCH("TASK",ZT1))
if 'ZT1
QUIT
SET ZTC=ZTC+1
+3 WRITE !?5,"There ",$SELECT(ZTC=0:"are no tasks",ZTC=1:"is 1 task",1:"are "_ZTC_" tasks")," currently running."
+4 QUIT
+5 ;
SUB ;Look for idle submanagers
+1 NEW %,%N,ZT1,ZT2,ZT3,ZT4,ZT5
+2 WRITE !!,"Sub-manager wait detail:"
+3 SET %N=""
SET ZT3=$$H3($HOROLOG)
+4 FOR
SET %N=$ORDER(^%ZTSCH("SUB",%N))
if %N=""
QUIT
Begin DoDot:1
+5 WRITE !,"Node: ",%N
+6 LOCK +^%ZTSCH("SUB",%N):3
if '$TEST
WRITE !,"Did not get the ^%ZTSCH(""SUB"",",%N,") lock."
+7 SET %=0
SET ZT1=0
SET ZT4=$GET(^%ZTSCH("LOADA",%N))
+8 ;W " Weight: ",$P(ZT4,U,2)
+9 FOR
SET ZT1=$ORDER(^%ZTSCH("SUB",%N,ZT1))
if ZT1'>0
QUIT
Begin DoDot:2
+10 WRITE !,?5,"Job: ",ZT1
+11 LOCK +^%ZTSCH("SUBLK",%N,ZT1):1
IF $TEST
Begin DoDot:3
+12 LOCK -^%ZTSCH("SUBLK",%N,ZT1)
if '$DATA(^%ZTSCH("SUB",%N,ZT1))
QUIT
+13 KILL ^%ZTSCH("SUB",%N,ZT1)
+14 WRITE " Didn't hold the lock, Removed from table."
+15 QUIT
End DoDot:3
QUIT
+16 SET ZT5=$GET(^(ZT1))
SET ZT2=$$H3($PIECE(ZT5,U))
SET ZT3=$$H3($HOROLOG)
SET ZT5=$PIECE(ZT5,U,2,4)
+17 IF (ZT2+30)<ZT3
WRITE " Last timestamp >30 sec old, Removed."
KILL ^%ZTSCH("SUB",%N,ZT1)
QUIT
+18 SET %=%+1
WRITE " ",ZT2-ZT3," ",$SELECT($LENGTH(ZT5):" Status: "_ZT5,1:" Looks good.")
End DoDot:2
+19 SET ^%ZTSCH("SUB",%N)=%
+20 WRITE !?5,"On node ",%N," there ",$SELECT('%:"are no",%=1:"is 1",1:"are "_$JUSTIFY(%,2))," free Sub-Manager(s)."
+21 WRITE " ",$SELECT(+ZT4:"Wait",1:"Run")
+22 IF $GET(^%ZTSCH("SUB",%N,0))>5
WRITE !?10,"SUB-MANAGERS ARE NOT STARTING."
+23 LOCK -^%ZTSCH("SUB",%N)
+24 QUIT
End DoDot:1
+25 QUIT
+26 ;
DONE ;Prompt to Quit Or Continue
+1 WRITE !!,"Enter monitor action: UPDATE// "
+2 READ ZTR:$SELECT($DATA(DTIME)#2:DTIME,1:60)
if ZTR=""
SET ZTR="U"
+3 IF "Ee"[$EXTRACT(ZTR)
if $$CALL("LIST^XUTMKE")
QUIT
GOTO DONE
+4 IF "Ss"[$EXTRACT(ZTR)
WRITE @IOF
XECUTE ^%ZOSF("SS")
GOTO DONE
+5 IF "Pp"[$EXTRACT(ZTR)
WRITE @IOF
DO PARAMS^ZTMCHK
GOTO DONE
+6 IF "Ll"[$EXTRACT(ZTR)
WRITE !!
DO LIST
GOTO DONE
+7 IF "Dd"[$EXTRACT(ZTR)
KILL ^%ZTSCH("UPDATE"),^%ZTSCH("STATUS")
WRITE !!,"OK"
HANG 2
+8 IF ZTR="^"!(ZTR="@")
QUIT
+9 IF ZTR'["?"
GOTO RUN^ZTMON2
+10 IF ZTR="??"
if $$CALL("SELECT^XUTMONH")
QUIT
GOTO RUN^ZTMON2
+11 WRITE !!?5,"Enter <RETURN> to update the monitor screen."
+12 WRITE !?5,"Enter ^ to exit the monitor."
+13 WRITE !?5,"Enter E to inspect the TaskMan Error file."
+14 WRITE !?5,"Enter L to see task's in JOB pending status"
+15 WRITE !?5,"Enter P to see Taskman parameters"
+16 WRITE !?5,"Enter S to see a system status listing."
+17 WRITE !?5,"Enter D to cause Taskman to ReRead it parameters."
+18 WRITE !?5,"Enter ? to see this message."
+19 WRITE !?5,"Enter ?? to inspect the tasks in the monitor's lists."
+20 GOTO DONE
+21 ;
H3(%) ;Convert $H to seconds.
+1 QUIT 86400*%+$PIECE(%,",",2)
+2 ;
CALL(RTN) ;Check for called routine
+1 NEW DUOUT
+2 IF $DATA(^DIC(19,0))[0
WRITE !,"In the wrong account."
QUIT 0
+3 DO @RTN
QUIT $DATA(DUOUT)
+4 ;
LIST ;Check for tasks in stat 3.
+1 NEW ZT1,ZT2
+2 SET ZT1=0
+3 FOR
SET ZT1=$ORDER(^%ZTSK(ZT1))
if 'ZT1
QUIT
IF 3=+$GET(^%ZTSK(ZT1,.1),0)
Begin DoDot:1
+4 DO EN^XUTMTP(ZT1)
End DoDot:1
+5 WRITE "Done",!
+6 QUIT
+7 ;
STIME(%H) ;Status time
+1 IF +$HOROLOG=+%H
QUIT "T@"_$PIECE($$HTE^%ZTLOAD7(%H),"@",2)
+2 QUIT "T-"_($HOROLOG-%H)_"@"_$PIECE($$HTE^%ZTLOAD7(%H),"@",2)
