Routine: BMXSQL3

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

 ;;4.0;BMX;;JUN 28, 2010

PLEVEL(BMXFF,BMXLVL,BMXRET) ;EP

 ;Analyze WHERE statement according to paren level

 ;Return a string to guide building of iterator(s)

 ;Basically, count the number of OR clauses on the

 ;same paren level

 ;IN: BMXFF()

 ;OUT: BMXLVL(), BMXRET

 ;BMXRET = 1&/!2&/!...&/!n   clauses

 ;BMXLVL(E,"BEGIN")=Index where element E begins

 ;BMXLVL(E,"END")  =Index where element E ends

 ;BMXLVL(E,"ELEMENTS")=Number of subelements in element E

 N BMXNOR,BMXNAND,J,C,BMXTMP

 N E,L,BMXCNT

 ;Test for no ORs or no ANDs

 S BMXNOR=1,BMXNAND=1

 S J=0 F  S J=$O(BMXFF(J)) Q:'+J  D  ;Q:'BMXNOR  Q:'BMXNAND

 . I BMXFF(J)="OR" S BMXNOR=0

 . I BMXFF(J)="AND" S BMXNAND=0

. Q

 ;If no ORs or no ANDs then take all parens out of BMXFF

 I ((BMXNOR)!(BMXNAND)) D

 . S:$D(BMXFF("INDEX")) BMXTMP("INDEX")=BMXFF("INDEX")

 . S J=0,C=0 F  S J=$O(BMXFF(J)) Q:'+J  D:"(^)"'[BMXFF(J)

 . . S C=C+1

 . . S BMXTMP(C)=BMXFF(J)

 . . S:$D(BMXFF(J,0)) BMXTMP(C,0)=BMXFF(J,0)

 . . S:$D(BMXFF(J,"INTERNAL")) BMXTMP(J,"INTERNAL")=BMXFF(J,"INTERNAL")

 . . S:$D(BMXFF(J,"TYPE")) BMXTMP(C,"TYPE")=BMXFF(J,"TYPE")

 . . S:$D(BMXFF(J,"IEN")) BMXTMP(C,"IEN")=BMXFF(J,"IEN")

 . . S:$D(BMXFF(J,"JOIN")) BMXTMP(C,"JOIN")=BMXFF(J,"JOIN")

 . . S:$D(BMXFF(J,"JOIN","IEN")) BMXTMP(C,"JOIN","IEN")=BMXFF(J,"JOIN","IEN")

 . . ;I $D(BMXFF(J,"JOIN")) D

 . . ;. N K S K=0 F  S K=$O(BMXFF(J,"JOIN",K)) Q:'+K  D

 . . ;. . N L S L=0 F  S L=$O(BMXFF(J,"JOIN",K,L)) Q:'+L  D

 . . ;. . . S BMXTMP(C,"JOIN",K,L)=BMXFF(J,"JOIN",K,L)

 . . I $D(BMXFF(J,"SET")) D

 . . . N BMXSS

 . . . S BMXSS="" F  S BMXSS=$O(BMXFF(J,"SET",BMXSS)) Q:BMXSS=""  D

 . . . . S BMXTMP(C,"SET",BMXSS)=BMXFF(J,"SET",BMXSS)

 . K BMXFF

 . I $D(BMXTMP("INDEX")) S BMXFF("INDEX")=BMXTMP("INDEX")

 . S J=0 F  S J=$O(BMXTMP(J)) Q:'+J  D

 . . S BMXFF(J)=BMXTMP(J)

 . . S:$D(BMXTMP(J,0)) BMXFF(J,0)=BMXTMP(J,0)

 . . S:$D(BMXTMP(J,"TYPE")) BMXFF(J,"TYPE")=BMXTMP(J,"TYPE")

 . . I $D(BMXTMP(J,"JOIN")) S BMXFF(J,"JOIN")=BMXTMP(J,"JOIN") S:$D(BMXTMP(J,"JOIN","IEN")) BMXFF(J,"JOIN","IEN")=BMXTMP(J,"JOIN","IEN") S BMXFJ("JOIN",+$P($P(BMXFF(J,0),U,2),"P",2))=J

 . . ;I $D(BMXTMP(J,"JOIN")) D

 . . ;. N K S K=0 F  S K=$O(BMXTMP(J,"JOIN",K)) Q:'+K  D

 . . ;. . N L S L=0 F  S L=$O(BMXTMP(J,"JOIN",K,L)) Q:'+L  D

 . . ;. . . S BMXFF(J,"JOIN",K,L)=BMXTMP(J,"JOIN",K,L)

 . . I $D(BMXTMP(J,"SET")) D

 . . . N BMXSS

 . . . S BMXSS="" F  S BMXSS=$O(BMXTMP(J,"SET",BMXSS)) Q:BMXSS=""  D

 . . . . S BMXFF(J,"SET",BMXSS)=BMXTMP(J,"SET",BMXSS)

 . . I $D(BMXTMP(J,"INTERNAL")) S BMXFF(J,"INTERNAL")=BMXTMP(J,"INTERNAL")

 . . I $D(BMXTMP(J,"IEN")) S BMXFF(J,"IEN")=BMXTMP(J,"IEN")

 . S BMXFF=C

. Q

 ;Remove excess leading and trailing parens

 ;Find close paren corresponding to BMXFF(1)

 ;If its the last paren, then remove the first and last parens

 ;Else, quit

 N BMXEND

 S BMXEND=0

 F  Q:'((BMXFF(1)="(")&(BMXFF(BMXFF)=")"))  Q:BMXEND  D

 . S L=1,J=1

 . F  S J=$O(BMXFF(J)) Q:'+J  D:"(^)"[BMXFF(J)  Q:BMXEND

 . . I BMXFF(J)="(" S L=L+1 Q

 . . I BMXFF(J)=")" S L=L-1

 . . I L=0,J<BMXFF S BMXEND=1 Q

 . . I L=0,J=BMXFF D  Q

 . . . K BMXFF(1),BMXFF(BMXFF)

 . . . F J=2:1:BMXFF-1 D

 . . . . S BMXFF(J-1)=BMXFF(J)

 . . . . S:$D(BMXFF(J,0)) BMXFF(J-1,0)=BMXFF(J,0)

 . . . . K BMXFF(J)

 . . . S BMXFF=BMXFF-2

 S BMXRET="",E=1,L=0,BMXCNT=0

 K BMXLVL

 S J=0 F  S J=$O(BMXFF(J)) Q:'+J  D

 . I BMXFF(J)="(" D  Q  ;If BMXFF(J) is an open paren

 . . S L=1

 . . S BMXLVL(E,"BEGIN")=J ;Start position of this expression

 . . S BMXCNT=0

 . . ;Find corresponding close paren

 . . F  S J=$O(BMXFF(J)) Q:'+J  D  Q:L=0

 . . . I BMXFF(J)=")" S L=L-1,BMXLVL(E,"END")=J,BMXLVL(E,"ELEMENTS")=BMXCNT Q

 . . . I BMXFF(J)="(" S L=L+1 Q

 . . . I "AND^OR"'[BMXFF(J) S BMXCNT=BMXCNT+1

 . . S BMXRET=BMXRET_E

 . . S E=E+1

 . . Q

 . I "AND^OR"[BMXFF(J) D  Q  ;If BMXFF(J) is an operator

 . . S BMXRET=BMXRET_$S(BMXFF(J)="OR":"!",1:"&")

 . D  Q  ; BMXFF(J) is an element unenclosed by parens

 . . S BMXLVL(E,"BEGIN")=J

 . . S BMXLVL(E,"END")=J

 . . S BMXLVL(E,"ELEMENTS")=1

 . . S BMXRET=BMXRET_E

 . . S E=E+1

. Q

XRTST(BMXFF,F,BMXHIT,BMXRNAM,BMXPFP)       ;EP

 ;Returns TRUE (1) in BMXRET if 'normal' index exists

 ;for field in BMXFF(BMXNDX)

 ;ELSE returns 0

 ;IN: BMXFF

 ;    F

 ;OUT:BMXRET  - 1 or 0

 ;    BMXRNAM - If BMXRET=1, Index name

 N BMXNOD0,BMXFNUM,BMXGL,BMXFLDNM,BMXREF,Q

 S BMXRET=0,Q=$C(34)

 Q:"AND^OR^(^)"[BMXFF(F)

 S BMXNOD=BMXFF(F)

 S BMXNOD0=BMXFF(F,0)

 S BMXFNUM=$P(BMXNOD,U,5)

 Q:'+BMXFNUM

 S BMXGL=$P(BMXNOD,U,7,8)

 S BMXFLDNM=$P(BMXNOD,U,6)

 S BMXHIT=0

 Q:$D(BMXFF("JOIN"))

 Q:$D(BMXFF(F,"INTERNAL"))

 I BMXPFF=0,$P(BMXFF(F),U,4)="" Q  ;Cannot create iterator on null

 I $D(BMXFF(F,"IEN")) S BMXHIT=1 Q

 I '$D(^DD(BMXFNUM,BMXFLDNM,1)) Q

 I $P(BMXNOD0,U,2)'["P",$D(BMXFF("INDEX")) D  Q  ;Explicit index

 . S BMXRNAM=BMXFF("INDEX")

 . S BMXHIT=1

 S BMXREF=0

 F  S BMXREF=$O(^DD(BMXFNUM,BMXFLDNM,1,BMXREF)) Q:'+BMXREF  Q:BMXHIT  D

 . Q:'$D(^DD(BMXFNUM,BMXFLDNM,1,BMXREF,0))

 . S BMXRNOD=^DD(BMXFNUM,BMXFLDNM,1,BMXREF,0)

 . Q:$P(BMXRNOD,U,3)]""

 . S BMXRNAM=$P(BMXRNOD,U,2)

 . S BMXTMP=BMXGL_Q_BMXRNAM_Q_")"

 . Q:'$D(@BMXTMP)

 . S BMXTMPV=0,BMXTMPV=$O(@BMXTMP@(BMXTMPV))

 . Q:BMXTMPV=""

 . S BMXTMP=BMXGL_Q_BMXRNAM_Q_","_Q_BMXTMPV_Q_")"

 . S BMXTMPI=0,BMXTMPI=$O(@BMXTMP@(BMXTMPI))

 . S BMXTMP=$S(BMXGL[",":$P(BMXGL,",")_")",1:$P(BMXGL,"("))

 . Q:'$D(@BMXTMP@(BMXTMPI))

 . S BMXTMPL=$P(BMXFF(F,0),U,4)

 . S BMXTMPP=$P(BMXTMPL,";",2)

 . S BMXTMPL=$P(BMXTMPL,";")

 . Q:BMXTMPL=""

 . S BMXTMP=BMXGL_BMXTMPI_")"

 . Q:'$D(@BMXTMP@(BMXTMPL))

 . S BMXTMPN=@BMXTMP@(BMXTMPL)

 . I BMXTMPP["E" D

 . . S BMXTMPP=$P(BMXTMPP,"E",2)

 . . S BMXTMPP=$E(BMXTMPN,$P(BMXTMPP,","),$P(BMXTMPP,",",2))

 . E  D

 . . S BMXTMPP=$P(BMXTMPN,"^",BMXTMPP)

 . I $P(BMXNOD0,U,2)["P" D  Q

 . . N BMXPFFN

 . . S BMXPFF(BMXPFF)=BMXFF(F)

 . . S BMXPFF(BMXPFF,0)=BMXFF(F,0)

 . . S BMXPFF(BMXPFF,1)=BMXREF

 . . S $P(BMXPFF(BMXPFF,1),U,2)=BMXRNAM

 . . S BMXPFP(BMXPFP,BMXPFF)=BMXFF(F)

 . . S BMXPFP(BMXPFP,BMXPFF,0)=BMXFF(F,0)

 . . S BMXPFP(BMXPFP,BMXPFF,1)=BMXREF

 . . S $P(BMXPFP(BMXPFP,BMXPFF,1),U,2)=BMXRNAM

 . . S BMXPFF=BMXPFF+1

 . . S BMXPFFN=$P(BMXNOD0,U,2)

 . . S BMXPFFN=+$P(BMXPFFN,"P",2)

 . . S $P(BMXPFF(BMXPFF),U,5)=BMXPFFN

 . . S $P(BMXPFF(BMXPFF),U,6)=".01"

 . . S $P(BMXPFF(BMXPFF),U,7)=^DIC(BMXPFFN,0,"GL")

 . . S BMXPFF(BMXPFF,0)=^DD(BMXPFFN,".01",0)

 . . S $P(BMXPFP(BMXPFP,BMXPFF),U,5)=BMXPFFN

 . . S $P(BMXPFP(BMXPFP,BMXPFF),U,6)=".01"

 . . S $P(BMXPFP(BMXPFP,BMXPFF),U,7)=^DIC(BMXPFFN,0,"GL")

 . . S BMXPFP(BMXPFP,BMXPFF,0)=^DD(BMXPFFN,".01",0)

 . . D XRTST(.BMXPFF,BMXPFF,.BMXHIT,BMXRNAM,.BMXPFP)

 . . Q

 . I BMXTMPP=BMXTMPV D  Q

 . . S BMXHIT=1,BMXRET=1

 . . I BMXPFF>0 D  Q

 . . . S BMXPFF(BMXPFF,1)=BMXREF

 . . . S $P(BMXPFF(BMXPFF,1),U,2)=BMXRNAM

 . . . S BMXPFP(BMXPFP,BMXPFF,1)=BMXREF

 . . . S $P(BMXPFP(BMXPFP,BMXPFF,1),U,2)=BMXRNAM

 . . Q

. Q

BLDIT(BMXFF,F,BMXRNAM,BMXRET,BMXPFP)        ;EP - Build iterator

 K BMXRET

 N BMXNOD,BMXOP,BMXV,BMXGL,Q

 S BMXNOD=BMXFF(F)

 S BMXOP=$P(BMXNOD,U,3)

 S BMXV=$P(BMXNOD,U,4)

 S BMXGL=$P(BMXNOD,U,7,8)

 S Q=$C(34)

 I $D(BMXPFP(F)) D BLDIT2 Q  ;Pointer

 ;TODO Set BMXV to the pointer or set or FM date that corresponds

 ;  to the user-entered value

 I $D(BMXFF(F,"IEN")),BMXFF(F,"IEN")="TEMPLATE" D  Q

 . N BMXTNUM

 . S BMXTNUM=$O(^DIBT("B",$P(BMXFF(F),U,4),0))

 . S BMXRET="S D0=0 F  S D0=$O(^DIBT("_BMXTNUM_",1,D0)) Q:'+D0  Q:BMXM>BMXXMAX  "

. Q

 I BMXOP="=" D  Q

 . I $D(BMXFF(F,"IEN")) S BMXRET="S D0="_BMXV_" Q:'+D0  Q:BMXM>BMXXMAX  " Q

 . S BMXRET="S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_","_Q_BMXV_Q_",D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

. Q

 I BMXOP=">=" D  Q

 . I $D(BMXFF(F,"IEN")) S BMXV=BMXV-1,BMXRET="S D0="_BMXV_" F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:BMXM>BMXXMAX  " Q

 . N BMXTMP

 . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"

 . S @BMXTMP

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

 I BMXOP=">" D  Q

 . I $D(BMXFF(F,"IEN")) S BMXRET="S D0="_BMXV_" F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:BMXM>BMXXMAX  " Q

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

 I BMXOP="<>" D  Q

 . I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F  S D0=$O("_BMXGL_"D0)) Q:'+D0  I D0'="_BMXV_" Q:BMXM>BMXXMAX  " Q

 . S BMXRET="S BMXV=0 F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  I BMXV'="_Q_BMXV_Q_" S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

 I BMXOP="<=" D  Q

 . I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:D0>"_BMXV_"  Q:BMXM>BMXXMAX  " Q

 . N BMXTMP

 . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV))"

 . S @BMXTMP

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

 I BMXOP="<" D  Q

 . I $D(BMXFF(F,"IEN")) S BMXRET="S D0=0 F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:D0'<"_BMXV_"  Q:BMXM>BMXXMAX  " Q

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

 I BMXOP="BETWEEN" D  Q  ;changed '< to > (inclusive BETWEEN)

 . I $D(BMXFF(F,"IEN")) D  Q

 . . S BMXRET="S D0="_(+$P(BMXV,"~")-1)_" F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:D0>"_$P(BMXV,"~",2)_"  Q:BMXM>BMXXMAX  "

 . I +$P(BMXV,"~")=$P(BMXV,"~") D  ;BMXV is a number

 . . S BMXRET="S BMXV="_$P(BMXV,"~")_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q

 . . S BMXRET=BMXRET_",BMXV)) Q:BMXV=""""  Q:BMXV>"_$P(BMXV,"~",2)_"  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

 . E  D  ;BMXV is a string

 . . S BMXRET="S BMXV="_Q_$P(BMXV,"~")_Q_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q

 . . S BMXRET=BMXRET_",BMXV)) Q:BMXV=""""  Q:BMXV]"_Q_$P(BMXV,"~",2)_Q_"  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

 I BMXOP="LIKE" D  Q

 . N BMXTMP,BMXV1

 . S BMXV1=BMXV

 . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"

 . S @BMXTMP

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXV'?1"_Q_BMXV1_Q_".E  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

BLDIT2 ;Pointer

 N BMXPS,J

 S BMXPS=$O(BMXPFP(F,999),-1)

 S BMXNOD=BMXPFP(F,BMXPS)

 S BMXGL=$P(BMXNOD,U,7,8)

 I BMXOP="=" D

 . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)

 . S BMXRET="S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_","_Q_BMXV_Q_",D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 I BMXOP=">" D

 . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 I BMXOP=">=" D

 . N BMXTMP

 . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)

 . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"

 . S @BMXTMP

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 I BMXOP="<=" D

 . N BMXTMP

 . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)

 . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV))"

 . S @BMXTMP

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 I BMXOP="<>" D

 . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)

 . S BMXRET="S BMXV=0 F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  I BMXV'="_Q_BMXV_Q_" S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 I BMXOP="<" D

 . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 I BMXOP="BETWEEN" D

 . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)

 . I +$P(BMXV,"~")=$P(BMXV,"~") D  ;BMXV is a number

 . . S BMXRET="S BMXV="_$P(BMXV,"~")_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q

 . . S BMXRET=BMXRET_",BMXV)) Q:BMXV=""""  Q:BMXV>"_$P(BMXV,"~",2)_"  Q:BMXM>BMXXMAX  S D"_BMXPS_"=0 F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 . E  D  ;BMXV is a string

 . . S BMXRET="S BMXV="_Q_$P(BMXV,"~")_Q_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q

 . . S BMXRET=BMXRET_",BMXV)) Q:BMXV=""""  Q:BMXV]"_Q_$P(BMXV,"~",2)_Q_"  Q:BMXM>BMXXMAX  S D"_BMXPS_"=0 F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 I BMXOP="LIKE" D

 . N BMXTMP,BMXV1

 . S BMXRNAM=$P(BMXPFP(F,BMXPS,1),U,2)

 . S BMXV1=BMXV

 . S BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"

 . S @BMXTMP

 . S BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXV'?1"_Q_BMXV1_Q_".E  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

 F J=BMXPS-1:-1:0 D

 . S BMXNOD=BMXPFP(F,J)

 . S BMXGL=$P(BMXNOD,U,7,8)

 . S BMXRNAM=$P(BMXPFP(F,J,1),U,2)

 . S BMXRET=BMXRET_"S D"_J_"=0 F  S D"_J_"=$O("_BMXGL_Q_BMXRNAM_Q_",D"_(J+1)_",D"_J_")) Q:'+D"_J_"  Q:BMXM>BMXXMAX  "

 ;TODO:  Computed fields

 ;TODO:  Sets of codes

 ;TODO:  User-specified index

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

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

 +2       ;

 +3       ;

PLEVEL(BMXFF,BMXLVL,BMXRET) ;EP

 +1       ;Analyze WHERE statement according to paren level

 +2       ;Return a string to guide building of iterator(s)

 +3       ;

 +4       ;Basically, count the number of OR clauses on the

 +5       ;same paren level

 +6       ;IN: BMXFF()

 +7       ;OUT: BMXLVL(), BMXRET

 +8       ;

 +9       ;BMXRET = 1&/!2&/!...&/!n   clauses

 +10      ;BMXLVL(E,"BEGIN")=Index where element E begins

 +11      ;BMXLVL(E,"END")  =Index where element E ends

 +12      ;BMXLVL(E,"ELEMENTS")=Number of subelements in element E

 +13      ;

 +14       NEW BMXNOR,BMXNAND,J,C,BMXTMP

 +15       NEW E,L,BMXCNT

 +16      ;Test for no ORs or no ANDs

 +17       SET BMXNOR=1

           SET BMXNAND=1

 +18      ;Q:'BMXNOR  Q:'BMXNAND

           SET J=0

FOR

               SET J=$ORDER(BMXFF(J))

               IF '+J

                   QUIT

               Begin DoDot:1

 +19               IF BMXFF(J)="OR"

                       SET BMXNOR=0

 +20               IF BMXFF(J)="AND"

                       SET BMXNAND=0

 +21               QUIT

               End DoDot:1

 +22      ;If no ORs or no ANDs then take all parens out of BMXFF

 +23       IF ((BMXNOR)!(BMXNAND))

               Begin DoDot:1

 +24               IF $DATA(BMXFF("INDEX"))

                       SET BMXTMP("INDEX")=BMXFF("INDEX")

 +25               SET J=0

                   SET C=0

FOR

                       SET J=$ORDER(BMXFF(J))

                       IF '+J

                           QUIT

                       IF "(^)"'[BMXFF(J)

                           Begin DoDot:2

 +26                           SET C=C+1

 +27                           SET BMXTMP(C)=BMXFF(J)

 +28                           IF $DATA(BMXFF(J,0))

                                   SET BMXTMP(C,0)=BMXFF(J,0)

 +29                           IF $DATA(BMXFF(J,"INTERNAL"))

                                   SET BMXTMP(J,"INTERNAL")=BMXFF(J,"INTERNAL")

 +30                           IF $DATA(BMXFF(J,"TYPE"))

                                   SET BMXTMP(C,"TYPE")=BMXFF(J,"TYPE")

 +31                           IF $DATA(BMXFF(J,"IEN"))

                                   SET BMXTMP(C,"IEN")=BMXFF(J,"IEN")

 +32                           IF $DATA(BMXFF(J,"JOIN"))

                                   SET BMXTMP(C,"JOIN")=BMXFF(J,"JOIN")

 +33                           IF $DATA(BMXFF(J,"JOIN","IEN"))

                                   SET BMXTMP(C,"JOIN","IEN")=BMXFF(J,"JOIN","IEN")

 +34      ;I $D(BMXFF(J,"JOIN")) D

 +35      ;. N K S K=0 F  S K=$O(BMXFF(J,"JOIN",K)) Q:'+K  D

 +36      ;. . N L S L=0 F  S L=$O(BMXFF(J,"JOIN",K,L)) Q:'+L  D

 +37      ;. . . S BMXTMP(C,"JOIN",K,L)=BMXFF(J,"JOIN",K,L)

 +38                           IF $DATA(BMXFF(J,"SET"))

                                   Begin DoDot:3

 +39                                   NEW BMXSS

 +40                                   SET BMXSS=""

FOR

                                           SET BMXSS=$ORDER(BMXFF(J,"SET",BMXSS))

                                           IF BMXSS=""

                                               QUIT

                                           Begin DoDot:4

 +41                                           SET BMXTMP(C,"SET",BMXSS)=BMXFF(J,"SET",BMXSS)

                                           End DoDot:4

                                   End DoDot:3

                           End DoDot:2

 +42               KILL BMXFF

 +43               IF $DATA(BMXTMP("INDEX"))

                       SET BMXFF("INDEX")=BMXTMP("INDEX")

 +44               SET J=0

FOR

                       SET J=$ORDER(BMXTMP(J))

                       IF '+J

                           QUIT

                       Begin DoDot:2

 +45                       SET BMXFF(J)=BMXTMP(J)

 +46                       IF $DATA(BMXTMP(J,0))

                               SET BMXFF(J,0)=BMXTMP(J,0)

 +47                       IF $DATA(BMXTMP(J,"TYPE"))

                               SET BMXFF(J,"TYPE")=BMXTMP(J,"TYPE")

 +48                       IF $DATA(BMXTMP(J,"JOIN"))

                               SET BMXFF(J,"JOIN")=BMXTMP(J,"JOIN")

                               IF $DATA(BMXTMP(J,"JOIN","IEN"))

                                   SET BMXFF(J,"JOIN","IEN")=BMXTMP(J,"JOIN","IEN")

                               SET BMXFJ("JOIN",+$PIECE($PIECE(BMXFF(J,0),U,2),"P",2))=J

 +49      ;I $D(BMXTMP(J,"JOIN")) D

 +50      ;. N K S K=0 F  S K=$O(BMXTMP(J,"JOIN",K)) Q:'+K  D

 +51      ;. . N L S L=0 F  S L=$O(BMXTMP(J,"JOIN",K,L)) Q:'+L  D

 +52      ;. . . S BMXFF(J,"JOIN",K,L)=BMXTMP(J,"JOIN",K,L)

 +53                       IF $DATA(BMXTMP(J,"SET"))

                               Begin DoDot:3

 +54                               NEW BMXSS

 +55                               SET BMXSS=""

FOR

                                       SET BMXSS=$ORDER(BMXTMP(J,"SET",BMXSS))

                                       IF BMXSS=""

                                           QUIT

                                       Begin DoDot:4

 +56                                       SET BMXFF(J,"SET",BMXSS)=BMXTMP(J,"SET",BMXSS)

                                       End DoDot:4

                               End DoDot:3

 +57                       IF $DATA(BMXTMP(J,"INTERNAL"))

                               SET BMXFF(J,"INTERNAL")=BMXTMP(J,"INTERNAL")

 +58                       IF $DATA(BMXTMP(J,"IEN"))

                               SET BMXFF(J,"IEN")=BMXTMP(J,"IEN")

                       End DoDot:2

 +59               SET BMXFF=C

 +60               QUIT

               End DoDot:1

 +61      ;

 +62      ;Remove excess leading and trailing parens

 +63      ;Find close paren corresponding to BMXFF(1)

 +64      ;If its the last paren, then remove the first and last parens

 +65      ;Else, quit

 +66       NEW BMXEND

 +67       SET BMXEND=0

 +68       FOR

               IF '((BMXFF(1)="(")&(BMXFF(BMXFF)=")"))

                   QUIT

               IF BMXEND

                   QUIT

               Begin DoDot:1

 +69               SET L=1

                   SET J=1

 +70               FOR

                       SET J=$ORDER(BMXFF(J))

                       IF '+J

                           QUIT

                       IF "(^)"[BMXFF(J)

                           Begin DoDot:2

 +71                           IF BMXFF(J)="("

                                   SET L=L+1

                                   QUIT

 +72                           IF BMXFF(J)=")"

                                   SET L=L-1

 +73                           IF L=0

                                   IF J<BMXFF

                                       SET BMXEND=1

                                       QUIT

 +74                           IF L=0

                                   IF J=BMXFF

                                       Begin DoDot:3

 +75                                       KILL BMXFF(1),BMXFF(BMXFF)

 +76                                       FOR J=2:1:BMXFF-1

                                               Begin DoDot:4

 +77                                               SET BMXFF(J-1)=BMXFF(J)

 +78                                               IF $DATA(BMXFF(J,0))

                                                       SET BMXFF(J-1,0)=BMXFF(J,0)

 +79                                               KILL BMXFF(J)

                                               End DoDot:4

 +80                                       SET BMXFF=BMXFF-2

                                       End DoDot:3

                                       QUIT

                           End DoDot:2

                       IF BMXEND

                           QUIT

               End DoDot:1

 +81      ;

 +82       SET BMXRET=""

           SET E=1

           SET L=0

           SET BMXCNT=0

 +83       KILL BMXLVL

 +84       SET J=0

FOR

               SET J=$ORDER(BMXFF(J))

               IF '+J

                   QUIT

               Begin DoDot:1

 +85      ;If BMXFF(J) is an open paren

                   IF BMXFF(J)="("

                       Begin DoDot:2

 +86                       SET L=1

 +87      ;Start position of this expression

                           SET BMXLVL(E,"BEGIN")=J

 +88                       SET BMXCNT=0

 +89      ;Find corresponding close paren

 +90                       FOR

                               SET J=$ORDER(BMXFF(J))

                               IF '+J

                                   QUIT

                               Begin DoDot:3

 +91                               IF BMXFF(J)=")"

                                       SET L=L-1

                                       SET BMXLVL(E,"END")=J

                                       SET BMXLVL(E,"ELEMENTS")=BMXCNT

                                       QUIT

 +92                               IF BMXFF(J)="("

                                       SET L=L+1

                                       QUIT

 +93                               IF "AND^OR"'[BMXFF(J)

                                       SET BMXCNT=BMXCNT+1

                               End DoDot:3

                               IF L=0

                                   QUIT

 +94                       SET BMXRET=BMXRET_E

 +95                       SET E=E+1

 +96                       QUIT

                       End DoDot:2

                       QUIT

 +97      ;If BMXFF(J) is an operator

                   IF "AND^OR"[BMXFF(J)

                       Begin DoDot:2

 +98                       SET BMXRET=BMXRET_$SELECT(BMXFF(J)="OR":"!",1:"&")

                       End DoDot:2

                       QUIT

 +99      ; BMXFF(J) is an element unenclosed by parens

                   Begin DoDot:2

 +100                  SET BMXLVL(E,"BEGIN")=J

 +101                  SET BMXLVL(E,"END")=J

 +102                  SET BMXLVL(E,"ELEMENTS")=1

 +103                  SET BMXRET=BMXRET_E

 +104                  SET E=E+1

                   End DoDot:2

                   QUIT

 +105              QUIT

               End DoDot:1

 +106      QUIT

 +107     ;

XRTST(BMXFF,F,BMXHIT,BMXRNAM,BMXPFP) ;EP

 +1       ;Returns TRUE (1) in BMXRET if 'normal' index exists

 +2       ;for field in BMXFF(BMXNDX)

 +3       ;ELSE returns 0

 +4       ;

 +5       ;IN: BMXFF

 +6       ;    F

 +7       ;OUT:BMXRET  - 1 or 0

 +8       ;    BMXRNAM - If BMXRET=1, Index name

 +9       ;

 +10       NEW BMXNOD0,BMXFNUM,BMXGL,BMXFLDNM,BMXREF,Q

 +11       SET BMXRET=0

           SET Q=$CHAR(34)

 +12      ;

 +13       IF "AND^OR^(^)"[BMXFF(F)

               QUIT

 +14       SET BMXNOD=BMXFF(F)

 +15       SET BMXNOD0=BMXFF(F,0)

 +16       SET BMXFNUM=$PIECE(BMXNOD,U,5)

 +17       IF '+BMXFNUM

               QUIT

 +18       SET BMXGL=$PIECE(BMXNOD,U,7,8)

 +19       SET BMXFLDNM=$PIECE(BMXNOD,U,6)

 +20       SET BMXHIT=0

 +21       IF $DATA(BMXFF("JOIN"))

               QUIT

 +22       IF $DATA(BMXFF(F,"INTERNAL"))

               QUIT

 +23      ;Cannot create iterator on null

           IF BMXPFF=0

               IF $PIECE(BMXFF(F),U,4)=""

                   QUIT

 +24       IF $DATA(BMXFF(F,"IEN"))

               SET BMXHIT=1

               QUIT

 +25       IF '$DATA(^DD(BMXFNUM,BMXFLDNM,1))

               QUIT

 +26      ;Explicit index

           IF $PIECE(BMXNOD0,U,2)'["P"

               IF $DATA(BMXFF("INDEX"))

                   Begin DoDot:1

 +27                   SET BMXRNAM=BMXFF("INDEX")

 +28                   SET BMXHIT=1

                   End DoDot:1

                   QUIT

 +29       SET BMXREF=0

 +30       FOR

               SET BMXREF=$ORDER(^DD(BMXFNUM,BMXFLDNM,1,BMXREF))

               IF '+BMXREF

                   QUIT

               IF BMXHIT

                   QUIT

               Begin DoDot:1

 +31               IF '$DATA(^DD(BMXFNUM,BMXFLDNM,1,BMXREF,0))

                       QUIT

 +32               SET BMXRNOD=^DD(BMXFNUM,BMXFLDNM,1,BMXREF,0)

 +33               IF $PIECE(BMXRNOD,U,3)]""

                       QUIT

 +34               SET BMXRNAM=$PIECE(BMXRNOD,U,2)

 +35               SET BMXTMP=BMXGL_Q_BMXRNAM_Q_")"

 +36               IF '$DATA(@BMXTMP)

                       QUIT

 +37               SET BMXTMPV=0

                   SET BMXTMPV=$ORDER(@BMXTMP@(BMXTMPV))

 +38               IF BMXTMPV=""

                       QUIT

 +39               SET BMXTMP=BMXGL_Q_BMXRNAM_Q_","_Q_BMXTMPV_Q_")"

 +40               SET BMXTMPI=0

                   SET BMXTMPI=$ORDER(@BMXTMP@(BMXTMPI))

 +41               SET BMXTMP=$SELECT(BMXGL[",":$PIECE(BMXGL,",")_")",1:$PIECE(BMXGL,"("))

 +42               IF '$DATA(@BMXTMP@(BMXTMPI))

                       QUIT

 +43               SET BMXTMPL=$PIECE(BMXFF(F,0),U,4)

 +44               SET BMXTMPP=$PIECE(BMXTMPL,";",2)

 +45               SET BMXTMPL=$PIECE(BMXTMPL,";")

 +46               IF BMXTMPL=""

                       QUIT

 +47               SET BMXTMP=BMXGL_BMXTMPI_")"

 +48               IF '$DATA(@BMXTMP@(BMXTMPL))

                       QUIT

 +49               SET BMXTMPN=@BMXTMP@(BMXTMPL)

 +50               IF BMXTMPP["E"

                       Begin DoDot:2

 +51                       SET BMXTMPP=$PIECE(BMXTMPP,"E",2)

 +52                       SET BMXTMPP=$EXTRACT(BMXTMPN,$PIECE(BMXTMPP,","),$PIECE(BMXTMPP,",",2))

                       End DoDot:2

 +53              IF '$TEST

                       Begin DoDot:2

 +54                       SET BMXTMPP=$PIECE(BMXTMPN,"^",BMXTMPP)

                       End DoDot:2

 +55               IF $PIECE(BMXNOD0,U,2)["P"

                       Begin DoDot:2

 +56                       NEW BMXPFFN

 +57                       SET BMXPFF(BMXPFF)=BMXFF(F)

 +58                       SET BMXPFF(BMXPFF,0)=BMXFF(F,0)

 +59                       SET BMXPFF(BMXPFF,1)=BMXREF

 +60                       SET $PIECE(BMXPFF(BMXPFF,1),U,2)=BMXRNAM

 +61                       SET BMXPFP(BMXPFP,BMXPFF)=BMXFF(F)

 +62                       SET BMXPFP(BMXPFP,BMXPFF,0)=BMXFF(F,0)

 +63                       SET BMXPFP(BMXPFP,BMXPFF,1)=BMXREF

 +64                       SET $PIECE(BMXPFP(BMXPFP,BMXPFF,1),U,2)=BMXRNAM

 +65                       SET BMXPFF=BMXPFF+1

 +66                       SET BMXPFFN=$PIECE(BMXNOD0,U,2)

 +67                       SET BMXPFFN=+$PIECE(BMXPFFN,"P",2)

 +68                       SET $PIECE(BMXPFF(BMXPFF),U,5)=BMXPFFN

 +69                       SET $PIECE(BMXPFF(BMXPFF),U,6)=".01"

 +70                       SET $PIECE(BMXPFF(BMXPFF),U,7)=^DIC(BMXPFFN,0,"GL")

 +71                       SET BMXPFF(BMXPFF,0)=^DD(BMXPFFN,".01",0)

 +72                       SET $PIECE(BMXPFP(BMXPFP,BMXPFF),U,5)=BMXPFFN

 +73                       SET $PIECE(BMXPFP(BMXPFP,BMXPFF),U,6)=".01"

 +74                       SET $PIECE(BMXPFP(BMXPFP,BMXPFF),U,7)=^DIC(BMXPFFN,0,"GL")

 +75                       SET BMXPFP(BMXPFP,BMXPFF,0)=^DD(BMXPFFN,".01",0)

 +76                       DO XRTST(.BMXPFF,BMXPFF,.BMXHIT,BMXRNAM,.BMXPFP)

 +77                       QUIT

                       End DoDot:2

                       QUIT

 +78               IF BMXTMPP=BMXTMPV

                       Begin DoDot:2

 +79                       SET BMXHIT=1

                           SET BMXRET=1

 +80                       IF BMXPFF>0

                               Begin DoDot:3

 +81                               SET BMXPFF(BMXPFF,1)=BMXREF

 +82                               SET $PIECE(BMXPFF(BMXPFF,1),U,2)=BMXRNAM

 +83                               SET BMXPFP(BMXPFP,BMXPFF,1)=BMXREF

 +84                               SET $PIECE(BMXPFP(BMXPFP,BMXPFF,1),U,2)=BMXRNAM

                               End DoDot:3

                               QUIT

 +85                       QUIT

                       End DoDot:2

                       QUIT

 +86               QUIT

               End DoDot:1

 +87       QUIT

 +88      ;

 +89      ;

BLDIT(BMXFF,F,BMXRNAM,BMXRET,BMXPFP) ;EP - Build iterator

 +1       ;

 +2        KILL BMXRET

 +3        NEW BMXNOD,BMXOP,BMXV,BMXGL,Q

 +4        SET BMXNOD=BMXFF(F)

 +5        SET BMXOP=$PIECE(BMXNOD,U,3)

 +6        SET BMXV=$PIECE(BMXNOD,U,4)

 +7        SET BMXGL=$PIECE(BMXNOD,U,7,8)

 +8        SET Q=$CHAR(34)

 +9       ;Pointer

           IF $DATA(BMXPFP(F))

               DO BLDIT2

               QUIT

 +10      ;TODO Set BMXV to the pointer or set or FM date that corresponds

 +11      ;  to the user-entered value

 +12       IF $DATA(BMXFF(F,"IEN"))

               IF BMXFF(F,"IEN")="TEMPLATE"

                   Begin DoDot:1

 +13                   NEW BMXTNUM

 +14                   SET BMXTNUM=$ORDER(^DIBT("B",$PIECE(BMXFF(F),U,4),0))

 +15                   SET BMXRET="S D0=0 F  S D0=$O(^DIBT("_BMXTNUM_",1,D0)) Q:'+D0  Q:BMXM>BMXXMAX  "

 +16                   QUIT

                   End DoDot:1

                   QUIT

 +17       IF BMXOP="="

               Begin DoDot:1

 +18               IF $DATA(BMXFF(F,"IEN"))

                       SET BMXRET="S D0="_BMXV_" Q:'+D0  Q:BMXM>BMXXMAX  "

                       QUIT

 +19               SET BMXRET="S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_","_Q_BMXV_Q_",D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

 +20               QUIT

               End DoDot:1

               QUIT

 +21      ;

 +22       IF BMXOP=">="

               Begin DoDot:1

 +23               IF $DATA(BMXFF(F,"IEN"))

                       SET BMXV=BMXV-1

                       SET BMXRET="S D0="_BMXV_" F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:BMXM>BMXXMAX  "

                       QUIT

 +24               NEW BMXTMP

 +25               SET BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"

 +26               SET @BMXTMP

 +27               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

               End DoDot:1

               QUIT

 +28      ;

 +29       IF BMXOP=">"

               Begin DoDot:1

 +30               IF $DATA(BMXFF(F,"IEN"))

                       SET BMXRET="S D0="_BMXV_" F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:BMXM>BMXXMAX  "

                       QUIT

 +31               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

               End DoDot:1

               QUIT

 +32      ;

 +33       IF BMXOP="<>"

               Begin DoDot:1

 +34               IF $DATA(BMXFF(F,"IEN"))

                       SET BMXRET="S D0=0 F  S D0=$O("_BMXGL_"D0)) Q:'+D0  I D0'="_BMXV_" Q:BMXM>BMXXMAX  "

                       QUIT

 +35               SET BMXRET="S BMXV=0 F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  I BMXV'="_Q_BMXV_Q_" S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

               End DoDot:1

               QUIT

 +36      ;

 +37       IF BMXOP="<="

               Begin DoDot:1

 +38               IF $DATA(BMXFF(F,"IEN"))

                       SET BMXRET="S D0=0 F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:D0>"_BMXV_"  Q:BMXM>BMXXMAX  "

                       QUIT

 +39               NEW BMXTMP

 +40               SET BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV))"

 +41               SET @BMXTMP

 +42               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

               End DoDot:1

               QUIT

 +43      ;

 +44       IF BMXOP="<"

               Begin DoDot:1

 +45               IF $DATA(BMXFF(F,"IEN"))

                       SET BMXRET="S D0=0 F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:D0'<"_BMXV_"  Q:BMXM>BMXXMAX  "

                       QUIT

 +46               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

               End DoDot:1

               QUIT

 +47      ;

 +48      ;changed '< to > (inclusive BETWEEN)

           IF BMXOP="BETWEEN"

               Begin DoDot:1

 +49               IF $DATA(BMXFF(F,"IEN"))

                       Begin DoDot:2

 +50                       SET BMXRET="S D0="_(+$PIECE(BMXV,"~")-1)_" F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:D0>"_$PIECE(BMXV,"~",2)_"  Q:BMXM>BMXXMAX  "

                       End DoDot:2

                       QUIT

 +51      ;BMXV is a number

                   IF +$PIECE(BMXV,"~")=$PIECE(BMXV,"~")

                       Begin DoDot:2

 +52                       SET BMXRET="S BMXV="_$PIECE(BMXV,"~")_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q

 +53                       SET BMXRET=BMXRET_",BMXV)) Q:BMXV=""""  Q:BMXV>"_$PIECE(BMXV,"~",2)_"  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

                       End DoDot:2

 +54      ;BMXV is a string

                  IF '$TEST

                       Begin DoDot:2

 +55                       SET BMXRET="S BMXV="_Q_$PIECE(BMXV,"~")_Q_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q

 +56                       SET BMXRET=BMXRET_",BMXV)) Q:BMXV=""""  Q:BMXV]"_Q_$PIECE(BMXV,"~",2)_Q_"  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

                       End DoDot:2

               End DoDot:1

               QUIT

 +57      ;

 +58       IF BMXOP="LIKE"

               Begin DoDot:1

 +59               NEW BMXTMP,BMXV1

 +60               SET BMXV1=BMXV

 +61               SET BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"

 +62               SET @BMXTMP

 +63               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXV'?1"_Q_BMXV1_Q_".E  Q:BMXM>BMXXMAX  S D0="""" F  S D0=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D0)) Q:D0=""""  Q:BMXM>BMXXMAX  "

               End DoDot:1

               QUIT

 +64       QUIT

 +65      ;

BLDIT2    ;Pointer

 +1        NEW BMXPS,J

 +2        SET BMXPS=$ORDER(BMXPFP(F,999),-1)

 +3        SET BMXNOD=BMXPFP(F,BMXPS)

 +4        SET BMXGL=$PIECE(BMXNOD,U,7,8)

 +5        IF BMXOP="="

               Begin DoDot:1

 +6                SET BMXRNAM=$PIECE(BMXPFP(F,BMXPS,1),U,2)

 +7                SET BMXRET="S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_","_Q_BMXV_Q_",D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

               End DoDot:1

 +8       ;

 +9        IF BMXOP=">"

               Begin DoDot:1

 +10               SET BMXRNAM=$PIECE(BMXPFP(F,BMXPS,1),U,2)

 +11               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

               End DoDot:1

 +12      ;

 +13       IF BMXOP=">="

               Begin DoDot:1

 +14               NEW BMXTMP

 +15               SET BMXRNAM=$PIECE(BMXPFP(F,BMXPS,1),U,2)

 +16               SET BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"

 +17               SET @BMXTMP

 +18               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

               End DoDot:1

 +19      ;

 +20       IF BMXOP="<="

               Begin DoDot:1

 +21               NEW BMXTMP

 +22               SET BMXRNAM=$PIECE(BMXPFP(F,BMXPS,1),U,2)

 +23               SET BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV))"

 +24               SET @BMXTMP

 +25               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

               End DoDot:1

 +26      ;

 +27       IF BMXOP="<>"

               Begin DoDot:1

 +28               SET BMXRNAM=$PIECE(BMXPFP(F,BMXPS,1),U,2)

 +29               SET BMXRET="S BMXV=0 F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXM>BMXXMAX  I BMXV'="_Q_BMXV_Q_" S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

               End DoDot:1

 +30      ;

 +31       IF BMXOP="<"

               Begin DoDot:1

 +32               SET BMXRNAM=$PIECE(BMXPFP(F,BMXPS,1),U,2)

 +33               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) Q:BMXV=""""  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

               End DoDot:1

 +34      ;

 +35       IF BMXOP="BETWEEN"

               Begin DoDot:1

 +36               SET BMXRNAM=$PIECE(BMXPFP(F,BMXPS,1),U,2)

 +37      ;BMXV is a number

                   IF +$PIECE(BMXV,"~")=$PIECE(BMXV,"~")

                       Begin DoDot:2

 +38                       SET BMXRET="S BMXV="_$PIECE(BMXV,"~")_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q

 +39                       SET BMXRET=BMXRET_",BMXV)) Q:BMXV=""""  Q:BMXV>"_$PIECE(BMXV,"~",2)_"  Q:BMXM>BMXXMAX  S D"_BMXPS_"=0 F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

                       End DoDot:2

 +40      ;BMXV is a string

                  IF '$TEST

                       Begin DoDot:2

 +41                       SET BMXRET="S BMXV="_Q_$PIECE(BMXV,"~")_Q_",BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1) F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q

 +42                       SET BMXRET=BMXRET_",BMXV)) Q:BMXV=""""  Q:BMXV]"_Q_$PIECE(BMXV,"~",2)_Q_"  Q:BMXM>BMXXMAX  S D"_BMXPS_"=0 F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX  "

                       End DoDot:2

               End DoDot:1

 +43      ;

 +44       IF BMXOP="LIKE"

               Begin DoDot:1

 +45               NEW BMXTMP,BMXV1

 +46               SET BMXRNAM=$PIECE(BMXPFP(F,BMXPS,1),U,2)

 +47               SET BMXV1=BMXV

 +48               SET BMXTMP="BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV),-1)"

 +49               SET @BMXTMP

 +50               SET BMXRET="S BMXV="_Q_BMXV_Q_" F  S BMXV=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV)) Q:BMXV=""""  Q:BMXV'?1"_Q_BMXV1_Q_".E  Q:BMXM>BMXXMAX  S D"_BMXPS_"="""" F  S D"_BMXPS_"=$O("_BMXGL_Q_BMXRNAM_Q_",BMXV,D"_BMXPS_")) Q:'+D"_BMXPS_"  Q:BMXM>BMXXMAX

               End DoDot:1

 +51      ;

 +52       FOR J=BMXPS-1:-1:0

               Begin DoDot:1

 +53               SET BMXNOD=BMXPFP(F,J)

 +54               SET BMXGL=$PIECE(BMXNOD,U,7,8)

 +55               SET BMXRNAM=$PIECE(BMXPFP(F,J,1),U,2)

 +56               SET BMXRET=BMXRET_"S D"_J_"=0 F  S D"_J_"=$O("_BMXGL_Q_BMXRNAM_Q_",D"_(J+1)_",D"_J_")) Q:'+D"_J_"  Q:BMXM>BMXXMAX  "

               End DoDot:1

 +57       QUIT

 +58      ;TODO:  Computed fields

 +59      ;TODO:  Sets of codes

 +60      ;TODO:  User-specified index

 +61       QUIT

BMXSQL3.m