BMXSQL.m

BMXSQL ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 

 ;;4.0;BMX;;JUN 28, 2010

 ;

 ;

 Q

 ;

FLDNDX(BMXGBL,BMXFL,BMXFLD)   ;

 ;Returns index name and set code for all indexes on field

 ;on field BMXFLD in file BMXFL

 S BMX31=$C(31)_$C(31)

 K ^BMXTMP($J),^BMXTEMP($J)

 S BMXGBL="^BMXTEMP("_$J_")"

 I +BMXFL'=BMXFL D

 . S BMXFL=$TR(BMXFL,"_"," ")

 . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q

 . S BMXFL=$O(^DIC("B",BMXFL,0))

 I '$G(BMXFL) D ERROUT("File number not provided.",1) Q

 ;

 ;Check for field name

 I +BMXFLD'=BMXFLD D

 . S BMXFLD=$TR(BMXFLD,"_"," ")

 . I '$D(^DD(BMXFL,"B",BMXFLD)) S BMXFLD="" Q

 . S BMXFLD=$O(^DD(BMXFL,"B",BMXFLD,0))

 I '$G(BMXFLD) D ERROUT("Field not provided",1) Q

 ;

 ;Set up Column names

 S ^BMXTEMP($J,0)="T"_$$NUMCHAR(30)_"INDEX^T"_$$NUMCHAR(200)_"CODE"_$C(30)

 ;

 ;Write field data to BMXTEMP

 S BMXI=0,I=0

 N BMXNAM,BMXCOD,BMXNOD,BMXTYP

 F  S BMXI=$O(^DD(BMXFL,BMXFLD,1,BMXI)) Q:'+BMXI  Q:$D(BMXERR)  D

 . S I=I+1

 . S BMXNOD=$G(^DD(BMXFL,BMXFLD,1,BMXI,0))

 . S BMXNAM=$P(BMXNOD,U,2)

 . S BMXTYP=$P(BMXNOD,U,3)

 . S:BMXTYP="" BMXTYP="REGULAR"

 . S BMXCOD=$G(^DD(BMXFL,BMXFLD,1,BMXI,1))

 . S BMXCOD=$TR(BMXCOD,"^","~")

 . S ^BMXTEMP($J,I)=BMXNAM_U_BMXTYP_U_BMXCOD_$C(30)

 Q

 ;

TLIST(BMXGBL,BMXFROM,BMXTO)      ;

 ;Returns list of Fileman files to which user has READ access

 ;TODO: Pass in type of access (RD,DL,WR) in BMXPAR

 ;

 N A,F,BMXF,BMXFLD,D0,BMXU,I,BMXCNT,BMXMFL,BMXRD,BMXMAX

 S U="^"

 S:$G(BMXFROM)="RD" BMXFROM=""

 K ^BMXTMP($J),^BMXTEMP($J)

 S BMXGBL="^BMXTEMP("_$J_")"

 S BMXF=1

 S BMXF("FILE")=1

 S BMXFLD("FILE")="1^.01"

 S BMXFLD("NUMBER")="1^.001" ;ADDED

 S BMXFLDN=$P(BMXFLD("FILE"),"^",2)

 S BMXFLDN(1,BMXFLDN)="FILE"

 S BMXFLDN=$P(BMXFLD("NUMBER"),"^",2) ;ADDED

 S BMXFLDN(1,BMXFLDN)="NUMBER" ;ADDED

 S BMXFLDO=2 ;CHANGED FROM 1 TO 2

 S BMXFLDO(0)="1^.01"

 S BMXFLDOX(1,.01,"E")=0

 S BMXFLDO(1)="1^.001" ;ADDED

 S BMXFLDOX(1,.001,"E")=1 ;ADDED

 S BMXFNX(1)="FILE"

 S BMXFO(1)="1"

 S BMXU=$G(DUZ(0))

 S BMXRD=$C(30)

 S ^BMXTEMP($J,0)="T00030FILE^N00010NUMBER"_BMXRD

 S BMXSET="S I=I+1,^BMXTEMP($J,I)=$P($G(^DIC(D0,0)),U)_U_D0_BMXRD,BMXCNT=BMXCNT+1"

 S D0=0,I=0,BMXCNT=0,BMXMAX=2000

 S BMXFROM=$G(BMXFROM),BMXTO=$G(BMXTO)

 I +BMXFROM=BMXFROM D  ;BMXFROM is a filenumber

 . S F=(+BMXFROM-1),T=+BMXTO

 . S:BMXTO<BMXFROM BMXTO=BMXFROM+1

 . S D0=F F  S D0=$O(^DIC(D0)) Q:'+D0  Q:D0>T  Q:BMXCNT>BMXMAX  I $D(^DD(D0)) D TLIST1

 I +BMXFROM'=BMXFROM D  ;F is a filename or is null

 . S F="",T="zzzzzzz"

 . S:$G(BMXFROM)]"" F=$O(^DIC("B",BMXFROM),-1)

 . S:$G(BMXTO)]"" T=BMXTO

 . F  S F=$O(^DIC("B",F)) Q:F=""  Q:F]T  Q:BMXCNT>BMXMAX  D

 . . S D0=0 F  S D0=$O(^DIC("B",F,D0)) Q:'+D0  D TLIST1

 ;

 S I=I+1,^BMXTEMP($J,I)=$C(31)

 Q

 ;

TLIST1 ;

 I BMXU="@" X BMXSET Q

 Q:$D(^DIC(D0,0))'=11

 S A=$G(^DIC(D0,0,"RD"))

 I $D(^VA(200,DUZ,"FOF",D0,0)) D  Q

 . ;I $P(^(0),U,5)="1" X BMXSET Q

 . I $P(^VA(200,DUZ,"FOF",D0,0),U,5)="1" X BMXSET Q

 F J=1:1:$L(A) I DUZ(0)[$E(A,J) X BMXSET

 Q

 ;

SQLCOL(BMXGBL,BMXSQL)        ;EP

 D INTSQL(.BMXGBL,.BMXSQL,1)

 Q

 ;

SQLD(BMXGBL,BMXSQL) ;EP Serenji Debug Entrypoint

 ;D DEBUG^%Serenji("SQLD^BMXSQL(.BMXGBL,.BMXSQL)")

 Q

 ;

SQL(BMXGBL,BMXSQL) ;EP

 D INTSQL(.BMXGBL,.BMXSQL,0)

 Q

 ;

INTSQL(BMXGBL,BMXSQL,BMXCOL)        ;EP

 ;

 ;SQL Top Wait for debug break

 ;D  

 ;. F J=1:1:10 S K=$H H 1

 ;. Q

 ;

 S X="ERRTRAP^BMXSQL",@^%ZOSF("TRAP")

 I $G(BMXSQL)="" S BMXSQL="" D

 . N C S C=0 F  S C=$O(BMXSQL(C)) Q:'+C  D

 . . S BMXSQL=BMXSQL_BMXSQL(C)

 ;

 I BMXSQL["call SHAPE" S BMXSQL="SELECT JUNKNAME, MULTCOLOR FROM JUNKMULT"

 ; Global-scope variables

 K BMXTK

 N BMXF,BMXTK,T,BMXFLD,BMXTMP,BMXM,BMXXMAX,BMXFLDN,BMXV

 N BMXX,BMXFG,BMXFF,BMXSCR,BMXPFP

 N BMXERR,BMXFLDO,BMXFLDOX,BMXFJ,BMXFO,BMXFNX

 N BMXMFL,BMXFLDA

 D ^XBKVAR

 S U="^"

 I $D(^%ZOSF("MAXSIZ")) S X=640 X ^%ZOSF("MAXSIZ")

 K ^BMXTMP($J),^BMXTEMP($J),^BMXTMPD($J)

 S BMXGBL="^BMXTEMP("_$J_")"

 ;Remove CR and LF from BMXSQL

 S BMXSQL=$TR(BMXSQL,$C(13)," ")

 S BMXSQL=$TR(BMXSQL,$C(10)," ")

 S BMXSQL=$TR(BMXSQL,$C(9)," ")

 S BMXSQL=$TR(BMXSQL,$C(34),"")

 D PARSE^BMXPRS(BMXSQL)

 S BMXXMAX=1000000 ;Default Maximum records to return.

 D KW^BMXSQL1(.BMXTK)

 Q:$D(BMXERR)

 ;

 ;Get file names into BMXF("NAME")="NUMBER"

 ;Get file numbers into BMXFNX(NUMBER)="NAME"

 ;  Files are ordered in BMXFO(order)="NUMBER"

 ;

FROM S T=$G(BMXTK("FROM"))

 I '+T S BMXERR="'FROM' CLAUSE NOT FOUND" D ERROR Q

 S BMXF=0

 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)

 . Q:BMXTK(T)=","

 . N BMXFNT

 . I BMXTK(T)["'" S BMXTK(T)=$P(BMXTK(T),"'",2)

 . S BMXTK(T)=$TR(BMXTK(T),"_"," ")

 . I '(BMXTK(T)?.N),'$D(^DIC("B",BMXTK(T))) S BMXERR="FILE NOT FOUND" D ERROR Q

 . S BMXF=BMXF+1

 . I BMXTK(T)?.N S BMXFNT=BMXTK(T)

 . E  S BMXFNT=$O(^DIC("B",BMXTK(T),0))

 . S BMXMFL(BMXFNT,"GLOC")=^DIC(BMXFNT,0,"GL")

 . D F1(BMXF,BMXTK(T),BMXFNT)

 . I '+BMXF(BMXTK(T)) S BMXERR="FILE NUMBER NOT FOUND" D ERROR Q

 . D  ;Test alias 

 . . Q:'+$O(BMXTK(T))

 . . N V

 . . S V=T+1

 . . Q:$G(BMXTK(V))=","

 . . Q:V=$G(BMXTK("WHERE"))

 . . Q:V=$G(BMXTK("ORDER BY"))

 . . Q:V=$G(BMXTK("GROUP BY"))

 . . S BMXTK(T,"ALIAS")=BMXTK(V)

 . . K BMXTK(V)

 . . Q

 . Q

 ;

 D SELECT^BMXSQL5

 I $D(BMXERR) G END

 D POST2^BMXPRS ;Remove commas from BMXTK

 D KW^BMXSQL1(.BMXTK)

 ;

 D WHERE^BMXSQL7

 ;

 ;Find the first WHERE field that has an index

 I $D(BMXERR) G END

 ;

 D INDEX(.BMXFF,.BMXX,.BMXTMP)

 ;

 S:BMXTMP BMXX=BMXTMP

 ;

 ;Set up screen logic for where fields

 D SCREEN^BMXSQL1

 D SETX^BMXSQL2(.BMXX,.BMXFG,.BMXSCR)

 ;

 ;

EXEC ;Execute enumerator and screen code to call Output routine

 ;

 N BMXOUT,J,BMXC

 S BMXOUT=0

 ;Debug lines (retain):

 ;K ^HW("BMXX") S J=0 F  S J=$O(BMXX(J)) Q:'+J  S ^HW("BMXX",J)=BMXX(J)

 ;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)

 ;Test for SHOWPLAN

 I $G(BMXTK("SHOWPLAN"))="TRUE" D WPLAN Q

 S BMXM=0

 I 'BMXCOL S J=0 F  S J=$O(BMXX(J)) Q:'+J  D  Q:BMXM>BMXXMAX

 . X BMXX(J)

 ;

 D WRITE^BMXSQL6

 ;

END Q

 ;

 ;

F1(BMXC,BMXNAM,BMXNUM) ;EP

 S BMXF(BMXNAM)=BMXNUM

 S BMXFNX(BMXNUM)=BMXNAM

 S BMXFO(BMXC)=BMXF(BMXNAM)

 Q

 ;

OUT ;Set result in ^BMXTMP

 S BMXOUT=BMXOUT+1

 S ^BMXTMP($J,"O",D0)=""

 S ^BMXTMP($J,BMXOUT)=D0

 S BMXM=BMXM+1

 Q

 ;

WPLAN ;Write execution plan

 ;Set up Column Names

 N BMXLEN,BMXTYP,BMXT,J,BMXSCRT,BMXXT

 S I=1

 F BMXT="VARIABLE^","VALUE"_$C(30) D

 . S ^BMXTEMP($J,I)=BMXT,BMXLEN(I)=15,BMXTYP(I)="T"

 . S I=I+1

 S J=0

 I $D(BMXX) F  S J=$O(BMXX(J)) Q:'+J  D

 . S ^BMXTEMP($J,I)="INDEX("_J_")^"

 . S I=I+1

 . S BMXXT(J)=BMXX(J)

 . S BMXXT(J)=$P(BMXXT(J)," X BMXSCR")

 . S ^BMXTEMP($J,I)=$TR(BMXXT(J),"^","~")_$C(30)

 . S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))

 . S I=I+1

 S ^BMXTEMP($J,I)="SCREEN^"

 S I=I+1

 S BMXSCRT=$G(BMXSCR)

 S BMXSCRT=$P(BMXSCRT,"D:'$D(^BMXTMP")

 S ^BMXTEMP($J,I)=$TR(BMXSCRT,"^","~")_$C(30)

 S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))

 S I=I+1

 S J=0

 I $D(BMXSCR("C")) F  S J=$O(BMXSCR("C",J)) Q:'+J  D

 . S ^BMXTEMP($J,I)="SCREEN("_J_")^"

 . S I=I+1

 . S ^BMXTEMP($J,I)=$TR(BMXSCR("C",J),"^","~")_$C(30)

 . S:$L(^BMXTEMP($J,I))>BMXLEN(2) BMXLEN(2)=$L(^BMXTEMP($J,I))

 . S I=I+1

 D COLTYPE

 S I=I+1

 D ERRTACK(I)

 Q

 ;

 ;

COLTYPE ;EP - Append column types and widths to output global

 ;REQUIRES - BMXLEN(),BMXTYP(),^BMXTEMP

 ;IHS/SET/HMW 4-22-2004 Modified to use new schema string

 ;

 ;"@@@meta@@@BMXIEN|FILE #|DA STRING"

 ;

 N C

 S C=0

 F  S C=$O(BMXLEN(C)) Q:'C  D

 . I BMXLEN(C)>99999 S BMXLEN(C)=99999

 . I BMXLEN(C)=0 S BMXLEN(C)=50 ;Default column length

 . S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)

 Q

 ;

 ;S ^BXTEMP($J,0)="@@@meta@@@BMXIEN|"_BMXF_"|" ;Last |-piece will be DA string

 ;N C

 ;S C=0

 ;F  S C=$O(BMXLEN(C)) Q:'C  D

 ;. I BMXLEN(C)>99999 S BMXLEN(C)=99999

 ;. I BMXLEN(C)=0 S BMXLEN(C)=50 ;Default column length

 ;. S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)

 ;Q

 ;

ERRTACK(I) ;EP

 ;

 S ^BMXTEMP($J,I)=$C(31)

 S:$D(BMXERR) ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXERR

 Q

 ;

NUMCHAR(BMXN)      ;EP

 ;---> Returns Field Length left-padded with 0

 ;

 N BMXC

 S BMXC="00000"_BMXN

 Q $E(BMXC,$L(BMXC)-4,$L(BMXC))

 ;

 ;

INDEX(BMXFF,BMXRET,BMXXCNT) ;

 ;Returns executable enumerator on first where field with an index

 ;or "" if no indexed where field

 ;IN: BMXFF()

 ;OUT: BMXRET()

 ;     BMXXCNT  - size of BMXRET array

 ;

 N F,BMXNOD,BMXFNUM,BMXFLDNM,BMXHIT,BMXREF,BMXRNAM,BMXOP,Q,BMXGL

 N BMXTMP,BMXTMPV,BMXTMPI,BMXTMPL,BMXTMPN,BMXV,BMXRNOD,BMXTMPP

 S BMXXCNT=0

 S Q=$C(34)

 I 'BMXFF Q

 S F=0,BMXHIT=0

 ;

 ;--->Search BMXFF for special case WHERE clause 1 = "0"

 ;    reset BMXX(1) to return no records

 F F=1:1:BMXFF S BMXNOD=BMXFF(F) D  Q:$D(BMXERR)  Q:BMXHIT

 . I ($P(BMXFF(F),"^",2,4)="1^=^0")!($P(BMXFF(F),"^",2,4)="0^=^1") S BMXRET(1)="Q  ",BMXHIT=1,BMXXCNT=1

 . Q

 Q:BMXHIT

 ;

 ;Organize the first level into AND- and OR-parts

 N BMXR1,BMXR2,BMXE,BMXR3,BMXRNAM

 N BMXSTOP,BMXOR

 D PLEVEL^BMXSQL3(.BMXFF,.BMXR1,.BMXR2)

 ;

 N BMXPFF S BMXPFF=0

 S BMXR3=0

 ;Look for an AND-part with only one element.

 ;  If found, build an iterator on it and quit

 F J=1:1:$L(BMXR2,"&") D  Q:BMXHIT

 . S BMXE=$P(BMXR2,"&",J)

 . I +BMXE=BMXE,BMXR1(BMXE,"ELEMENTS")=1 D

 . . ;Test index for element

 . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D  Q  ;I'm not sure why this quit was here

 . . . Q:$D(BMXFF(K,"JOIN"))

 . . . S BMXPFP=K,BMXPFF=0

 . . . D XRTST^BMXSQL3(.BMXFF,K,.BMXR3,.BMXRNAM,.BMXPFP)

 . . . I BMXR3 S BMXHIT=1,BMXFF(K,"INDEXED")=1

 . Q:'BMXHIT

 . ;Build iterator and quit

 . D BLDIT^BMXSQL3(.BMXFF,K,.BMXRNAM,.BMXOR,.BMXPFP)

 . S BMXXCNT=1

 . S BMXRET(BMXXCNT)=BMXOR

 . Q

 Q:BMXHIT

 ;

 ;None of the single-element AND parts has a good index or

 ;  there are no single-element AND parts

 ;If there are no OR-parts, then there are no good indexes so quit

 I $L(BMXR2,"!")=1 Q

 ;

 ;Test each OR-part for a good index.

 ;If an OR-part is multi-element or

 ;if one OR-part doesn't have an index

 ;then set up to do a table scan and quit

 S BMXSTOP=0

 F J=1:1:$L(BMXR2,"!") D  Q:BMXSTOP

 . S BMXE=$P(BMXR2,"!",J)

 . I +BMXE=BMXE D

 . . I BMXR1(BMXE,"ELEMENTS")'=1 S BMXSTOP=1 Q  ;Multiple elements

 . . ;Test index elements

 . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D  Q

 . . . S BMXPFP=K,BMXPFF=0

 . . . D XRTST^BMXSQL3(.BMXFF,K,.BMXR3,.BMXRNAM,.BMXPFP)

 . . . I 'BMXR3 S BMXSTOP=1 Q

 . . . S BMXFF(K,"INDEXED")=1

 . . . S BMXR1(BMXE,"XREF")=BMXRNAM

 ;

 ;Build iterator and quit

 I BMXSTOP D  Q  ;One of the elements had no index

 . S J=0 F  S J=$O(BMXFF(J)) Q:'+J  K BMXFF(J,"INDEXED")

 S BMXXCNT=0

 F J=1:1:$L(BMXR2,"!") D

 . S BMXE=$P(BMXR2,"!",J)

 . I +BMXE=BMXE,BMXR1(BMXE,"ELEMENTS")=1 D

 . . F K=BMXR1(BMXE,"BEGIN"):1:BMXR1(BMXE,"END") I "(^)"'[BMXFF(K) D  Q

 . . . D BLDIT^BMXSQL3(.BMXFF,K,BMXR1(BMXE,"XREF"),.BMXOR,.BMXPFP)

 . . . S BMXXCNT=BMXXCNT+1

 . . . S BMXRET(BMXXCNT)=BMXOR

 . Q

 Q

 ;

 ;

 ;

ERROR ;EP - Error processing

 ;W !,BMXERR

 ;N A

 ;S A=0

 ;I $D(I) S A=I

 ;D ERROUT(BMXERR,A)

 ;B  ;ERROR in BMXSQL

 Q

 ;

ERROUT(BMXERR,I) ;EP

 ;---> Save next line for Error Code File if ever used.

 ;---> If necessary, use I>1 to avoid overwriting valid data.

 D ERRTACK(I)

 Q

 ;

ERRTRAP ;

 ;

 K ^BMXTEMP($J)

 S ^BMXTEMP($J,0)="T00030M_ERROR"_$C(30)

 S BMXZE=$$EC^%ZOSV

 S BMXZE=$TR(BMXZE,"^","~")

 S ^BMXTEMP($J,1)=BMXZE_$C(30)

 S ^BMXTEMP($J,2)=$C(31)

 Q

BMXSQL    ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 

 +1       ;;4.0;BMX;;JUN 28, 2010

 +2       ;

 +3       ;

 +4        QUIT 

 +5       ;

FLDNDX(BMXGBL,BMXFL,BMXFLD) ;

 +1       ;Returns index name and set code for all indexes on field

 +2       ;on field BMXFLD in file BMXFL

 +3        SET BMX31=$CHAR(31)_$CHAR(31)

 +4        KILL ^BMXTMP($JOB),^BMXTEMP($JOB)

 +5        SET BMXGBL="^BMXTEMP("_$JOB_")"

 +6        IF +BMXFL'=BMXFL

               Begin DoDot:1

 +7                SET BMXFL=$TRANSLATE(BMXFL,"_"," ")

 +8                IF '$DATA(^DIC("B",BMXFL))

                       SET BMXFL=""

                       QUIT 

 +9                SET BMXFL=$ORDER(^DIC("B",BMXFL,0))

               End DoDot:1

 +10       IF '$GET(BMXFL)

               DO ERROUT("File number not provided.",1)

               QUIT 

 +11      ;

 +12      ;Check for field name

 +13       IF +BMXFLD'=BMXFLD

               Begin DoDot:1

 +14               SET BMXFLD=$TRANSLATE(BMXFLD,"_"," ")

 +15               IF '$DATA(^DD(BMXFL,"B",BMXFLD))

                       SET BMXFLD=""

                       QUIT 

 +16               SET BMXFLD=$ORDER(^DD(BMXFL,"B",BMXFLD,0))

               End DoDot:1

 +17       IF '$GET(BMXFLD)

               DO ERROUT("Field not provided",1)

               QUIT 

 +18      ;

 +19      ;Set up Column names

 +20       SET ^BMXTEMP($JOB,0)="T"_$$NUMCHAR(30)_"INDEX^T"_$$NUMCHAR(200)_"CODE"_$CHAR(30)

 +21      ;

 +22      ;Write field data to BMXTEMP

 +23       SET BMXI=0

           SET I=0

 +24       NEW BMXNAM,BMXCOD,BMXNOD,BMXTYP

 +25       FOR 

               SET BMXI=$ORDER(^DD(BMXFL,BMXFLD,1,BMXI))

               IF '+BMXI

                   QUIT 

               IF $DATA(BMXERR)

                   QUIT 

               Begin DoDot:1

 +26               SET I=I+1

 +27               SET BMXNOD=$GET(^DD(BMXFL,BMXFLD,1,BMXI,0))

 +28               SET BMXNAM=$PIECE(BMXNOD,U,2)

 +29               SET BMXTYP=$PIECE(BMXNOD,U,3)

 +30               IF BMXTYP=""

                       SET BMXTYP="REGULAR"

 +31               SET BMXCOD=$GET(^DD(BMXFL,BMXFLD,1,BMXI,1))

 +32               SET BMXCOD=$TRANSLATE(BMXCOD,"^","~")

 +33               SET ^BMXTEMP($JOB,I)=BMXNAM_U_BMXTYP_U_BMXCOD_$CHAR(30)

               End DoDot:1

 +34       QUIT 

 +35      ;

TLIST(BMXGBL,BMXFROM,BMXTO) ;

 +1       ;Returns list of Fileman files to which user has READ access

 +2       ;TODO: Pass in type of access (RD,DL,WR) in BMXPAR

 +3       ;

 +4        NEW A,F,BMXF,BMXFLD,D0,BMXU,I,BMXCNT,BMXMFL,BMXRD,BMXMAX

 +5        SET U="^"

 +6        IF $GET(BMXFROM)="RD"

               SET BMXFROM=""

 +7        KILL ^BMXTMP($JOB),^BMXTEMP($JOB)

 +8        SET BMXGBL="^BMXTEMP("_$JOB_")"

 +9        SET BMXF=1

 +10       SET BMXF("FILE")=1

 +11       SET BMXFLD("FILE")="1^.01"

 +12      ;ADDED

           SET BMXFLD("NUMBER")="1^.001"

 +13       SET BMXFLDN=$PIECE(BMXFLD("FILE"),"^",2)

 +14       SET BMXFLDN(1,BMXFLDN)="FILE"

 +15      ;ADDED

           SET BMXFLDN=$PIECE(BMXFLD("NUMBER"),"^",2)

 +16      ;ADDED

           SET BMXFLDN(1,BMXFLDN)="NUMBER"

 +17      ;CHANGED FROM 1 TO 2

           SET BMXFLDO=2

 +18       SET BMXFLDO(0)="1^.01"

 +19       SET BMXFLDOX(1,.01,"E")=0

 +20      ;ADDED

           SET BMXFLDO(1)="1^.001"

 +21      ;ADDED

           SET BMXFLDOX(1,.001,"E")=1

 +22       SET BMXFNX(1)="FILE"

 +23       SET BMXFO(1)="1"

 +24       SET BMXU=$GET(DUZ(0))

 +25       SET BMXRD=$CHAR(30)

 +26       SET ^BMXTEMP($JOB,0)="T00030FILE^N00010NUMBER"_BMXRD

 +27       SET BMXSET="S I=I+1,^BMXTEMP($J,I)=$P($G(^DIC(D0,0)),U)_U_D0_BMXRD,BMXCNT=BMXCNT+1"

 +28       SET D0=0

           SET I=0

           SET BMXCNT=0

           SET BMXMAX=2000

 +29       SET BMXFROM=$GET(BMXFROM)

           SET BMXTO=$GET(BMXTO)

 +30      ;BMXFROM is a filenumber

           IF +BMXFROM=BMXFROM

               Begin DoDot:1

 +31               SET F=(+BMXFROM-1)

                   SET T=+BMXTO

 +32               IF BMXTO<BMXFROM

                       SET BMXTO=BMXFROM+1

 +33               SET D0=F

                   FOR 

                       SET D0=$ORDER(^DIC(D0))

                       IF '+D0

                           QUIT 

                       IF D0>T

                           QUIT 

                       IF BMXCNT>BMXMAX

                           QUIT 

                       IF $DATA(^DD(D0))

                           DO TLIST1

               End DoDot:1

 +34      ;F is a filename or is null

           IF +BMXFROM'=BMXFROM

               Begin DoDot:1

 +35               SET F=""

                   SET T="zzzzzzz"

 +36               IF $GET(BMXFROM)]""

                       SET F=$ORDER(^DIC("B",BMXFROM),-1)

 +37               IF $GET(BMXTO)]""

                       SET T=BMXTO

 +38               FOR 

                       SET F=$ORDER(^DIC("B",F))

                       IF F=""

                           QUIT 

                       IF F]T

                           QUIT 

                       IF BMXCNT>BMXMAX

                           QUIT 

                       Begin DoDot:2

 +39                       SET D0=0

                           FOR 

                               SET D0=$ORDER(^DIC("B",F,D0))

                               IF '+D0

                                   QUIT 

                               DO TLIST1

                       End DoDot:2

               End DoDot:1

 +40      ;

 +41       SET I=I+1

           SET ^BMXTEMP($JOB,I)=$CHAR(31)

 +42       QUIT 

 +43      ;

TLIST1    ;

 +1        IF BMXU="@"

               XECUTE BMXSET

               QUIT 

 +2        IF $DATA(^DIC(D0,0))'=11

               QUIT 

 +3        SET A=$GET(^DIC(D0,0,"RD"))

 +4        IF $DATA(^VA(200,DUZ,"FOF",D0,0))

               Begin DoDot:1

 +5       ;I $P(^(0),U,5)="1" X BMXSET Q

 +6                IF $PIECE(^VA(200,DUZ,"FOF",D0,0),U,5)="1"

                       XECUTE BMXSET

                       QUIT 

               End DoDot:1

               QUIT 

 +7        FOR J=1:1:$LENGTH(A)

               IF DUZ(0)[$EXTRACT(A,J)

                   XECUTE BMXSET

 +8        QUIT 

 +9       ;

SQLCOL(BMXGBL,BMXSQL) ;EP

 +1        DO INTSQL(.BMXGBL,.BMXSQL,1)

 +2        QUIT 

 +3       ;

SQLD(BMXGBL,BMXSQL) ;EP Serenji Debug Entrypoint

 +1       ;D DEBUG^%Serenji("SQLD^BMXSQL(.BMXGBL,.BMXSQL)")

 +2        QUIT 

 +3       ;

SQL(BMXGBL,BMXSQL) ;EP

 +1        DO INTSQL(.BMXGBL,.BMXSQL,0)

 +2        QUIT 

 +3       ;

INTSQL(BMXGBL,BMXSQL,BMXCOL) ;EP

 +1       ;

 +2       ;SQL Top Wait for debug break

 +3       ;D  

 +4       ;. F J=1:1:10 S K=$H H 1

 +5       ;. Q

 +6       ;

 +7        SET X="ERRTRAP^BMXSQL"

           SET @^%ZOSF("TRAP")

 +8        IF $GET(BMXSQL)=""

               SET BMXSQL=""

               Begin DoDot:1

 +9                NEW C

                   SET C=0

                   FOR 

                       SET C=$ORDER(BMXSQL(C))

                       IF '+C

                           QUIT 

                       Begin DoDot:2

 +10                       SET BMXSQL=BMXSQL_BMXSQL(C)

                       End DoDot:2

               End DoDot:1

 +11      ;

 +12       IF BMXSQL["call SHAPE"

               SET BMXSQL="SELECT JUNKNAME, MULTCOLOR FROM JUNKMULT"

 +13      ; Global-scope variables

 +14       KILL BMXTK

 +15       NEW BMXF,BMXTK,T,BMXFLD,BMXTMP,BMXM,BMXXMAX,BMXFLDN,BMXV

 +16       NEW BMXX,BMXFG,BMXFF,BMXSCR,BMXPFP

 +17       NEW BMXERR,BMXFLDO,BMXFLDOX,BMXFJ,BMXFO,BMXFNX

 +18       NEW BMXMFL,BMXFLDA

 +19       DO ^XBKVAR

 +20       SET U="^"

 +21       IF $DATA(^%ZOSF("MAXSIZ"))

               SET X=640

               XECUTE ^%ZOSF("MAXSIZ")

 +22       KILL ^BMXTMP($JOB),^BMXTEMP($JOB),^BMXTMPD($JOB)

 +23       SET BMXGBL="^BMXTEMP("_$JOB_")"

 +24      ;Remove CR and LF from BMXSQL

 +25       SET BMXSQL=$TRANSLATE(BMXSQL,$CHAR(13)," ")

 +26       SET BMXSQL=$TRANSLATE(BMXSQL,$CHAR(10)," ")

 +27       SET BMXSQL=$TRANSLATE(BMXSQL,$CHAR(9)," ")

 +28       SET BMXSQL=$TRANSLATE(BMXSQL,$CHAR(34),"")

 +29       DO PARSE^BMXPRS(BMXSQL)

 +30      ;Default Maximum records to return.

           SET BMXXMAX=1000000

 +31       DO KW^BMXSQL1(.BMXTK)

 +32       IF $DATA(BMXERR)

               QUIT 

 +33      ;

 +34      ;Get file names into BMXF("NAME")="NUMBER"

 +35      ;Get file numbers into BMXFNX(NUMBER)="NAME"

 +36      ;  Files are ordered in BMXFO(order)="NUMBER"

 +37      ;

FROM       SET T=$GET(BMXTK("FROM"))

 +1        IF '+T

               SET BMXERR="'FROM' CLAUSE NOT FOUND"

               DO ERROR

               QUIT 

 +2        SET BMXF=0

 +3        FOR 

               SET T=$ORDER(BMXTK(T))

               IF '+T

                   QUIT 

               IF T=$GET(BMXTK("WHERE"))

                   QUIT 

               IF T=$GET(BMXTK("ORDER BY"))

                   QUIT 

               IF T=$GET(BMXTK("GROUP BY"))

                   QUIT 

               Begin DoDot:1

 +4                IF BMXTK(T)=","

                       QUIT 

 +5                NEW BMXFNT

 +6                IF BMXTK(T)["'"

                       SET BMXTK(T)=$PIECE(BMXTK(T),"'",2)

 +7                SET BMXTK(T)=$TRANSLATE(BMXTK(T),"_"," ")

 +8                IF '(BMXTK(T)?.N)

                       IF '$DATA(^DIC("B",BMXTK(T)))

                           SET BMXERR="FILE NOT FOUND"

                           DO ERROR

                           QUIT 

 +9                SET BMXF=BMXF+1

 +10               IF BMXTK(T)?.N

                       SET BMXFNT=BMXTK(T)

 +11              IF '$TEST

                       SET BMXFNT=$ORDER(^DIC("B",BMXTK(T),0))

 +12               SET BMXMFL(BMXFNT,"GLOC")=^DIC(BMXFNT,0,"GL")

 +13               DO F1(BMXF,BMXTK(T),BMXFNT)

 +14               IF '+BMXF(BMXTK(T))

                       SET BMXERR="FILE NUMBER NOT FOUND"

                       DO ERROR

                       QUIT 

 +15      ;Test alias 

                   Begin DoDot:2

 +16                   IF '+$ORDER(BMXTK(T))