%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 35
;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)
Q
QUIT ;Submanager exit
D KMPR("$STOP ZTMS$")
I ZTPFLG("XUSCNT") D COUNT^XUSCNT(-1)
Q
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
Q
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTMS 3988 printed Apr 09, 2024@21:16:40 Page 2
%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 35
+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
