source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL1.m@ 1181

Last change on this file since 1181 was 1087, checked in by Sam Habiel, 14 years ago

BMX updated to v2.3. No actual routine changes from 2.21
File size: 10.0 KB
Line 
1BMXSQL1 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
2 ;;2.3;BMX;;Jan 25, 2011
3 ;
4 ;
5KW(BMXTK) ;EP
6 ;Identify and mark keywords in BMXTK
7 ;MODIFIES BMXTK
8 ;
9 N J,BMXSTOP,BMXTMP
10 ;Combine ORDER BY and GROUP BY into a single token
11 ;
12 S J=0
13 F S J=$O(BMXTK(J)) Q:'+J D
14 . S BMXTMP=$$UCASE(BMXTK(J))
15 . I BMXTMP="ORDER"!(BMXTMP="GROUP") D
16 . . I $D(BMXTK(J+1)),$$UCASE(BMXTK(J+1))="BY" D
17 . . . S BMXTK(J)=BMXTK(J)_" "_BMXTK(J+1)
18 . . . S BMXTK(J)=$$UCASE(BMXTK(J))
19 . . . S BMXTK(BMXTK(J))=J
20 . . . K BMXTK(J+1)
21 . . . Q
22 . . Q
23 . Q
24 ;
25 ;Find SELECT
26 S J=0,BMXSTOP=0
27 F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
28 . I $$UCASE(BMXTK(J))="SELECT" D
29 . . S BMXTK(J)=$$UCASE(BMXTK(J))
30 . . S BMXTK("SELECT")=J
31 . . S BMXSTOP=1
32 . . Q
33 . Q
34 I '+J S BMXERR="SELECT KEYWORD NOT FOUND" Q
35 ;
36 ;DISTINCT
37 S BMXSTOP=0
38 F S J=$O(BMXTK(J)) Q:'+J Q:$$UCASE(BMXTK(J))="FROM" D Q:BMXSTOP
39 . I $$UCASE(BMXTK(J))="DISTINCT" D
40 . . S BMXTK("DISTINCT")="TRUE"
41 . . K BMXTK(J)
42 . . S J=J-1
43 . . S BMXSTOP=1
44 . Q
45 ;
46 ;FROM
47 S BMXSTOP=0
48 S J=J-1
49 F S J=$O(BMXTK(J)) Q:'+J Q:$$UCASE(BMXTK(J))="WHERE" D Q:BMXSTOP
50 . I $$UCASE(BMXTK(J))="FROM" D
51 . . S BMXTK(J)=$$UCASE(BMXTK(J))
52 . . S BMXTK("FROM")=J
53 . . S BMXSTOP=1
54 . . Q
55 . Q
56 ;
57 I '$D(BMXTK("FROM")) S BMXERR="'FROM' KEYWORD NOT FOUND" Q
58 ;
59 ;WHERE
60 S BMXSTOP=0
61 F S J=$O(BMXTK(J)) Q:'+J Q:BMXTK(J)="ORDER BY" Q:BMXTK(J)="GROUP BY" D Q:BMXSTOP
62 . I $$UCASE(BMXTK(J))="WHERE" D
63 . . S BMXTK(J)=$$UCASE(BMXTK(J))
64 . . S BMXTK("WHERE")=J
65 . . S BMXSTOP=1
66 . Q
67 ;
68 ;SHOWPLAN
69 S J=BMXTK("FROM")
70 S BMXSTOP=0
71 F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
72 . I $$UCASE(BMXTK(J))="SHOWPLAN" D
73 . . S BMXTK("SHOWPLAN")="TRUE"
74 . . K BMXTK(J)
75 . . S J=J-1
76 . . S BMXSTOP=1
77 . Q
78 ;
79 ;MAXRECORDS
80 S J=BMXTK("FROM")
81 S BMXSTOP=0
82 F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
83 . I $$UCASE(BMXTK(J))["MAXRECORDS" D
84 . . S BMXXMAX=+$P(BMXTK(J),":",2)-1
85 . . S:+BMXXMAX<0 BMXXMAX=0
86 . . K BMXTK(J)
87 . . S J=J-1
88 . . S BMXSTOP=1
89 . Q
90 Q
91 ;
92SCREEN ;EP
93 ;Set up BMXFG() array of executable screen code
94 N F,BMXNOD,BMXFNUM,BMXFLDNUM,BMXHIT,BMXREF
95 N BMXRNAM,BMXRET,BMXOP,Q,BMXPC,BMXV,BMXFLDLO,BMXFLDNO
96 N BMXGL
97 S BMXRET=""
98 S Q=$C(34)
99 S BMXFG=BMXFF
100 S BMXFG("C")=0
101 I 'BMXFF Q
102 S F=0,BMXHIT=0
103 F F=1:1:BMXFF S BMXNOD=BMXFF(F) D Q:$D(BMXERR) Q:BMXHIT
104 . I $G(BMXFF(F,"INDEXED"))=1 D Q
105 . . S BMXFG(F)="1"
106 . . Q
107 . I $D(BMXFF(F,"JOIN")) D Q
108 . . S BMXFG(F)="1"
109 . . Q
110 . I "(^)"[BMXFF(F) D Q
111 . . S BMXFG(F)=BMXFF(F)
112 . . Q
113 . I "AND^OR"[BMXFF(F) D Q
114 . . I BMXFF(F)="AND" S BMXFG(F)="&" Q
115 . . S BMXFG(F)="!"
116 . . Q
117 . S BMXFNUM=$S(+$P(BMXNOD,U):$P(BMXNOD,U),1:$O(^DIC("B",$P(BMXNOD,U),0)))
118 . I '+BMXFNUM D ;Not a fileman field
119 . . S BMXFLDNUM=0,BMXFLDNO=""
120 . . S BMXFLDLO=$P(BMXFF(F),U,2)
121 . . ;
122 . E D ;Get fileman field data
123 . . S BMXGL=^DIC(BMXFNUM,0,"GL")
124 . . I $D(BMXFF(F,"IEN")) D
125 . . . S BMXFLDNUM=".001"
126 . . . S BMXFLDNO="IEN"
127 . . E D
128 . . . S BMXFLDNUM=$O(^DD(BMXFNUM,"B",$P(BMXNOD,U,2),0))
129 . . . S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0)
130 . I BMXFLDNO="IEN" D ;BMXIEN field
131 . . N BMXEXT,C S BMXEXT=0
132 . . ;S BMXPC=$P(BMXFLDNO,U,4)
133 . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
134 . . S BMXFLDLO="D0"
135 . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
136 . I $P(BMXFLDNO,U,2)["D" D ;Date field
137 . . N BMXEXT,C S BMXEXT=0
138 . . S BMXPC=$P(BMXFLDNO,U,4)
139 . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
140 . . S BMXFLDLO="$P($G("_BMXGL_"D0,"_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
141 . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
142 . I $P(BMXFLDNO,U,2)["S" D ;Set field
143 . . N BMXEXT,C S BMXEXT=0
144 . . S BMXPC=$P(BMXFLDNO,U,4)
145 . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
146 . . S BMXFLDLO="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
147 . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
148 . ;
149 . I $P(BMXFLDNO,U,2)["P" D ;Pointer field
150 . . N C,BMXEXT
151 . . S BMXEXT=0
152 . . I $P(BMXFF(F),U,5)'=BMXFO(1) D
153 . . . N R,G,BMXJN,BMXMSCR
154 . . . S BMXMXCR=1 ;Remove after testing. Find out if the field is from a subfile.
155 . . . I BMXMXCR D Q
156 . . . . ;Set up a screen in BMXSCR and in BMXMFL(
157 . . . . Q
158 . . . ;
159 . . . ;Find the node of BMXFF that has the join info
160 . . . S BMXEXT=1
161 . . . S BMXFG("C")=BMXFG("C")+1
162 . . . S C=BMXFG("C")
163 . . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
164 . . . S BMXJN=BMXFF(G,"JOIN")
165 . . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
166 . . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X="
167 . . . S BMXFG("C",C)=BMXJN
168 . . S BMXFLDLO=$$SCRNP(F,BMXGL,BMXFLDNUM,BMXFLDNO)
169 . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
170 . I $P(BMXFLDNO,U,2)["C" D ;Computed field
171 . . N C
172 . . S BMXPC=$P(BMXFLDNO,U,5,99)
173 . . S BMXFG("C")=BMXFG("C")+1
174 . . S C=BMXFG("C")
175 . . ;If computed field not in primary file, connect navigation code
176 . . I $P(BMXFF(F),U,5)'=BMXFO(1) D
177 . . . ;Find the node of BMXFF that has the join info
178 . . . N R,G,BMXJN
179 . . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
180 . . . S BMXJN=BMXFF(G,"JOIN")
181 . . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
182 . . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 "
183 . . . S BMXJN=BMXJN_BMXPC
184 . . . S BMXFF(F,0)=$P(BMXFF(F,0),U,1,4)
185 . . . S $P(BMXFF(F,0),U,5)=BMXJN
186 . . . S BMXPC=BMXJN
187 . . S BMXFG("C",C)=BMXPC
188 . . S BMXFLDLO="BMXSCR(""X"","_C_")"
189 . I $P(BMXFLDNO,U,2)["N" D ;Numeric field
190 . . N BMXEXT,C S BMXEXT=0
191 . . S BMXPC=$P(BMXFLDNO,U,4)
192 . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
193 . . S BMXFLDLO="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
194 . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
195 . ;
196 . I $P(BMXFLDNO,U,2)["F" D ;Free Text field
197 . . N BMXEXT,C S BMXEXT=0,C=0
198 . . S BMXPC=$P(BMXFLDNO,U,4)
199 . . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D
200 . . . N R,G,BMXJN
201 . . . S BMXFG("C")=BMXFG("C")+1
202 . . . S C=BMXFG("C")
203 . . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
204 . . . S BMXJN=BMXFF(G,"JOIN")
205 . . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
206 . . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN
207 . . . S BMXJN=BMXJN_"I +D0 S X="
208 . . . S BMXFG("C",C)=BMXJN
209 . . . S BMXFLDLO="BMXSCR(""X"","_C_")"
210 . . I $P(BMXFLDNO,U,4)["E" D
211 . . . N BMXPC2,BMXTMP
212 . . . S BMXPC2=$P(BMXPC,"E",2)
213 . . . S BMXTMP="$E("_BMXGL_"D0,"_$P(BMXPC,";")_"),"_$P(BMXPC2,",")_","_$P(BMXPC2,",",2)_")"
214 . . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXTMP
215 . . . E S BMXFLDLO=BMXTMP
216 . . E D
217 . . . N BMXTMP
218 . . . S BMXTMP="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
219 . . . S BMXTMP="$S($D("_BMXGL_"D0,"_$P(BMXPC,";")_")):"_BMXTMP_",1:"""")"
220 . . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXTMP
221 . . . E S BMXFLDLO=BMXTMP
222 . ;
223 . S BMXOP=$P(BMXNOD,U,3)
224 . S BMXV=$P(BMXFF(F),U,4)
225 . I "<^>^=^["[BMXOP D
226 . . I BMXOP=">",BMXV?.A S BMXOP="]"
227 . . I BMXOP="<",BMXV?.A S BMXOP="']"
228 . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
229 . . Q
230 . I "<>"=BMXOP D
231 . . S BMXOP="'="
232 . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
233 . I ">="=BMXOP D
234 . . I BMXV="" S BMXRET="(I 1)" Q
235 . . I +BMXV=BMXV D Q
236 . . . S BMXOP="'<"
237 . . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
238 . . S BMXV=$$DECSTR^BMXSQL2(BMXV)
239 . . S BMXOP="]"
240 . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
241 . I "<="=BMXOP D
242 . . I BMXV="" S BMXRET="(I 0)" Q
243 . . I +BMXV=BMXV D Q
244 . . . S BMXOP="'>"
245 . . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
246 . . S BMXV=$$INCSTR^BMXSQL2(BMXV)
247 . . S BMXOP="']"
248 . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
249 . I BMXOP="BETWEEN" D
250 . . I +$P(BMXV,"~")'=$P(BMXV,"~") D ;BMXV a string
251 . . . N W,X,Y,Z
252 . . . S X=$P(BMXV,"~")
253 . . . S Y=$E(X,1,$L(X)-1)
254 . . . S Z=$E(X,$L(X))
255 . . . S Z=$A(Z)
256 . . . S Z=Z-1
257 . . . S Z=$C(Z)
258 . . . S W=Y_Z
259 . . . S $P(BMXV,"~")=W
260 . . . S BMXRET="(("_BMXFLDLO_"]"_Q_$P(BMXV,"~")_Q_")&("_BMXFLDLO_"']"_Q_$P(BMXV,"~",2)_Q_"))"
261 . . E D ;BMXV a number
262 . . . S BMXRET="(("_BMXFLDLO_"'<"_$P(BMXV,"~")_")&("_BMXFLDLO_"'>"_$P(BMXV,"~",2)_"))"
263 . . Q
264 . I BMXOP="LIKE" D
265 . . S BMXRET="("_BMXFLDLO_"?1"_Q_BMXV_Q_".E)"
266 . I BMXRET]"" D
267 . . S BMXFG(F)=BMXRET
268 . . Q
269 . ;TODO: Pointer fields
270 . ;TODO: Computed fields
271 . ;TODO: Sets of codes
272 . ;TODO: Dates
273 . Q
274 Q
275 ;
276SCRNP(F,BMXGL,BMXFLDNU,BMXFLDNO) ;
277 ;Requires BMXFF()
278 ;Sets up expression for pointer field
279 N BMX,BMXCOR,BMXRET,BMXPC
280 S BMXPC=$P(BMXFLDNO,U,4)
281 S BMXCOR="$P($G("_BMXGL_"D0,"_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
282 S BMXRET=BMXCOR
283 Q:$D(BMXFF(F,"INTERNAL")) BMXRET
284 S BMXFNUM=$P(BMXFLDNO,U,2)
285 S BMXFNUM=+$P(BMXFNUM,"P",2)
286 S BMXGL=^DIC(BMXFNUM,0,"GL")
287 S BMXFLDNUM=".01"
288 S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0)
289 F D:$P(BMXFLDNO,U,2)["P" Q:$P(BMXFLDNO,U,2)'["P"
290 . S BMXPC=$P(BMXFLDNO,U,4)
291 . S BMXRET="$P($G("_BMXGL_BMXRET_","_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
292 . S BMXFNUM=$P(BMXFLDNO,U,2)
293 . S BMXFNUM=+$P(BMXFNUM,"P",2)
294 . S BMXGL=^DIC(BMXFNUM,0,"GL")
295 . S BMXFLDNUM=".01"
296 . S BMXFLDNO=^DD(BMXFNUM,BMXFLDNUM,0)
297 ;B ;SCRN2 After chain
298 ;I 0 D ;$P(BMXFLDNO,U,2)["D" D ;Pointer to a date
299 ;. Q:+$G(BMXFF(F,"INDEXED")) ;Dates converted when iterator built
300 ;. N BMXD,J
301 ;. S BMXD=$P(BMXFF(F),U,4)
302 ;. S %DT="T"
303 ;. F J=1:1:$L(BMXD,"~") D
304 ;. . S X=$P(BMXD,"~",J)
305 ;. . D ^%DT
306 ;. . S $P(BMXD,"~",J)=Y
307 ;. S $P(BMXFF(F),U,4)=BMXD
308 S BMXRET="$P($G("_BMXGL_BMXRET_",0)),U,1)"
309 S BMXRET="$S(+"_BMXCOR_":"_BMXRET_",1:"""")"
310 Q BMXRET
311 ;
312CASE(BMXTK) ;EP
313 ;Convert keywords to uppercase
314 N J
315 S J=0
316 F S J=$O(BMXTK(J)) Q:'+J D
317 . F K="DISTINCT","SELECT","WHERE","FROM","SHOWPLAN" D
318 . . I $$UCASE(BMXTK(J))=K S BMXTK(J)=$$UCASE(BMXTK(J))
319 . Q
320 Q
321 ;
322UCASE(X) ;EP Convert X to uppercase
323 F %=1:1:$L(X) S:$E(X,%)?1L X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999)
324 Q X
325 ;
326EXP ;Extended pointer
327 N R,G,BMXJN
328 S BMXEXT=1
329 S BMXFG("C")=BMXFG("C")+1
330 S C=BMXFG("C")
331 S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
332 S BMXJN=BMXFF(G,"JOIN")
333 S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
334 S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X="
335 S BMXFG("C",C)=BMXJN
336 Q
Note: See TracBrowser for help on using the repository browser.