%ZTLOAD5 ;SEA/RDS-TaskMan: P I: Task Status ;1/18/08 14:29
;;8.0;KERNEL;**49,339,446**;JUL 10, 1995;Build 35
;
INPUT ;check input parameters for error conditions
N %,ZT1,ZT2,ZT3
S:$D(ZTSK)[0 ZTSK=""
I $D(ZTSK)>1 S %=ZTSK K ZTSK S ZTSK=%
S ZTSK(0)=0,ZTSK(1)=0,ZTSK(2)="Undefined"
I ZTSK<1!('$D(^%ZTSK(ZTSK,0))) Q
L +^%ZTSK(ZTSK):5 E S ZTSK(2)="Busy" Q ;p446
D SEARCH L -^%ZTSK(ZTSK)
Q
;
SEARCH ;search ^%ZTSCH for task
I $D(^%ZTSCH("TASK",ZTSK))#2 D Q
. S ZTSK(0)=1,ZTSK(1)=2,ZTSK(2)="Active: Running"
. ;With a zero lock timeout it may report "active" falsely
. L +^%ZTSCH("TASK",ZTSK):0 I $T S ZTSK(1)=5,ZTSK(2)="Inactive: Interrupted" L -^%ZTSCH("TASK",ZTSK) ;p446
. Q
S ZT1=0 D Q:ZTSK(0) ;*339
. F S ZT1=$O(^%ZTSCH(ZT1)) Q:ZT1'>0 I $D(^%ZTSCH(ZT1,ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=1,ZTSK(2)="Active: Pending" Q
S ZT1="" D Q:ZTSK(0)
. F S ZT1=$O(^%ZTSCH("IO",ZT1)),ZT2="" Q:ZT1="" D Q:ZTSK(0)
. . F S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=1,ZTSK(2)="Active: Pending" Q
S ZT1="" D Q:ZTSK(0)
. F S ZT1=$O(^%ZTSCH("JOB",ZT1)) Q:ZT1="" I $D(^(ZT1,ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=1,ZTSK(2)="Active: Pending" Q
S ZT1="" D Q:ZTSK(0)
. F S ZT1=$O(^%ZTSCH("LINK",ZT1)),ZT2="" Q:ZT1="" D Q:ZTSK(0)
. . F S ZT2=$O(^%ZTSCH("LINK",ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=1,ZTSK(2)="Active: Pending" Q
S ZT1=0 D Q:ZTSK(0) ;*339
. F S ZT1=$O(^%ZTSCH("C",ZT1)) Q:ZT1'>0 I $D(^(ZT1,ZTSK)) S ZTSK(0)=1,ZTSK(2)="Active: Pending" Q
;
FLAG ;If we didn't find it in a list, use status flag
I $D(^%ZTSK(ZTSK,.1))[0 Q
S ZT=$P(^%ZTSK(ZTSK,.1),U),ZTSK(0)=1
I ZT=2!(ZT=4) S ZTSK(1)=1,ZTSK(2)="Active: Pending" Q
I ZT=6 S ZTSK(1)=3,ZTSK(2)="Inactive: Finished" Q
I ZT="H"!(ZT="K") S ZTSK(1)=4,ZTSK(2)="Inactive: Available" Q
S ZTSK(1)=5,ZTSK(2)="Inactive: Interrupted"
Q
;
DESC ;Find tasks with matching description.
;From %ZTLOAD input param DESC,LST
Q:$G(DESC)=""
N ZTSK,X D ENV
S:'$D(LST) LST="^TMP($J)" S ZTSK=0
F S ZTSK=$O(^%ZTSK(ZTSK)) Q:ZTSK'>0 S X=$G(^%ZTSK(ZTSK,0)) D
. Q:$$SKIP()
. I $G(^%ZTSK(ZTSK,.03))=DESC S @LST@(ZTSK)=""
. Q
Q
RTN ;Find tasks with matching routines
;From %ZTLOAD input param RTN,LST
Q:$G(RTN)=""
N ZTSK,X D ENV
S:'$D(LST) LST="^TMP($J)" S:RTN'["^" RTN="^"_RTN S ZTSK=0
F S ZTSK=$O(^%ZTSK(ZTSK)) Q:ZTSK'>0 S X=$G(^%ZTSK(ZTSK,0)) D
. Q:$$SKIP()
. I $P(X,"^",1,2)=RTN S @LST@(ZTSK)="" Q
. I "^"_($P(X,"^",2))=RTN S @LST@(ZTSK)=""
. Q
Q
OPTION ;Find tasks with matching option names
;From %ZTLOAD input param OPNM, LST
Q:$G(OPNM)="" N ZTSK,X,FLG D ENV
S:'$D(LST) LST="^TMP($J)" S ZTSK=0,FLG=(OPNM?1.N1"^"1A.ANP)
Q:'FLG&(OPNM'?1A.ANP)
F S ZTSK=$O(^%ZTSK(ZTSK)) Q:ZTSK'>0 S X=$G(^%ZTSK(ZTSK,0)) D
. Q:$$SKIP()
. I FLG,$P(X,"^",8,9)=OPNM S @LST@(ZTSK)="" Q
. I $P(X,"^",1,2)="ZTSK^XQ1",$P(X,"^",9)=OPNM S @LST@(ZTSK)=""
. Q
Q
SKIP() ;Screen on ZTKEY, UCI, DUZ, return: 0=OK, 1=Skip
Q:ZTKEY 0
Q:($P(X,U,11)_","_$P(X,U,12))'=ZTUCI 1
Q:$P(X,U,3)'=DUZ 1
Q 0
ENV ;Setup
S ZTKEY=$D(^XUSEC("ZTMQ",DUZ)),U="^"
X ^%ZOSF("UCI") S ZTUCI=Y
Q
;
JOB ;Return JOB # for running task. Called from JOB^ZTLOAD (*339)
N Z1,Z2 S Z1=""
I $G(ZTM)>0 S Z2=$G(^%ZTSCH("TASK",ZTM)),Z1=$S($L(Z2):$P(Z2,"^",10),1:"")
Q Z1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTLOAD5 3343 printed Nov 22, 2024@17:26:10 Page 2
%ZTLOAD5 ;SEA/RDS-TaskMan: P I: Task Status ;1/18/08 14:29
+1 ;;8.0;KERNEL;**49,339,446**;JUL 10, 1995;Build 35
+2 ;
INPUT ;check input parameters for error conditions
+1 NEW %,ZT1,ZT2,ZT3
+2 if $DATA(ZTSK)[0
SET ZTSK=""
+3 IF $DATA(ZTSK)>1
SET %=ZTSK
KILL ZTSK
SET ZTSK=%
+4 SET ZTSK(0)=0
SET ZTSK(1)=0
SET ZTSK(2)="Undefined"
+5 IF ZTSK<1!('$DATA(^%ZTSK(ZTSK,0)))
QUIT
+6 ;p446
LOCK +^%ZTSK(ZTSK):5
IF '$TEST
SET ZTSK(2)="Busy"
QUIT
+7 DO SEARCH
LOCK -^%ZTSK(ZTSK)
+8 QUIT
+9 ;
SEARCH ;search ^%ZTSCH for task
+1 IF $DATA(^%ZTSCH("TASK",ZTSK))#2
Begin DoDot:1
+2 SET ZTSK(0)=1
SET ZTSK(1)=2
SET ZTSK(2)="Active: Running"
+3 ;With a zero lock timeout it may report "active" falsely
+4 ;p446
LOCK +^%ZTSCH("TASK",ZTSK):0
IF $TEST
SET ZTSK(1)=5
SET ZTSK(2)="Inactive: Interrupted"
LOCK -^%ZTSCH("TASK",ZTSK)
+5 QUIT
End DoDot:1
QUIT
+6 ;*339
SET ZT1=0
Begin DoDot:1
+7 FOR
SET ZT1=$ORDER(^%ZTSCH(ZT1))
if ZT1'>0
QUIT
IF $DATA(^%ZTSCH(ZT1,ZTSK))#2
SET ZTSK(0)=1
SET ZTSK(1)=1
SET ZTSK(2)="Active: Pending"
QUIT
End DoDot:1
if ZTSK(0)
QUIT
+8 SET ZT1=""
Begin DoDot:1
+9 FOR
SET ZT1=$ORDER(^%ZTSCH("IO",ZT1))
SET ZT2=""
if ZT1=""
QUIT
Begin DoDot:2
+10 FOR
SET ZT2=$ORDER(^%ZTSCH("IO",ZT1,ZT2))
if ZT2=""
QUIT
IF $DATA(^(ZT2,ZTSK))#2
SET ZTSK(0)=1
SET ZTSK(1)=1
SET ZTSK(2)="Active: Pending"
QUIT
End DoDot:2
if ZTSK(0)
QUIT
End DoDot:1
if ZTSK(0)
QUIT
+11 SET ZT1=""
Begin DoDot:1
+12 FOR
SET ZT1=$ORDER(^%ZTSCH("JOB",ZT1))
if ZT1=""
QUIT
IF $DATA(^(ZT1,ZTSK))#2
SET ZTSK(0)=1
SET ZTSK(1)=1
SET ZTSK(2)="Active: Pending"
QUIT
End DoDot:1
if ZTSK(0)
QUIT
+13 SET ZT1=""
Begin DoDot:1
+14 FOR
SET ZT1=$ORDER(^%ZTSCH("LINK",ZT1))
SET ZT2=""
if ZT1=""
QUIT
Begin DoDot:2
+15 FOR
SET ZT2=$ORDER(^%ZTSCH("LINK",ZT1,ZT2))
if ZT2=""
QUIT
IF $DATA(^(ZT2,ZTSK))#2
SET ZTSK(0)=1
SET ZTSK(1)=1
SET ZTSK(2)="Active: Pending"
QUIT
End DoDot:2
if ZTSK(0)
QUIT
End DoDot:1
if ZTSK(0)
QUIT
+16 ;*339
SET ZT1=0
Begin DoDot:1
+17 FOR
SET ZT1=$ORDER(^%ZTSCH("C",ZT1))
if ZT1'>0
QUIT
IF $DATA(^(ZT1,ZTSK))
SET ZTSK(0)=1
SET ZTSK(2)="Active: Pending"
QUIT
End DoDot:1
if ZTSK(0)
QUIT
+18 ;
FLAG ;If we didn't find it in a list, use status flag
+1 IF $DATA(^%ZTSK(ZTSK,.1))[0
QUIT
+2 SET ZT=$PIECE(^%ZTSK(ZTSK,.1),U)
SET ZTSK(0)=1
+3 IF ZT=2!(ZT=4)
SET ZTSK(1)=1
SET ZTSK(2)="Active: Pending"
QUIT
+4 IF ZT=6
SET ZTSK(1)=3
SET ZTSK(2)="Inactive: Finished"
QUIT
+5 IF ZT="H"!(ZT="K")
SET ZTSK(1)=4
SET ZTSK(2)="Inactive: Available"
QUIT
+6 SET ZTSK(1)=5
SET ZTSK(2)="Inactive: Interrupted"
+7 QUIT
+8 ;
DESC ;Find tasks with matching description.
+1 ;From %ZTLOAD input param DESC,LST
+2 if $GET(DESC)=""
QUIT
+3 NEW ZTSK,X
DO ENV
+4 if '$DATA(LST)
SET LST="^TMP($J)"
SET ZTSK=0
+5 FOR
SET ZTSK=$ORDER(^%ZTSK(ZTSK))
if ZTSK'>0
QUIT
SET X=$GET(^%ZTSK(ZTSK,0))
Begin DoDot:1
+6 if $$SKIP()
QUIT
+7 IF $GET(^%ZTSK(ZTSK,.03))=DESC
SET @LST@(ZTSK)=""
+8 QUIT
End DoDot:1
+9 QUIT
RTN ;Find tasks with matching routines
+1 ;From %ZTLOAD input param RTN,LST
+2 if $GET(RTN)=""
QUIT
+3 NEW ZTSK,X
DO ENV
+4 if '$DATA(LST)
SET LST="^TMP($J)"
if RTN'["^"
SET RTN="^"_RTN
SET ZTSK=0
+5 FOR
SET ZTSK=$ORDER(^%ZTSK(ZTSK))
if ZTSK'>0
QUIT
SET X=$GET(^%ZTSK(ZTSK,0))
Begin DoDot:1
+6 if $$SKIP()
QUIT
+7 IF $PIECE(X,"^",1,2)=RTN
SET @LST@(ZTSK)=""
QUIT
+8 IF "^"_($PIECE(X,"^",2))=RTN
SET @LST@(ZTSK)=""
+9 QUIT
End DoDot:1
+10 QUIT
OPTION ;Find tasks with matching option names
+1 ;From %ZTLOAD input param OPNM, LST
+2 if $GET(OPNM)=""
QUIT
NEW ZTSK,X,FLG
DO ENV
+3 if '$DATA(LST)
SET LST="^TMP($J)"
SET ZTSK=0
SET FLG=(OPNM?1.N1"^"1A.ANP)
+4 if 'FLG&(OPNM'?1A.ANP)
QUIT
+5 FOR
SET ZTSK=$ORDER(^%ZTSK(ZTSK))
if ZTSK'>0
QUIT
SET X=$GET(^%ZTSK(ZTSK,0))
Begin DoDot:1
+6 if $$SKIP()
QUIT
+7 IF FLG
IF $PIECE(X,"^",8,9)=OPNM
SET @LST@(ZTSK)=""
QUIT
+8 IF $PIECE(X,"^",1,2)="ZTSK^XQ1"
IF $PIECE(X,"^",9)=OPNM
SET @LST@(ZTSK)=""
+9 QUIT
End DoDot:1
+10 QUIT
SKIP() ;Screen on ZTKEY, UCI, DUZ, return: 0=OK, 1=Skip
+1 if ZTKEY
QUIT 0
+2 if ($PIECE(X,U,11)_","_$PIECE(X,U,12))'=ZTUCI
QUIT 1
+3 if $PIECE(X,U,3)'=DUZ
QUIT 1
+4 QUIT 0
ENV ;Setup
+1 SET ZTKEY=$DATA(^XUSEC("ZTMQ",DUZ))
SET U="^"
+2 XECUTE ^%ZOSF("UCI")
SET ZTUCI=Y
+3 QUIT
+4 ;
JOB ;Return JOB # for running task. Called from JOB^ZTLOAD (*339)
+1 NEW Z1,Z2
SET Z1=""
+2 IF $GET(ZTM)>0
SET Z2=$GET(^%ZTSCH("TASK",ZTM))
SET Z1=$SELECT($LENGTH(Z2):$PIECE(Z2,"^",10),1:"")
+3 QUIT Z1
