Routine: ZTMS

%ZTMS ;SEA/RDS-TaskMan: Submanager, (Entry & Trap) ;09/25/08  16:07

 ;;8.0;KERNEL;**2,18,24,36,67,94,118,127,136,162,275,446**;Jul 10, 1995;Build 44

 ;Per VHA Directive 2004-038, this routine should not be modified.

START ;Bottom level of submanager

 S $ETRAP="D ERROR^%ZTMS HALT"

 D NOW^%DTC S ZTQUEUED=0,U="^",DT=X

 D KMPR("$STRT ZTMS$")

 D PARAMS G:$D(ZTOUT) QUIT

 I ZTPFLG("XUSCNT") D COUNT^XUSCNT(1)

 D SETNM^%ZOSV("Sub "_$J)

 S ^%ZTSCH("SUB",ZTPFLG("HOME"),0)=0

 I $D(^%ZTSCH("STOP","SUB",ZTPAIR)) G QUIT

 I ZTPFLG("XUSCNT") D SETLOCK^XUSCNT($NA(^%ZTSCH("SUBLK",ZTPFLG("HOME"),$J)))

 G SUBMGR^%ZTMS1

KMPR(TAG) ;Call KMPR to log data

N Y

 I +$G(^%ZTSCH("LOGRSRC")) S Y="" X $G(^%ZOSF("UCI")) I Y[^%ZOSF("PROD") D LOGRSRC^%ZOSV(TAG)

QUIT ;Submanager exit

 D KMPR("$STOP ZTMS$")

 I ZTPFLG("XUSCNT") D COUNT^XUSCNT(-1)

PARAMS ;

 ;START--lookup parameters

 S U="^"

 X ^%ZOSF("PRIINQ") S %ZTMS("PRIO")=Y ;Get starting priority

 D GETENV^%ZOSV

 S ZTCPU=$P(Y,U,2),ZTNODE=$P(Y,U,3),ZTPAIR=$P(Y,U,4),ZTUCI=$P(Y,U)_$S(ZTCPU]"":","_ZTCPU,1:"") S:ZTPAIR[":" ZTNODE=$P(ZTPAIR,":",2)

 S ZTPFLG("RT")=0,ZTPFLG("MIN")=1,ZTYPE="",ZTPFLG("ZTREQ")=0

 S ZTPN=$O(^%ZIS(14.7,"B",ZTPAIR,0)),ZTPFLG("ZTPN")=ZTPN

 I ZTPN>0 S %=$G(^%ZIS(14.7,ZTPN,0)) D

 . S ZTPFLG("RT")=+$P(%,U,6),ZTYPE=$P(%,U,9) S:$P(%,U,12)>1 ZTPFLG("MIN")=$P(%,U,12)

 . S ZTPFLG("HOME")=$S($P(%,U,13):$P(^%ZIS(14.7,+$P(%,U,13),0),U),1:ZTPAIR)

 . S ZTPFLG("ZTREQ")=+$G(^%ZIS(14.7,ZTPN,3))

. Q

 S ZTPFLG("XUSCNT")=0 I ^%ZOSF("OS")["GT.M" S ZTPFLG("XUSCNT")=$L($T(^XUSCNT))

 S (ZTPFLG("LOCKTM"),ZTLKTM)=+$G(^DD("DILOCKTM"),0) ;p446

 S ZTPFLG("BalLimit")=$G(^%ZTSCH("BALLIMIT"),100) ;p446

 S X=0 I $L($T(APFIND^XUSAP)) S X=+$$APFIND^XUSAP("TASKMAN,PROXY USER") ;p446

 S ZTPFLG("USER")=$S(X>0:X,1:.5) ;p446

 K ZTMLOG ;Set to log msg about locks

 I "FO"[ZTYPE S ZTOUT=1 Q  ;SM only run on C,P,G types

ERROR ;START--trap

 I $S(^%ZOSF("OS")["GT.M":$ZS["STACKO",1:$ZE["STKOVR"!($ZE["STACK")) S $ET="Q:$ST>"_($ST-8)_"  D ERR2^%ZTMS" Q

 ;set backup trap, prepare to handle error.

ERR2 S $ETRAP="D ERROR2^%ZTMS0 HALT"

 S %ZTERLGR=$$LGR^%ZOSV

 S %ZTME=$$EC^%ZOSV,%ZTMEH=$H

 S %ZTMETSK=$S($D(%ZTTV)#2:$P(%ZTTV,"^",4),$G(ZTSK)>0:ZTSK,1:0)

 I %ZTMETSK L ^%ZTSK(%ZTMETSK):99 ;Unlock all other locks

 I $G(IO)]"" L +^%ZTSCH("DEV",IO):99 ;Keep other tasks from IO device.

 ;Check if to record error

 I '$$SCREEN^%ZTER(%ZTME) D

 . D ^%ZTER ;Kernel error file

 . ;log error and context in TaskMan Error file

 . L +^%ZTSCH("ER"):99 H 1 S %ZTMEH=$H

 . S ^%ZTSCH("ER",+%ZTMEH,$P(%ZTMEH,",",2))=%ZTME

 . D XREF^%ZTMS0

 . S ^%ZTSCH("ER",+%ZTMEH,$P(%ZTMEH,",",2),1)=ZTERROX1

 . L -^%ZTSCH("ER")

. Q

 I $D(ZTDEVOK) S $P(^%ZTSCH("IO"),U,2)=ZTDEVOK ;Have others skip dev.

 ;Update Task file entry

 I $G(ZTQUEUED),%ZTMETSK,$D(^%ZTSK(%ZTMETSK)) D STATUS^%ZTMS0

 I ZTPFLG("XUSCNT") D COUNT^XUSCNT(-1)

 I ZTQUEUED>.9,%ZTMETSK>0,$G(DUZ)>.9,$D(^DD(8992,.01,0)) D

 . S XQA(DUZ)="",XQAMSG="Your task #"_%ZTMETSK_" stopped because of an error",XQADATA=%ZTMETSK,XQAROU="XQA^XUTMUTL"

 . D SETUP^XQALERT Q

CLEAN ;clean up global data related to this process

 I $G(ZTQUEUED)>.9,'$D(^%ZTSCH("TASK",ZTQUEUED,"P")) K ^%ZTSCH("TASK",ZTQUEUED)

 K ^TMP($J),^UTILITY($J),^XUTL("XQ",$J)

 I '$G(ZTQUEUED) D SUB^%ZTMS1(-1)

 I $D(ZTDEVN)#2,$D(%ZTIO)#2,%ZTIO]"" D DEVLK^%ZTMS1(-1,%ZTIO)

 I $D(ZTDEVOK)#2 D DEVBAD^%ZTMS0

 I $G(ZTSYNCFL)]"" S X=$$SYNCFLG^%ZTMS2("S",ZTSYNCFL,"","Stopped because of an error")

CLOSE ;close i/o device after error

 D ERCLOZ^%ZTMS0

 I $G(IO)]"" C IO H 5 ;In case of a port problem give it time to reset.

 D KMPR("$STOP ZTMS$")

 I ZTQUEUED=.5,%ZTMETSK>0,$P($G(^%ZTSK(%ZTMETSK,.12)),"^")<5 D  ;Only try 5 times

 . S $P(^(.12),"^")=^%ZTSK(%ZTMETSK,.12)+1

 . S ^%ZTSCH($$NEWH^%ZTMS2($H,600),%ZTMETSK)=""

 HALT  ;Start a new process to continue

GTM ;Special entry point for GT.M

 S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")

 G START

%ZTMS     ;SEA/RDS-TaskMan: Submanager, (Entry & Trap) ;09/25/08  16:07

 +1       ;;8.0;KERNEL;**2,18,24,36,67,94,118,127,136,162,275,446**;Jul 10, 1995;Build 44

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

START     ;Bottom level of submanager

 +1        SET $ETRAP="D ERROR^%ZTMS HALT"

 +2        DO NOW^%DTC

           SET ZTQUEUED=0

           SET U="^"

           SET DT=X

 +3        DO KMPR("$STRT ZTMS$")

 +4        DO PARAMS

           IF $DATA(ZTOUT)

               GOTO QUIT

 +5        IF ZTPFLG("XUSCNT")

               DO COUNT^XUSCNT(1)

 +6        DO SETNM^%ZOSV("Sub "_$JOB)

 +7        SET ^%ZTSCH("SUB",ZTPFLG("HOME"),0)=0

 +8        IF $DATA(^%ZTSCH("STOP","SUB",ZTPAIR))

               GOTO QUIT

 +9        IF ZTPFLG("XUSCNT")

               DO SETLOCK^XUSCNT($NAME(^%ZTSCH("SUBLK",ZTPFLG("HOME"),$JOB)))

 +10       GOTO SUBMGR^%ZTMS1

 +11      ;

KMPR(TAG) ;Call KMPR to log data

 +1        NEW Y

 +2        IF +$GET(^%ZTSCH("LOGRSRC"))

               SET Y=""

               XECUTE $GET(^%ZOSF("UCI"))

               IF Y[^%ZOSF("PROD")

                   DO LOGRSRC^%ZOSV(TAG)

 +3        QUIT

QUIT      ;Submanager exit

 +1        DO KMPR("$STOP ZTMS$")

 +2        IF ZTPFLG("XUSCNT")

               DO COUNT^XUSCNT(-1)

 +3        QUIT

PARAMS    ;

 +1       ;START--lookup parameters

 +2        SET U="^"

 +3       ;Get starting priority

           XECUTE ^%ZOSF("PRIINQ")

           SET %ZTMS("PRIO")=Y

 +4        DO GETENV^%ZOSV

 +5        SET ZTCPU=$PIECE(Y,U,2)

           SET ZTNODE=$PIECE(Y,U,3)

           SET ZTPAIR=$PIECE(Y,U,4)

           SET ZTUCI=$PIECE(Y,U)_$SELECT(ZTCPU]"":","_ZTCPU,1:"")

           IF ZTPAIR["

               SET ZTNODE=$PIECE(ZTPAIR,":",2)

 +6        SET ZTPFLG("RT")=0

           SET ZTPFLG("MIN")=1

           SET ZTYPE=""

           SET ZTPFLG("ZTREQ")=0

 +7        SET ZTPN=$ORDER(^%ZIS(14.7,"B",ZTPAIR,0))

           SET ZTPFLG("ZTPN")=ZTPN

 +8        IF ZTPN>0

               SET %=$GET(^%ZIS(14.7,ZTPN,0))

               Begin DoDot:1

 +9                SET ZTPFLG("RT")=+$PIECE(%,U,6)

                   SET ZTYPE=$PIECE(%,U,9)

                   IF $PIECE(%,U,12)>1

                       SET ZTPFLG("MIN")=$PIECE(%,U,12)

 +10               SET ZTPFLG("HOME")=$SELECT($PIECE(%,U,13):$PIECE(^%ZIS(14.7,+$PIECE(%,U,13),0),U),1:ZTPAIR)

 +11               SET ZTPFLG("ZTREQ")=+$GET(^%ZIS(14.7,ZTPN,3))

 +12               QUIT

               End DoDot:1

 +13       SET ZTPFLG("XUSCNT")=0

           IF ^%ZOSF("OS")["GT.M"

               SET ZTPFLG("XUSCNT")=$LENGTH($TEXT(^XUSCNT))

 +14      ;p446

           SET (ZTPFLG("LOCKTM"),ZTLKTM)=+$GET(^DD("DILOCKTM"),0)

 +15      ;p446

           SET ZTPFLG("BalLimit")=$GET(^%ZTSCH("BALLIMIT"),100)

 +16      ;p446

           SET X=0

           IF $LENGTH($TEXT(APFIND^XUSAP))

               SET X=+$$APFIND^XUSAP("TASKMAN,PROXY USER")

 +17      ;p446

           SET ZTPFLG("USER")=$SELECT(X>0:X,1:.5)

 +18      ;Set to log msg about locks

           KILL ZTMLOG

 +19      ;SM only run on C,P,G types

           IF "FO"[ZTYPE

               SET ZTOUT=1

               QUIT

 +20       QUIT

ERROR     ;START--trap

 +1        IF $SELECT(^%ZOSF("OS")["GT.M":$ZS["STACKO",1:$ZE["STKOVR"!($ZE["STACK"))

               SET $ETRAP="Q:$ST>"_($STACK-8)_"  D ERR2^%ZTMS"

               QUIT

 +2       ;set backup trap, prepare to handle error.

ERR2       SET $ETRAP="D ERROR2^%ZTMS0 HALT"

 +1        SET %ZTERLGR=$$LGR^%ZOSV

 +2        SET %ZTME=$$EC^%ZOSV

           SET %ZTMEH=$HOROLOG

 +3        SET %ZTMETSK=$SELECT($DATA(%ZTTV)#2:$PIECE(%ZTTV,"^",4),$GET(ZTSK)>0:ZTSK,1:0)

 +4       ;Unlock all other locks

           IF %ZTMETSK

               LOCK ^%ZTSK(%ZTMETSK):99

 +5       ;Keep other tasks from IO device.

           IF $GET(IO)]""

               LOCK +^%ZTSCH("DEV",IO):99

 +6       ;Check if to record error

 +7        IF '$$SCREEN^%ZTER(%ZTME)

               Begin DoDot:1

 +8       ;Kernel error file

                   DO ^%ZTER

 +9       ;log error and context in TaskMan Error file

 +10               LOCK +^%ZTSCH("ER"):99

                   HANG 1

                   SET %ZTMEH=$HOROLOG

 +11               SET ^%ZTSCH("ER",+%ZTMEH,$PIECE(%ZTMEH,",",2))=%ZTME

 +12               DO XREF^%ZTMS0

 +13               SET ^%ZTSCH("ER",+%ZTMEH,$PIECE(%ZTMEH,",",2),1)=ZTERROX1

 +14               LOCK -^%ZTSCH("ER")

 +15               QUIT

               End DoDot:1

 +16      ;

 +17      ;Have others skip dev.

           IF $DATA(ZTDEVOK)

               SET $PIECE(^%ZTSCH("IO"),U,2)=ZTDEVOK

 +18      ;Update Task file entry

 +19       IF $GET(ZTQUEUED)

               IF %ZTMETSK

                   IF $DATA(^%ZTSK(%ZTMETSK))

                       DO STATUS^%ZTMS0

 +20      ;

 +21       IF ZTPFLG("XUSCNT")

               DO COUNT^XUSCNT(-1)

 +22       IF ZTQUEUED>.9

               IF %ZTMETSK>0

                   IF $GET(DUZ)>.9

                       IF $DATA(^DD(8992,.01,0))

                           Begin DoDot:1

 +23                           SET XQA(DUZ)=""

                               SET XQAMSG="Your task #"_%ZTMETSK_" stopped because of an error"

                               SET XQADATA=%ZTMETSK

                               SET XQAROU="XQA^XUTMUTL"

 +24                           DO SETUP^XQALERT

                               QUIT

                           End DoDot:1

 +25      ;

CLEAN     ;clean up global data related to this process

 +1        IF $GET(ZTQUEUED)>.9

               IF '$DATA(^%ZTSCH("TASK",ZTQUEUED,"P"))

                   KILL ^%ZTSCH("TASK",ZTQUEUED)

 +2        KILL ^TMP($JOB),^UTILITY($JOB),^XUTL("XQ",$JOB)

 +3        IF '$GET(ZTQUEUED)

               DO SUB^%ZTMS1(-1)

 +4        IF $DATA(ZTDEVN)#2

               IF $DATA(%ZTIO)#2

                   IF %ZTIO]""

                       DO DEVLK^%ZTMS1(-1,%ZTIO)

 +5        IF $DATA(ZTDEVOK)#2

               DO DEVBAD^%ZTMS0

 +6        IF $GET(ZTSYNCFL)]""

               SET X=$$SYNCFLG^%ZTMS2("S",ZTSYNCFL,"","Stopped because of an error")

 +7       ;

CLOSE     ;close i/o device after error

 +1        DO ERCLOZ^%ZTMS0

 +2       ;In case of a port problem give it time to reset.

           IF $GET(IO)]""

               CLOSE IO

               HANG 5

 +3       ;

 +4        DO KMPR("$STOP ZTMS$")

 +5       ;Only try 5 times

           IF ZTQUEUED=.5

               IF %ZTMETSK>0

                   IF $PIECE($GET(^%ZTSK(%ZTMETSK,.12)),"^")<5

                       Begin DoDot:1

 +6                        SET $PIECE(^(.12),"^")=^%ZTSK(%ZTMETSK,.12)+1

 +7                        SET ^%ZTSCH($$NEWH^%ZTMS2($HOROLOG,600),%ZTMETSK)=""

                       End DoDot:1

 +8       ;Start a new process to continue

           HALT

 +9       ;

GTM       ;Special entry point for GT.M

 +1        SET @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")

 +2        GOTO START

ZTMS.m