BMXSQL6.m

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

 ;;4.0;BMX;;JUN 28, 2010

 ;

 ;

WRITE ;EP

 N BMXFN,C,BMXN,BMXGF,BMXA,BMXFLDF,N,A,IEN0,I

 N BMXCNT,BMXCNTB,BMXLEN,BMXLTMP,BMXNUM,BMXORD,BMXTYP

 N BMXCFN,BMXCFNX,F,BMXROOT,BMXCID,BMXZ  ;From MAKEC

 N BMXREC,BMXCHAIN  ;TODO: COMMENT AFTER TESTING

 N BMXIENS

 ;Set up FIELD value for GETS^DIQ call

 ; BMXFLD("NAME")="FILE#^FIELD#"

 ; Need: BMXFLDN(FieldNumber)

 ; and : BMXFLDO(SelectOrder)

 ; Get file number -- for now just use first file in array

 ; TODO: Set up same main file and related files here and in enumerator

 S C=0,BMXN=""

 N F

 S BMXGF=0

 S F=0 F  S F=$O(BMXF(F)) Q:F=""  S BMXFN=BMXF(F) D

 . S C=0,BMXN=-1 F  S BMXN=$O(BMXFLDO(BMXN)) Q:BMXN=""  D

 . . Q:$P(BMXFLDO(BMXN),U)'=BMXFN

 . . I $P(BMXFLDO(BMXN),U,2)=".001" S BMXGF=BMXGF+1 Q

 . . S C=C+1

 . . S $P(BMXGF(BMXFN),";",C)=$P(BMXFLDO(BMXN),U,2)

 . . S:'$D(BMXGF(BMXFN,"INTERNAL")) BMXGF(BMXFN,"INTERNAL")="E"

 . . I $P(BMXFLDO(BMXN),U,3)="I" S BMXGF(BMXFN,"INTERNAL")="IE"

 . . S BMXGF=BMXGF+1

 . . Q

 . Q

 ;

 I BMXGF>1 K BMXTK("DISTINCT") ;Distinct supported for only one field

 S N=0,BMXFLDF=0,I=1,BMXNUM=0

 D FIELDS

 D MAKEC

 ;

 ;

 I BMXCOL D COLTYPE^BMXSQL,ERRTACK^BMXSQL(I) Q  ;Column info only

 ;

 S BMXA="A"

 N G,R

 ;---> Loop through results global

 F  S N=$O(^BMXTMP($J,N)) Q:'+N  D

 . K A

 . S R=0 F  S R=$O(BMXFO(R)) Q:'+R  D  ;For each file in ORDER array

 . . S IEN0=0

 . . S BMXFN=BMXFO(R)

 . . Q:$D(BMXMFL(BMXFN,"MULT"))

 . . I R=1 S IEN0=^BMXTMP($J,N)  ;Primary file

 . . I R>1,$D(BMXFJ("JOIN",BMXFN)) D  ;Joined file

 . . . S IEN0=0

 . . . S G=BMXFJ("JOIN",BMXFN)

 . . . S V=BMXFF(G,"JOIN","IEN")

 . . . S @V=^BMXTMP($J,N)

 . . . X BMXFF(G,"JOIN")

 . . I +IEN0 D  ;Removed $D(BMXGF(BMXFN)) for mult fld on extdnd ptr

 . . . D SUBFILE(BMXFN)

 . . I +IEN0,$D(BMXFLDN(BMXFN,.001)) D SETIEN(IEN0,BMXFN)

 . . ;

 . . I 0,R>1,$D(BMXMFL(BMXFN,"MULT")) D  ;Multiple field

 . . . Q:'+IEN0

 . . . Q:'$D(BMXGF(BMXFN))  ;Intervening multiple

 . . . ;Call GETS for each subentry in multiple

 . . . X BMXMFL(BMXFN,"EXEC")

 . S F=0,BMXCNT=0

 . ;

 . D RECORD

 . D OUT

 ;

 ;

 ;---> Tack on Error Delimiter and any error.

 S I=I+1

 D ERRTACK^BMXSQL(I)

 D COLTYPE^BMXSQL

 Q

 ;

SETIEN(BMXIEN,BMXFN)         ;

 ;B  ;SETIEN

 Q:'$D(BMXFLDN(BMXFN,.001))

 Q:'+BMXIEN

 S A(BMXFN,BMXIEN_",",.001,"E")=BMXIEN

 Q

 ;

SUBFILE(BMXFN) ;

 ;Execute GETS for Any fields in BMXGF(SUBFILE)

 ;

 ;If the subfile itself has subfiles, call SUBFILE(BMXSUBFN)

 ;  (Loop through BMXMFL(BMXFN,"SUBFILE",BMXSUBFN))

 I $D(BMXMFL(BMXFN,"SUBFILE")) D

 . N BMXSUBFN

 . S BMXSUBFN=0

 . F  S BMXSUBFN=$O(BMXMFL(BMXFN,"SUBFILE",BMXSUBFN)) Q:'+BMXSUBFN  D SUBFILE(BMXSUBFN)

 . Q

 ;

 I $D(BMXGF(BMXFN)) D

 . I '$D(BMXMFL(BMXFN,"MULT")) S BMXMSCR=1 D GETS^DIQ(BMXFN,IEN0_",",BMXGF(BMXFN),BMXGF(BMXFN,"INTERNAL"),BMXA) Q

 . E  X BMXMFL(BMXFN,"EXEC") Q

 ;

 ;

 Q

 ;

FIELDS ;---> Write Field Names

 ;Field name is TAAAAANAME

 ;Where T is the field type (T=Text; D=Date)

 ;      AAAAA is the field size (see NUMCHAR routine)

 ;      NAME is the field name

 N BMXNUM,BMXFNUM,BMXFNAM,R

 K BMXLEN,BMXTYP

 S BMXFLDF=1

 S BMXNUM=0

 ;B  ;In FIELDS sub

 D  ;:$D(A)

 . I BMXNUM S ^BMXTEMP($J,I)="IEN^",BMXLEN(I)=10,BMXTYP(I)="T",I=I+1 ;TODO: Change from text to number

 . S BMXFNUM=0

 . S BMXFNAM=0

 . F R=0:1:(BMXFLDO-1) S BMXFN=$P(BMXFLDO(R),U),BMXFNUM=$P(BMXFLDO(R),U,2) D

 . . ;S BMXFNAM=$P(^DD(BMXFN,BMXFNUM,0),"^") ;Get type here

 . . S BMXFNAM=BMXFLDN(BMXFN,BMXFNUM)

 . . I $P(BMXFLDO(R),U,3)="I" S BMXFNAM="INTERNAL["_BMXFNAM_"]"

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

 . . I BMXF>1 S BMXFNAM=$TR($P(BMXFNX(BMXFN),".")," ","_")_"."_BMXFNAM

 . . S BMXTYP(I)="T"

 . . S:$P(BMXFLDO(R),U,5)="D" BMXTYP(I)="D"

 . . S:$P(BMXFLDO(R),U,5)="I" BMXTYP(I)="I"

 . . S BMXLEN(I)=0 ;Start with length zero

 . . ;I $D(BMXFLDA(BMXFN,BMXFNUM)) S BMXFNAM=BMXFLDA(BMXFN,BMXFNUM)

 . . I $P(BMXFLDO(R),U,6)]"" S BMXFNAM=$P(BMXFLDO(R),U,6)

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

 . . S I=I+1

 . S ^BMXTEMP($J,I-1)=$E(^BMXTEMP($J,I-1),1,$L(^BMXTEMP($J,I-1))-1)_$C(30)

 Q

 ;

OUT ;

 ;Output to BMXTEMP($J

 Q:'$D(BMXREC)

 N J,K,L,BMXLENT

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

 . S K=0 F  S K=$O(BMXREC(J,K)) Q:'+K  D

 . . I +$O(BMXREC(J,K,0)) D  Q  ;WP

 . . . S L=0,BMXLENT=0 F  S L=$O(BMXREC(J,K,L)) Q:'+L  D

 . . . . S:'$D(^BMXTEMP($J,I)) ^BMXTEMP($J,I)=""

 . . . . S:$L(^BMXTEMP($J,I))>250 I=I+1,^BMXTEMP($J,I)=""

 . . . . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXREC(J,K,L)

 . . . . S BMXLENT=BMXLENT+$L(BMXREC(J,K,L))

 . . . I BMXLEN(K)<BMXLENT S BMXLEN(K)=BMXLENT

 . . S:'$D(^BMXTEMP($J,I)) ^BMXTEMP($J,I)=""

 . . S:$L(^BMXTEMP($J,I))>250 I=I+1,^BMXTEMP($J,I)=""

 . . I $G(BMXTK("DISTINCT"))="TRUE",BMXREC(J,K)]"" Q:$D(^BMXTEMP($J,"DISTINCT",BMXREC(J,K)))

 . . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXREC(J,K)

 . . S:$L(BMXREC(J,K))>BMXLEN(K) BMXLEN(K)=$L(BMXREC(J,K))

 . . I $G(BMXTK("DISTINCT"))="TRUE" S ^BMXTEMP($J,"DISTINCT",BMXREC(J,K))=""

 Q

 ;

RECORD ;

 ;For each chain

 N C,BMXCQ,BMXLCQ,BMXCQN,BMXLCQN,BMXTRACK,BMXNODE,BMXCNAME,BMXWP

 K BMXREC,BMXCHAIN  ;TODO: REMOVE AFTER TESTING

 D BLDCHN

 S BMXREC=0

 D RECINI

 S C=0 F  S C=$O(BMXCHAIN(C)) Q:'+C  D

 . ;New chain

 . ;Go to the end of the chain, writing record pieces as you go

 . ;At the end of the chain, write end-of-record marker,increment record counter, copy previous record

 . K BMXTRACK

 . S BMXCNAME="BMXCHAIN("_C_")"

 . S BMXCQN=""

 . S BMXCQ=BMXCNAME F  S BMXCQ=$Q(@BMXCQ) Q:BMXCQ=""  Q:$P(BMXCQ,",")'=("BMXCHAIN("_C)  D

 . . S BMXNODE=@BMXCQ

 . . I $P(BMXNODE,U,2)="" Q

 . . S BMXWP=$P(BMXNODE,U,3)

 . . S BMXLCQ=$L(BMXCQ,",")

 . . S BMXCQN=$Q(@BMXCQ)

 . . S BMXLCQN=$L(BMXCQN,",")

 . . I BMXWP="W" D

 . . . S BMXREC(BMXREC,$P(BMXNODE,U,2),$P(BMXNODE,U,4))=$P(BMXNODE,U)

 . . . S BMXTRACK(BMXLCQ-1,$P(BMXNODE,U,2))=BMXNODE

 . . E  D

 . . . S BMXREC(BMXREC,$P(BMXNODE,U,2))=$P(BMXNODE,U)_U

 . . . S BMXTRACK(BMXLCQ,$P(BMXNODE,U,2))=BMXNODE

 . . I BMXCQN="" D EOR Q

 . . I $P(BMXCQN,",")'=("BMXCHAIN("_C) D EOR Q

 . . I BMXLCQN>BMXLCQ Q

 . . I (BMXLCQN>$S(BMXWP="W":7,1:6)) D  Q

 . . . I ($P(BMXCQ,",",1,BMXLCQ-2)=$P(BMXCQN,",",1,BMXLCQN-2)) Q

 . . . D EOR ;End of chain

 Q

 ;

RECINI ;

 N J

 S BMXREC=BMXREC+1

 F J=1:1:BMXFLDO D

 . I $P(BMXFLDO(J-1),U,4)="W" S BMXREC(BMXREC,J,999999)="^" Q

 . S BMXREC(BMXREC,J)="^"

 Q

 ;

EOR ;

 ;B  ;EOR

 N J,K,L,M,I,N

 S M=$Q(BMXREC(9999999),-1)

 S @M=$TR(@M,"^",$C(30))

 Q:BMXCQN=""

 I BMXCQN'="" D RECINI

 ;K BMXTRACK(BMXLCQ) ;Also kill all track levels between current and next level

 F  K BMXTRACK($O(BMXTRACK(999999),-1)) Q:$O(BMXTRACK(9999999),-1)'>BMXLCQN

 S J=0 F  S J=$O(BMXTRACK(J)) Q:'+J  D  ;Level

 . S K=0 F  S K=$O(BMXTRACK(J,K)) Q:'+K  D  ;Order

 . . I $D(BMXTRACK(J,K)) S BMXNODE=BMXTRACK(J,K) S BMXREC(BMXREC,$P(BMXNODE,U,2))=$P(BMXNODE,U)_U

 . . S L=0 F  S L=$O(BMXTRACK(J,K,L)) Q:'+L  D  ;wp node

 . . . I $D(BMXTRACK(J,K,L)) S BMXNODE=BMXTRACK(J,K,L) S BMXREC(BMXREC,$P(BMXNODE,U,2),L)=$P(BMXNODE,U)

 Q

 ;

BLDCHN ;

 N B

 D MAKEB

 ;D MAKEC

 D BUILD

 Q

 ;

MAKEC ;

 ;MAKE Chain

 ;How many chains are there?

 S BMXZ=0 S BMXCID=1 K BMXCFN

 ;

 ;

 ;Create BMXCHNP(BMXCID)

 S F=0 F  S F=$O(BMXMFL(F)) Q:'+F  I '$D(BMXMFL("SUBFILE",F)),$D(BMXMFL("PARENT",F)) S BMXMFL("BOTTOM",F)=""

 N BMXCB,BMXCHNP,BMXP

 S BMXCID=0,BMXCB=0,BMXCHNP=0

 I $D(BMXMFL("BOTTOM")) F  S BMXCB=$O(BMXMFL("BOTTOM",BMXCB)) Q:'BMXCB  D

 . S BMXCID=BMXCID+1,BMXCHNP=BMXCID

 . S BMXCHNP(BMXCID)=BMXCB

 . S BMXP=BMXCB

 . F  Q:'$D(BMXMFL("PARENT",BMXP))  S BMXP=BMXMFL("PARENT",BMXP) S BMXCHNP(BMXCID)=BMXP_U_BMXCHNP(BMXCID)

 ;

 N J,K,L,M

 ;Create BMXMFL("BASE")="FILE1^FILE2^...^FILEN"

 S F=0,M=0,BMXMFL("BASE")="" F  S F=$O(BMXMFL(F)) Q:'+F  I (('$D(BMXMFL("PARENT",F)))&('$D(BMXMFL(F,"SUBFILE"))))!(BMXFO(1)=F) S M=M+1,$P(BMXMFL("BASE"),U,M)=F ;Changed to make BMXFO(1) always a member of the base

 ;

 ;Create BMXCFN(BMXCID,BMXZ,FILE)

 I BMXCID=0 S BMXCID=1

 S J=0,BMXZ=0 F J=1:1:BMXCID D

 . I BMXMFL("BASE")]"" F L=1:1:$L(BMXMFL("BASE"),"^") S F=$P(BMXMFL("BASE"),"^",L) D

 . . S BMXZ=BMXZ+100

 . . S BMXCFN(J,BMXZ,F)=""

 . I +BMXCHNP F K=1:1:$L(BMXCHNP(J),"^") S F=$P(BMXCHNP(J),"^",K) D

 . . Q:F=BMXFO(1)  ;BMXFO(1) Is always a member of the base

 . . S BMXZ=BMXZ+100

 . . S BMXCFN(J,BMXZ,F)=""

 ;

 ;

 ;B  ;FIXCFN

 D FIXCFN

 Q

 ;

BUILD ;Building BMXCHAIN(

 N BMXIEN,BMXCID,BMXFLD,BMXCS,BMXINT,BMXCFNC,BMXCFIEN

 S BMXCID=0,BMXIEN=0

 F  S BMXCID=$O(BMXCFN(BMXCID)) Q:'+BMXCID  D

 . S BMXCFNC=0 F  S BMXCFNC=$O(BMXCFN(BMXCID,BMXCFNC)) Q:'+BMXCFNC  S BMXCFN=+BMXCFN(BMXCID,BMXCFNC) D

 . . S BMXIEN=0 F  S BMXIEN=$O(B(BMXCFN,BMXIEN)) Q:BMXIEN=""  D

 . . . S $P(BMXCFN(BMXCID,BMXCFNC),U,2)=BMXIEN

 . . . S BMXFLD=0 F  S BMXFLD=$O(B(BMXCFN,BMXIEN,BMXFLD)) Q:'+BMXFLD  D

 . . . . S BMXINT="D" F  S BMXINT=$O(B(BMXCFN,BMXIEN,BMXFLD,BMXINT)) Q:BMXINT=""  D

 . . . . . Q:'$D(BMXFLDOX(BMXCFN,BMXFLD,BMXINT))

 . . . . . I $P(BMXFLDO(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)),U,4)="W" D MCWP Q

 . . . . . D FIXIEN

 . . . . . S BMXCS="BMXCHAIN("_BMXCID_","_$S($L(BMXIEN,",")=2:1,1:2)_","_BMXCFIEN_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_")"

 . . . . . S @BMXCS=B(BMXCFN,BMXIEN,BMXFLD,BMXINT)_U_(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)+1)

 Q

 ;

FIXIEN ;

 N BMXC,BMXCFN1,BMXOFF

 S BMXC=BMXCFNC

 S BMXCFIEN=BMXCFN_","_$P(BMXIEN,",",$L(BMXIEN,","))

 S BMXOFF=1

 F  S BMXC=$O(BMXCFN(BMXCID,BMXC),-1) Q:'+BMXC  D

 . S BMXCFN1=+BMXCFN(BMXCID,BMXC)

 . I '$D(BMXMFL(BMXCFN,"OTM")) D

 . . I '$D(BMXMFL(BMXCFN1,"SUBFILE",BMXCFN)) Q

 . . S BMXCFIEN=BMXCFN1_","_$P(BMXIEN,",",$L(BMXIEN,",")-BMXOFF)_","_BMXCFIEN

 . I $D(BMXMFL(BMXCFN,"OTM")) D

 . . I '$D(BMXMFL(BMXCFN1,"SUBFILE",BMXCFN)) Q

 . . S BMXCFIEN=BMXCFN1_$P(BMXCFN(BMXCID,BMXC),U,2)_","_BMXCFIEN

 . S BMXOFF=BMXOFF+1

 ;

 ;

 Q

 ;

FIXCFN ;

 N J,K,L

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

 . S K=0 F  S K=$O(BMXCFN(J,K)) Q:'+K  D

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

 . . . K BMXCFN(J,K,L)

 . . . S BMXCFN(J,K)=L

 ;

 Q

 ;

MCWP ;

 ;MAKEC Process WP Field

 N BMXIENL,BMXWP

 S BMXIENL=1

 S:$L(BMXIEN,",")>2 BMXIENL=2

 S BMXWP=0

 ;

 F  S BMXWP=$O(B(BMXCFN,BMXIEN,BMXFLD,BMXWP)) Q:'+BMXWP  D

 . S BMXCS="BMXCHAIN("_BMXCID_","_BMXIENL_","_BMXCFN_BMXIEN_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_","_BMXWP_")"

 . S @BMXCS=B(BMXCFN,BMXIEN,BMXFLD,BMXWP)_U_(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)+1)_U_"W"_U_BMXWP

 Q

 ;

 ;

MAKEB ;

 N BMXFILE,BMXIEN,BMXFLD,BMXINT

 N BMXSUB,BMXIENR

 S BMXFILE=0 F  S BMXFILE=$O(A(BMXFILE)) Q:'+BMXFILE  D

 . S BMXIEN=0 F  S BMXIEN=$O(A(BMXFILE,BMXIEN)) Q:'+BMXIEN  D

 . . S BMXFLD=0 F  S BMXFLD=$O(A(BMXFILE,BMXIEN,BMXFLD)) Q:'+BMXFLD  D

 . . . S BMXINT=0 F  S BMXINT=$O(A(BMXFILE,BMXIEN,BMXFLD,BMXINT)) Q:BMXINT=""  D

 . . . . S BMXIENR=$$REVERSE(BMXIEN)

 . . . . S BMXSUB="B("_BMXFILE_","_$C(34)_BMXIENR_$C(34)_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_")"

 . . . . I $D(BMXFLDOX(BMXFILE,BMXFLD,BMXINT)),$P(BMXFLDO(BMXFLDOX(BMXFILE,BMXFLD,BMXINT)),U,5)="D" D  Q

 . . . . . S @BMXSUB=$TR(A(BMXFILE,BMXIEN,BMXFLD,BMXINT),"@"," ")

 . . . . S @BMXSUB=A(BMXFILE,BMXIEN,BMXFLD,BMXINT)

 Q

 ;

REVERSE(BMXIEN) ;

 N J,T,C

 S C=1

 F J=$L(BMXIEN,","):-1:1 D

 . S $P(T,",",C)=$P(BMXIEN,",",J)

 . S C=C+1

 Q T

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

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

 +2       ;

 +3       ;

WRITE     ;EP

 +1        NEW BMXFN,C,BMXN,BMXGF,BMXA,BMXFLDF,N,A,IEN0,I

 +2        NEW BMXCNT,BMXCNTB,BMXLEN,BMXLTMP,BMXNUM,BMXORD,BMXTYP

 +3       ;From MAKEC

           NEW BMXCFN,BMXCFNX,F,BMXROOT,BMXCID,BMXZ

 +4       ;TODO: COMMENT AFTER TESTING

           NEW BMXREC,BMXCHAIN

 +5        NEW BMXIENS

 +6       ;Set up FIELD value for GETS^DIQ call

 +7       ; BMXFLD("NAME")="FILE#^FIELD#"

 +8       ; Need: BMXFLDN(FieldNumber)

 +9       ; and : BMXFLDO(SelectOrder)

 +10      ; Get file number -- for now just use first file in array

 +11      ; TODO: Set up same main file and related files here and in enumerator

 +12       SET C=0

           SET BMXN=""

 +13       NEW F

 +14       SET BMXGF=0

 +15       SET F=0

           FOR 

               SET F=$ORDER(BMXF(F))

               IF F=""

                   QUIT 

               SET BMXFN=BMXF(F)

               Begin DoDot:1

 +16               SET C=0

                   SET BMXN=-1

                   FOR 

                       SET BMXN=$ORDER(BMXFLDO(BMXN))

                       IF BMXN=""

                           QUIT 

                       Begin DoDot:2

 +17                       IF $PIECE(BMXFLDO(BMXN),U)'=BMXFN

                               QUIT 

 +18                       IF $PIECE(BMXFLDO(BMXN),U,2)=".001"

                               SET BMXGF=BMXGF+1

                               QUIT 

 +19                       SET C=C+1

 +20                       SET $PIECE(BMXGF(BMXFN),";",C)=$PIECE(BMXFLDO(BMXN),U,2)

 +21                       IF '$DATA(BMXGF(BMXFN,"INTERNAL"))

                               SET BMXGF(BMXFN,"INTERNAL")="E"

 +22                       IF $PIECE(BMXFLDO(BMXN),U,3)="I"

                               SET BMXGF(BMXFN,"INTERNAL")="IE"

 +23                       SET BMXGF=BMXGF+1

 +24                       QUIT 

                       End DoDot:2

 +25               QUIT 

               End DoDot:1

 +26      ;

 +27      ;Distinct supported for only one field

           IF BMXGF>1

               KILL BMXTK("DISTINCT")

 +28       SET N=0

           SET BMXFLDF=0

           SET I=1

           SET BMXNUM=0

 +29       DO FIELDS

 +30       DO MAKEC

 +31      ;

 +32      ;

 +33      ;Column info only

           IF BMXCOL

               DO COLTYPE^BMXSQL

               DO ERRTACK^BMXSQL(I)

               QUIT 

 +34      ;

 +35       SET BMXA="A"

 +36       NEW G,R

 +37      ;---> Loop through results global

 +38       FOR 

               SET N=$ORDER(^BMXTMP($JOB,N))

               IF '+N

                   QUIT 

               Begin DoDot:1

 +39               KILL A

 +40      ;For each file in ORDER array

                   SET R=0

                   FOR 

                       SET R=$ORDER(BMXFO(R))

                       IF '+R

                           QUIT 

                       Begin DoDot:2

 +41                       SET IEN0=0

 +42                       SET BMXFN=BMXFO(R)

 +43                       IF $DATA(BMXMFL(BMXFN,"MULT"))

                               QUIT 

 +44      ;Primary file

                           IF R=1

                               SET IEN0=^BMXTMP($JOB,N)

 +45      ;Joined file

                           IF R>1

                               IF $DATA(BMXFJ("JOIN",BMXFN))

                                   Begin DoDot:3

 +46                                   SET IEN0=0

 +47                                   SET G=BMXFJ("JOIN",BMXFN)

 +48                                   SET V=BMXFF(G,"JOIN","IEN")

 +49                                   SET @V=^BMXTMP($JOB,N)

 +50                                   XECUTE BMXFF(G,"JOIN")

                                   End DoDot:3

 +51      ;Removed $D(BMXGF(BMXFN)) for mult fld on extdnd ptr

                           IF +IEN0

                               Begin DoDot:3

 +52                               DO SUBFILE(BMXFN)

                               End DoDot:3

 +53                       IF +IEN0

                               IF $DATA(BMXFLDN(BMXFN,.001))

                                   DO SETIEN(IEN0,BMXFN)

 +54      ;

 +55      ;Multiple field

                           IF 0

                               IF R>1

                                   IF $DATA(BMXMFL(BMXFN,"MULT"))

                                       Begin DoDot:3

 +56                                       IF '+IEN0

                                               QUIT 

 +57      ;Intervening multiple

                                           IF '$DATA(BMXGF(BMXFN))

                                               QUIT 

 +58      ;Call GETS for each subentry in multiple

 +59                                       XECUTE BMXMFL(BMXFN,"EXEC")

                                       End DoDot:3

                       End DoDot:2

 +60               SET F=0

                   SET BMXCNT=0

 +61      ;

 +62               DO RECORD

 +63               DO OUT

               End DoDot:1

 +64      ;

 +65      ;

 +66      ;---> Tack on Error Delimiter and any error.

 +67       SET I=I+1

 +68       DO ERRTACK^BMXSQL(I)

 +69       DO COLTYPE^BMXSQL

 +70       QUIT 

 +71      ;

SETIEN(BMXIEN,BMXFN) ;

 +1       ;B  ;SETIEN

 +2        IF '$DATA(BMXFLDN(BMXFN,.001))

               QUIT 

 +3        IF '+BMXIEN

               QUIT 

 +4        SET A(BMXFN,BMXIEN_",",.001,"E")=BMXIEN

 +5        QUIT 

 +6       ;

SUBFILE(BMXFN) ;

 +1       ;Execute GETS for Any fields in BMXGF(SUBFILE)

 +2       ;

 +3       ;If the subfile itself has subfiles, call SUBFILE(BMXSUBFN)

 +4       ;  (Loop through BMXMFL(BMXFN,"SUBFILE",BMXSUBFN))

 +5        IF $DATA(BMXMFL(BMXFN,"SUBFILE"))

               Begin DoDot:1

 +6                NEW BMXSUBFN

 +7                SET BMXSUBFN=0

 +8                FOR 

                       SET BMXSUBFN=$ORDER(BMXMFL(BMXFN,"SUBFILE",BMXSUBFN))

                       IF '+BMXSUBFN

                           QUIT 

                       DO SUBFILE(BMXSUBFN)

 +9                QUIT 

               End DoDot:1

 +10      ;

 +11       IF $DATA(BMXGF(BMXFN))

               Begin DoDot:1

 +12               IF '$DATA(BMXMFL(BMXFN,"MULT"))

                       SET BMXMSCR=1

                       DO GETS^DIQ(BMXFN,IEN0_",",BMXGF(BMXFN),BMXGF(BMXFN,"INTERNAL"),BMXA)

                       QUIT 

 +13              IF '$TEST

                       XECUTE BMXMFL(BMXFN,"EXEC")

                       QUIT 

               End DoDot:1

 +14      ;

 +15      ;

 +16       QUIT 

 +17      ;

FIELDS    ;---> Write Field Names

 +1       ;Field name is TAAAAANAME

 +2       ;Where T is the field type (T=Text; D=Date)

 +3       ;      AAAAA is the field size (see NUMCHAR routine)

 +4       ;      NAME is the field name

 +5        NEW BMXNUM,BMXFNUM,BMXFNAM,R

 +6        KILL BMXLEN,BMXTYP

 +7        SET BMXFLDF=1

 +8        SET BMXNUM=0

 +9       ;B  ;In FIELDS sub

 +10      ;:$D(A)

           Begin DoDot:1

 +11      ;TODO: Change from text to number

               IF BMXNUM

                   SET ^BMXTEMP($JOB,I)="IEN^"

                   SET BMXLEN(I)=10

                   SET BMXTYP(I)="T"

                   SET I=I+1

 +12           SET BMXFNUM=0

 +13           SET BMXFNAM=0

 +14           FOR R=0:1:(BMXFLDO-1)

                   SET BMXFN=$PIECE(BMXFLDO(R),U)

                   SET BMXFNUM=$PIECE(BMXFLDO(R),U,2)

                   Begin DoDot:2

 +15      ;S BMXFNAM=$P(^DD(BMXFN,BMXFNUM,0),"^") ;Get type here

 +16                   SET BMXFNAM=BMXFLDN(BMXFN,BMXFNUM)

 +17                   IF $PIECE(BMXFLDO(R),U,3)="I"

                           SET BMXFNAM="INTERNAL["_BMXFNAM_"]"

 +18                   SET BMXFNAM=$TRANSLATE(BMXFNAM," ","_")

 +19                   IF BMXF>1

                           SET BMXFNAM=$TRANSLATE($PIECE(BMXFNX(BMXFN),".")," ","_")_"."_BMXFNAM

 +20                   SET BMXTYP(I)="T"

 +21                   IF $PIECE(BMXFLDO(R),U,5)="D"

                           SET BMXTYP(I)="D"

 +22                   IF $PIECE(BMXFLDO(R),U,5)="I"

                           SET BMXTYP(I)="I"

 +23      ;Start with length zero

                       SET BMXLEN(I)=0

 +24      ;I $D(BMXFLDA(BMXFN,BMXFNUM)) S BMXFNAM=BMXFLDA(BMXFN,BMXFNUM)

 +25                   IF $PIECE(BMXFLDO(R),U,6)]""

                           SET BMXFNAM=$PIECE(BMXFLDO(R),U,6)

 +26                   SET ^BMXTEMP($JOB,I)=BMXFNAM_"^"

 +27                   SET I=I+1

                   End DoDot:2

 +28           SET ^BMXTEMP($JOB,I-1)=$EXTRACT(^BMXTEMP($JOB,I-1),1,$LENGTH(^BMXTEMP($JOB,I-1))-1)_$CHAR(30)

           End DoDot:1

 +29       QUIT 

 +30      ;

OUT       ;

 +1       ;Output to BMXTEMP($J

 +2        IF '$DATA(BMXREC)

               QUIT 

 +3        NEW J,K,L,BMXLENT

 +4        SET J=0

           FOR 

               SET J=$ORDER(BMXREC(J))

               IF '+J

                   QUIT 

               Begin DoDot:1

 +5                SET K=0

                   FOR 

                       SET K=$ORDER(BMXREC(J,K))

                       IF '+K

                           QUIT 

                       Begin DoDot:2

 +6       ;WP

                           IF +$ORDER(BMXREC(J,K,0))

                               Begin DoDot:3

 +7                                SET L=0

                                   SET BMXLENT=0

                                   FOR 

                                       SET L=$ORDER(BMXREC(J,K,L))

                                       IF '+L

                                           QUIT 

                                       Begin DoDot:4

 +8                                        IF '$DATA(^BMXTEMP($JOB,I))

                                               SET ^BMXTEMP($JOB,I)=""

 +9                                        IF $LENGTH(^BMXTEMP($JOB,I))>250

                                               SET I=I+1

                                               SET ^BMXTEMP($JOB,I)=""

 +10                                       SET ^BMXTEMP($JOB,I)=^BMXTEMP($JOB,I)_BMXREC(J,K,L)