XUTMRP1 ;SFISC/RWF,BOSTON/MEF - REQUEUE ALL TASKS FOR A DEVICE PART TWO ;06/11/2001 11:12
;;8.0;KERNEL;**2,86,120,169**;Jul 10, 1995
;called by XUTMRP
W !
WTSK I WAIT S ZTDH="" F S ZTDH=$O(^%ZTSCH("IO",OLDLTA,ZTDH)),ZTSK="" Q:ZTDH="" F S ZTSK=$O(^%ZTSCH("IO",OLDLTA,ZTDH,ZTSK)) Q:ZTSK="" D
. L +^%ZTSK(ZTSK) S DEVNAM=$P($P(^%ZTSK(ZTSK,.2),";"),U)
. D CONF:'$D(CONFDEV(DEVNAM)),REQ S:$G(REPNT) ^TMP($J,ZTSK)=""
. L -^%ZTSK(ZTSK) Q
S WAIT=0
;
FTSK I FUT S TT="" F S TT=$O(^%ZTSCH(TT)) Q:TT=""!($E(TT)'?1N) F ZTSK=0:0 S ZTSK=$O(^%ZTSCH(TT,ZTSK)) Q:'ZTSK L +^%ZTSK(ZTSK) D L -^%ZTSK(ZTSK)
. D WT
. I $D(^%ZTSK(ZTSK,0))#2 S DEVNAM=$P($P($G(^(.2)),";"),U) I DEVNAM]"",$D(OLDDEV(DEVNAM)) I $$DATCK D
.. S ZTDTH=$P(^(0),U,6)
.. D CONF:'$D(CONFDEV(DEVNAM))
.. I $G(REPNT) Q:$D(^TMP($J,ZTSK)) ;Already requeued
.. D REQ
.. Q
. Q
;
OPT I $G(OPT) S TT="" F S TT=$O(^DIC(19.2,TT)) Q:TT'>0 D
. S T1=$G(^DIC(19.2,TT,0)),DEVNAM=$P($P(T1,U,3),";")
. Q:DEVNAM="" Q:'$D(OLDDEV(DEVNAM)) L +^DIC(19.2,TT,0)
. S X=NEWDEV(DEVNAME)_";"_$P($P(T1,U,3),";",2,99)
. S $P(^DIC(19.2,TT,0),U,3)=X
. L -^DIC(19.2,TT,0)
. Q
;
END Q ;return to XUTMRP
;
WT S FLAG=1+$G(FLAG)#10 W:'FLAG "."
Q
;
REQ Q:'$D(CONFDEV(DEVNAM))
I $G(XUTMDTH) S ZTDTH=XUTMDTH
S ZTIO=NEWDEV(CONFDEV(DEVNAM)) D REQ^%ZTLOAD K ZTDTH
Q:'ZTSK(0)
W !!,"Requeued ",$S(WAIT:"waiting ",1:""),"task #",ZTSK," to device ",CONFDEV(DEVNAM),!
Q
;
CONF ;Build the CONFDEV array
S DEV="" F S DEV=$O(NEWDEV(DEV)) Q:DEV="" D
. I $D(OLDDEV(DEVNAM)),$P(OLDDEV(DEVNAM),";",3,4)=$P(NEWDEV(DEV),";",3,4) S CONFDEV(DEVNAM)=DEV
. Q
Q:$D(CONFDEV(DEVNAM))>0 ;Have a mapping
;Get user input
D ASKD Q:Y'>0
S CONFDEV(DEVNAM)=DEV,IOP=DEV D D0^XUTMRP S NEWDEV(DEV)=ZTIO,II=""
F S II=$O(OLDDEV(II)) Q:II="" D
. Q:'$D(OLDDEV(DEVNAM))
. I $P(OLDDEV(DEVNAM),";",3,4)=$P(OLDDEV(II),";",3,4),$D(CONFDEV(DEVNAM)) S CONFDEV(II)=CONFDEV(DEVNAM)
;
Q
ASKD ;For devices that don't match ask user
W !!,"I can't find a printer for task #",ZTSK,!," with old device ",DEVNAM," with the correct parameters."
I $D(OLDDEV(DEVNAM)) W !," (MARGIN= ",$P(OLDDEV(DEVNAM),";",3),"/ PAGE LENGTH= ",$P(OLDDEV(DEVNAM),";",4)," )."
W !,"Where should I print it?",! D ASKD^XUTMRP(),DTSK:Y'>0
Q
DTSK D LIST Q:'$G(ZTC)
ASK W !!,"You didn't select a device. Do you want to delete the task"
S %=2 D YN^DICN I %'>0 S XQH="XUTM DELETE TASK" D ^XQH G ASK
S DEL=(%=1) I 'DEL D
. S DIR(0)="Y",DIR("A")="Do you want another chance to select a device"
. S DIR("B")="Yes" D ^DIR K DIR
. Q:$D(DIRUT) Q:'Y
. D ASKD^XUTMRP()
Q:'DEL
D DQ^%ZTLOAD
I ZTSK(0) W !,"Task #",ZTSK," deleted."
Q
DATCK() N X S X=$$HTFM^XLFDT($P(^%ZTSK(ZTSK,0),U,6))
Q X'<SDT&(X'>EDT)
;
LIST ;List a task.
N DIR,DIRUT,DTOUT,DUOUT
S ZTC=0 I $D(^%ZTSK(ZTSK)) D EN^XUTMTP(ZTSK) S ZTC=1
I 'ZTC W !!?5,"That task is not defined in this volume set's Task File."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMRP1 2958 printed Sep 23, 2025@19:49:53 Page 2
XUTMRP1 ;SFISC/RWF,BOSTON/MEF - REQUEUE ALL TASKS FOR A DEVICE PART TWO ;06/11/2001 11:12
+1 ;;8.0;KERNEL;**2,86,120,169**;Jul 10, 1995
+2 ;called by XUTMRP
+3 WRITE !
WTSK IF WAIT
SET ZTDH=""
FOR
SET ZTDH=$ORDER(^%ZTSCH("IO",OLDLTA,ZTDH))
SET ZTSK=""
if ZTDH=""
QUIT
FOR
SET ZTSK=$ORDER(^%ZTSCH("IO",OLDLTA,ZTDH,ZTSK))
if ZTSK=""
QUIT
Begin DoDot:1
+1 LOCK +^%ZTSK(ZTSK)
SET DEVNAM=$PIECE($PIECE(^%ZTSK(ZTSK,.2),";"),U)
+2 if '$DATA(CONFDEV(DEVNAM))
DO CONF
DO REQ
if $GET(REPNT)
SET ^TMP($JOB,ZTSK)=""
+3 LOCK -^%ZTSK(ZTSK)
QUIT
End DoDot:1
+4 SET WAIT=0
+5 ;
FTSK IF FUT
SET TT=""
FOR
SET TT=$ORDER(^%ZTSCH(TT))
if TT=""!($EXTRACT(TT)'?1N)
QUIT
FOR ZTSK=0:0
SET ZTSK=$ORDER(^%ZTSCH(TT,ZTSK))
if 'ZTSK
QUIT
LOCK +^%ZTSK(ZTSK)
Begin DoDot:1
+1 DO WT
+2 IF $DATA(^%ZTSK(ZTSK,0))#2
SET DEVNAM=$PIECE($PIECE($GET(^(.2)),";"),U)
IF DEVNAM]""
IF $DATA(OLDDEV(DEVNAM))
IF $$DATCK
Begin DoDot:2
+3 SET ZTDTH=$PIECE(^(0),U,6)
+4 if '$DATA(CONFDEV(DEVNAM))
DO CONF
+5 ;Already requeued
IF $GET(REPNT)
if $DATA(^TMP($JOB,ZTSK))
QUIT
+6 DO REQ
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
LOCK -^%ZTSK(ZTSK)
+9 ;
OPT IF $GET(OPT)
SET TT=""
FOR
SET TT=$ORDER(^DIC(19.2,TT))
if TT'>0
QUIT
Begin DoDot:1
+1 SET T1=$GET(^DIC(19.2,TT,0))
SET DEVNAM=$PIECE($PIECE(T1,U,3),";")
+2 if DEVNAM=""
QUIT
if '$DATA(OLDDEV(DEVNAM))
QUIT
LOCK +^DIC(19.2,TT,0)
+3 SET X=NEWDEV(DEVNAME)_";"_$PIECE($PIECE(T1,U,3),";",2,99)
+4 SET $PIECE(^DIC(19.2,TT,0),U,3)=X
+5 LOCK -^DIC(19.2,TT,0)
+6 QUIT
End DoDot:1
+7 ;
END ;return to XUTMRP
QUIT
+1 ;
WT SET FLAG=1+$GET(FLAG)#10
if 'FLAG
WRITE "."
+1 QUIT
+2 ;
REQ if '$DATA(CONFDEV(DEVNAM))
QUIT
+1 IF $GET(XUTMDTH)
SET ZTDTH=XUTMDTH
+2 SET ZTIO=NEWDEV(CONFDEV(DEVNAM))
DO REQ^%ZTLOAD
KILL ZTDTH
+3 if 'ZTSK(0)
QUIT
+4 WRITE !!,"Requeued ",$SELECT(WAIT:"waiting ",1:""),"task #",ZTSK," to device ",CONFDEV(DEVNAM),!
+5 QUIT
+6 ;
CONF ;Build the CONFDEV array
+1 SET DEV=""
FOR
SET DEV=$ORDER(NEWDEV(DEV))
if DEV=""
QUIT
Begin DoDot:1
+2 IF $DATA(OLDDEV(DEVNAM))
IF $PIECE(OLDDEV(DEVNAM),";",3,4)=$PIECE(NEWDEV(DEV),";",3,4)
SET CONFDEV(DEVNAM)=DEV
+3 QUIT
End DoDot:1
+4 ;Have a mapping
if $DATA(CONFDEV(DEVNAM))>0
QUIT
+5 ;Get user input
+6 DO ASKD
if Y'>0
QUIT
+7 SET CONFDEV(DEVNAM)=DEV
SET IOP=DEV
DO D0^XUTMRP
SET NEWDEV(DEV)=ZTIO
SET II=""
+8 FOR
SET II=$ORDER(OLDDEV(II))
if II=""
QUIT
Begin DoDot:1
+9 if '$DATA(OLDDEV(DEVNAM))
QUIT
+10 IF $PIECE(OLDDEV(DEVNAM),";",3,4)=$PIECE(OLDDEV(II),";",3,4)
IF $DATA(CONFDEV(DEVNAM))
SET CONFDEV(II)=CONFDEV(DEVNAM)
End DoDot:1
+11 ;
+12 QUIT
ASKD ;For devices that don't match ask user
+1 WRITE !!,"I can't find a printer for task #",ZTSK,!," with old device ",DEVNAM," with the correct parameters."
+2 IF $DATA(OLDDEV(DEVNAM))
WRITE !," (MARGIN= ",$PIECE(OLDDEV(DEVNAM),";",3),"/ PAGE LENGTH= ",$PIECE(OLDDEV(DEVNAM),";",4)," )."
+3 WRITE !,"Where should I print it?",!
DO ASKD^XUTMRP()
if Y'>0
DO DTSK
+4 QUIT
DTSK DO LIST
if '$GET(ZTC)
QUIT
ASK WRITE !!,"You didn't select a device. Do you want to delete the task"
+1 SET %=2
DO YN^DICN
IF %'>0
SET XQH="XUTM DELETE TASK"
DO ^XQH
GOTO ASK
+2 SET DEL=(%=1)
IF 'DEL
Begin DoDot:1
+3 SET DIR(0)="Y"
SET DIR("A")="Do you want another chance to select a device"
+4 SET DIR("B")="Yes"
DO ^DIR
KILL DIR
+5 if $DATA(DIRUT)
QUIT
if 'Y
QUIT
+6 DO ASKD^XUTMRP()
End DoDot:1
+7 if 'DEL
QUIT
+8 DO DQ^%ZTLOAD
+9 IF ZTSK(0)
WRITE !,"Task #",ZTSK," deleted."
+10 QUIT
DATCK() NEW X
SET X=$$HTFM^XLFDT($PIECE(^%ZTSK(ZTSK,0),U,6))
+1 QUIT X'<SDT&(X'>EDT)
+2 ;
LIST ;List a task.
+1 NEW DIR,DIRUT,DTOUT,DUOUT
+2 SET ZTC=0
IF $DATA(^%ZTSK(ZTSK))
DO EN^XUTMTP(ZTSK)
SET ZTC=1
+3 IF 'ZTC
WRITE !!?5,"That task is not defined in this volume set's Task File."
+4 QUIT
