%ZTMS3 ;SEA/RDS-TaskMan: Submanager, Part 5 (Run Task) ;08/27/08 14:19
;;8.0;KERNEL;**1,18,36,49,64,67,94,118,127,136,175,275,355,446**;Jul 10, 1995;Build 35
;Per VHA Directive 2004-038, this routine should not be modified.
;
TASK ;SUBMGR--prepare and run task; cleanup after
;
BEFORE ;prepare task
;Save submanager's variables
K %ZTTV
S (%ZTTV("DUZ"),DUZ)=+$P(ZTREC,U,3)
S %ZTTV=ZTUCI_U_IOS_U_U_ZTSK_U_IO_U_IOT_U_ZTCPU_U_ZTNODE_U_DUZ_U_U_IOF_U_IOST_U_ZTPAIR_U_ZTYPE_U
S %ZTTV(0)=ZTRTN_U_$P(ZTREC,U,8,9)_U_$P(ZTREC,U,6)_U_ION_U_ZTUCI_U_$P(ZTREC,U,5)_U_$S($L($P(ZTREC,U,10)):$P(ZTREC,U,10),1:$P(ZTREC,U,3))_U_$J_U_ZTSYNCFL_U_ZTPAIR_U_$H
;
I +$G(^%ZTSCH("LOGRSRC")) S %ZTTV(1)="!"_$S($P(ZTREC,U,9)="":$P(ZTREC,U,2),1:$P(ZTREC,U,9))
;
;external calls
D NOW^%DTC S DT=% ;DT is Date.time at this point.
1 D SETNM^%ZOSV($E("BTask ",(ZTIO]"")+1,6)_(ZTSK#100000000))
;
;priority (Not done in the VA)
;
2 ;restore saved variables
S X=$O(^XTV(8989.3,1,4,"B",ZTCPU,0)) S:$P($G(^XTV(8989.3,1,4,+X,0)),U,6)="y" XRTL=ZTUCI
K %,%H,%I,%ZTI,%ZTIO,IO("C"),IO("T"),X,Y,ZTCPU,ZTDEF,ZTIOST,ZTIOT,ZTNODE,ZTPAIR,ZTREC,ZTREC2,ZTREC21,ZTREC25,ZTUCI
K ^TMP($J),^UTILITY($J),^XUTL("XQ",$J)
S DUZ(0)="" D RESTORE^%ZTMS4
;Setup User, If zero Default to Taskman Proxy
S DUZ=%ZTTV("DUZ") S:'DUZ DUZ=ZTPFLG("USER") ;p446
I DUZ(0)="" S DUZ(0)=$P($G(^VA(200,DUZ,0)),U,4)
I $D(DUZ(2))[0 S DUZ(2)=$S($D(^VA(200,DUZ,2,"AX1",1)):$O(^(1,0)),$D(^VA(200,DUZ,2,0)):$O(^(0)),1:0)
;force values, DTIME=1 so HFS reads work under Cache
S DTIME=1,ZTDESC=$G(^%ZTSK(ZTSK,.03)),ZTDTH=$H
S DILOCKTM=+$G(^DD("DILOCKTM"),1) ;p446
;Build Globals
S ^XUTL("XQ",$J,0)=DT,^("ZTSK")=ZTDESC,^("ZTSKNUM")=ZTSK
S ^XUTL("XQ",$J,"DUZ")=DUZ D SAVEVAR^%ZIS
S X="DUZ" F S X=$Q(@X) Q:X="" I $D(@X) S ^XUTL("XQ",$J,$TR(X,""""))=@X
3 ;
;final checks & sets
I '$D(^%ZTSK(ZTSK)) D AFTER(0) Q
I $L($P($G(^%ZTSK(ZTSK,.1)),U,10)) D Q
. D TSKSTAT("D","Stopped by User"),AFTER(0)
D TSKSTAT(5,"Started Running",$J)
S ZTQUEUED=ZTSK,ZTSTAT="1 General error"
;
4 ;run task
;Clear all locks
I ZTPFLG("XUSCNT") D SETLOCK^XUSCNT($NA(^%ZTSCH("TASK",ZTSK)))
L ^%ZTSCH("TASK",ZTSK):99 ;Clear any other Locks and establish a lock to be used to indicate that it is active p446
;Persistents flag gets set in ZTSK^XQ1
I $P(^%ZIS(14.7,ZTPFLG("ZTPN"),0),U,3)="Y" S %ZTTV("LOG")=1 D LOGIN^%ZTMS4
S $P(%ZTTV(0),U,13)=$H,^%ZTSCH("TASK",ZTSK)=%ZTTV(0),^(ZTSK,2)=%ZTTV
I $D(%ZTTV(1)) D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV(%ZTTV(1))
S DT=$P(DT,".") S:ZTPFLG("ZTREQ") ZTREQ="@"
M %ZTPFLG=ZTPFLG
D RUN
5 K %ZTPFLG ;p446
S U="^",ZTLKTM=$G(ZTPFLG("LOCKTM")),ZTSK=$P(%ZTTV,U,4) ;p446
I $D(%ZTTV(1)) D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$AFTR ZTMS$")
I $G(%ZTTV("LOG")) D LOGOUT^%ZTMS4
D PCLEAR^%ZTLOAD(ZTSK) ;Clear persistent flag
D TSKSTAT(6,"Finished"),AFTER(1)
Q
;
AFTER(ZTTASK) ;cleanup after task; reset partition
I ZTPFLG("XUSCNT") D SETLOCK^XUSCNT()
;L ;Clear all user locks. p446
L ^%ZTSK(ZTSK):99 ;Clear any Locks from Task and set our Lock. p446
I ZTTASK K ^%ZTSCH("TASK",ZTSK) S ZTQUEUED=.6
;S X=10 X ^%ZOSF("PRIORITY")
D SETNM^%ZOSV("Sub "_$J) ;Change name back
S ZTUCI=$P(%ZTTV,U),IOS=$P(%ZTTV,U,2),(IO,IO(0),%ZTIO)=$P(%ZTTV,U,5),IOT=$P(%ZTTV,U,6),ZTCPU=$P(%ZTTV,U,7),ZTNODE=$P(%ZTTV,U,8)
S IOF=$P(%ZTTV,U,11),IOST=$P(%ZTTV,U,12),ZTPAIR=$P(%ZTTV,U,13),ZTYPE=$P(%ZTTV,U,14),ZTSYNCFL=$P(%ZTTV(0),U,11),DUZ=%ZTTV("DUZ")
I $G(ZTSYNCFL)]"" S X=$$SYNCFLG^%ZTMS2($S($G(ZTSTAT):"S",1:"D"),ZTSYNCFL,IO,$G(ZTSTAT)) D SCHSYNC^%ZTMS2(ZTSYNCFL,IO):'$G(ZTSTAT)
D POST^%ZTMS4:ZTTASK,CLOSE
K ^TMP($J),^UTILITY($J),^XUTL("XQ",$J) I $T(XUTL^XUSCLEAN)]"" D XUTL^XUSCLEAN
K (%ZTIO,%ZTTV,DT,IO,IOF,ION,IOS,IOST,IOT,U,ZTCPU,ZTNODE,ZTNONEXT,ZTPAIR,ZTPFLG,ZTQUEUED,ZTREQ,ZTSTOP,ZTUCI,ZTYPE,ZTLKTM) ;p446
K IO("C"),IO("T"),IO("ERROR"),IO("LASTERR"),IO("DOC"),IO("P"),IO("HFSIO")
S DUZ=0,DUZ(0)="@",ZTQUEUED=0
L ;Clear all locks, -^%ZTSK(ZTSK)
Q
;
RUN ;Need ZTPFLG in run environment in case of error trap.
N %,%ZTTV,ZTPFLG,XUALLOC
M ZTPFLG=%ZTPFLG ;p446
F %=1:1:12 S $P(XUALLOC(%)," ",250)=""
D @ZTRTN
Q
;
CLOSE ;RUN--close &/or close execute
I %ZTIO="" S ZTNONEXT=1 G CLX
N ZTUCI,ZTCPU,ZTNODE,IOCPU,%IO
I IOT="HFS"!(IOT="SPL") S ZTNONEXT=1
K IO("C") S:IOT'="TRM" IO("C")=1
S:$D(IO("CLOSE")) IO("T")=1
I IOT="RES" K ZTNONEXT Q ;For a Resource, don't close.
;Here is the Lock and hang to allow IDCU ports to reset. See %ZTMS2.
;I IOST["MINIOUT" S IO("C")=1,%IO=1 L +^%ZTSCH("NETMAIL",%ZTIO):8 ;p446
I $D(IO(1,IO))#2 D ^%ZISC
I $G(%IO) H 6 ;Wait for terminal server to reset.
;Unlock of all locks is done in clean
;See that all devices are closed.
CLX S %IO="" F S %IO=$O(IO(1,%IO)) Q:%IO="" I %IO'=IO K IO(1,%IO) C %IO
Q
;
TSKSTAT(CODE,MSG,JOB) ; Update task's status
S $P(^%ZTSK(ZTSK,.1),U,1,3)=$G(CODE)_U_$H_U_$G(MSG)
I $G(JOB)>0 S $P(^%ZTSK(ZTSK,.1),U,4)=JOB
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTMS3 4971 printed Apr 09, 2024@21:12:41 Page 2
%ZTMS3 ;SEA/RDS-TaskMan: Submanager, Part 5 (Run Task) ;08/27/08 14:19
+1 ;;8.0;KERNEL;**1,18,36,49,64,67,94,118,127,136,175,275,355,446**;Jul 10, 1995;Build 35
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
TASK ;SUBMGR--prepare and run task; cleanup after
+1 ;
BEFORE ;prepare task
+1 ;Save submanager's variables
+2 KILL %ZTTV
+3 SET (%ZTTV("DUZ"),DUZ)=+$PIECE(ZTREC,U,3)
+4 SET %ZTTV=ZTUCI_U_IOS_U_U_ZTSK_U_IO_U_IOT_U_ZTCPU_U_ZTNODE_U_DUZ_U_U_IOF_U_IOST_U_ZTPAIR_U_ZTYPE_U
+5 SET %ZTTV(0)=ZTRTN_U_$PIECE(ZTREC,U,8,9)_U_$PIECE(ZTREC,U,6)_U_ION_U_ZTUCI_U_$PIECE(ZTREC,U,5)_U_$SELECT($LENGTH($PIECE(ZTREC,U,10)):$PIECE(ZTREC,U,10),1:$PIECE(ZTREC,U,3))_U_$JOB_U_ZTSYNCFL_U_ZTPAIR_U_$HOROLOG
+6 ;
+7 IF +$GET(^%ZTSCH("LOGRSRC"))
SET %ZTTV(1)="!"_$SELECT($PIECE(ZTREC,U,9)="":$PIECE(ZTREC,U,2),1:$PIECE(ZTREC,U,9))
+8 ;
+9 ;external calls
+10 ;DT is Date.time at this point.
DO NOW^%DTC
SET DT=%
1 DO SETNM^%ZOSV($EXTRACT("BTask ",(ZTIO]"")+1,6)_(ZTSK#100000000))
+1 ;
+2 ;priority (Not done in the VA)
+3 ;
2 ;restore saved variables
+1 SET X=$ORDER(^XTV(8989.3,1,4,"B",ZTCPU,0))
if $PIECE($GET(^XTV(8989.3,1,4,+X,0)),U,6)="y"
SET XRTL=ZTUCI
+2 KILL %,%H,%I,%ZTI,%ZTIO,IO("C"),IO("T"),X,Y,ZTCPU,ZTDEF,ZTIOST,ZTIOT,ZTNODE,ZTPAIR,ZTREC,ZTREC2,ZTREC21,ZTREC25,ZTUCI
+3 KILL ^TMP($JOB),^UTILITY($JOB),^XUTL("XQ",$JOB)
+4 SET DUZ(0)=""
DO RESTORE^%ZTMS4
+5 ;Setup User, If zero Default to Taskman Proxy
+6 ;p446
SET DUZ=%ZTTV("DUZ")
if 'DUZ
SET DUZ=ZTPFLG("USER")
+7 IF DUZ(0)=""
SET DUZ(0)=$PIECE($GET(^VA(200,DUZ,0)),U,4)
+8 IF $DATA(DUZ(2))[0
SET DUZ(2)=$SELECT($DATA(^VA(200,DUZ,2,"AX1",1)):$ORDER(^(1,0)),$DATA(^VA(200,DUZ,2,0)):$ORDER(^(0)),1:0)
+9 ;force values, DTIME=1 so HFS reads work under Cache
+10 SET DTIME=1
SET ZTDESC=$GET(^%ZTSK(ZTSK,.03))
SET ZTDTH=$HOROLOG
+11 ;p446
SET DILOCKTM=+$GET(^DD("DILOCKTM"),1)
+12 ;Build Globals
+13 SET ^XUTL("XQ",$JOB,0)=DT
SET ^("ZTSK")=ZTDESC
SET ^("ZTSKNUM")=ZTSK
+14 SET ^XUTL("XQ",$JOB,"DUZ")=DUZ
DO SAVEVAR^%ZIS
+15 SET X="DUZ"
FOR
SET X=$QUERY(@X)
if X=""
QUIT
IF $DATA(@X)
SET ^XUTL("XQ",$JOB,$TRANSLATE(X,""""))=@X
3 ;
+1 ;final checks & sets
+2 IF '$DATA(^%ZTSK(ZTSK))
DO AFTER(0)
QUIT
+3 IF $LENGTH($PIECE($GET(^%ZTSK(ZTSK,.1)),U,10))
Begin DoDot:1
+4 DO TSKSTAT("D","Stopped by User")
DO AFTER(0)
End DoDot:1
QUIT
+5 DO TSKSTAT(5,"Started Running",$JOB)
+6 SET ZTQUEUED=ZTSK
SET ZTSTAT="1 General error"
+7 ;
4 ;run task
+1 ;Clear all locks
+2 IF ZTPFLG("XUSCNT")
DO SETLOCK^XUSCNT($NAME(^%ZTSCH("TASK",ZTSK)))
+3 ;Clear any other Locks and establish a lock to be used to indicate that it is active p446
LOCK ^%ZTSCH("TASK",ZTSK):99
+4 ;Persistents flag gets set in ZTSK^XQ1
+5 IF $PIECE(^%ZIS(14.7,ZTPFLG("ZTPN"),0),U,3)="Y"
SET %ZTTV("LOG")=1
DO LOGIN^%ZTMS4
+6 SET $PIECE(%ZTTV(0),U,13)=$HOROLOG
SET ^%ZTSCH("TASK",ZTSK)=%ZTTV(0)
SET ^(ZTSK,2)=%ZTTV
+7 IF $DATA(%ZTTV(1))
if +$GET(^%ZTSCH("LOGRSRC"))
DO LOGRSRC^%ZOSV(%ZTTV(1))
+8 SET DT=$PIECE(DT,".")
if ZTPFLG("ZTREQ")
SET ZTREQ="@"
+9 MERGE %ZTPFLG=ZTPFLG
+10 DO RUN
5 ;p446
KILL %ZTPFLG
+1 ;p446
SET U="^"
SET ZTLKTM=$GET(ZTPFLG("LOCKTM"))
SET ZTSK=$PIECE(%ZTTV,U,4)
+2 IF $DATA(%ZTTV(1))
if +$GET(^%ZTSCH("LOGRSRC"))
DO LOGRSRC^%ZOSV("$AFTR ZTMS$")
+3 IF $GET(%ZTTV("LOG"))
DO LOGOUT^%ZTMS4
+4 ;Clear persistent flag
DO PCLEAR^%ZTLOAD(ZTSK)
+5 DO TSKSTAT(6,"Finished")
DO AFTER(1)
+6 QUIT
+7 ;
AFTER(ZTTASK) ;cleanup after task; reset partition
+1 IF ZTPFLG("XUSCNT")
DO SETLOCK^XUSCNT()
+2 ;L ;Clear all user locks. p446
+3 ;Clear any Locks from Task and set our Lock. p446
LOCK ^%ZTSK(ZTSK):99
+4 IF ZTTASK
KILL ^%ZTSCH("TASK",ZTSK)
SET ZTQUEUED=.6
+5 ;S X=10 X ^%ZOSF("PRIORITY")
+6 ;Change name back
DO SETNM^%ZOSV("Sub "_$JOB)
+7 SET ZTUCI=$PIECE(%ZTTV,U)
SET IOS=$PIECE(%ZTTV,U,2)
SET (IO,IO(0),%ZTIO)=$PIECE(%ZTTV,U,5)
SET IOT=$PIECE(%ZTTV,U,6)
SET ZTCPU=$PIECE(%ZTTV,U,7)
SET ZTNODE=$PIECE(%ZTTV,U,8)
+8 SET IOF=$PIECE(%ZTTV,U,11)
SET IOST=$PIECE(%ZTTV,U,12)
SET ZTPAIR=$PIECE(%ZTTV,U,13)
SET ZTYPE=$PIECE(%ZTTV,U,14)
SET ZTSYNCFL=$PIECE(%ZTTV(0),U,11)
SET DUZ=%ZTTV("DUZ")
+9 IF $GET(ZTSYNCFL)]""
SET X=$$SYNCFLG^%ZTMS2($SELECT($GET(ZTSTAT):"S",1:"D"),ZTSYNCFL,IO,$GET(ZTSTAT))
if '$GET(ZTSTAT)
DO SCHSYNC^%ZTMS2(ZTSYNCFL,IO)
+10 if ZTTASK
DO POST^%ZTMS4
DO CLOSE
+11 KILL ^TMP($JOB),^UTILITY($JOB),^XUTL("XQ",$JOB)
IF $TEXT(XUTL^XUSCLEAN)]""
DO XUTL^XUSCLEAN
+12 ;p446
KILL (%ZTIO,%ZTTV,DT,IO,IOF,ION,IOS,IOST,IOT,U,ZTCPU,ZTNODE,ZTNONEXT,ZTPAIR,ZTPFLG,ZTQUEUED,ZTREQ,ZTSTOP,ZTUCI,ZTYPE,ZTLKTM)
+13 KILL IO("C"),IO("T"),IO("ERROR"),IO("LASTERR"),IO("DOC"),IO("P"),IO("HFSIO")
+14 SET DUZ=0
SET DUZ(0)="@"
SET ZTQUEUED=0
+15 ;Clear all locks, -^%ZTSK(ZTSK)
LOCK
+16 QUIT
+17 ;
RUN ;Need ZTPFLG in run environment in case of error trap.
+1 NEW %,%ZTTV,ZTPFLG,XUALLOC
+2 ;p446
MERGE ZTPFLG=%ZTPFLG
+3 FOR %=1:1:12
SET $PIECE(XUALLOC(%)," ",250)=""
+4 DO @ZTRTN
+5 QUIT
+6 ;
CLOSE ;RUN--close &/or close execute
+1 IF %ZTIO=""
SET ZTNONEXT=1
GOTO CLX
+2 NEW ZTUCI,ZTCPU,ZTNODE,IOCPU,%IO
+3 IF IOT="HFS"!(IOT="SPL")
SET ZTNONEXT=1
+4 KILL IO("C")
if IOT'="TRM"
SET IO("C")=1
+5 if $DATA(IO("CLOSE"))
SET IO("T")=1
+6 ;For a Resource, don't close.
IF IOT="RES"
KILL ZTNONEXT
QUIT
+7 ;Here is the Lock and hang to allow IDCU ports to reset. See %ZTMS2.
+8 ;I IOST["MINIOUT" S IO("C")=1,%IO=1 L +^%ZTSCH("NETMAIL",%ZTIO):8 ;p446
+9 IF $DATA(IO(1,IO))#2
DO ^%ZISC
+10 ;Wait for terminal server to reset.
IF $GET(%IO)
HANG 6
+11 ;Unlock of all locks is done in clean
+12 ;See that all devices are closed.
CLX SET %IO=""
FOR
SET %IO=$ORDER(IO(1,%IO))
if %IO=""
QUIT
IF %IO'=IO
KILL IO(1,%IO)
CLOSE %IO
+1 QUIT
+2 ;
TSKSTAT(CODE,MSG,JOB) ; Update task's status
+1 SET $PIECE(^%ZTSK(ZTSK,.1),U,1,3)=$GET(CODE)_U_$HOROLOG_U_$GET(MSG)
+2 IF $GET(JOB)>0
SET $PIECE(^%ZTSK(ZTSK,.1),U,4)=JOB
+3 QUIT
+4 ;
