source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUTMRP.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1XUTMRP ;ISF/RWF,BOSTON/MEF - REQUEUE ALL TASKS FOR A DEVICE -PART ONE ;06/11/2001 11:13
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
5INIT ;Setup
6 Q:$D(DUZ)[0 Q:DUZ=""!(DUZ=0) D ENV^XUTMUTL S XUCPU=$P(XUTMUCI,",",2)
7 ;
8 N WAIT,FUT,MEFEND,DIR,XUTMDTH K ^TMP($J)
9 D WAIT ;Get what list to work on.
10 G:('FUT&'WAIT) EXIT G:($G(MEFEND)&'WAIT) EXIT
11OPT W ! S DIR(0)="Y",DIR("A")="Change the device field in the option Scheduling file"
12 S DIR("B")="NO",DIR("?")="A yes answer will permanently change the schedule for these tasks"
13 D ^DIR K DIR Q:$D(DIRUT)!($D(DUOUT)) S OPT=Y
14 W !
15 ;
16DEV D ASKD("Requeue tasks for device: ") K DIC G:Y'>0 EXIT
17 S OLDLTA=LTA,CONFDEV=DEV D DVARRY("OLDDEV",OLDLTA,1)
18 D ASKD("Requeue to device: ") K DIC G:Y'>0 EXIT
19 D DEV2
20 I Y'>0 D EXIT Q ;no target device
21 S CONFDEV(CONFDEV)=DEV D DVARRY("NEWDEV",LTA)
22CONF S DEVNAM=""
23 F S DEVNAM=$O(OLDDEV(DEVNAM)) Q:DEVNAM="" I '$D(CONFDEV(DEVNAM)) D
24 . 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
25 . Q
26 D ^XUTMRP1
27 ;
28EXIT K CONFDEV,DEL,DEV,DEVNAM,DIC,DIRUT,DUOUT,EDATE,EDT,FUT,I,II,LTA,MEFEND
29 K NEWDEV,OLDDEV,OLDLTA,POP,SDATE,SDT,SN,SRCE,WAIT,XQH,Y,XUCPU,ZTDH,ZTIO
30 K OPT,ZTKEY,ZTMD,ZTNAME,ZTUCI,ZTSK,ZTC,ZTOPT,XUTMDTH,^TMP($J)
31 Q
32 ;
33DEVNAM(ARRAY) ;Build @ARRAY@(devname) from DEVNAM
34 S DEVNAM=""
35 F S DEVNAM=$O(DEVNAM(DEVNAM)) Q:DEVNAM="" S IOP=DEVNAM D D0 S @ARRAY@(DEVNAM)=ZTIO K DEVNAM(DEVNAM)
36 Q
37 ;Slave printers and Spool Documents not allowed
38ASKD(%A,%B) ;Ask for a device
39 N DIC S:$G(%A)]"" DIC("A")=%A S:$G(%B)]"" DIC("B")=%B
40 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"
41 D ^DIC Q:Y'>0
42 S DEV=Y(0,0),LTA=$P(Y(0),U,2)
43 Q
44 ;
45DVARRY(II,LTA,OOS) ;Build list of devices for a LTA.
46 N SN S OOS=$G(OOS)
47 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
48 . 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
49 Q
50 ;
51WAIT S (WAIT,FUT)=0
52 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
53 ;
54FUT 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
55 I FUT D
56 . W !,"Now give a date/time range of future tasks to change."
57 . S SDT=$$DT("STARTING DATE/TIME","NOW") Q:SDT'>0
58 . S EDT=$$DT("ENDING DATE/TIME","T@24:00") Q:EDT'>0
59 . I SDT>EDT S ZDT=SDT,SDT=EDT,EDT=ZDT
60 . S SDATE=$$FMTE^XLFDT(SDT),EDATE=$$FMTE^XLFDT(EDT)
61 Q
62 ;
63REPNT ;Re-queues tasks to new lta# when dsv/ports are changed
64 Q:$D(DUZ)[0 Q:DUZ=""!(DUZ=0) D ENV^XUTMUTL S XUCPU=$P(XUTMUCI,",",2)
65 K ^TMP($J),EXIT S REPNT=1
66 D REP2
67 G:$G(EXIT) EXIT D ^XUTMRP1,EXIT
68 Q
69REP2 ;
70 D WAIT I $D(DIRUT)!($D(DUOUT)) S EXIT=1 Q
71 W ! S DIR("A")="Enter old $I (i.e. _LTA111: or 367) ",DIR(0)="F^1:55",DIR("?")="^D LISTIO^XUTMRP" D ^DIR
72 I $D(DIRUT)!($D(DUOUT)) S EXIT=1 Q
73 I $O(^%ZTSCH("IO",Y,0))="" S EXIT=1 W !,"There are NO tasks waiting for this device.",!
74 S OLDLTA=Y Q:$G(EXIT)
75 W ! D ASKD("Requeue tasks to device: ") ;Returns LTA,Y,DEV
76 K DIC I Y'>0 D Q:$G(EXIT)
77 . K DIR S DIR(0)="Y",DIR("A")="Want to just move the Tasks back to the schedul list with a new run time:"
78 . D ^DIR I 'Y S EXIT=1 Q
79 . S LTA=OLDLTA
80 . Q
81 S NEWLTA=LTA
82 D DVARRY("NEWDEV",NEWLTA),DVARRY("OLDDEV",OLDLTA,1)
83 S II=""
84 F S II=$O(NEWDEV(II)) Q:II="" S CONFDEV(II)=II
85 S XUTMDTH=$$DT("When to have the tasks restart:","NOW")
86 Q
87 ;
88DEV2 ;Return Y=0 to quit
89 S IOP=DEV,Y=1 D D0
90 Q:$P(OLDDEV(CONFDEV),";",3,4)=$P(ZTIO,";",3,4)
91 S SRCE=OLDDEV(CONFDEV)
92 W !,$C(7),$P(SRCE,";")," margin ",$P(SRCE,";",3)," page length ",$P(SRCE,";",4),$C(7)
93 W !,"doesn't match ",$P(ZTIO,";")," margin ",$P(ZTIO,";",3)," page length ",$P(ZTIO,";",4)
94 W !,"Please confirm target device.",!,"If I can find a matching margin/page length",!,"I'll use it for the default.",!!,$C(7)
95 D DVARRY("DEVNAM",LTA)
96 S DEVNAM="" F S DEVNAM=$O(DEVNAM(DEVNAM)) Q:DEVNAM="" Q:$P(DEVNAM(DEVNAM),";",3,4)=$P(OLDDEV(CONFDEV),";",3,4)
97 I DEVNAM]"" S DEFDEV=DEVNAM
98 K DEVNAM D ASKD("Requeue to device: ",$G(DEFDEV)) K DIC,DEFDEV Q:Y'>0
99 S IOP=DEV D D0
100 Q
101 ;
102D0 ;
103 S %ZIS="NQZ" D ^%ZIS
104 S ZTIO=$S($D(IOS)[0:"",POP:"",$D(ION)[0:"",ION]"":ION,IOS="":"",$D(^%ZIS(1,IOS,0))[0:"",1:$P(^(0),U))
105 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"))
106 S:$D(IOCPU)#2 XUCPU=IOCPU
107 I $D(IO("HFSIO"))#2,$D(IOPAR)#2,IOT="HFS" S ZTIO("H")=IO("HFSIO"),ZTIO("P")=IOPAR
108 Q
109 ;
110DT(MES,DEF) S DIR("A")=MES,DIR("B")=DEF
111 S DIR(0)="D^DT::AEFT",DIR("?")="This response must be a date/time"
112 D ^DIR K DIR
113 Q Y
114LISTIO ;List the entries in the IO queue.
115 N DEV,I,Y,DIR
116 S DEV="" W @IOF
117 W !," $IO Device names",!,"_______ ____________"
118 F S DEV=$O(^%ZTSCH("IO",DEV)) Q:DEV="" D
119 . Q:$D(^%ZTSCH("IO",DEV))'>2
120 . W !,DEV,?14," => "
121 . 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,", "
122 . I ($Y+4)>IOSL S DIR(0)="E" D ^DIR S:$D(DIRUT) DEV=$C(126) W @IOF
123 . Q
124 Q
Note: See TracBrowser for help on using the repository browser.