XUTMG19.m

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 ---XUTMG19   4532     printed  Mar 13, 2025@21:18:10                                                                                                                                                                                                     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