source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUTMRP1.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1XUTMRP1 ;SFISC/RWF,BOSTON/MEF - REQUEUE ALL TASKS FOR A DEVICE PART TWO ;06/11/2001 11:12
2 ;;8.0;KERNEL;**2,86,120,169**;Jul 10, 1995
3 ;called by XUTMRP
4 W !
5WTSK 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
6 . L +^%ZTSK(ZTSK) S DEVNAM=$P($P(^%ZTSK(ZTSK,.2),";"),U)
7 . D CONF:'$D(CONFDEV(DEVNAM)),REQ S:$G(REPNT) ^TMP($J,ZTSK)=""
8 . L -^%ZTSK(ZTSK) Q
9 S WAIT=0
10 ;
11FTSK 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)
12 . D WT
13 . I $D(^%ZTSK(ZTSK,0))#2 S DEVNAM=$P($P($G(^(.2)),";"),U) I DEVNAM]"",$D(OLDDEV(DEVNAM)) I $$DATCK D
14 .. S ZTDTH=$P(^(0),U,6)
15 .. D CONF:'$D(CONFDEV(DEVNAM))
16 .. I $G(REPNT) Q:$D(^TMP($J,ZTSK)) ;Already requeued
17 .. D REQ
18 .. Q
19 . Q
20 ;
21OPT I $G(OPT) S TT="" F S TT=$O(^DIC(19.2,TT)) Q:TT'>0 D
22 . S T1=$G(^DIC(19.2,TT,0)),DEVNAM=$P($P(T1,U,3),";")
23 . Q:DEVNAM="" Q:'$D(OLDDEV(DEVNAM)) L +^DIC(19.2,TT,0)
24 . S X=NEWDEV(DEVNAME)_";"_$P($P(T1,U,3),";",2,99)
25 . S $P(^DIC(19.2,TT,0),U,3)=X
26 . L -^DIC(19.2,TT,0)
27 . Q
28 ;
29END Q ;return to XUTMRP
30 ;
31WT S FLAG=1+$G(FLAG)#10 W:'FLAG "."
32 Q
33 ;
34REQ Q:'$D(CONFDEV(DEVNAM))
35 I $G(XUTMDTH) S ZTDTH=XUTMDTH
36 S ZTIO=NEWDEV(CONFDEV(DEVNAM)) D REQ^%ZTLOAD K ZTDTH
37 Q:'ZTSK(0)
38 W !!,"Requeued ",$S(WAIT:"waiting ",1:""),"task #",ZTSK," to device ",CONFDEV(DEVNAM),!
39 Q
40 ;
41CONF ;Build the CONFDEV array
42 S DEV="" F S DEV=$O(NEWDEV(DEV)) Q:DEV="" D
43 . I $D(OLDDEV(DEVNAM)),$P(OLDDEV(DEVNAM),";",3,4)=$P(NEWDEV(DEV),";",3,4) S CONFDEV(DEVNAM)=DEV
44 . Q
45 Q:$D(CONFDEV(DEVNAM))>0 ;Have a mapping
46 ;Get user input
47 D ASKD Q:Y'>0
48 S CONFDEV(DEVNAM)=DEV,IOP=DEV D D0^XUTMRP S NEWDEV(DEV)=ZTIO,II=""
49 F S II=$O(OLDDEV(II)) Q:II="" D
50 . Q:'$D(OLDDEV(DEVNAM))
51 . I $P(OLDDEV(DEVNAM),";",3,4)=$P(OLDDEV(II),";",3,4),$D(CONFDEV(DEVNAM)) S CONFDEV(II)=CONFDEV(DEVNAM)
52 ;
53 Q
54ASKD ;For devices that don't match ask user
55 W !!,"I can't find a printer for task #",ZTSK,!," with old device ",DEVNAM," with the correct parameters."
56 I $D(OLDDEV(DEVNAM)) W !," (MARGIN= ",$P(OLDDEV(DEVNAM),";",3),"/ PAGE LENGTH= ",$P(OLDDEV(DEVNAM),";",4)," )."
57 W !,"Where should I print it?",! D ASKD^XUTMRP(),DTSK:Y'>0
58 Q
59DTSK D LIST Q:'$G(ZTC)
60ASK W !!,"You didn't select a device. Do you want to delete the task"
61 S %=2 D YN^DICN I %'>0 S XQH="XUTM DELETE TASK" D ^XQH G ASK
62 S DEL=(%=1) I 'DEL D
63 . S DIR(0)="Y",DIR("A")="Do you want another chance to select a device"
64 . S DIR("B")="Yes" D ^DIR K DIR
65 . Q:$D(DIRUT) Q:'Y
66 . D ASKD^XUTMRP()
67 Q:'DEL
68 D DQ^%ZTLOAD
69 I ZTSK(0) W !,"Task #",ZTSK," deleted."
70 Q
71DATCK() N X S X=$$HTFM^XLFDT($P(^%ZTSK(ZTSK,0),U,6))
72 Q X'<SDT&(X'>EDT)
73 ;
74LIST ;List a task.
75 N DIR,DIRUT,DTOUT,DUOUT
76 S ZTC=0 I $D(^%ZTSK(ZTSK)) D EN^XUTMTP(ZTSK) S ZTC=1
77 I 'ZTC W !!?5,"That task is not defined in this volume set's Task File."
78 Q
Note: See TracBrowser for help on using the repository browser.