%ZTMS5 ;ISF/RWF - TaskMan utility ;2/19/08 13:46
;;8.0;KERNEL;**275,446**;Jul 10, 1995;Build 35
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;Called from ZTMON1, Jobed from %ZTM5.
SUBCHK(DILOCKTM) ;Check for lost submanagers, Update Count
N %C,%N,%J,ZT2,ZT3,TO
I '$D(DILOCKTM) S DILOCKTM=+$G(^DD("DILOCKTM"),0) ;p446
S %N="",MARK=$G(MARK)
F S %N=$O(^%ZTSCH("SUB",%N)) Q:%N="" D
. L +^%ZTSCH("SUB",%N):DILOCKTM
. S %C=0,%J=0,ZT3=$$H3^%ZTM($H)
. F S %J=$O(^%ZTSCH("SUB",%N,%J)) Q:%J'>0 D
. . S ZT2=$$H3^%ZTM($G(^(%J)))
. . ;Check for old
. . I (ZT2+30)<ZT3 K ^%ZTSCH("SUB",%N,%J) Q
. . ;Check for not locked.
. . L +^%ZTSCH("SUBLK",%N,%J):DILOCKTM I $T L -^%ZTSCH("SUBLK",%N,%J) K ^%ZTSCH("SUB",%N,%J) Q
. . S %C=%C+1
. . Q
. S ^%ZTSCH("SUB",%N)=%C
. L -^%ZTSCH("SUB",%N)
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTMS5 850 printed Dec 13, 2024@02:16:31 Page 2
%ZTMS5 ;ISF/RWF - TaskMan utility ;2/19/08 13:46
+1 ;;8.0;KERNEL;**275,446**;Jul 10, 1995;Build 35
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;Called from ZTMON1, Jobed from %ZTM5.
SUBCHK(DILOCKTM) ;Check for lost submanagers, Update Count
+1 NEW %C,%N,%J,ZT2,ZT3,TO
+2 ;p446
IF '$DATA(DILOCKTM)
SET DILOCKTM=+$GET(^DD("DILOCKTM"),0)
+3 SET %N=""
SET MARK=$GET(MARK)
+4 FOR
SET %N=$ORDER(^%ZTSCH("SUB",%N))
if %N=""
QUIT
Begin DoDot:1
+5 LOCK +^%ZTSCH("SUB",%N):DILOCKTM
+6 SET %C=0
SET %J=0
SET ZT3=$$H3^%ZTM($HOROLOG)
+7 FOR
SET %J=$ORDER(^%ZTSCH("SUB",%N,%J))
if %J'>0
QUIT
Begin DoDot:2
+8 SET ZT2=$$H3^%ZTM($GET(^(%J)))
+9 ;Check for old
+10 IF (ZT2+30)<ZT3
KILL ^%ZTSCH("SUB",%N,%J)
QUIT
+11 ;Check for not locked.
+12 LOCK +^%ZTSCH("SUBLK",%N,%J):DILOCKTM
IF $TEST
LOCK -^%ZTSCH("SUBLK",%N,%J)
KILL ^%ZTSCH("SUB",%N,%J)
QUIT
+13 SET %C=%C+1
+14 QUIT
End DoDot:2
+15 SET ^%ZTSCH("SUB",%N)=%C
+16 LOCK -^%ZTSCH("SUB",%N)
+17 QUIT
End DoDot:1
+18 QUIT
