source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL7.m@ 1155

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

BMX updated to v2.3. No actual routine changes from 2.21
File size: 8.1 KB
Line 
1BMXSQL7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
2 ;;2.3;BMX;;Jan 25, 2011
3 ;
4 ;
5CHKCR(BMXFNUM,BMXFLDNU,BMXRET) ;Returns cross reference to iterate on for related file
6 N BMXREF,BMXHIT,BMXRNOD,BMXTMP,BMXTMPV,BMXTMPI,BMXTMPP,BMXPFFN,BMXPFF,Q
7 N BMXHIT,BMXREF,BMXGL,BMXNOD,BMXRNAM,BMXTMPL,BMXTMPN,BMXTST
8 ;
9 S BMXNOD=^DD(BMXFNUM,BMXFLDNU,0)
10 S BMXGL=^DIC(BMXFNUM,0,"GL") ;Subfile global
11 S BMXREF=0,BMXHIT=0,Q=$C(34),BMXRET=""
12 F S BMXREF=$O(^DD(BMXFNUM,BMXFLDNU,1,BMXREF)) Q:'+BMXREF D Q:BMXHIT
13 . Q:'$D(^DD(BMXFNUM,BMXFLDNU,1,BMXREF,0))
14 . S BMXRNOD=^DD(BMXFNUM,BMXFLDNU,1,BMXREF,0)
15 . Q:$P(BMXRNOD,U,3)]""
16 . S BMXRNAM=$P(BMXRNOD,U,2)
17 . S BMXTMP=BMXGL_Q_BMXRNAM_Q_")"
18 . S BMXTST=$P(BMXTMP,")")_",IEN0,"
19 . Q:'$D(@BMXTMP)
20 . S BMXTMPV=0,BMXTMPV=$O(@BMXTMP@(BMXTMPV))
21 . Q:BMXTMPV=""
22 . S BMXTMP=BMXGL_Q_BMXRNAM_Q_","_Q_BMXTMPV_Q_")"
23 . S BMXTMPI=0,BMXTMPI=$O(@BMXTMP@(BMXTMPI))
24 . S BMXTMP=$S(BMXGL[",":$P(BMXGL,",")_")",1:$P(BMXGL,"("))
25 . Q:'$D(@BMXTMP@(BMXTMPI))
26 . S BMXTMPL=$P(BMXNOD,U,4)
27 . S BMXTMPP=$P(BMXTMPL,";",2)
28 . S BMXTMPL=$P(BMXTMPL,";")
29 . Q:BMXTMPL=""
30 . S BMXTMP=BMXGL_BMXTMPI_")"
31 . Q:'$D(@BMXTMP@(BMXTMPL))
32 . S BMXTMPN=@BMXTMP@(BMXTMPL)
33 . S BMXTMPP=$P(BMXTMPN,"^",BMXTMPP)
34 . I BMXTMPP=BMXTMPV S BMXRET=BMXTST,BMXHIT=1
35 Q BMXHIT
36 ;
37 ;
38WHERE ;EP - WHERE-clause processing
39 ;
40 ;Set up the defualt iterator in BMXX(1) to scan the entire file.
41 ;For now, just use first file in the FROM group
42 ;Later, pick the smallest file if more than one file
43 ;
44 ;Set up BMXFF array for each expression element
45 ; BMXFF(n)=FILENAME^FIELDNAME^OPERATOR^VALUE^FILENUMBER^FIELDNUMBER
46 ; ^FILE GLOBAL^FIELD DATA LOCATION
47 ; BMXFF(n,0)=Field descriptor ^DD(FILE,FIELD,0)
48 ;
49 N BMXGL,BMXOP,BMXTYP,BMXV,BMXV1,BMXV2,BMXFILE,BMXTMP
50 N BMXINTNL,BMXTMPLT
51 N BMXIEN
52 S BMXGL=^DIC(BMXFO(1),0,"GL")
53 S BMXX=1
54 S BMXX(1)="S D0=0 F S D0=$O("_BMXGL_"D0)) Q:'+D0 Q:BMXM>BMXXMAX "
55 S BMXTMP=BMXGL
56 I BMXTMP["," S BMXTMP=$TR(BMXTMP,",",")")
57 E S BMXTMP=$P(BMXTMP,"(",1)
58 I $D(@BMXTMP@("B")) D
59 . S BMXX(1)="S BMXTMP=0 F S BMXTMP=$O("_BMXGL_$C(34)_"B"_$C(34)_",BMXTMP)) Q:BMXTMP="""" S D0=0 F S D0=$O("_BMXGL_$C(34)_"B"_$C(34)_",BMXTMP,D0)) Q:'+D0 Q:BMXM>BMXXMAX "
60 ;
61 ;--->BMXFF array:
62 ;
63 S T=$G(BMXTK("WHERE"))
64 S BMXFF=0,C=0
65 Q:'+T
66 F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("ORDER BY")) Q:T=$G(BMXTK("GROUP BY")) D Q:$D(BMXERR)
67 . ;Get the file of the field
68 . I "AND^OR^(^)"[BMXTK(T) D Q
69 . . S C=C+1
70 . . S BMXFF(C)=BMXTK(T)
71 . . S BMXFF=C
72 . S BMXTK(T)=$TR(BMXTK(T),"_"," ")
73 . S BMXTK(T)=$TR(BMXTK(T),"'","")
74 . S BMXINTNL=0
75 . S BMXTMPLT=0
76 . S BMXIEN=0
77 . I BMXTK(T)["INTERNAL[" S BMXINTNL=1,BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1)
78 . I BMXTK(T)["TEMPLATE[" S BMXTMPLT=1,BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1),BMXIEN=1
79 . I BMXTK(T)["BMXIEN" S BMXIEN=1
80 . S BMXFILE=$$FLDFILE^BMXSQL2(BMXTK(T))
81 . Q:$D(BMXERR)
82 . S C=C+1
83 . S BMXFF=C ;This is a count of the where fields
84 . I BMXFILE]"" D
85 . . S $P(BMXFF(C),U,1)=$P(BMXFILE,U,1) ;FILENAME
86 . . S $P(BMXFF(C),U,2)=$P(BMXFILE,U,2) ;FIELDNAME
87 . . S $P(BMXFF(C),U,5)=$P(BMXFILE,U,3) ;FILENUMBER
88 . . S $P(BMXFF(C),U,6)=$P(BMXFILE,U,4) ;FIELDNUMBER
89 . . I $P(BMXFILE,U,3),$D(^DIC($P(BMXFILE,U,3),0,"GL")) S $P(BMXFF(C),U,7)=^DIC($P(BMXFILE,U,3),0,"GL")
90 . . I BMXIEN S BMXFF(C,0)="IEN",BMXFF(C,"IEN")=1,BMXFF(C,"TYPE")="IEN"
91 . . E S BMXFF(C,0)=$S(+$P(BMXFILE,U,3):^DD($P(BMXFILE,U,3),$P(BMXFILE,U,4),0),1:"")
92 . . I BMXINTNL S BMXFF(C,"INTERNAL")=1
93 . ;
94 . ;If BMXFF(C) is a pointer, traverse pointer chain to retrieve type
95 . I $P(BMXFF(C,0),U,2)["P" D
96 . . ;B ;WHERE Pointer Type
97 . . N BMXFILN,BMXFLDN,BMXDD
98 . . S BMXDD=BMXFF(C,0)
99 . . F Q:$P(BMXDD,U,2)'["P" D:$P(BMXDD,U,2)["P"
100 . . . S BMXFILN=$P(BMXDD,U,2)
101 . . . S BMXFILN=+$P(BMXFILN,"P",2)
102 . . . S BMXDD=^DD(BMXFILN,".01",0)
103 . . S BMXFF(C,"TYPE")=$S($P(BMXDD,U,2)["D":"DATE",$P(BMXDD,U,2)["S":"SET",1:"OTHER")
104 . . I BMXFF(C,"TYPE")="SET" S $P(BMXFF(C,"TYPE"),U,2)=$P(BMXDD,U,3)
105 . ;B ;WHERE Set Type
106 . I ($P(BMXFF(C,0),U,2)["S")!($P($G(BMXFF(C,"TYPE")),U)="SET") D ;Set
107 . . N BMXSET,BMXSETP
108 . . I $P(BMXFF(C,0),U,2)["S" D
109 . . . S BMXFF(C,"TYPE")="SET"
110 . . . S $P(BMXFF(C,"TYPE"),U,2)=$P(BMXFF(C,0),U,3)
111 . . S BMXSET=$P(BMXFF(C,"TYPE"),U,2)
112 . . F J=1:1:$L(BMXSET,";") D
113 . . . S BMXSETP=$P(BMXSET,";",J)
114 . . . Q:BMXSETP=""
115 . . . S BMXFF(C,"SET",$P(BMXSETP,":",2))=$P(BMXSETP,":")
116 . ;
117 . ;Set up comparisons based on operators
118 . S T=T+1
119 . S BMXOP=BMXTK(T)
120 . I BMXTMPLT S BMXOP="="
121 . I "^<^>^=^[^<>^>=^<=^LIKE"[BMXOP D Q
122 . . S $P(BMXFF(C),U,3)=BMXTK(T)
123 . . ;Get the comparison value
124 . . S T=T+1
125 . . S BMXTMP=BMXTK(T)
126 . . S BMXTMP=$TR(BMXTMP,"'","")
127 . . I BMXOP="LIKE" S BMXTMP=$P(BMXTMP,"%"),$P(BMXFF(C),U,4)=BMXTMP Q
128 . . I BMXTMPLT D TMPLATE Q
129 . . I BMXTMP="*" S T=T+1,BMXTMP=BMXTK(T) D OTM Q
130 . . I BMXTMP[".",BMXTK(T)'["'" D ;This is a join ;TODO: Extended pointers
131 . . . ;Setting BMXFJ("JOIN"
132 . . . S BMXTMP=BMXTK(T)
133 . . . I $D(BMXF($P(BMXTMP,"."))),BMXF($P(BMXTMP,"."))=BMXFO(1) D Q
134 . . . . S BMXTMP=BMXTK(T-2)
135 . . . . D OTM
136 . . . N BMXJN
137 . . . S BMXFF(C,"JOIN")="Pointer chain"
138 . . . S BMXJN=+$P($P(BMXFF(C,0),U,2),"P",2)
139 . . . S BMXFJ("JOIN",+$P($P(BMXFF(C,0),U,2),"P",2))=C
140 . . . S:+$P($P(BMXFF(C,0),U,2),"P",2)=2 BMXFJ("JOIN",9000001)=C ;IHS Only -- auto join PATIENT to VA PATIENT
141 . . I ($P(BMXFF(C,0),U,2)["D")!($G(BMXFF(C,"TYPE"))="DATE") D ;Date
142 . . . Q:$D(BMXFF(C,"INTERNAL"))
143 . . . I BMXTMP]"" S X=BMXTMP,%DT="T" D ^%DT S BMXTMP=Y
144 . . I $P($G(BMXFF(C,"TYPE")),U)="SET" D
145 . . . Q:$D(BMXFF(C,"INTERNAL"))
146 . . . Q:BMXTMP=""
147 . . . I $G(BMXFF(C,"SET",BMXTMP))="" S BMXTMP="ZZZZZZ" Q
148 . . . S BMXTMP=$G(BMXFF(C,"SET",BMXTMP))
149 . . S $P(BMXFF(C),U,4)=BMXTMP
150 . . Q
151 . I BMXOP="BETWEEN" D
152 . . S $P(BMXFF(C),U,3)="BETWEEN"
153 . . ;Get the comparison value
154 . . S T=T+1
155 . . S BMXV1=BMXTK(T)
156 . . S:BMXV1["'" BMXV1=$P(BMXV1,"'",2)
157 . . S T=T+1
158 . . I BMXTK(T)'="AND" S BMXERR="'BETWEEN' VALUES NOT SPECIFIED" D ERROR Q
159 . . S T=T+1
160 . . S BMXV2=BMXTK(T)
161 . . S:BMXV2["'" BMXV2=$P(BMXV2,"'",2)
162 . . I ($P(BMXFF(C,0),U,2)["D")!($G(BMXFF(C,"TYPE"))="DATE") D ;Date
163 . . . Q:$D(BMXFF(C,"INTERNAL"))
164 . . . S X=BMXV1,%DT="T" D ^%DT S BMXV1=Y
165 . . . S X=BMXV2,%DT="T" D ^%DT S BMXV2=Y
166 . . I BMXV1>BMXV2 S BMXTMP=BMXV1,BMXV1=BMXV2,BMXV2=BMXTMP
167 . . S $P(BMXFF(C),U,4)=BMXV1_"~"_BMXV2
168 . . Q
169 . I $P(BMXFF(C),U,3)="" S BMXERR="INVALID OPERATOR" D ERROR Q
170 . I $D(BMXTK(T+1)),BMXTK(T+1)["[INDEX:" D
171 . . S T=T+1
172 . . N BMXIND
173 . . S BMXIND=$P(BMXTK(T),"INDEX:",2)
174 . . S:BMXIND["]" BMXIND=$P(BMXIND,"]")
175 . . S:BMXIND["'" BMXIND=$P(BMXIND,"'",2)
176 . . S BMXFF("INDEX")=BMXIND
177 . Q
178 ;
179 Q:$D(BMXERR)
180 D JOIN^BMXSQL4
181 Q
182 ;
183TMPLATE ;
184 N BMXTNUM,BMXTNOD
185 I BMXTMP["[" S BMXTMP=$P(BMXTMP,"[",2),BMXTMP=$P(BMXTMP,"]")
186 S BMXTMP=$TR(BMXTMP,"_"," ")
187 ;Test template validity
188 I '$D(^DIBT("B",BMXTMP)) S BMXERR="TEMPLATE NOT FOUND" D ERROR Q
189 S BMXTNUM=$O(^DIBT("B",BMXTMP,0))
190 I '$D(^DIBT(BMXTNUM,0)) S BMXERR="TEMPLATE NOT FOUND" D ERROR Q
191 S BMXTNOD=^DIBT(BMXTNUM,0)
192 I $P(BMXTNOD,U,4)'=$P(BMXFF(C),U,5) S BMXERR="TEMPLATE DOES NOT MATCH FILE" D ERROR Q
193 I '$D(^DIBT(BMXTNUM,1)) S BMXERR="TEMPLATE HAS NO ENTRIES" D ERROR Q
194 S BMXFF(C,0)="IEN",BMXFF(C,"IEN")="TEMPLATE",BMXFF(C,"TYPE")="IEN"
195 S $P(BMXFF(C),U,4)=BMXTMP
196 ;
197 Q
198 ;
199OTM ;One-To-Many
200 N BMXUPFN,BMXSUBFN,BMXA,BMXB,BMXSUBFLD,BMXFNAM
201 I BMXTMP["INTERNAL[" S BMXTMP=$P(BMXTMP,"INTERNAL[",2),BMXTMP=$P(BMXTMP,"]")
202 S BMXUPFN=BMXFO(1)
203 S BMXA=$TR($P(BMXTMP,"."),"_"," ")
204 S BMXB=$TR($P(BMXTMP,".",2),"_"," ")
205 S BMXFNAM=BMXB ;Required by SETMFL. Won't work if filename BMXB [ "."
206 ;Get the subfile
207 I '$D(BMXF(BMXA)) S BMXERR="Related File Not Found" Q
208 S BMXSUBFN=BMXF(BMXA)
209 I '$D(^DD(BMXSUBFN,0)) S BMXERR="Related file not found" Q
210 ;Get the field that points to the main file
211 I '$D(^DD(BMXSUBFN,"B",BMXB)) S BMXERR="Related field not found" Q
212 S BMXSUBFLD=$O(^DD(BMXSUBFN,"B",BMXB,0))
213 I '+BMXSUBFLD S BMXERR="Related field not found" Q
214 ;
215 ;Find a normal index on that field
216 ;Set up for call to CHKCR^BMXSQL7
217 N BMXEXEC
218 I '$$CHKCR^BMXSQL7(BMXSUBFN,BMXSUBFLD,.BMXEXEC) S BMXERR="Related File not indexed" Q
219 ;
220 ;
221 S BMXFF(C,"JOIN")="One-to-many Join"
222 ;
223 ;Call SETMFL^BMXSQL5 to set up the iteration code
224 D SETMFL^BMXSQL5(BMXUPFN,BMXSUBFN,BMXEXEC,1,1)
225 ;
226 ;
227 ;Upfile is the mainfile, Subfile is the related file
228 ;BMXOFF is 1 but What is BMXGL?
229 ;
230 Q
231 ;
232ERROR Q
Note: See TracBrowser for help on using the repository browser.