XUTMRP ;ISF/RWF,BOSTON/MEF - REQUEUE ALL TASKS FOR A DEVICE -PART ONE ;06/11/2001 11:13
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMRP 5530 printed Oct 16, 2024@18:14:25 Page 2
XUTMRP ;ISF/RWF,BOSTON/MEF - REQUEUE ALL TASKS FOR A DEVICE -PART ONE ;06/11/2001 11:13
+1 ;;8.0;KERNEL;**2,20,86,120,169**;Jul 10, 1995
+2 ;REPNT=1 if your using the ZZWFRep option because the device's lta#
+3 ; 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
