XUTMG19 ;SF/RWF - TaskMan Code For File 19.2 ;06/09/99 09:32
;;8.0;KERNEL;**20,67,118**;Jul 10, 1995
;
Q
FIND ;subroutine--find scheduled task that will run this option
;Return XUTASK = task number, XUDTH = H3 time
N %,OPT,X,X1,Y X ^%ZOSF("UCI") S XUTASK=0,Y=$P(Y,","),OPT=$$GET(19,$$GET(19.2,DA,.01),.01)
S X=+$S($D(ZTMQDT):ZTMQDT,$D(^DIC(19.2,DA,0)):$$GET(19.2,DA,2),1:0) Q:'X
S XUDTH=$$H3^%ZTM($$FMTH^XLFDT(X))
S %=$$GET(19.2,DA,12) I %>0 D CHECK Q:XUTASK
F S %=$O(^%ZTSCH(XUDTH,%)) Q:%'>0 I $P($G(^%ZTSK(%,0)),"^",1,2)="ZTSK^XQ1" D CHECK Q:XUTASK
Q
CHECK ;Check a task
S X1=$G(^%ZTSK(%,0)) Q:$P(X1,"^",1,2)'="ZTSK^XQ1" Q:$P(X1,"^",11)'=Y
I $G(^%ZTSK(%,.03))'[OPT Q ;Check for name in desc.
S:$G(^%ZTSK(%,.3,"XQSCH"))=DA XUTASK=%
Q
;
GET(FN,IEN,FE) ;
N A,B,C
S A=$G(^DD(FN,FE,0)),A=$P(A,"^",4)
S B=$P(A,";"),C=$P(A,";",2)
Q $P($G(^DIC(FN,IEN,B)),"^",C)
;--------------------------------------------------------------------
IT2 ;input transform for time (#2)
N Y,% S %DT="ETRXF" D ^%DT S X=Y,%=$$NOW^XLFDT() I %+.0002>X K X
I '$D(X),'$D(DDS) D CT^XUTMG19
Q
;
CT ;IT2--show current time %=NOW
W !,?5,"The current time is ",$E(%,9,10),":",$E(%,11,12)
Q
;
S2 ;set logic for AZTM cross-reference on time (#2)
N DV,ZTSK,ZTIO,ZTDTH,ZTDESC,ZTRTN,ZTCPU,X1
S ZTDTH=X I 'ZTDTH G EXIT
S ZTCPU=$$GET(19.2,DA,5) I ZTCPU']"" K ZTCPU
S ZTRTN="ZTSK^XQ1"
S ZTSAVE("XQSCH")=DA,X1=+^DIC(19.2,DA,0),ZTSAVE("XQY")=X1
S ZTDESC=$P(^DIC(19,X1,0),U)_" - "_$P(^DIC(19,X1,0),U,2)
S ZTIO=$$GET(19.2,DA,3)
D ^%ZTLOAD S ^DIC(19.2,DA,1)=ZTSK
EXIT Q
;
K2 ;kill logic for AZTM cross-reference on time (#2)
N XUTASK,XUDTH,XUTMT S ZTMQDT=X D FIND K ZTMQDT I XUTASK'>0 Q
Q:XUTASK=$G(ZTQUEUED)
S XUTMT=XUTASK,^DIC(19.2,DA,1)="" D ^XUTMTD
Q
;
;--------------------------------------------------------------------
;
IT3 ;input transform for device (#3)
N DIC,Y,XUTMG19
I X[""""!($A(X)=45)!($L(X)>70) K X Q
S DIC="^%ZIS(1,",DIC(0)="E",XUTMG19=X,X=$P(X,";") D ^DIC
I Y=-1 K X Q
S $P(XUTMG19,";")=$P(Y,U,2),IOP=XUTMG19,%ZIS="NQR" D ^%ZIS
I POP K X
E S X=ION_";"_$S($D(IO("DOC"))#2:IO("DOC"),1:IOST_";"_IOM_";"_IOSL)
D RESETVAR^%ZIS
Q
;
S3 ;set logic for AZTIO cross-reference of device (#3)
N XUTASK,XUDTH D FIND I XUTASK'>0 Q
S $P(^%ZTSK(XUTASK,.2),U)=X
Q
;
K3 ;kill logic for AZTIO cross-reference of device (#3)
N XUTASK,XUDTH D FIND I XUTASK'>0 Q
S $P(^%ZTSK(XUTASK,.2),U)=""
Q
;
;--------------------------------------------------------------------
;
IT6 ;input transform for re-sch freq
I $L(X)>15!($L(X)<2) K X Q
I X?1.3N1"H" Q
I X?1.4N1"S" Q
I X?1.3N1"D" Q
I X?1.2N1"M" Q
I X?1.2N1"M(".E1")" Q
I "MTWRFSUDE"[$E(X),"@,"[$E(X,2) Q
K X
Q
;
;-------------------------------------------------------------------
;
IT5 ;input transform for volume (#5)
N X1,X2 S X1=$P(X,":"),X2=$P(X,":",2)
I X[""""!($A(X)=45) K X Q
I $L(X)>21!($L(X)<2) K X Q
I '((X?1.8UN)!(X?1.8UN.1":".12UN)) K X Q
I X'[":",'$D(^%ZIS(14.5,"B",X)) K X Q
I X[":",'$D(^%ZIS(14.7,"B",X)) K X Q
Q
;
S5 ;set logic for AZTVOL cross-reference of volume
N XUCPU,XUTASK,XUDTH D FIND I XUTASK>0 D
. S $P(^%ZTSK(XUTASK,0),U,14)=X
N X S X=$$GET(19.2,DA,9) D S9 ;Trigger the startup X-ref
Q
;
K5 ;kill logic for AZTVOL cross-reference on volume
N XUCPU,XUTASK,XUDTH D FIND I XUTASK>0 D
. S $P(^%ZTSK(XUTASK,0),U,14)=""
D K9X(X) ;Trigger the startup X-ref
Q
;
;--------------------------------------------------------------------
;
IT9 ;input transform for special queueing (#9)
N Y S Y=$P(^DIC(19,+^DIC(19.2,DA,0),0),U,4)
I Y="A"!(Y="R") Q
K X W $C(7)," ONLY FOR 'ROUTINE' OR 'ACTION' TYPES OF OPTIONS"
Q
;
S9 ;set logic for ASTARTUP cross-reference on special queueing
Q:X'["S" ;Only for startup type
N Y,Y1,XUCPU,XIO S XUCPU=$$GET(19.2,DA,5),Y1=$$GET(19.2,DA,.01)
X ^%ZOSF("UCI") I XUCPU]"" S $P(Y,",",2)=XUCPU
S ^%ZTSCH("STARTUP",Y,DA_"Q"_Y1)=$H_U_$$GET(19.2,DA,3)_U
Q
;
K9 ;kill logic for ASTARTUP cross-reference on special queueing
N Y,Y1,XUCPU S XUCPU=$$GET(19.2,DA,5),Y1=$$GET(19.2,DA,.01)
K9A X ^%ZOSF("UCI") I XUCPU]"" S $P(Y,",",2)=XUCPU
K ^%ZTSCH("STARTUP",Y,Y1),^%ZTSCH("STARTUP",Y,DA_"Q"_Y1)
Q
;
K9X(XUCPU,Y1) ;Kill logic called from other X-ref
N Y S:'$D(XUCPU) XUCPU=$$GET(19.2,DA,5) S:'$D(Y1) Y1=$$GET(19.2,DA,.01)
G K9A
;
XREF ;Reindex the STARTUP nodes
N DIK,DA,X
F DA=0:0 S DA=$O(^DIC(19.2,DA)) Q:DA'>0 S DIK="^DIC(19.2," D IX^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMG19 4532 printed Apr 09, 2024@21:13:21 Page 2
XUTMG19 ;SF/RWF - TaskMan Code For File 19.2 ;06/09/99 09:32
+1 ;;8.0;KERNEL;**20,67,118**;Jul 10, 1995
+2 ;
+3 QUIT
FIND ;subroutine--find scheduled task that will run this option
+1 ;Return XUTASK = task number, XUDTH = H3 time
+2 NEW %,OPT,X,X1,Y
XECUTE ^%ZOSF("UCI")
SET XUTASK=0
SET Y=$PIECE(Y,",")
SET OPT=$$GET(19,$$GET(19.2,DA,.01),.01)
+3 SET X=+$SELECT($DATA(ZTMQDT):ZTMQDT,$DATA(^DIC(19.2,DA,0)):$$GET(19.2,DA,2),1:0)
if 'X
QUIT
+4 SET XUDTH=$$H3^%ZTM($$FMTH^XLFDT(X))
+5 SET %=$$GET(19.2,DA,12)
IF %>0
DO CHECK
if XUTASK
QUIT
+6 FOR
SET %=$ORDER(^%ZTSCH(XUDTH,%))
if %'>0
QUIT
IF $PIECE($GET(^%ZTSK(%,0)),"^",1,2)="ZTSK^XQ1"
DO CHECK
if XUTASK
QUIT
+7 QUIT
CHECK ;Check a task
+1 SET X1=$GET(^%ZTSK(%,0))
if $PIECE(X1,"^",1,2)'="ZTSK^XQ1"
QUIT
if $PIECE(X1,"^",11)'=Y
QUIT
+2 ;Check for name in desc.
IF $GET(^%ZTSK(%,.03))'[OPT
QUIT
+3 if $GET(^%ZTSK(%,.3,"XQSCH"))=DA
SET XUTASK=%
+4 QUIT
+5 ;
GET(FN,IEN,FE) ;
+1 NEW A,B,C
+2 SET A=$GET(^DD(FN,FE,0))
SET A=$PIECE(A,"^",4)
+3 SET B=$PIECE(A,";")
SET C=$PIECE(A,";",2)
+4 QUIT $PIECE($GET(^DIC(FN,IEN,B)),"^",C)
+5 ;--------------------------------------------------------------------
IT2 ;input transform for time (#2)
+1 NEW Y,%
SET %DT="ETRXF"
DO ^%DT
SET X=Y
SET %=$$NOW^XLFDT()
IF %+.0002>X
KILL X
+2 IF '$DATA(X)
IF '$DATA(DDS)
DO CT^XUTMG19
+3 QUIT
+4 ;
CT ;IT2--show current time %=NOW
+1 WRITE !,?5,"The current time is ",$EXTRACT(%,9,10),":",$EXTRACT(%,11,12)
+2 QUIT
+3 ;
S2 ;set logic for AZTM cross-reference on time (#2)
+1 NEW DV,ZTSK,ZTIO,ZTDTH,ZTDESC,ZTRTN,ZTCPU,X1
+2 SET ZTDTH=X
IF 'ZTDTH
GOTO EXIT
+3 SET ZTCPU=$$GET(19.2,DA,5)
IF ZTCPU']""
KILL ZTCPU
+4 SET ZTRTN="ZTSK^XQ1"
+5 SET ZTSAVE("XQSCH")=DA
SET X1=+^DIC(19.2,DA,0)
SET ZTSAVE("XQY")=X1
+6 SET ZTDESC=$PIECE(^DIC(19,X1,0),U)_" - "_$PIECE(^DIC(19,X1,0),U,2)
+7 SET ZTIO=$$GET(19.2,DA,3)
+8 DO ^%ZTLOAD
SET ^DIC(19.2,DA,1)=ZTSK
EXIT QUIT
+1 ;
K2 ;kill logic for AZTM cross-reference on time (#2)
+1 NEW XUTASK,XUDTH,XUTMT
SET ZTMQDT=X
DO FIND
KILL ZTMQDT
IF XUTASK'>0
QUIT
+2 if XUTASK=$GET(ZTQUEUED)
QUIT
+3 SET XUTMT=XUTASK
SET ^DIC(19.2,DA,1)=""
DO ^XUTMTD
+4 QUIT
+5 ;
+6 ;--------------------------------------------------------------------
+7 ;
IT3 ;input transform for device (#3)
+1 NEW DIC,Y,XUTMG19
+2 IF X[""""!($ASCII(X)=45)!($LENGTH(X)>70)
KILL X
QUIT
+3 SET DIC="^%ZIS(1,"
SET DIC(0)="E"
SET XUTMG19=X
SET X=$PIECE(X,";")
DO ^DIC
+4 IF Y=-1
KILL X
QUIT
+5 SET $PIECE(XUTMG19,";")=$PIECE(Y,U,2)
SET IOP=XUTMG19
SET %ZIS="NQR"
DO ^%ZIS
+6 IF POP
KILL X
+7 IF '$TEST
SET X=ION_";"_$SELECT($DATA(IO("DOC"))#2:IO("DOC"),1:IOST_";"_IOM_";"_IOSL)
+8 DO RESETVAR^%ZIS
+9 QUIT
+10 ;
S3 ;set logic for AZTIO cross-reference of device (#3)
+1 NEW XUTASK,XUDTH
DO FIND
IF XUTASK'>0
QUIT
+2 SET $PIECE(^%ZTSK(XUTASK,.2),U)=X
+3 QUIT
+4 ;
K3 ;kill logic for AZTIO cross-reference of device (#3)
+1 NEW XUTASK,XUDTH
DO FIND
IF XUTASK'>0
QUIT
+2 SET $PIECE(^%ZTSK(XUTASK,.2),U)=""
+3 QUIT
+4 ;
+5 ;--------------------------------------------------------------------
+6 ;
IT6 ;input transform for re-sch freq
+1 IF $LENGTH(X)>15!($LENGTH(X)<2)
KILL X
QUIT
+2 IF X?1.3N1"H"
QUIT
+3 IF X?1.4N1"S"
QUIT
+4 IF X?1.3N1"D"
QUIT
+5 IF X?1.2N1"M"
QUIT
+6 IF X?1.2N1"M(".E1")"
QUIT
+7 IF "MTWRFSUDE"[$EXTRACT(X)
IF "@,"[$EXTRACT(X,2)
QUIT
+8 KILL X
+9 QUIT
+10 ;
+11 ;-------------------------------------------------------------------
+12 ;
IT5 ;input transform for volume (#5)
+1 NEW X1,X2
SET X1=$PIECE(X,":")
SET X2=$PIECE(X,":",2)
+2 IF X[""""!($ASCII(X)=45)
KILL X
QUIT
+3 IF $LENGTH(X)>21!($LENGTH(X)<2)
KILL X
QUIT
+4 IF '((X?1.8UN)!(X?1.8UN.1":".12UN))
KILL X
QUIT
+5 IF X'[":"
IF '$DATA(^%ZIS(14.5,"B",X))
KILL X
QUIT
+6 IF X[":"
IF '$DATA(^%ZIS(14.7,"B",X))
KILL X
QUIT
+7 QUIT
+8 ;
S5 ;set logic for AZTVOL cross-reference of volume
+1 NEW XUCPU,XUTASK,XUDTH
DO FIND
IF XUTASK>0
Begin DoDot:1
+2 SET $PIECE(^%ZTSK(XUTASK,0),U,14)=X
End DoDot:1
+3 ;Trigger the startup X-ref
NEW X
SET X=$$GET(19.2,DA,9)
DO S9
+4 QUIT
+5 ;
K5 ;kill logic for AZTVOL cross-reference on volume
+1 NEW XUCPU,XUTASK,XUDTH
DO FIND
IF XUTASK>0
Begin DoDot:1
+2 SET $PIECE(^%ZTSK(XUTASK,0),U,14)=""
End DoDot:1
+3 ;Trigger the startup X-ref
DO K9X(X)
+4 QUIT
+5 ;
+6 ;--------------------------------------------------------------------
+7 ;
IT9 ;input transform for special queueing (#9)
+1 NEW Y
SET Y=$PIECE(^DIC(19,+^DIC(19.2,DA,0),0),U,4)
+2 IF Y="A"!(Y="R")
QUIT
+3 KILL X
WRITE $CHAR(7)," ONLY FOR 'ROUTINE' OR 'ACTION' TYPES OF OPTIONS"
+4 QUIT
+5 ;
S9 ;set logic for ASTARTUP cross-reference on special queueing
+1 ;Only for startup type
if X'["S"
QUIT
+2 NEW Y,Y1,XUCPU,XIO
SET XUCPU=$$GET(19.2,DA,5)
SET Y1=$$GET(19.2,DA,.01)
+3 XECUTE ^%ZOSF("UCI")
IF XUCPU]""
SET $PIECE(Y,",",2)=XUCPU
+4 SET ^%ZTSCH("STARTUP",Y,DA_"Q"_Y1)=$HOROLOG_U_$$GET(19.2,DA,3)_U
+5 QUIT
+6 ;
K9 ;kill logic for ASTARTUP cross-reference on special queueing
+1 NEW Y,Y1,XUCPU
SET XUCPU=$$GET(19.2,DA,5)
SET Y1=$$GET(19.2,DA,.01)
K9A XECUTE ^%ZOSF("UCI")
IF XUCPU]""
SET $PIECE(Y,",",2)=XUCPU
+1 KILL ^%ZTSCH("STARTUP",Y,Y1),^%ZTSCH("STARTUP",Y,DA_"Q"_Y1)
+2 QUIT
+3 ;
K9X(XUCPU,Y1) ;Kill logic called from other X-ref
+1 NEW Y
if '$DATA(XUCPU)
SET XUCPU=$$GET(19.2,DA,5)
if '$DATA(Y1)
SET Y1=$$GET(19.2,DA,.01)
+2 GOTO K9A
+3 ;
XREF ;Reindex the STARTUP nodes
+1 NEW DIK,DA,X
+2 FOR DA=0:0
SET DA=$ORDER(^DIC(19.2,DA))
if DA'>0
QUIT
SET DIK="^DIC(19.2,"
DO IX^DIK
+3 QUIT
