- 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 Apr 23, 2025@18:28:11 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
