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/XUTMOPT.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1XUTMOPT ;SFISC/RWF - One time queue and Schedule option code. ;12/04/2000 11:02
2 ;;8.0;KERNEL;**2,111,112,118,127,175**;Jul 10, 1995
3ONE ;One time queue setup
4 N XUXQM,DIC,DIR,Y,ZTSK,ZTSAVE,ZTCPU
5 W !!,"You can only select OPTION's that have the SCHEDULING RECOMMENDED",!,"field set to YES or STARTUP."
6 S DIC=19,DIC(0)="AEMQZ",DIC("S")="I $TR($P($G(^DIC(19,Y,200.9)),U,1),""nsy"",""011"")" D ^DIC G:Y'>0 EXIT
7 S XUXQM=+Y,XUXQM(0)=Y(0)
8 S DIR(0)="Y",DIR("A")="Does this option need a DEVICE",DIR("B")="NO" D ^DIR G:$D(DIRUT) EXIT
9OZ S ZTIO=""
10 I Y=1 D G EXIT:POP,OZ:'$D(IO("Q"))
11 . W ! S IOP="Q",%ZIS="NQM",%ZIS("B")="" D ^%ZIS Q:POP K ZTIO
12 . I '$D(IO("Q")) U IO(0) W !,"Not a valid device for Queueing." D ^%ZISC
13 . Q
14 K DIR S DIR(0)="FO^2:15",DIR("A")="Enter Particular Volume set if needed" D ^DIR G EXIT:$D(DTOUT)!$D(DUOUT)
15 I X]"" S ZTCPU=X
16 S ZTSAVE("XQY")=$O(^DIC(19,"B","XU OPTION START",0)),ZTSAVE("XUXQM*")="",ZTRTN="ZTSK^XQ1"
17 S ZTDESC="One time Queue: "_$P(XUXQM(0),U,2)
18 D ^%ZTLOAD K IO("Q")
19EXIT D HOME^%ZIS
20 Q
21 ;
22EDIT(OPTION) ;User edit of option schedule file.
23 N DR,DIE,DA,DIC,DDSFILE
24 I OPTION?1A.ANP S OPTION=$$FIND(OPTION) Q:OPTION'>0
25 I '$D(^DIC(19.2,OPTION,0)) Q
26 S DA=OPTION,DR="[XU OPTION SCHEDULE]",DIE="^DIC(19.2," D XUDIE^XUS5
27 Q
28 ;
29DISP(OPTION) ;Display an option schedule (public entry-point)
30 N DR,DIC,DA
31 I OPTION?1A.ANP S OPTION=$$FIND(OPTION) Q:OPTION'>0
32 S L=0,DIC="^DIC(19.2,",FLDS="[XQ-BACKGROUND SCHEDULE]",BY="NUMBER",(FR,TO)=OPTION,IOP=$G(IOP,0),DHD="Scheduled Option Display"
33 D EN1^DIP
34 Q
35 ;
36RESCH(OPTION,WHEN,DEVICE,BY,FLAG,ERR) ;EF. App reschedule entry point
37 N DIE,DR,DIC,DA,X
38 I OPTION?1A.ANP S OPTION=$$FIND(OPTION,$S($G(FLAG)["L":"L",1:""))
39 I OPTION'>0 S ERR=-1
40 S DIE="^DIC(19.2,",DA=OPTION,DR="" S:$D(WHEN) DR="2///"_WHEN_";" S:$D(DEVICE) DR=DR_"3///"_DEVICE_";" S:$D(BY) DR=DR_"6///"_BY
41 D ^DIE
42 ;S X=$NA(XFDA(19.2,OPTION_","))
43 ;S:$D(WHEN) @X@(2)=WHEN S:$D(DEVICE) @X@(3)=DEVICE S:$D(BY) @X@(6)=BY
44 ;D FILE^DIE("","XFDA")
45 Q
46 ;
47FIND(X,F) ;Find and option
48 N DIC,Y,DLAYGO S DLAYGO=19
49 ;S X=$O(^DIC(19,"B",X,0)) I X'>0 Q -1
50 ;S X=$O(^DIC(19.2,"B",X,0)) I X'>0 Q -1
51 S DIC="^DIC(19.2,",DIC(0)="M"_$G(F) D ^DIC S X=+Y
52 Q X
53 ;
54OPTSTAT(OPTION,ROOT) ;Get the status of an option
55 ;Return an array because an option can be scheduled more than once
56 N XUTMDA,XUTMMSG
57 D FIND^DIC(19.2,,,"X",OPTION,5,,,,"XUTMDA","XUTMMSG")
58 S XU1=0,ROOT=+$G(XUTMDA("DILIST",0))
59 F S XU1=$O(XUTMDA("DILIST",2,XU1)) Q:XU1'>0 D
60 . S XU2=XUTMDA("DILIST",2,XU1),%=^DIC(19.2,XU2,0)
61 . S ROOT(XU1)=$G(^DIC(19.2,XU2,1))_U_$P(%,U,2)_U_$P(%,U,6)_U_$P(%,U,9)
62 . Q
63 Q
Note: See TracBrowser for help on using the repository browser.