source: IHS-VA_UTILITIES-XB/trunk/XBDSET.m@ 1745

Last change on this file since 1745 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 4.3 KB
RevLine 
[641]1XBDSET ; IHS/ADC/GTH - BUILDS LIST OF FILEMAN FILES ; [ 12/11/2000 3:13 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*8 - IHS/ASDST/GTH 12-07-00 - Add ability to select from BUILD file.
4 ;
5 ; This routine selects FileMan dictionaries individually,
6 ; by a range, or for a specific package. This routine can
7 ; be called from another routine by setting the variables
8 ; XBDSLO, XBDSHI and then D EN1^XBDSET.
9 ;
10 ; If the variable XBDSND exist upon entry no default menu
11 ; option will be displayed.
12 ;
13START ;
14 S IOP=0
15 D ^%ZIS
16 KILL DIC,DIR,^UTILITY("XBDSET",$J)
17 S (XBDSP,XBDSQ)=0
18 F D GETFILES Q:XBDSQ
19 D EOJ
20 Q
21 ;
22GETFILES ;
23 W !
24 ; S DIR(0)="SO^"_$S('XBDSP:"O:One file only;",1:"")_"S:Selected files;R:Range of files;P:Package;"_$S($D(^UTILITY("XBDSET",$J)):"L:List of files already selected; : ",1:" : "); XB*3*8
25 S DIR(0)="SO^"_$S('XBDSP:"O:One file only;",1:"")_"S:Selected files;R:Range of files;P:Package;B:Build;"_$S($D(^UTILITY("XBDSET",$J)):"L:List of files already selected; : ",1:" : ") ; XB*3*8
26 S DIR("A")="Choose one,"_$S(XBDSP!($D(XBDSND)):" RETURN to continue,",1:"")_" or ^ to cancel"
27 I 'XBDSP,'$D(XBDSND) S DIR("B")="O"
28 S DIR("?")=$S(XBDSP:"Do you want",1:"Do you want one file,")
29 ; S DIR("?")=DIR("?")_" a range of files by number, files from a specific package, "_$S($D(^UTILITY("XBDSET",$J)):"individual files, or a list of files already selected?",1:"or individual files?") ; XB*3*8
30 S DIR("?")=DIR("?")_" a range of files by number, files from a specific package or build, "_$S($D(^UTILITY("XBDSET",$J)):"individual files, or a list of files already selected?",1:"or individual files?") ; XB*3*8
31 D ^DIR
32 KILL DIR
33 I $D(DIRUT) K:$D(DUOUT)!($D(DTOUT)) ^UTILITY("XBDSET",$J) S XBDSQ=1 Q
34 D OPTION ; Get files for selected option
35 I $D(^UTILITY("XBDSET",$J)) S XBDSP=1
36 Q
37 ;
38OPTION ; GET FILES FOR SELECTED OPTION
39 W !
40 I Y="O" D ONEFILE Q ; Get one file and exit
41 I Y="S" D SELECT Q ; Get selected files
42 I Y="R" D RANGE Q ; Get range of files
43 I Y="P" D PACKAGE Q ; Get files from package
44 I Y="L" D LIST Q ; List selected files
45 I Y="B" D BUILD Q ; Get files from build ; XB*3*8
46 Q
47 ;
48ONEFILE ; GET ONE FILE AND EXIT
49 S XBDSND=1
50 S DIC="^DIC(",DIC(0)="AEMQ"
51 D ^DIC
52 KILL DIC
53 Q:Y<0
54 S ^UTILITY("XBDSET",$J,+Y)=""
55 S XBDSQ=1
56 Q
57 ;
58SELECT ; GET SELECTED FILES
59 S DIC="^DIC(",DIC(0)="AEMQ"
60 F D ^DIC Q:Y<0 S ^UTILITY("XBDSET",$J,+Y)=""
61 KILL DIC
62 I '$O(^UTILITY("XBDSET",$J,""))!($D(DUOUT)) S XBDSQ=1 Q
63 Q
64 ;
65RANGE ; GET RANGE OF FILES
66 S DIR(0)="NO^1:99999999:3",DIR("A")="From file number"
67 D ^DIR
68 KILL DIR
69 I $D(DIRUT) S XBDSQ=1 Q
70 S XBDSFF=+Y
71 F S DIR(0)="NO^1:99999999:3",DIR("A")="Thru file number" D ^DIR KILL DIR Q:$D(DIRUT) D Q:'XBDSQ S XBDSQ=0
72 . I +Y<XBDSFF W !," 'Thru FILE' number less than 'From FILE' number!",*7 S XBDSQ=9
73 .Q
74 I $D(DIRUT) S XBDSQ=1 Q
75 S XBDSTF=+Y
76 D RANGE2
77 W !
78 I XBDSC W !?4,XBDSC," file",$S(XBDSC=1:"",1:"s")," selected" I 1
79 E W !?4,"No files selected",*7
80 Q
81 ;
82RANGE2 ; LABEL FOR EXTERNAL ENTRY POINT EN1
83 S XBDSFILE=XBDSFF,XBDSC=0
84 F D S XBDSFILE=$O(^DIC(XBDSFILE)) Q:XBDSFILE'=+XBDSFILE!(XBDSFILE>XBDSTF)
85 . Q:'$D(^DIC(XBDSFILE,0))
86 . S ^UTILITY("XBDSET",$J,XBDSFILE)=""
87 . S XBDSC=XBDSC+1
88 .Q
89 Q
90 ;
91PACKAGE ; GET FILES FROM SPECIFIC PACKAGE
92 S DIC=9.4,DIC(0)="AEMQ"
93 D ^DIC
94 KILL DIC
95 Q:Y<0
96 S Y=+Y,X=0
97 F S X=$O(^DIC(9.4,Y,4,X)) Q:X'=+X I $D(^DIC(^DIC(9.4,Y,4,X,0),0)) S ^UTILITY("XBDSET",$J,^DIC(9.4,Y,4,X,0))=""
98 Q
99 ;
100 ; XB*3*8 start block
101BUILD ; Get files from selected BUILD
102 S DIC=9.6,DIC(0)="AEMQ"
103 D ^DIC
104 KILL DIC
105 Q:Y<0
106 S Y=+Y,X=0
107 F S X=$O(^XPD(9.6,Y,4,X)) Q:X'=+X I $D(^XPD(9.6,Y,4,X,0)) S ^UTILITY("XBDSET",$J,^XPD(9.6,Y,4,X,0))=""
108 Q
109 ; XB*3*8 end block
110 ;
111LIST ; LIST FILES ALREADY SELECTED
112 I '$D(^UTILITY("XBDSET",$J)) W !,"No files selected." Q
113 W @IOF,"Files already selected:",!
114 S XBDSX=""
115 F S XBDSX=$O(^UTILITY("XBDSET",$J,XBDSX)) Q:XBDSX="" W !,XBDSX,?14,$P(^DIC(XBDSX,0),U,1) I $Y>(IOSL-3) D PXBSE Q:$D(DUOUT) W @IOF
116 I '$D(DUOUT),$Y>(IOSL-10) D PXBSE
117 Q
118 ;
119PXBSE ; GIVE USER A CHANCE TO SEE LAST PAGE AND QUIT
120 I IO=IO(0),$E(IOST,1,2)="C-" S Y=$$DIR^XBDIR("E")
121 Q
122 ;
123EN1 ;EP - Non-interactive selection of range of files.
124 KILL ^UTILITY("XBDSET",$J)
125 I '$D(XBDSLO)!('$D(XBDSHI)) Q
126 S XBDSFF=XBDSLO,XBDSTF=XBDSHI
127 D RANGE2
128 D EOJ
129 Q
130 ;
131EOJ ;
132 KILL XBDSC,XBDSFF,XBDSFILE,XBDSHI,XBDSL,XBDSLO,XBDSND,XBDSP,XBDSQ,XBDSTF,XBDSX
133 KILL DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
134 Q
135 ;
Note: See TracBrowser for help on using the repository browser.