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
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
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 "
Q
;
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 "
Q
;TODO: Computed fields
;TODO: Sets of codes
;TODO: User-specified index
Q
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
