ZTMS5.m

%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 ---ZTMS5   850     printed  Apr 09, 2024@21:18:07                                                                                                                                                                                                        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