XUTMRP.m

XUTMRP ;ISF/RWF,BOSTON/MEF - REQUEUE ALL TASKS FOR A DEVICE -PART ONE ;06/11/2001  11:13 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**2,20,86,120,169**;Jul 10, 1995

 ;REPNT=1 if your using the ZZWFRep option because the device's lta#

 ; was changed 

INIT ;Setup

 Q:$D(DUZ)[0  Q:DUZ=""!(DUZ=0)  D ENV^XUTMUTL S XUCPU=$P(XUTMUCI,",",2)

 ;

 N WAIT,FUT,MEFEND,DIR,XUTMDTH K ^TMP($J)

 D WAIT ;Get what list to work on.

 G:('FUT&'WAIT) EXIT G:($G(MEFEND)&'WAIT) EXIT

OPT W ! S DIR(0)="Y",DIR("A")="Change the device field in the option Scheduling file"

 S DIR("B")="NO",DIR("?")="A yes answer will permanently change the schedule for these tasks"

 D ^DIR K DIR Q:$D(DIRUT)!($D(DUOUT))  S OPT=Y

 W !

 ;

DEV D ASKD("Requeue tasks for device: ") K DIC G:Y'>0 EXIT

 S OLDLTA=LTA,CONFDEV=DEV D DVARRY("OLDDEV",OLDLTA,1)

 D ASKD("Requeue to device: ") K DIC G:Y'>0 EXIT

 D DEV2

 I Y'>0 D EXIT Q  ;no target device

 S CONFDEV(CONFDEV)=DEV D DVARRY("NEWDEV",LTA)

CONF S DEVNAM=""

 F  S DEVNAM=$O(OLDDEV(DEVNAM)) Q:DEVNAM=""  I '$D(CONFDEV(DEVNAM)) D

 . S DEV="" F  S DEV=$O(CONFDEV(DEV)) Q:DEV=""  I $P(OLDDEV(DEVNAM),";",3,4)=$P(NEWDEV(CONFDEV(DEV)),";",3,4) S CONFDEV(DEVNAM)=CONFDEV(DEV) Q

 . Q

 D ^XUTMRP1

 ;

EXIT K CONFDEV,DEL,DEV,DEVNAM,DIC,DIRUT,DUOUT,EDATE,EDT,FUT,I,II,LTA,MEFEND

 K NEWDEV,OLDDEV,OLDLTA,POP,SDATE,SDT,SN,SRCE,WAIT,XQH,Y,XUCPU,ZTDH,ZTIO

 K OPT,ZTKEY,ZTMD,ZTNAME,ZTUCI,ZTSK,ZTC,ZTOPT,XUTMDTH,^TMP($J)

 Q

 ;

DEVNAM(ARRAY) ;Build @ARRAY@(devname) from DEVNAM 

 S DEVNAM=""

 F  S DEVNAM=$O(DEVNAM(DEVNAM)) Q:DEVNAM=""  S IOP=DEVNAM D D0 S @ARRAY@(DEVNAM)=ZTIO K DEVNAM(DEVNAM)

 Q

 ;Slave printers and Spool Documents not allowed

ASKD(%A,%B) ;Ask for a device

 N DIC S:$G(%A)]"" DIC("A")=%A S:$G(%B)]"" DIC("B")=%B

 S DIC("S")="I $S($L($P(^(0),U,9)):($P(^(0),U,9)=XUCPU),$P(^(0),U,2)=0:0,""^SPL^VTRM^MT^OTH""[(U_$P(^(""TYPE""),U)):0,+$G(^(90)):$S(^(90)'>DT:0,1:1),1:1)",DIC="^%ZIS(1,",DIC(0)="AEMQZ"

 D ^DIC Q:Y'>0

 S DEV=Y(0,0),LTA=$P(Y(0),U,2)

 Q

 ;

DVARRY(II,LTA,OOS) ;Build list of devices for a LTA.

 N SN S OOS=$G(OOS)

 F SN=0:0 S SN=$O(^%ZIS(1,"C",LTA,SN)) Q:SN'>0  S (ZTMD,IOP)=$P(^%ZIS(1,+SN,0),U) D

 . I $S($L($P(^(0),U,9)):($P(^(0),U,9)=XUCPU),$P(^(0),U,2)=0:0,"^SPL^VTRM^MT^OTH"[(U_$P(^("TYPE"),U)):0,OOS:1,+$G(^(90)):$S(^(90)'>DT:0,1:1),1:1) D D0 S @II@(ZTMD)=ZTIO

 Q

 ;

WAIT S (WAIT,FUT)=0

 S DIR(0)="Y",DIR("A")="Do you want to re-direct waiting tasks",DIR("B")="Yes" D ^DIR K DIR Q:$D(DIRUT)!($D(DUOUT))  S WAIT=Y

 ;

FUT W ! S DIR(0)="Y",DIR("A")="Do you want to re-direct future tasks",DIR("B")="NO" D ^DIR K DIR Q:$D(DIRUT)!($D(DUOUT))  S FUT=Y

 I FUT D

 . W !,"Now give a date/time range of future tasks to change."

 . S SDT=$$DT("STARTING DATE/TIME","NOW") Q:SDT'>0

 . S EDT=$$DT("ENDING DATE/TIME","T@24:00") Q:EDT'>0

 . I SDT>EDT S ZDT=SDT,SDT=EDT,EDT=ZDT

 . S SDATE=$$FMTE^XLFDT(SDT),EDATE=$$FMTE^XLFDT(EDT)

 Q

 ;

REPNT ;Re-queues tasks to new lta# when dsv/ports are changed

 Q:$D(DUZ)[0  Q:DUZ=""!(DUZ=0)  D ENV^XUTMUTL S XUCPU=$P(XUTMUCI,",",2)

 K ^TMP($J),EXIT S REPNT=1

 D REP2

 G:$G(EXIT) EXIT D ^XUTMRP1,EXIT

 Q

REP2 ;

 D WAIT I $D(DIRUT)!($D(DUOUT)) S EXIT=1 Q

 W ! S DIR("A")="Enter old $I (i.e. _LTA111: or 367) ",DIR(0)="F^1:55",DIR("?")="^D LISTIO^XUTMRP" D ^DIR

 I $D(DIRUT)!($D(DUOUT)) S EXIT=1 Q

 I $O(^%ZTSCH("IO",Y,0))="" S EXIT=1 W !,"There are NO tasks waiting for this device.",!

 S OLDLTA=Y Q:$G(EXIT)

 W ! D ASKD("Requeue tasks to device: ") ;Returns LTA,Y,DEV

 K DIC I Y'>0 D  Q:$G(EXIT)

 . K DIR S DIR(0)="Y",DIR("A")="Want to just move the Tasks back to the schedul list with a new run time:"

 . D ^DIR I 'Y S EXIT=1 Q

 . S LTA=OLDLTA

 . Q

 S NEWLTA=LTA

 D DVARRY("NEWDEV",NEWLTA),DVARRY("OLDDEV",OLDLTA,1)

 S II=""

 F  S II=$O(NEWDEV(II)) Q:II=""  S CONFDEV(II)=II

 S XUTMDTH=$$DT("When to have the tasks restart:","NOW")

 Q

 ;

DEV2 ;Return Y=0 to quit

 S IOP=DEV,Y=1 D D0

 Q:$P(OLDDEV(CONFDEV),";",3,4)=$P(ZTIO,";",3,4)

 S SRCE=OLDDEV(CONFDEV)

 W !,$C(7),$P(SRCE,";")," margin ",$P(SRCE,";",3)," page length ",$P(SRCE,";",4),$C(7)

 W !,"doesn't match ",$P(ZTIO,";")," margin ",$P(ZTIO,";",3)," page length ",$P(ZTIO,";",4)

 W !,"Please confirm target device.",!,"If I can find a matching margin/page length",!,"I'll use it for the default.",!!,$C(7)

 D DVARRY("DEVNAM",LTA)

 S DEVNAM="" F  S DEVNAM=$O(DEVNAM(DEVNAM))  Q:DEVNAM=""  Q:$P(DEVNAM(DEVNAM),";",3,4)=$P(OLDDEV(CONFDEV),";",3,4)

 I DEVNAM]"" S DEFDEV=DEVNAM

 K DEVNAM D ASKD("Requeue to device: ",$G(DEFDEV)) K DIC,DEFDEV Q:Y'>0

 S IOP=DEV D D0

 Q

 ;

D0 ;

 S %ZIS="NQZ" D ^%ZIS

 S ZTIO=$S($D(IOS)[0:"",POP:"",$D(ION)[0:"",ION]"":ION,IOS="":"",$D(^%ZIS(1,IOS,0))[0:"",1:$P(^(0),U))

 S ZTIO=ZTIO_$S($D(IOST)[0:"",1:";"_IOST)_$S($D(IO("DOC"))[0:$S($D(IOM)[0:"",1:";"_IOM_$S($D(IOSL)[0:"",1:";"_IOSL)),1:";"_IO("DOC"))_$S($D(IO("P"))[0:"",IO("P")="":"",1:";/"_IO("P"))

 S:$D(IOCPU)#2 XUCPU=IOCPU

 I $D(IO("HFSIO"))#2,$D(IOPAR)#2,IOT="HFS" S ZTIO("H")=IO("HFSIO"),ZTIO("P")=IOPAR

 Q

 ;

DT(MES,DEF) S DIR("A")=MES,DIR("B")=DEF

 S DIR(0)="D^DT::AEFT",DIR("?")="This response must be a date/time"

 D ^DIR K DIR

 Q Y

LISTIO ;List the entries in the IO queue.

 N DEV,I,Y,DIR

 S DEV="" W @IOF

 W !,"  $IO       Device names",!,"_______     ____________"

 F  S DEV=$O(^%ZTSCH("IO",DEV)) Q:DEV=""  D

 . Q:$D(^%ZTSCH("IO",DEV))'>2

 . W !,DEV,?14," => "

 . F I=0:0 S I=$O(^%ZIS(1,"C",DEV,I)) Q:I'>0  S Y=$P($G(^%ZIS(1,I,0)),U) W:$X+$L(Y)+2>79 !,?18 W Y,", "

 . I ($Y+4)>IOSL S DIR(0)="E" D ^DIR S:$D(DIRUT) DEV=$C(126) W @IOF

 . Q

 Q

XUTMRP    ;ISF/RWF,BOSTON/MEF - REQUEUE ALL TASKS FOR A DEVICE -PART ONE ;06/11/2001  11:13 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**2,20,86,120,169**;Jul 10, 1995

 +3       ;REPNT=1 if your using the ZZWFRep option because the device's lta#

 +4       ; was changed 

INIT      ;Setup

 +1        IF $DATA(DUZ)[0

               QUIT 

           IF DUZ=""!(DUZ=0)

               QUIT 

           DO ENV^XUTMUTL

           SET XUCPU=$PIECE(XUTMUCI,",",2)

 +2       ;

 +3        NEW WAIT,FUT,MEFEND,DIR,XUTMDTH

           KILL ^TMP($JOB)

 +4       ;Get what list to work on.

           DO WAIT

 +5        IF ('FUT&'WAIT)

               GOTO EXIT

           IF ($GET(MEFEND)&'WAIT)

               GOTO EXIT

OPT        WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Change the device field in the option Scheduling file"

 +1        SET DIR("B")="NO"

           SET DIR("?")="A yes answer will permanently change the schedule for these tasks"

 +2        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!($DATA(DUOUT))

               QUIT 

           SET OPT=Y

 +3        WRITE !

 +4       ;

DEV        DO ASKD("Requeue tasks for device: ")

           KILL DIC

           IF Y'>0

               GOTO EXIT

 +1        SET OLDLTA=LTA

           SET CONFDEV=DEV

           DO DVARRY("OLDDEV",OLDLTA,1)

 +2        DO ASKD("Requeue to device: ")

           KILL DIC

           IF Y'>0

               GOTO EXIT

 +3        DO DEV2

 +4       ;no target device

           IF Y'>0

               DO EXIT

               QUIT 

 +5        SET CONFDEV(CONFDEV)=DEV

           DO DVARRY("NEWDEV",LTA)

CONF       SET DEVNAM=""

 +1        FOR 

               SET DEVNAM=$ORDER(OLDDEV(DEVNAM))

               IF DEVNAM=""

                   QUIT 

               IF '$DATA(CONFDEV(DEVNAM))

                   Begin DoDot:1

 +2                    SET DEV=""

                       FOR 

                           SET DEV=$ORDER(CONFDEV(DEV))

                           IF DEV=""

                               QUIT 

                           IF $PIECE(OLDDEV(DEVNAM),";",3,4)=$PIECE(NEWDEV(CONFDEV(DEV)),";",3,4)

                               SET CONFDEV(DEVNAM)=CONFDEV(DEV)

                               QUIT 

 +3                    QUIT 

                   End DoDot:1

 +4        DO ^XUTMRP1

 +5       ;

EXIT       KILL CONFDEV,DEL,DEV,DEVNAM,DIC,DIRUT,DUOUT,EDATE,EDT,FUT,I,II,LTA,MEFEND

 +1        KILL NEWDEV,OLDDEV,OLDLTA,POP,SDATE,SDT,SN,SRCE,WAIT,XQH,Y,XUCPU,ZTDH,ZTIO

 +2        KILL OPT,ZTKEY,ZTMD,ZTNAME,ZTUCI,ZTSK,ZTC,ZTOPT,XUTMDTH,^TMP($JOB)

 +3        QUIT 

 +4       ;

DEVNAM(ARRAY) ;Build @ARRAY@(devname) from DEVNAM 

 +1        SET DEVNAM=""

 +2        FOR 

               SET DEVNAM=$ORDER(DEVNAM(DEVNAM))

               IF DEVNAM=""

                   QUIT 

               SET IOP=DEVNAM

               DO D0

               SET @ARRAY@(DEVNAM)=ZTIO

               KILL DEVNAM(DEVNAM)

 +3        QUIT 

 +4       ;Slave printers and Spool Documents not allowed

ASKD(%A,%B) ;Ask for a device

 +1        NEW DIC

           IF $GET(%A)]""

               SET DIC("A")=%A

           IF $GET(%B)]""

               SET DIC("B")=%B

 +2        SET DIC("S")="I $S($L($P(^(0),U,9)):($P(^(0),U,9)=XUCPU),$P(^(0),U,2)=0:0,""^SPL^VTRM^MT^OTH""[(U_$P(^(""TYPE""),U)):0,+$G(^(90)):$S(^(90)'>DT:0,1:1),1:1)"

           SET DIC="^%ZIS(1,"

           SET DIC(0)="AEMQZ"

 +3        DO ^DIC

           IF Y'>0

               QUIT 

 +4        SET DEV=Y(0,0)

           SET LTA=$PIECE(Y(0),U,2)

 +5        QUIT 

 +6       ;

DVARRY(II,LTA,OOS) ;Build list of devices for a LTA.

 +1        NEW SN

           SET OOS=$GET(OOS)

 +2        FOR SN=0:0

               SET SN=$ORDER(^%ZIS(1,"C",LTA,SN))

               IF SN'>0

                   QUIT 

               SET (ZTMD,IOP)=$PIECE(^%ZIS(1,+SN,0),U)

               Begin DoDot:1

 +3                IF $SELECT($LENGTH($PIECE(^(0),U,9)):($PIECE(^(0),U,9)=XUCPU),$PIECE(^(0),U,2)=0:0,"^SPL^VTRM^MT^OTH"[(U_$PIECE(^("TYPE"),U)):0,OOS:1,+$GET(^(90)):$SELECT(^(90)'>DT:0,1:1),1:1)

                       DO D0

                       SET @II@(ZTMD)=ZTIO

               End DoDot:1

 +4        QUIT 

 +5       ;

WAIT       SET (WAIT,FUT)=0

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you want to re-direct waiting tasks"

           SET DIR("B")="Yes"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!($DATA(DUOUT))

               QUIT 

           SET WAIT=Y

 +2       ;

FUT        WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Do you want to re-direct future tasks"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!($DATA(DUOUT))

               QUIT 

           SET FUT=Y

 +1        IF FUT

               Begin DoDot:1

 +2                WRITE !,"Now give a date/time range of future tasks to change."

 +3                SET SDT=$$DT("STARTING DATE/TIME","NOW")

                   IF SDT'>0

                       QUIT 

 +4                SET EDT=$$DT("ENDING DATE/TIME","T@24:00")

                   IF EDT'>0

                       QUIT 

 +5                IF SDT>EDT

                       SET ZDT=SDT

                       SET SDT=EDT

                       SET EDT=ZDT

 +6                SET SDATE=$$FMTE^XLFDT(SDT)

                   SET EDATE=$$FMTE^XLFDT(EDT)

               End DoDot:1

 +7        QUIT 

 +8       ;

REPNT     ;Re-queues tasks to new lta# when dsv/ports are changed

 +1        IF $DATA(DUZ)[0

               QUIT 

           IF DUZ=""!(DUZ=0)

               QUIT 

           DO ENV^XUTMUTL

           SET XUCPU=$PIECE(XUTMUCI,",",2)

 +2        KILL ^TMP($JOB),EXIT

           SET REPNT=1

 +3        DO REP2

 +4        IF $GET(EXIT)

               GOTO EXIT

           DO ^XUTMRP1

           DO EXIT

 +5        QUIT 

REP2      ;

 +1        DO WAIT

           IF $DATA(DIRUT)!($DATA(DUOUT))

               SET EXIT=1

               QUIT 

 +2        WRITE !

           SET DIR("A")="Enter old $I (i.e. _LTA111: or 367) "

           SET DIR(0)="F^1:55"

           SET DIR("?")="^D LISTIO^XUTMRP"

           DO ^DIR

 +3        IF $DATA(DIRUT)!($DATA(DUOUT))

               SET EXIT=1

               QUIT 

 +4        IF $ORDER(^%ZTSCH("IO",Y,0))=""

               SET EXIT=1

               WRITE !,"There are NO tasks waiting for this device.",!

 +5        SET OLDLTA=Y

           IF $GET(EXIT)

               QUIT 

 +6       ;Returns LTA,Y,DEV

           WRITE !

           DO ASKD("Requeue tasks to device: ")

 +7        KILL DIC

           IF Y'>0

               Begin DoDot:1

 +8                KILL DIR

                   SET DIR(0)="Y"

                   SET DIR("A")="Want to just move the Tasks back to the schedul list with a new run time:"

 +9                DO ^DIR

                   IF 'Y

                       SET EXIT=1

                       QUIT 

 +10               SET LTA=OLDLTA

 +11               QUIT 

               End DoDot:1

               IF $GET(EXIT)

                   QUIT 

 +12       SET NEWLTA=LTA

 +13       DO DVARRY("NEWDEV",NEWLTA)

           DO DVARRY("OLDDEV",OLDLTA,1)

 +14       SET II=""

 +15       FOR 

               SET II=$ORDER(NEWDEV(II))

               IF II=""

                   QUIT 

               SET CONFDEV(II)=II

 +16       SET XUTMDTH=$$DT("When to have the tasks restart:","NOW")

 +17       QUIT 

 +18      ;

DEV2      ;Return Y=0 to quit

 +1        SET IOP=DEV

           SET Y=1

           DO D0

 +2        IF $PIECE(OLDDEV(CONFDEV),";",3,4)=$PIECE(ZTIO,";",3,4)

               QUIT 

 +3        SET SRCE=OLDDEV(CONFDEV)

 +4        WRITE !,$CHAR(7),$PIECE(SRCE,";")," margin ",$PIECE(SRCE,";",3)," page length ",$PIECE(SRCE,";",4),$CHAR(7)

 +5        WRITE !,"doesn't match ",$PIECE(ZTIO,";")," margin ",$PIECE(ZTIO,";",3)," page length ",$PIECE(ZTIO,";",4)

 +6        WRITE !,"Please confirm target device.",!,"If I can find a matching margin/page length",!,"I'll use it for the default.",!!,$CHAR(7)

 +7        DO DVARRY("DEVNAM",LTA)

 +8        SET DEVNAM=""

           FOR 

               SET DEVNAM=$ORDER(DEVNAM(DEVNAM))

               IF DEVNAM=""

                   QUIT 

               IF $PIECE(DEVNAM(DEVNAM),";",3,4)=$PIECE(OLDDEV(CONFDEV),";",3,4)

                   QUIT 

 +9        IF DEVNAM]""

               SET DEFDEV=DEVNAM

 +10       KILL DEVNAM

           DO ASKD("Requeue to device: ",$GET(DEFDEV))

           KILL DIC,DEFDEV

           IF Y'>0

               QUIT 

 +11       SET IOP=DEV

           DO D0

 +12       QUIT 

 +13      ;

D0        ;

 +1        SET %ZIS="NQZ"

           DO ^%ZIS

 +2        SET ZTIO=$SELECT($DATA(IOS)[0:"",POP:"",$DATA(ION)[0:"",ION]"":ION,IOS="":"",$DATA(^%ZIS(1,IOS,0))[0:"",1:$PIECE(^(0),U))

 +3        SET ZTIO=ZTIO_$SELECT($DATA(IOST)[0:"",1:";"_IOST)_$SELECT($DATA(IO("DOC"))[0:$SELECT($DATA(IOM)[0:"",1:";"_IOM_$SELECT($DATA(IOSL)[0:"",1:";"_IOSL)),1:";"_IO("DOC"))_$SELECT($DATA(IO("P"))[0:"",IO("P")="":"",1:";/"_IO("P"))

 +4        IF $DATA(IOCPU)#2

               SET XUCPU=IOCPU

 +5        IF $DATA(IO("HFSIO"))#2

               IF $DATA(IOPAR)#2

                   IF IOT="HFS"

                       SET ZTIO("H")=IO("HFSIO")

                       SET ZTIO("P")=IOPAR

 +6        QUIT 

 +7       ;

DT(MES,DEF)  SET DIR("A")=MES

           SET DIR("B")=DEF

 +1        SET DIR(0)="D^DT::AEFT"

           SET DIR("?")="This response must be a date/time"

 +2        DO ^DIR

           KILL DIR

 +3        QUIT Y

LISTIO    ;List the entries in the IO queue.

 +1        NEW DEV,I,Y,DIR

 +2        SET DEV=""

           WRITE @IOF

 +3        WRITE !,"  $IO       Device names",!,"_______     ____________"

 +4        FOR 

               SET DEV=$ORDER(^%ZTSCH("IO",DEV))

               IF DEV=""

                   QUIT 

               Begin DoDot:1

 +5                IF $DATA(^%ZTSCH("IO",DEV))'>2

                       QUIT 

 +6                WRITE !,DEV,?14," => "

 +7                FOR I=0:0

                       SET I=$ORDER(^%ZIS(1,"C",DEV,I))

                       IF I'>0

                           QUIT 

                       SET Y=$PIECE($GET(^%ZIS(1,I,0)),U)

                       IF $X+$LENGTH(Y)+2>79

                           WRITE !,?18

                       WRITE Y,", "

 +8                IF ($Y+4)>IOSL

                       SET DIR(0)="E"

                       DO ^DIR

                       IF $DATA(DIRUT)

                           SET DEV=$CHAR(126)

                       WRITE @IOF

 +9                QUIT 

               End DoDot:1

 +10       QUIT