source: IHS-VA_UTILITIES-XB/trunk/XBDR1.m@ 1680

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

Modified directory structure; moved routines.
File size: 2.7 KB
Line 
1XBDR1 ; IHS/ADC/GTH - XBDR SUBROUTINE; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Prevent <LINER>
4 ;
5 ; Part of XBDR
6 ;
7TYPE ;
8 S DIR("A")="Input data type"
9 S DIR(0)="S^D:DATE;E:END-OF-PAGE;F:FREE TEXT;L:LIST OR RANGE;N:NUMERIC;S:SET;Y:YES/NO;Z:FILEMAN"
10 D ^DIR KILL DIR
11 I $D(DIRUT) S XBDRQUIT="" Q
12 ;S XBDRTYPE=X;IHS/SET/GTH XB*3*9 10/29/2002
13 S (XBDRTYPE,X)=$$UP^XLFSTR(X) ;IHS/SET/GTH XB*3*9 10/29/2002
14 D @X
15 I $D(XBDRQUIT) Q
16 I XBDRTYPE'?1.4U Q
17 S DIR("A")="Is this query mandatory",DIR("B")="NO",DIR(0)="Y"
18 D ^DIR KILL DIR
19 X XBDROUT
20 I S XBDRQUIT="" Q
21 I "yY"'[$E(X) S XBDRTYPE=XBDRTYPE_"O"
22 Q
23 ;
24E ;
25Y ;
26 Q
27 ;
28MINMAX ;
29 S DIR("A")="Minimum "_Z_" allowed",DIR(0)="NO^::7"
30 D ^DIR
31 KILL DIR
32 X XBDROUT
33 I S XBDRQUIT="" Q
34 S XBDRMIN=X,DIR("A")="Maximum "_Z_" allowed",DIR(0)="NO^::7"
35 D ^DIR
36 KILL DIR
37 X XBDROUT
38 I S XBDRQUIT="" Q
39 S XBDRMAX=X
40 Q
41 ;
42F ;
43 S Z="length"
44 D MINMAX
45 Q
46 ;
47L ;
48 S Z="value"
49 D MINMAX
50 Q
51 ;
52N ;
53 S Z="value"
54 D MINMAX
55 S DIR("A")="Maximum number of decimal places",DIR(0)="NO^0:9"
56 D ^DIR
57 KILL DIR
58 X XBDROUT
59 I S XBDRQUIT="" Q
60 S XBDRSPEC=X
61 Q
62 ;
63S ;
64 S XBDRMIN=""
65 F L=0:0 D S1 Q:X=""
66 I XBDRMIN="" S XBDRQUIT="" Q
67 I '$D(XBDRQUIT) D S2
68 Q
69 ;
70S1 ;
71 W !
72 S DIR("A")="Code",DIR(0)="FO"
73 D ^DIR
74 KILL DIR
75 X XBDROUT
76 I S XBDRQUIT="",X="" Q
77 I X="" Q
78 S Z=X,DIR("A")="Stands for",DIR(0)="F"
79 D ^DIR
80 KILL DIR
81 X XBDROUT
82 I S XBDRQUIT="",X="" Q
83 S:XBDRMIN]"" XBDRMIN=XBDRMIN_";"
84 S XBDRMIN=XBDRMIN_Z_":"_X
85 I $L(XBDRMIN)>240 W *7," DIR STRING TOO LONG...SESSION ABORTED" S XBDRQUIT="",X=""
86 Q
87 ;
88S2 ;
89 S DIR("A")="Possible choices should be listed which format"
90 S DIR("B")="VERTICAL"
91 S DIR(0)="SB^H:HORIZONTAL;V:VERTICAL;"
92 W !
93 D ^DIR
94 KILL DIR
95 X XBDROUT
96 I S XBDRQUIT=""
97 I $E(X)="H" S XBDRTYPE=XBDRTYPE_"B"
98 Q
99 ;
100D ;
101 S DIR("A")="Enter earliest date",DIR(0)="DO^::ETS"
102 D ^DIR
103 KILL DIR
104 X XBDROUT
105 I S XBDRQUIT="" Q
106 S XBDRMIN=Y
107 S DIR("A")="Enter maximum date",DIR(0)="DO^"_XBDRMIN_"::ETS"
108 D ^DIR
109 KILL DIR
110 X XBDROUT
111 I S XBDRQUIT="" Q
112 S XBDRMAX=Y
113DTS ;
114 W !!!,"Enter the %DT string using as many of the following as you wish:",!!
115 S X="F;Future dates assumed^N;Numeric input not allowed^P;Past dates assumed^R;Time required^T;Time allowed^X;Exact time required^S;Seconds allowed"
116 F I=1:1 S Y=$P(X,U,I) Q:Y="" W $P(Y,";")," ",$P(Y,";",2),!
117ADTS ;
118 S DIR("A")="%DT String",DIR(0)="FO"
119 D ^DIR
120 KILL DIR
121 X XBDROUT
122 I S XBDRQUIT="" Q
123 I X="" S XBDRSPEC="E" Q
124 I X'?1.9U W *7," ??" G ADTS
125 S XBDRSPEC="E"_X
126 Q
127 ;
128Z ;
129 S DIC=1,DIC(0)="AEQ",DIC("A")="Enter FILE name: "
130 W !
131 D ^DIC
132 KILL DIC
133 I Y=-1 S XBDRQUIT="" Q
134 S Z=+Y,DIC="^DD("_+Y_",",DIC(0)="AEQ",DIC("A")="Enter FIELD name: "
135 D ^DIC
136 KILL DIC
137 I Y=-1 S XBDRQUIT="" Q
138 S XBDRTYPE=Z_","_+Y,XBDRRUN=5
139 Q
140 ;
Note: See TracBrowser for help on using the repository browser.