source: IHS-VA_UTILITIES-XB/XBDR1.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 2.7 KB
RevLine 
[641]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.