%ZTLOAD4 ;SEA/RDS-TaskMan: P I: Is Queued? ;1/24/08 16:15
;;8.0;KERNEL;**440**;JUL 10, 1995;Build 13
;Per VHA Directive 2004-038, this routine should not be modified
;Call with ZTSK, [ZTCPU]; Return ZTSK()
INPUT ;check input parameters for error conditions
N %,$ES,$ET,%ZTVOL,ZTREC,ZTD,ZT1,ZT2,ZT3
I $D(ZTSK)[0 S ZTSK=""
I $D(ZTSK)>1 S %=ZTSK K ZTSK S ZTSK=%
I ZTSK<1!(ZTSK\1'=ZTSK) S ZTSK="",ZTSK(0)="",ZTSK("E")="IT" G QUIT
S ZTSK(0)="",ZTSK("E")="U",$ET="Q:$ES S $EC="""" G QUIT^%ZTLOAD4"
S %ZTVOL=^%ZOSF("VOL")
I $D(ZTCPU)[0 S ZTCPU=%ZTVOL
I ZTCPU="" S ZTCPU=%ZTVOL
I ZTCPU'=%ZTVOL G THERE
;
HERE ;lookup task's status on current volume set
L +^%ZTSK(ZTSK):1
I $D(^%ZTSK(ZTSK,0))[0 S ZTSK("E")="I" G QUIT
S ZTREC=^%ZTSK(ZTSK,0),ZTD=$G(^(.04))
S ZTSK("DUZ")=$P(ZTREC,U,3),ZTSK("D")=$P(ZTREC,U,6) ;scheduled $H
I ZTD]"",$D(^%ZTSCH(ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT
I ZTD]"",$D(^%ZTSCH("JOB",ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT
;
S ZT1="" F S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 I $D(^(ZT1,ZTSK))#2 S ZTSK(0)=1 G QUIT
S ZT1="IO",ZT2="" F S ZT2=$O(^%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F S ZT3=$O(^%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT
S ZT1="JOB",ZT2="" F S ZT2=$O(^%ZTSCH(ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1 G QUIT
S ZT1="LINK",ZT2="" F S ZT2=$O(^%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F S ZT3=$O(^%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT
S ZTSK(0)=0
;
QUIT ;cleanup and quit
L:ZTSK -^%ZTSK(ZTSK) ;K %ZTCPU,%ZTM,%ZTM1,%ZTM2,%ZTMAST,%ZTVOL,X,Y,ZT,ZT1,ZT2,ZT3,ZTCPU,ZTD,ZTREC
I ZTSK(0)]"" K ZTSK("E") Q
I ZTSK("E")'="U" Q
S ZTSK("E",0)=$$EC^%ZOSV
Q
;
THERE ;rest of code looks up task's status on some other volume set
N %ZTCPU,%ZTM,X,Y
;
FILES ;find TaskMan files on the volume set to be searched
S %ZTCPU=$O(^%ZIS(14.5,"B",ZTCPU,""))
I %ZTCPU="" S ZTSK("E")="IS" G QUIT
S %ZTM=$P(^%ZOSF("MGR"),",")
S %ZTM=$S($D(^%ZIS(14.5,%ZTCPU,0))[0:%ZTM,$P(^(0),U,6)="":%ZTM,1:$P(^(0),U,6))
S X=%ZTM,Y=ZTCPU
S ZTSK("E")="LS",ZT=$D(^[X,Y]%ZTSK(0)),ZTSK("E")="U" ; check link
;
SEARCH ;find out if task is queued on that volume set
I $D(^[X,Y]%ZTSK(ZTSK,0))[0 S ZTSK("E")="I" G QUIT
S ZTREC=^[X,Y]%ZTSK(ZTSK,0),ZTD=$G(^(.04))
S ZTSK("DUZ")=$P(ZTREC,U,3),ZTSK("D")=$P(ZTREC,U,6)
I ZTD]"",$D(^[X,Y]%ZTSCH(ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT
I ZTD]"",$D(^[X,Y]%ZTSCH("JOB",ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT
;
S ZT1="" F S ZT1=$O(^[X,Y]%ZTSCH(ZT1)) Q:'ZT1 I $D(^(ZT1,ZTSK))#2 S ZTSK(0)=1 G QUIT
S ZT1="IO",ZT2="" F S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F S ZT3=$O(^[X,Y]%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT
S ZT1="JOB",ZT2="" F S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1 G QUIT
S ZT1="LINK",ZT2="" F S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F S ZT3=$O(^[X,Y]%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT
S ZTSK(0)=0 G QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTLOAD4 2993 printed Oct 16, 2024@18:16:49 Page 2
%ZTLOAD4 ;SEA/RDS-TaskMan: P I: Is Queued? ;1/24/08 16:15
+1 ;;8.0;KERNEL;**440**;JUL 10, 1995;Build 13
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;Call with ZTSK, [ZTCPU]; Return ZTSK()
INPUT ;check input parameters for error conditions
+1 NEW %,$ESTACK,$ETRAP,%ZTVOL,ZTREC,ZTD,ZT1,ZT2,ZT3
+2 IF $DATA(ZTSK)[0
SET ZTSK=""
+3 IF $DATA(ZTSK)>1
SET %=ZTSK
KILL ZTSK
SET ZTSK=%
+4 IF ZTSK<1!(ZTSK\1'=ZTSK)
SET ZTSK=""
SET ZTSK(0)=""
SET ZTSK("E")="IT"
GOTO QUIT
+5 SET ZTSK(0)=""
SET ZTSK("E")="U"
SET $ETRAP="Q:$ES S $EC="""" G QUIT^%ZTLOAD4"
+6 SET %ZTVOL=^%ZOSF("VOL")
+7 IF $DATA(ZTCPU)[0
SET ZTCPU=%ZTVOL
+8 IF ZTCPU=""
SET ZTCPU=%ZTVOL
+9 IF ZTCPU'=%ZTVOL
GOTO THERE
+10 ;
HERE ;lookup task's status on current volume set
+1 LOCK +^%ZTSK(ZTSK):1
+2 IF $DATA(^%ZTSK(ZTSK,0))[0
SET ZTSK("E")="I"
GOTO QUIT
+3 SET ZTREC=^%ZTSK(ZTSK,0)
SET ZTD=$GET(^(.04))
+4 ;scheduled $H
SET ZTSK("DUZ")=$PIECE(ZTREC,U,3)
SET ZTSK("D")=$PIECE(ZTREC,U,6)
+5 IF ZTD]""
IF $DATA(^%ZTSCH(ZTD,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+6 IF ZTD]""
IF $DATA(^%ZTSCH("JOB",ZTD,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+7 ;
+8 SET ZT1=""
FOR
SET ZT1=$ORDER(^%ZTSCH(ZT1))
if 'ZT1
QUIT
IF $DATA(^(ZT1,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+9 SET ZT1="IO"
SET ZT2=""
FOR
SET ZT2=$ORDER(^%ZTSCH(ZT1,ZT2))
SET ZT3=""
if ZT2=""
QUIT
FOR
SET ZT3=$ORDER(^%ZTSCH(ZT1,ZT2,ZT3))
if ZT3=""
QUIT
IF $DATA(^(ZT3,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+10 SET ZT1="JOB"
SET ZT2=""
FOR
SET ZT2=$ORDER(^%ZTSCH(ZT1,ZT2))
if ZT2=""
QUIT
IF $DATA(^(ZT2,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+11 SET ZT1="LINK"
SET ZT2=""
FOR
SET ZT2=$ORDER(^%ZTSCH(ZT1,ZT2))
SET ZT3=""
if ZT2=""
QUIT
FOR
SET ZT3=$ORDER(^%ZTSCH(ZT1,ZT2,ZT3))
if ZT3=""
QUIT
IF $DATA(^(ZT3,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+12 SET ZTSK(0)=0
+13 ;
QUIT ;cleanup and quit
+1 ;K %ZTCPU,%ZTM,%ZTM1,%ZTM2,%ZTMAST,%ZTVOL,X,Y,ZT,ZT1,ZT2,ZT3,ZTCPU,ZTD,ZTREC
if ZTSK
LOCK -^%ZTSK(ZTSK)
+2 IF ZTSK(0)]""
KILL ZTSK("E")
QUIT
+3 IF ZTSK("E")'="U"
QUIT
+4 SET ZTSK("E",0)=$$EC^%ZOSV
+5 QUIT
+6 ;
THERE ;rest of code looks up task's status on some other volume set
+1 NEW %ZTCPU,%ZTM,X,Y
+2 ;
FILES ;find TaskMan files on the volume set to be searched
+1 SET %ZTCPU=$ORDER(^%ZIS(14.5,"B",ZTCPU,""))
+2 IF %ZTCPU=""
SET ZTSK("E")="IS"
GOTO QUIT
+3 SET %ZTM=$PIECE(^%ZOSF("MGR"),",")
+4 SET %ZTM=$SELECT($DATA(^%ZIS(14.5,%ZTCPU,0))[0:%ZTM,$PIECE(^(0),U,6)="":%ZTM,1:$PIECE(^(0),U,6))
+5 SET X=%ZTM
SET Y=ZTCPU
+6 ; check link
SET ZTSK("E")="LS"
SET ZT=$DATA(^[X,Y]%ZTSK(0))
SET ZTSK("E")="U"
+7 ;
SEARCH ;find out if task is queued on that volume set
+1 IF $DATA(^[X,Y]%ZTSK(ZTSK,0))[0
SET ZTSK("E")="I"
GOTO QUIT
+2 SET ZTREC=^[X
SET Y]%ZTSK(ZTSK,0)
SET ZTD=$GET(^(.04))
+3 SET ZTSK("DUZ")=$PIECE(ZTREC,U,3)
SET ZTSK("D")=$PIECE(ZTREC,U,6)
+4 IF ZTD]""
IF $DATA(^[X,Y]%ZTSCH(ZTD,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+5 IF ZTD]""
IF $DATA(^[X,Y]%ZTSCH("JOB",ZTD,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+6 ;
+7 SET ZT1=""
FOR
SET ZT1=$ORDER(^[X,Y]%ZTSCH(ZT1))
if 'ZT1
QUIT
IF $DATA(^(ZT1,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+8 SET ZT1="IO"
SET ZT2=""
FOR
SET ZT2=$ORDER(^[X,Y]%ZTSCH(ZT1,ZT2))
SET ZT3=""
if ZT2=""
QUIT
FOR
SET ZT3=$ORDER(^[X,Y]%ZTSCH(ZT1,ZT2,ZT3))
if ZT3=""
QUIT
IF $DATA(^(ZT3,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+9 SET ZT1="JOB"
SET ZT2=""
FOR
SET ZT2=$ORDER(^[X,Y]%ZTSCH(ZT1,ZT2))
if ZT2=""
QUIT
IF $DATA(^(ZT2,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+10 SET ZT1="LINK"
SET ZT2=""
FOR
SET ZT2=$ORDER(^[X,Y]%ZTSCH(ZT1,ZT2))
SET ZT3=""
if ZT2=""
QUIT
FOR
SET ZT3=$ORDER(^[X,Y]%ZTSCH(ZT1,ZT2,ZT3))
if ZT3=""
QUIT
IF $DATA(^(ZT3,ZTSK))#2
SET ZTSK(0)=1
GOTO QUIT
+11 SET ZTSK(0)=0
GOTO QUIT
+12 ;
