| [1147] | 1 | BMXSQL ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
|
|---|
| 2 | ;;4.1000;BMX;;Apr 17, 2011
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | FLDNDX(BMXGBL,BMXFL,BMXFLD) ;
|
|---|
| 8 | ;Returns index name and set code for all indexes on field
|
|---|
| 9 | ;on field BMXFLD in file BMXFL
|
|---|
| 10 | S BMX31=$C(31)_$C(31)
|
|---|
| 11 | K ^BMXTMP($J),^BMXTEMP($J)
|
|---|
| 12 | S BMXGBL="^BMXTEMP("_$J_")"
|
|---|
| 13 | I +BMXFL'=BMXFL D
|
|---|
| 14 | . S BMXFL=$TR(BMXFL,"_"," ")
|
|---|
| 15 | . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
|
|---|
| 16 | . S BMXFL=$O(^DIC("B",BMXFL,0))
|
|---|
| 17 | I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
|
|---|
| 18 | ;
|
|---|
| 19 | ;Check for field name
|
|---|
| 20 | I +BMXFLD'=BMXFLD D
|
|---|
| 21 | . S BMXFLD=$TR(BMXFLD,"_"," ")
|
|---|
| 22 | . I '$D(^DD(BMXFL,"B",BMXFLD)) S BMXFLD="" Q
|
|---|
| 23 | . S BMXFLD=$O(^DD(BMXFL,"B",BMXFLD,0))
|
|---|
| 24 | I '$G(BMXFLD) D ERROUT("Field not provided",1) Q
|
|---|
| 25 | ;
|
|---|
| 26 | ;Set up Column names
|
|---|
| 27 | S ^BMXTEMP($J,0)="T"_$$NUMCHAR(30)_"INDEX^T"_$$NUMCHAR(200)_"CODE"_$C(30)
|
|---|
| 28 | ;
|
|---|
| 29 | ;Write field data to BMXTEMP
|
|---|
| 30 | S BMXI=0,I=0
|
|---|
| 31 | N BMXNAM,BMXCOD,BMXNOD,BMXTYP
|
|---|
| 32 | F S BMXI=$O(^DD(BMXFL,BMXFLD,1,BMXI)) Q:'+BMXI Q:$D(BMXERR) D
|
|---|
| 33 | . S I=I+1
|
|---|
| 34 | . S BMXNOD=$G(^DD(BMXFL,BMXFLD,1,BMXI,0))
|
|---|
| 35 | . S BMXNAM=$P(BMXNOD,U,2)
|
|---|
| 36 | . S BMXTYP=$P(BMXNOD,U,3)
|
|---|
| 37 | . S:BMXTYP="" BMXTYP="REGULAR"
|
|---|
| 38 | . S BMXCOD=$G(^DD(BMXFL,BMXFLD,1,BMXI,1))
|
|---|
| 39 | . S BMXCOD=$TR(BMXCOD,"^","~")
|
|---|
| 40 | . S ^BMXTEMP($J,I)=BMXNAM_U_BMXTYP_U_BMXCOD_$C(30)
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | TLIST(BMXGBL,BMXFROM,BMXTO) ;
|
|---|
| 44 | ;Returns list of Fileman files to which user has READ access
|
|---|
| 45 | ;TODO: Pass in type of access (RD,DL,WR) in BMXPAR
|
|---|
| 46 | ;
|
|---|
| 47 | N A,F,BMXF,BMXFLD,D0,BMXU,I,BMXCNT,BMXMFL,BMXRD,BMXMAX
|
|---|
| 48 | S U="^"
|
|---|
| 49 | S:$G(BMXFROM)="RD" BMXFROM=""
|
|---|
| 50 | K ^BMXTMP($J),^BMXTEMP($J)
|
|---|
| 51 | S BMXGBL="^BMXTEMP("_$J_")"
|
|---|
| 52 | S BMXF=1
|
|---|
| 53 | S BMXF("FILE")=1
|
|---|
| 54 | S BMXFLD("FILE")="1^.01"
|
|---|
| 55 | S BMXFLD("NUMBER")="1^.001" ;ADDED
|
|---|
| 56 | S BMXFLDN=$P(BMXFLD("FILE"),"^",2)
|
|---|
| 57 | S BMXFLDN(1,BMXFLDN)="FILE"
|
|---|
| 58 | S BMXFLDN=$P(BMXFLD("NUMBER"),"^",2) ;ADDED
|
|---|
| 59 | S BMXFLDN(1,BMXFLDN)="NUMBER" ;ADDED
|
|---|
| 60 | S BMXFLDO=2 ;CHANGED FROM 1 TO 2
|
|---|
| 61 | S BMXFLDO(0)="1^.01"
|
|---|
| 62 | S BMXFLDOX(1,.01,"E")=0
|
|---|
| 63 | S BMXFLDO(1)="1^.001" ;ADDED
|
|---|
| 64 | S BMXFLDOX(1,.001,"E")=1 ;ADDED
|
|---|
| 65 | S BMXFNX(1)="FILE"
|
|---|
| 66 | S BMXFO(1)="1"
|
|---|
| 67 | S BMXU=$G(DUZ(0))
|
|---|
| 68 | S BMXRD=$C(30)
|
|---|
| 69 | S ^BMXTEMP($J,0)="T00030FILE^N00010NUMBER"_BMXRD
|
|---|
| 70 | S BMXSET="S I=I+1,^BMXTEMP($J,I)=$P($G(^DIC(D0,0)),U)_U_D0_BMXRD,BMXCNT=BMXCNT+1"
|
|---|
| 71 | S D0=0,I=0,BMXCNT=0,BMXMAX=2000
|
|---|
| 72 | S BMXFROM=$G(BMXFROM),BMXTO=$G(BMXTO)
|
|---|
| 73 | I +BMXFROM=BMXFROM D ;BMXFROM is a filenumber
|
|---|
| 74 | . S F=(+BMXFROM-1),T=+BMXTO
|
|---|
| 75 | . S:BMXTO<BMXFROM BMXTO=BMXFROM+1
|
|---|
| 76 | . S D0=F F S D0=$O(^DIC(D0)) Q:'+D0 Q:D0>T Q:BMXCNT>BMXMAX I $D(^DD(D0)) D TLIST1
|
|---|
| 77 | I +BMXFROM'=BMXFROM D ;F is a filename or is null
|
|---|
| 78 | . S F="",T="zzzzzzz"
|
|---|
| 79 | . S:$G(BMXFROM)]"" F=$O(^DIC("B",BMXFROM),-1)
|
|---|
| 80 | . S:$G(BMXTO)]"" T=BMXTO
|
|---|
| 81 | . F S F=$O(^DIC("B",F)) Q:F="" Q:F]T Q:BMXCNT>BMXMAX D
|
|---|
| 82 | . . S D0=0 F S D0=$O(^DIC("B",F,D0)) Q:'+D0 D TLIST1
|
|---|
| 83 | ;
|
|---|
| 84 | S I=I+1,^BMXTEMP($J,I)=$C(31)
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | TLIST1 ;
|
|---|
| 88 | I BMXU="@" X BMXSET Q
|
|---|
| 89 | Q:$D(^DIC(D0,0))'=11
|
|---|
| 90 | S A=$G(^DIC(D0,0,"RD"))
|
|---|
| 91 | I $D(^VA(200,DUZ,"FOF",D0,0)) D Q
|
|---|
| 92 | . ;I $P(^(0),U,5)="1" X BMXSET Q
|
|---|
| 93 | . I $P(^VA(200,DUZ,"FOF",D0,0),U,5)="1" X BMXSET Q
|
|---|
| 94 | F J=1:1:$L(A) I DUZ(0)[$E(A,J) X BMXSET
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | SQLCOL(BMXGBL,BMXSQL) ;EP
|
|---|
| 98 | D INTSQL(.BMXGBL,.BMXSQL,1)
|
|---|
| 99 | Q
|
|---|
| 100 | ;
|
|---|
| 101 | SQLD(BMXGBL,BMXSQL) ;EP Serenji Debug Entrypoint
|
|---|
| 102 | ;D DEBUG^%Serenji("SQLD^BMXSQL(.BMXGBL,.BMXSQL)")
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | SQL(BMXGBL,BMXSQL) ;EP
|
|---|
| 106 | D INTSQL(.BMXGBL,.BMXSQL,0)
|
|---|
| 107 | Q
|
|---|
| 108 | ;
|
|---|
| 109 | INTSQL(BMXGBL,BMXSQL,BMXCOL) ;EP
|
|---|
| 110 | ;
|
|---|
| 111 | ;SQL Top Wait for debug break
|
|---|
| 112 | ;D
|
|---|
| 113 | ;. F J=1:1:10 S K=$H H 1
|
|---|
| 114 | ;. Q
|
|---|
| 115 | ;
|
|---|
| 116 | S X="ERRTRAP^BMXSQL",@^%ZOSF("TRAP")
|
|---|
| 117 | I $G(BMXSQL)="" S BMXSQL="" D
|
|---|
| 118 | . N C S C=0 F S C=$O(BMXSQL(C)) Q:'+C D
|
|---|
| 119 | . . S BMXSQL=BMXSQL_BMXSQL(C)
|
|---|
| 120 | ;
|
|---|
| 121 | I BMXSQL["call SHAPE" S BMXSQL="SELECT JUNKNAME, MULTCOLOR FROM JUNKMULT"
|
|---|
| 122 | ; Global-scope variables
|
|---|
| 123 | K BMXTK
|
|---|
| 124 | N BMXF,BMXTK,T,BMXFLD,BMXTMP,BMXM,BMXXMAX,BMXFLDN,BMXV
|
|---|
| 125 | N BMXX,BMXFG,BMXFF,BMXSCR,BMXPFP
|
|---|
| 126 | N BMXERR,BMXFLDO,BMXFLDOX,BMXFJ,BMXFO,BMXFNX
|
|---|
| 127 | N BMXMFL,BMXFLDA
|
|---|
| 128 | D ^XBKVAR
|
|---|
| 129 | S U="^"
|
|---|
| 130 | I $D(^%ZOSF("MAXSIZ")) S X=640 X ^%ZOSF("MAXSIZ")
|
|---|
| 131 | K ^BMXTMP($J),^BMXTEMP($J),^BMXTMPD($J)
|
|---|
| 132 | S BMXGBL="^BMXTEMP("_$J_")"
|
|---|
| 133 | ;Remove CR and LF from BMXSQL
|
|---|
| 134 | S BMXSQL=$TR(BMXSQL,$C(13)," ")
|
|---|
| 135 | S BMXSQL=$TR(BMXSQL,$C(10)," ")
|
|---|
| 136 | S BMXSQL=$TR(BMXSQL,$C(9)," ")
|
|---|
| 137 | S BMXSQL=$TR(BMXSQL,$C(34),"")
|
|---|
| 138 | D PARSE^BMXPRS(BMXSQL)
|
|---|
| 139 | S BMXXMAX=1000000 ;Default Maximum records to return.
|
|---|
| 140 | D KW^BMXSQL1(.BMXTK)
|
|---|
| 141 | Q:$D(BMXERR)
|
|---|
| 142 | ;
|
|---|
| 143 | ;Get file names into BMXF("NAME")="NUMBER"
|
|---|
| 144 | ;Get file numbers into BMXFNX(NUMBER)="NAME"
|
|---|
| 145 | ; Files are ordered in BMXFO(order)="NUMBER"
|
|---|
| 146 | ;
|
|---|
| 147 | FROM S T=$G(BMXTK("FROM"))
|
|---|
| 148 | I '+T S BMXERR="'FROM' CLAUSE NOT FOUND" D ERROR Q
|
|---|
| 149 | S BMXF=0
|
|---|
| 150 | F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("WHERE")) Q:T=$G(BMXTK("ORDER BY")) Q:T=$G(BMXTK("GROUP BY")) D Q:$D(BMXERR)
|
|---|
| 151 | . Q:BMXTK(T)=","
|
|---|
| 152 | . N BMXFNT
|
|---|
| 153 | . I BMXTK(T)["'" S BMXTK(T)=$P(BMXTK(T),"'",2)
|
|---|
| 154 | . S BMXTK(T)=$TR(BMXTK(T),"_"," ")
|
|---|
| 155 | . I '(BMXTK(T)?.N),'$D(^DIC("B",BMXTK(T))) S BMXERR="FILE NOT FOUND" D ERROR Q
|
|---|
| 156 | . S BMXF=BMXF+1
|
|---|
| 157 | . I BMXTK(T)?.N S BMXFNT=BMXTK(T)
|
|---|
| 158 | . E S BMXFNT=$O(^DIC("B",BMXTK(T),0))
|
|---|
| 159 | . S BMXMFL(BMXFNT,"GLOC")=^DIC(BMXFNT,0,"GL")
|
|---|
| 160 | . D F1(BMXF,BMXTK(T),BMXFNT)
|
|---|
| 161 | . I '+BMXF(BMXTK(T)) S BMXERR="FILE NUMBER NOT FOUND" D ERROR Q
|
|---|
| 162 | . D ;Test alias
|
|---|
| 163 | . . Q:'+$O(BMXTK(T))
|
|---|
| 164 | . . N V
|
|---|
| 165 | . . S V=T+1
|
|---|
| 166 | . . Q:$G(BMXTK(V))=","
|
|---|
| 167 | . . Q:V=$G(BMXTK("WHERE"))
|
|---|
| 168 | . . Q:V=$G(BMXTK("ORDER BY"))
|
|---|
| 169 | . . Q:V=$G(BMXTK("GROUP BY"))
|
|---|
| 170 | . . S BMXTK(T,"ALIAS")=BMXTK(V)
|
|---|
| 171 | . . K BMXTK(V)
|
|---|
| 172 | . . Q
|
|---|
| 173 | . Q
|
|---|
| 174 | ;
|
|---|
| 175 | D SELECT^BMXSQL5
|
|---|
| 176 | I $D(BMXERR) G END
|
|---|
| 177 | D POST2^BMXPRS ;Remove commas from BMXTK
|
|---|
| 178 | D KW^BMXSQL1(.BMXTK)
|
|---|
| 179 | ;
|
|---|
| 180 | D WHERE^BMXSQL7
|
|---|
| 181 | ;
|
|---|
| 182 | ;Find the first WHERE field that has an index
|
|---|
| 183 | I $D(BMXERR) G END
|
|---|
| 184 | ;
|
|---|
| 185 | D INDEX(.BMXFF,.BMXX,.BMXTMP)
|
|---|
| 186 | ;
|
|---|
| 187 | S:BMXTMP BMXX=BMXTMP
|
|---|
| 188 | ;
|
|---|
| 189 | ;Set up screen logic for where fields
|
|---|
| 190 | D SCREEN^BMXSQL1
|
|---|
| 191 | D SETX^BMXSQL2(.BMXX,.BMXFG,.BMXSCR)
|
|---|
| 192 | ;
|
|---|
| 193 | ;
|
|---|
| 194 | EXEC ;Execute enumerator and screen code to call Output routine
|
|---|
| 195 | ;
|
|---|
| 196 | N BMXOUT,J,BMXC
|
|---|
| 197 | S BMXOUT=0
|
|---|
| 198 | ;Debug lines (retain):
|
|---|
| 199 | ;K ^HW("BMXX") S J=0 F S J=$O(BMXX(J)) Q:'+J S ^HW("BMXX",J)=BMXX(J)
|
|---|
| 200 | ;K ^HW("BMXSCR") S ^HW("BMXSCR")=$G(BMXSCR) S J=0 F S J=$O(BMXSCR(J)) Q:'+J S ^HW("BMXSCR",J)=BMXSCR(J)
|
|---|
| 201 | ;Test for SHOWPLAN
|
|---|
| 202 | I $G(BMXTK("SHOWPLAN"))="TRUE" D WPLAN Q
|
|---|
| 203 | S BMXM=0
|
|---|
| 204 | I 'BMXCOL S J=0 F S J=$O(BMXX(J)) Q:'+J D Q:BMXM>BMXXMAX
|
|---|
| 205 | . X BMXX(J)
|
|---|
| 206 | ;
|
|---|
| 207 | D WRITE^BMXSQL6
|
|---|
| 208 | ;
|
|---|
| 209 | END Q
|
|---|
| 210 | ;
|
|---|
| 211 | ;
|
|---|
| 212 | F1(BMXC,BMXNAM,BMXNUM) ;EP
|
|---|
| 213 | S BMXF(BMXNAM)=BMXNUM
|
|---|
| 214 | S BMXFNX(BMXNUM)=BMXNAM
|
|---|
| 215 | S BMXFO(BMXC)=BMXF(BMXNAM)
|
|---|
| 216 | Q
|
|---|
| 217 | ;
|
|---|
| 218 | OUT ;Set result in ^BMXTMP
|
|---|
| 219 | S BMXOUT=BMXOUT+1
|
|---|
| 220 | S ^BMXTMP($J,"O",D0)=""
|
|---|
| 221 | S ^BMXTMP($J,BMXOUT)=D0
|
|---|
| 222 | S BMXM=BMXM+1
|
|---|
| 223 | Q
|
|---|
| 224 | ;
|
|---|
| 225 | WPLAN ;Write execution plan
|
|---|
| 226 | ;Set up Column Names
|
|---|
| 227 | N BMXLEN,BMXTYP,BMXT,J,BMXSCRT,BMXXT
|
|---|
| 228 | S I=1
|
|---|
| 229 | F BMXT="VARIABLE^","VALUE"_$C(30) D
|
|---|
| 230 | . S ^BMXTEMP($J,I)=BMXT,BMXLEN(I)=15,BMXTYP(I)="T"
|
|---|
| 231 | . S I=I+1
|
|---|
| 232 | S J=0
|
|---|
| 233 | I $D(BMXX) F S J=$O(BMXX(J)) Q:'+J D
|
|---|
| 234 | . S ^BMXTEMP($J,I)="INDEX("_J_")^"
|
|---|
| 235 | . S I=I+1
|
|---|
| 236 | . S BMXXT(J)=BMXX(J)
|
|---|
| 237 | . S BMXXT(J)=$P(BMXXT(J)," X BMXSCR")
|
|---|
| 238 | . S ^BMXTEMP($J,I)=$TR(BMXXT(J),"^","~")_$C(30)
|
|---|
| 239 | . S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))
|
|---|
| 240 | . S I=I+1
|
|---|
| 241 | S ^BMXTEMP($J,I)="SCREEN^"
|
|---|
| 242 | S I=I+1
|
|---|
| 243 | S BMXSCRT=$G(BMXSCR)
|
|---|
| 244 | S BMXSCRT=$P(BMXSCRT,"D:'$D(^BMXTMP")
|
|---|
| 245 | S ^BMXTEMP($J,I)=$TR(BMXSCRT,"^","~")_$C(30)
|
|---|
| 246 | S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))
|
|---|
| 247 | S I=I+1
|
|---|
| 248 | S J=0
|
|---|
| 249 | I $D(BMXSCR("C")) F S J=$O(BMXSCR("C",J)) Q:'+J D
|
|---|
| 250 | . S ^BMXTEMP($J,I)="SCREEN("_J_")^"
|
|---|
| 251 | . S I=I+1
|
|---|
| 252 | . S ^BMXTEMP($J,I)=$TR(BMXSCR("C",J),"^","~")_$C(30)
|
|---|
| 253 | . S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))
|
|---|
| 254 | . S I=I+1
|
|---|
| 255 | D COLTYPE
|
|---|
| 256 | S I=I+1
|
|---|
| 257 | D ERRTACK(I)
|
|---|
| 258 | Q
|
|---|
| 259 | ;
|
|---|
| 260 | ;
|
|---|
| 261 | COLTYPE ;EP - Append column types and widths to output global
|
|---|
| 262 | ;REQUIRES - BMXLEN(),BMXTYP(),^BMXTEMP
|
|---|
| 263 | ;IHS/SET/HMW 4-22-2004 Modified to use new schema string
|
|---|
| 264 | ;
|
|---|
| 265 | ;"@@@meta@@@BMXIEN|FILE #|DA STRING"
|
|---|
| 266 | ;
|
|---|
| 267 | N C
|
|---|
| 268 | S C=0
|
|---|
| 269 | F S C=$O(BMXLEN(C)) Q:'C D
|
|---|
| 270 | . I BMXLEN(C)>99999 S BMXLEN(C)=99999
|
|---|
| 271 | . I BMXLEN(C)=0 S BMXLEN(C)=50 ;Default column length
|
|---|
| 272 | . S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)
|
|---|
| 273 | Q
|
|---|
| 274 | ;
|
|---|
| 275 | ;S ^BXTEMP($J,0)="@@@meta@@@BMXIEN|"_BMXF_"|" ;Last |-piece will be DA string
|
|---|
| 276 | ;N C
|
|---|
| 277 | ;S C=0
|
|---|
| 278 | ;F S C=$O(BMXLEN(C)) Q:'C D
|
|---|
| 279 | ;. I BMXLEN(C)>99999 S BMXLEN(C)=99999
|
|---|
| 280 | ;. I BMXLEN(C)=0 S BMXLEN(C)=50 ;Default column length
|
|---|
| 281 | ;. S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)
|
|---|
| 282 | ;Q
|
|---|
| 283 | ;
|
|---|
| 284 | ERRTACK(I) ;EP
|
|---|
| 285 | ;
|
|---|
| 286 | S ^BMXTEMP($J,I)=$C(31)
|
|---|
| 287 | S:$D(BMXERR) ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXERR
|
|---|
| 288 | Q
|
|---|
| 289 | ;
|
|---|
| 290 | NUMCHAR(BMXN) ;EP
|
|---|
| 291 | ;---> Returns Field Length left-padded with 0
|
|---|
| 292 | ;
|
|---|
| 293 | N BMXC
|
|---|
| 294 | S BMXC="00000"_BMXN
|
|---|
| 295 | Q $E(BMXC,$L(BMXC)-4,$L(BMXC))
|
|---|
| 296 | ;
|
|---|
| 297 | ;
|
|---|
| 298 | INDEX(BMXFF,BMXRET,BMXXCNT) ;
|
|---|
| 299 | ;Returns executable enumerator on first where field with an index
|
|---|
| 300 | ;or "" if no indexed where field
|
|---|
| 301 | ;IN: BMXFF()
|
|---|
| 302 | ;OUT: BMXRET()
|
|---|
| 303 | ; BMXXCNT - size of BMXRET array
|
|---|
| 304 | ;
|
|---|
| 305 | N F,BMXNOD,BMXFNUM,BMXFLDNM,BMXHIT,BMXREF,BMXRNAM,BMXOP,Q,BMXGL
|
|---|
| 306 | N BMXTMP,BMXTMPV,BMXTMPI,BMXTMPL,BMXTMPN,BMXV,BMXRNOD,BMXTMPP
|
|---|
| 307 | S BMXXCNT=0
|
|---|
| 308 | S Q=$C(34)
|
|---|
| 309 | I 'BMXFF Q
|
|---|
| 310 | S F=0,BMXHIT=0
|
|---|
| 311 | ;
|
|---|
| 312 | ;--->Search BMXFF for special case WHERE clause 1 = "0"
|
|---|
| 313 | ; reset BMXX(1) to return no records
|
|---|
| 314 | F F=1:1:BMXFF S BMXNOD=BMXFF(F) D Q:$D(BMXERR) Q:BMXHIT
|
|---|
| 315 | . I ($P(BMXFF(F),"^",2,4)="1^=^0")!($P(BMXFF(F),"^",2,4)="0^=^1") S BMXRET(1)="Q ",BMXHIT=1,BMXXCNT=1
|
|---|
| 316 | . Q
|
|---|
| 317 | Q:BMXHIT
|
|---|
| 318 | ;
|
|---|
| 319 | ;Organize the first level into AND- and OR-parts
|
|---|
| 320 | N BMXR1,BMXR2,BMXE,BMXR3,BMXRNAM
|
|---|
| 321 | N BMXSTOP,BMXOR
|
|---|
| 322 | D PLEVEL^BMXSQL3(.BMXFF,.BMXR1,.BMXR2)
|
|---|
| 323 | ;
|
|---|
| 324 | N BMXPFF S BMXPFF=0
|
|---|
| 325 | S BMXR3=0
|
|---|
| 326 | ;Look for an AND-part with only one element.
|
|---|
| 327 | ; If found, build an iterator on it and quit
|
|---|
| 328 | F J=1:1:$L(BMXR2,"&") D Q:BMXHIT
|
|---|
| 329 | . S BMXE=$P(BMXR2,"&",J)
|
|---|
| 330 | . I +BMXE=BMXE,BMXR1(BMXE,"ELEMENTS")=1 D
|
|---|
| 331 | . . ;Test index for element
|
|---|
| 332 | . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q ;I'm not sure why this quit was here
|
|---|
| 333 | . . . Q:$D(BMXFF(K,"JOIN"))
|
|---|
| 334 | . . . S BMXPFP=K,BMXPFF=0
|
|---|
| 335 | . . . D XRTST^BMXSQL3(.BMXFF,K,.BMXR3,.BMXRNAM,.BMXPFP)
|
|---|
| 336 | . . . I BMXR3 S BMXHIT=1,BMXFF(K,"INDEXED")=1
|
|---|
| 337 | . Q:'BMXHIT
|
|---|
| 338 | . ;Build iterator and quit
|
|---|
| 339 | . D BLDIT^BMXSQL3(.BMXFF,K,.BMXRNAM,.BMXOR,.BMXPFP)
|
|---|
| 340 | . S BMXXCNT=1
|
|---|
| 341 | . S BMXRET(BMXXCNT)=BMXOR
|
|---|
| 342 | . Q
|
|---|
| 343 | Q:BMXHIT
|
|---|
| 344 | ;
|
|---|
| 345 | ;None of the single-element AND parts has a good index or
|
|---|
| 346 | ; there are no single-element AND parts
|
|---|
| 347 | ;If there are no OR-parts, then there are no good indexes so quit
|
|---|
| 348 | I $L(BMXR2,"!")=1 Q
|
|---|
| 349 | ;
|
|---|
| 350 | ;Test each OR-part for a good index.
|
|---|
| 351 | ;If an OR-part is multi-element or
|
|---|
| 352 | ;if one OR-part doesn't have an index
|
|---|
| 353 | ;then set up to do a table scan and quit
|
|---|
| 354 | S BMXSTOP=0
|
|---|
| 355 | F J=1:1:$L(BMXR2,"!") D Q:BMXSTOP
|
|---|
| 356 | . S BMXE=$P(BMXR2,"!",J)
|
|---|
| 357 | . I +BMXE=BMXE D
|
|---|
| 358 | . . I BMXR1(BMXE,"ELEMENTS")'=1 S BMXSTOP=1 Q ;Multiple elements
|
|---|
| 359 | . . ;Test index elements
|
|---|
| 360 | . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q
|
|---|
| 361 | . . . S BMXPFP=K,BMXPFF=0
|
|---|
| 362 | . . . D XRTST^BMXSQL3(.BMXFF,K,.BMXR3,.BMXRNAM,.BMXPFP)
|
|---|
| 363 | . . . I 'BMXR3 S BMXSTOP=1 Q
|
|---|
| 364 | . . . S BMXFF(K,"INDEXED")=1
|
|---|
| 365 | . . . S BMXR1(BMXE,"XREF")=BMXRNAM
|
|---|
| 366 | ;
|
|---|
| 367 | ;Build iterator and quit
|
|---|
| 368 | I BMXSTOP D Q ;One of the elements had no index
|
|---|
| 369 | . S J=0 F S J=$O(BMXFF(J)) Q:'+J K BMXFF(J,"INDEXED")
|
|---|
| 370 | S BMXXCNT=0
|
|---|
| 371 | F J=1:1:$L(BMXR2,"!") D
|
|---|
| 372 | . S BMXE=$P(BMXR2,"!",J)
|
|---|
| 373 | . I +BMXE=BMXE,BMXR1(BMXE,"ELEMENTS")=1 D
|
|---|
| 374 | . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D Q
|
|---|
| 375 | . . . D BLDIT^BMXSQL3(.BMXFF,K,BMXR1(BMXE,"XREF"),.BMXOR,.BMXPFP)
|
|---|
| 376 | . . . S BMXXCNT=BMXXCNT+1
|
|---|
| 377 | . . . S BMXRET(BMXXCNT)=BMXOR
|
|---|
| 378 | . Q
|
|---|
| 379 | Q
|
|---|
| 380 | ;
|
|---|
| 381 | ;
|
|---|
| 382 | ;
|
|---|
| 383 | ERROR ;EP - Error processing
|
|---|
| 384 | ;W !,BMXERR
|
|---|
| 385 | ;N A
|
|---|
| 386 | ;S A=0
|
|---|
| 387 | ;I $D(I) S A=I
|
|---|
| 388 | ;D ERROUT(BMXERR,A)
|
|---|
| 389 | ;B ;ERROR in BMXSQL
|
|---|
| 390 | Q
|
|---|
| 391 | ;
|
|---|
| 392 | ERROUT(BMXERR,I) ;EP
|
|---|
| 393 | ;---> Save next line for Error Code File if ever used.
|
|---|
| 394 | ;---> If necessary, use I>1 to avoid overwriting valid data.
|
|---|
| 395 | D ERRTACK(I)
|
|---|
| 396 | Q
|
|---|
| 397 | ;
|
|---|
| 398 | ERRTRAP ;
|
|---|
| 399 | ;
|
|---|
| 400 | K ^BMXTEMP($J)
|
|---|
| 401 | S ^BMXTEMP($J,0)="T00030M_ERROR"_$C(30)
|
|---|
| 402 | S BMXZE=$$EC^%ZOSV
|
|---|
| 403 | S BMXZE=$TR(BMXZE,"^","~")
|
|---|
| 404 | S ^BMXTEMP($J,1)=BMXZE_$C(30)
|
|---|
| 405 | S ^BMXTEMP($J,2)=$C(31)
|
|---|
| 406 | Q
|
|---|
