BMXSQL5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;4.0;BMX;;JUN 28, 2010
;
;
SELECT ;EP - Get field names into BMXFLD("NAME")="FILE#^FIELD#"
N BMXA,BMXB,BMXS,BMXSINGL
N BMXINTNL
S T=$G(BMXTK("SELECT"))
I '+T S BMXERR="'SELECT' CLAUSE NOT FOUND" D ERRTACK^BMXSQL(1) Q
S BMXFLD=0
N BMXOFF,BMXGS1,BMXLVL
F S T=$O(BMXTK(T)) Q:'+T Q:T=$G(BMXTK("FROM")) I BMXTK(T)'="," S BMXOFF=1,BMXLVL=0 D S1 Q:$D(BMXERR)
Q
;
SALIAS ;
Q:'+$O(BMXTK(T))
N V
S V=T+1
Q:$G(BMXTK(V))=","
Q:V=$G(BMXTK("FROM"))
S:BMXTK(V)["'" BMXTK(V)=$P(BMXTK(V),"'",2)
S BMXFLDA(BMXFILE,BMXFLDN)=BMXTK(V)
S $P(BMXFLDO(BMXFLDO-1),U,6)=BMXTK(V)
S T=T+1
Q
;
S1 ;
S BMXTK(T)=$TR(BMXTK(T),"_"," ")
;Check for INTERNAL[ modifier
S BMXGS1=0
S BMXINTNL="E"
I BMXTK(T)["[" S BMXINTNL="I",BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1)
;If explicit file name
S BMXSINGL=0
I BMXTK(T)["." D G:BMXGS1 S1 G:BMXSINGL NOTEXP Q
. ;Before FILE.FIELD Parsing
. S BMXA=$P(BMXTK(T),".",1,BMXOFF) ;File Name
. I '$D(BMXF(BMXA)) D Q:$D(BMXERR) Q:BMXSINGL
. . I $D(^DD(BMXFO(1),"B",BMXTK(T))),BMXOFF=1 S BMXSINGL=1 Q
. . S BMXERR="FILE NOT FOUND" D ERRTACK^BMXSQL(1) Q
. S BMXB=$P(BMXTK(T),".",1+BMXOFF,99) ;Field Name TODO: Test here for multiple in extended pointer -- FILE.MULTIPLE.FIELD
. N BMXLAST S BMXLAST=0
. I $L(BMXB,".")>1 D Q:'BMXLAST ;Multiple
. . N BMXFNUM,BMXFNAM,BMXFNOD,BMXSUBFN,BMXUPFN,BMXGL,W,BMXFOUND
. . ;Multiple or Field-name with period?
. . S BMXFOUND=0
. . F W=1:1:$L(BMXTK(T),".") D Q:BMXFOUND
. . . S BMXOFF=BMXOFF+1
. . . I $D(^DD(BMXF(BMXA),"B",$P(BMXB,".",1,W))) D
. . . . S BMXFNAM=$P(BMXB,".",1,W)
. . . . S BMXFOUND=1
. . . . S:W=$L(BMXB,".") BMXLAST=1
. . . . S BMXLVL=BMXLVL+1
. . ;
. . Q:BMXLAST
. . S BMXF=BMXF+1
. . S BMXFNUM=$O(^DD(BMXF(BMXA),"B",BMXFNAM,0)) ;FieldNumber
. . S BMXFNOD=^DD(BMXF(BMXA),BMXFNUM,0)
. . S BMXGL=$P(BMXFNOD,U,4),BMXGL=$P(BMXGL,";")
. . S BMXSUBFN=+$P(BMXFNOD,U,2) ;Subfile Number
. . S BMXUPFN=^DD(BMXSUBFN,0,"UP") ;Parent File Number
. . D SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXLVL,0)
. . S BMXGS1=1
. S:BMXB["'" BMXB=$P(BMXB,"'",2)
. I BMXB="BMXIEN" D Q
. . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
. . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
. . D SELECT1
. I BMXB="*" D Q ;All fields in file BMXA
. . ;BMXIEN Has to be first because ADO doesn't handle it well if a DATE type column is returned first
. . S BMXB="BMXIEN"
. . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
. . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
. . D SELECT1
. . S BMXB=0 F S BMXB=$O(^DD(BMXF(BMXA),"B",BMXB)) Q:BMXB="" D
. . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
. . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
. . . D SELECT1
. S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
. I '$D(^DD(BMXF(BMXA),"B",BMXB)) S BMXERR="FIELD NOT FOUND" D ERRTACK^BMXSQL(1) Q
. S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
. D SELECT1
. Q
;
NOTEXP ;File not explicit so Loop through files in BMXF to locate field name
;
I BMXTK(T)["'" S BMXTK(T)=$P(BMXTK(T),"'",2)
S C=0,BMXA=""
I BMXTK(T)="BMXIEN" D Q
. S BMXB=BMXTK(T)
. S BMXA=BMXFO(1) ;File defaults to first named file in FROM
. S BMXA=BMXFNX(BMXA)
. S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
. S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
. D SELECT1
F S BMXA=$O(BMXF(BMXA)) Q:BMXA="" D Q:$D(BMXERR)
. S BMXB=BMXTK(T)
. I BMXB="*" D Q ;All fields in file BMXA
. . S BMXB="BMXIEN"
. . S BMXA=BMXFO(1) ;File defaults to first named file in FROM
. . S BMXA=BMXFNX(BMXA)
. . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
. . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
. . D SELECT1
. . S BMXB=0 F S BMXB=$O(^DD(BMXF(BMXA),"B",BMXB)) Q:BMXB="" D
. . . S BMXS=BMXA_"."_BMXB
. . . S BMXFLD(BMXS)=BMXF(BMXA)
. . . S $P(BMXFLD(BMXS),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
. . . D SELECT1
. . . S C=1
. I $D(^DD(BMXF(BMXA),"B",BMXTK(T))) D Q:$D(BMXERR)
. . S C=C+1
. . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERRTACK^BMXSQL(1) Q
. . S BMXB=BMXTK(T) ;Field Name
. . I BMXB["'" S BMXB=$P(BMXB,"'",2)
. . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
. . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
. . D SELECT1
. . Q
. Q
I C=0 S BMXERR="FIELD NOT FOUND" D ERRTACK^BMXSQL(1) Q
Q
;
SELECT1 ;
N BMXGNOD,BMXFILE,BMXGNOD1
S BMXFLDN=$P(BMXFLD(BMXA_"."_BMXB),"^",2)
S BMXFILE=$P(BMXFLD(BMXA_"."_BMXB),U)
S BMXFLDN(BMXFILE,BMXFLDN)=BMXB
I BMXFLDN=".001" S BMXGNOD="IEN",BMXGNOD1="",$P(BMXGNOD1,U,2)="N"
E S BMXGNOD1=^DD(BMXFILE,BMXFLDN,0)
S BMXGNOD=$P(BMXGNOD1,"^",4)
S $P(BMXFLD(BMXA_"."_BMXB),"^",3)=$P(BMXGNOD,";")
S $P(BMXFLD(BMXA_"."_BMXB),"^",4)=$P(BMXGNOD,";",2)
S $P(BMXFLD(BMXA_"."_BMXB),"^",5)=BMXINTNL
S BMXFLDO(BMXFLD)=BMXFILE_"^"_BMXFLDN_"^"_BMXINTNL
I +$P(BMXGNOD1,U,2) D ;Check for WP
. S BMXGNOD1=+$P(BMXGNOD1,U,2)
. Q:'$D(^DD(BMXGNOD1,.01,0))
. I $P(^DD(BMXGNOD1,.01,0),U,2)["W" S $P(BMXFLDO(BMXFLD),U,4)="W"
;HMW20030630 Modified next line to make data type of Internal[] for pointer an Integer.
I $P(BMXGNOD1,U,2)["P" S BMXGNOD1=$$PTYPE(BMXGNOD1) Q:BMXGNOD1="" S:$G(BMXINTNL)="I" $P(BMXGNOD1,U,2)="N" ;I BMXGNOD1="" then Pointed-to file doesn't exist
I $P(BMXGNOD1,U,2)["D" S $P(BMXFLDO(BMXFLD),U,5)="D"
I $P(BMXGNOD1,U,2)["N" D
. N Z
. S Z=$P(BMXGNOD1,U,2)
. I +$P(Z,",",2)=0 S $P(BMXFLDO(BMXFLD),U,5)="I" ;Integer
S BMXFLDOX(BMXFILE,BMXFLDN,BMXINTNL)=BMXFLD
S BMXFLD=BMXFLD+1
S BMXFLDO=BMXFLD
D SALIAS
Q
;
SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXOFF,BMXOTM) ;EP
;
;BMXOTM = One-To-Many
N BMXUPG
S BMXMFL("PARENT",BMXSUBFN)=BMXUPFN
S BMXMFL(BMXUPFN,"SUBFILE",BMXSUBFN)=""
S BMXMFL("SUBFILE",BMXUPFN,BMXSUBFN)=""
S BMXUPG=BMXMFL(BMXUPFN,"GLOC") ;Parent File Global Set in FROM clause
S BMXFNAM=BMXA_"."_BMXFNAM ;TODO: Regression test this line with OTM
I 'BMXOTM S BMXMFL(BMXSUBFN,"GLOC")=BMXUPG_"IEN"_(BMXOFF-1)_","_$C(34)_BMXGL_$C(34)_","
E S BMXMFL(BMXSUBFN,"GLOC")=BMXGL,BMXMFL(BMXSUBFN,"OTM")=""
S BMXMFL(BMXSUBFN,"MULT")="S IEN"_BMXOFF_"=0 F S IEN"_BMXOFF_"=$O("_BMXMFL(BMXSUBFN,"GLOC")_"IEN"_BMXOFF_")) Q:'+IEN"_BMXOFF_" "
I $D(BMXMFL(BMXUPFN,"MULT")) S BMXMFL(BMXSUBFN,"MULT")=BMXMFL(BMXUPFN,"MULT")_" "_BMXMFL(BMXSUBFN,"MULT")
I 'BMXOTM S BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" F J=0:1:"_BMXOFF_" S BMXIENS=@(""IEN""_J)_"",""_BMXIENS"
E S BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" S J=1 S BMXIENS=@(""IEN""_J)_"",""_BMXIENS"
S BMXMFL(BMXSUBFN,"EXEC")=BMXMFL(BMXSUBFN,"MULT")_"X BMXMFL(BMXFN,""IENS"")"_" D GETS^DIQ(BMXFN,BMXIENS,BMXGF(BMXFN),""E"",BMXA) D SETIEN(IEN"_BMXOFF_",BMXFN)"
D F1^BMXSQL(BMXF,BMXFNAM,BMXSUBFN)
;
Q
;
PTYPE(BMXGNOD1) ;
;Traverse pointer chain to retrieve data type of pointed-to field
N BMXFILE
I $P(BMXGNOD1,U,2)'["P" Q BMXGNOD1
S BMXFILE=$P(BMXGNOD1,U,2)
S BMXFILE=+$P(BMXFILE,"P",2)
S BMXGNOD1=$G(^DD(BMXFILE,".01",0))
S BMXGNOD1=$$PTYPE(BMXGNOD1)
Q BMXGNOD1
BMXSQL5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
SELECT ;EP - Get field names into BMXFLD("NAME")="FILE#^FIELD#"
+1 NEW BMXA,BMXB,BMXS,BMXSINGL
+2 NEW BMXINTNL
+3 SET T=$GET(BMXTK("SELECT"))
+4 IF '+T
SET BMXERR="'SELECT' CLAUSE NOT FOUND"
DO ERRTACK^BMXSQL(1)
QUIT
+5 SET BMXFLD=0
+6 NEW BMXOFF,BMXGS1,BMXLVL
+7 FOR
SET T=$ORDER(BMXTK(T))
IF '+T
QUIT
IF T=$GET(BMXTK("FROM"))
QUIT
IF BMXTK(T)'=","
SET BMXOFF=1
SET BMXLVL=0
DO S1
IF $DATA(BMXERR)
QUIT
+8 QUIT
+9 ;
SALIAS ;
+1 IF '+$ORDER(BMXTK(T))
QUIT
+2 NEW V
+3 SET V=T+1
+4 IF $GET(BMXTK(V))=","
QUIT
+5 IF V=$GET(BMXTK("FROM"))
QUIT
+6 IF BMXTK(V)["'"
SET BMXTK(V)=$PIECE(BMXTK(V),"'",2)
+7 SET BMXFLDA(BMXFILE,BMXFLDN)=BMXTK(V)
+8 SET $PIECE(BMXFLDO(BMXFLDO-1),U,6)=BMXTK(V)
+9 SET T=T+1
+10 QUIT
+11 ;
S1 ;
+1 SET BMXTK(T)=$TRANSLATE(BMXTK(T),"_"," ")
+2 ;Check for INTERNAL[ modifier
+3 SET BMXGS1=0
+4 SET BMXINTNL="E"
+5 IF BMXTK(T)["["
SET BMXINTNL="I"
SET BMXTK(T)=$PIECE(BMXTK(T),"[",2)
SET BMXTK(T)=$PIECE(BMXTK(T),"]",1)
+6 ;If explicit file name
+7 SET BMXSINGL=0
+8 IF BMXTK(T)["."
Begin DoDot:1
+9 ;Before FILE.FIELD Parsing
+10 ;File Name
SET BMXA=$PIECE(BMXTK(T),".",1,BMXOFF)
+11 IF '$DATA(BMXF(BMXA))
Begin DoDot:2
+12 IF $DATA(^DD(BMXFO(1),"B",BMXTK(T)))
IF BMXOFF=1
SET BMXSINGL=1
QUIT
+13 SET BMXERR="FILE NOT FOUND"
DO ERRTACK^BMXSQL(1)
QUIT
End DoDot:2
IF $DATA(BMXERR)
QUIT
IF BMXSINGL
QUIT
+14 ;Field Name TODO: Test here for multiple in extended pointer -- FILE.MULTIPLE.FIELD
SET BMXB=$PIECE(BMXTK(T),".",1+BMXOFF,99)
+15 NEW BMXLAST
SET BMXLAST=0
+16 ;Multiple
IF $LENGTH(BMXB,".")>1
Begin DoDot:2
+17 NEW BMXFNUM,BMXFNAM,BMXFNOD,BMXSUBFN,BMXUPFN,BMXGL,W,BMXFOUND
+18 ;Multiple or Field-name with period?
+19 SET BMXFOUND=0
+20 FOR W=1:1:$LENGTH(BMXTK(T),".")
Begin DoDot:3
+21 SET BMXOFF=BMXOFF+1
+22 IF $DATA(^DD(BMXF(BMXA),"B",$PIECE(BMXB,".",1,W)))
Begin DoDot:4
+23 SET BMXFNAM=$PIECE(BMXB,".",1,W)
+24 SET BMXFOUND=1
+25 IF W=$LENGTH(BMXB,".")
SET BMXLAST=1
+26 SET BMXLVL=BMXLVL+1
End DoDot:4
End DoDot:3
IF BMXFOUND
QUIT
+27 ;
+28 IF BMXLAST
QUIT
+29 SET BMXF=BMXF+1
+30 ;FieldNumber
SET BMXFNUM=$ORDER(^DD(BMXF(BMXA),"B",BMXFNAM,0))
+31 SET BMXFNOD=^DD(BMXF(BMXA),BMXFNUM,0)
+32 SET BMXGL=$PIECE(BMXFNOD,U,4)
SET BMXGL=$PIECE(BMXGL,";")
+33 ;Subfile Number
SET BMXSUBFN=+$PIECE(BMXFNOD,U,2)
+34 ;Parent File Number
SET BMXUPFN=^DD(BMXSUBFN,0,"UP")
+35 DO SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXLVL,0)
+36 SET BMXGS1=1
End DoDot:2
IF 'BMXLAST
QUIT
+37 IF BMXB["'"
SET BMXB=$PIECE(BMXB,"'",2)
+38 IF BMXB="BMXIEN"
Begin DoDot:2
+39 SET BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
+40 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
+41 DO SELECT1
End DoDot:2
QUIT
+42 ;All fields in file BMXA
IF BMXB="*"
Begin DoDot:2
+43 ;BMXIEN Has to be first because ADO doesn't handle it well if a DATE type column is returned first
+44 SET BMXB="BMXIEN"
+45 SET BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
+46 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
+47 DO SELECT1
+48 SET BMXB=0
FOR
SET BMXB=$ORDER(^DD(BMXF(BMXA),"B",BMXB))
IF BMXB=""
QUIT
Begin DoDot:3
+49 SET BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
+50 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",2)=$ORDER(^DD(BMXF(BMXA),"B",BMXB,0))
+51 DO SELECT1
End DoDot:3
End DoDot:2
QUIT
+52 SET BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
+53 IF '$DATA(^DD(BMXF(BMXA),"B",BMXB))
SET BMXERR="FIELD NOT FOUND"
DO ERRTACK^BMXSQL(1)
QUIT
+54 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",2)=$ORDER(^DD(BMXF(BMXA),"B",BMXB,0))
+55 DO SELECT1
+56 QUIT
End DoDot:1
IF BMXGS1
GOTO S1
IF BMXSINGL
GOTO NOTEXP
QUIT
+57 ;
NOTEXP ;File not explicit so Loop through files in BMXF to locate field name
+1 ;
+2 IF BMXTK(T)["'"
SET BMXTK(T)=$PIECE(BMXTK(T),"'",2)
+3 SET C=0
SET BMXA=""
+4 IF BMXTK(T)="BMXIEN"
Begin DoDot:1
+5 SET BMXB=BMXTK(T)
+6 ;File defaults to first named file in FROM
SET BMXA=BMXFO(1)
+7 SET BMXA=BMXFNX(BMXA)
+8 SET BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
+9 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
+10 DO SELECT1
End DoDot:1
QUIT
+11 FOR
SET BMXA=$ORDER(BMXF(BMXA))
IF BMXA=""
QUIT
Begin DoDot:1
+12 SET BMXB=BMXTK(T)
+13 ;All fields in file BMXA
IF BMXB="*"
Begin DoDot:2
+14 SET BMXB="BMXIEN"
+15 ;File defaults to first named file in FROM
SET BMXA=BMXFO(1)
+16 SET BMXA=BMXFNX(BMXA)
+17 SET BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
+18 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
+19 DO SELECT1
+20 SET BMXB=0
FOR
SET BMXB=$ORDER(^DD(BMXF(BMXA),"B",BMXB))
IF BMXB=""
QUIT
Begin DoDot:3
+21 SET BMXS=BMXA_"."_BMXB
+22 SET BMXFLD(BMXS)=BMXF(BMXA)
+23 SET $PIECE(BMXFLD(BMXS),"^",2)=$ORDER(^DD(BMXF(BMXA),"B",BMXB,0))
+24 DO SELECT1
+25 SET C=1
End DoDot:3
End DoDot:2
QUIT
+26 IF $DATA(^DD(BMXF(BMXA),"B",BMXTK(T)))
Begin DoDot:2
+27 SET C=C+1
+28 IF C>1
SET BMXERR="AMBIGUOUS FIELD NAME"
DO ERRTACK^BMXSQL(1)
QUIT
+29 ;Field Name
SET BMXB=BMXTK(T)
+30 IF BMXB["'"
SET BMXB=$PIECE(BMXB,"'",2)
+31 SET BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
+32 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",2)=$ORDER(^DD(BMXF(BMXA),"B",BMXB,0))
+33 DO SELECT1
+34 QUIT
End DoDot:2
IF $DATA(BMXERR)
QUIT
+35 QUIT
End DoDot:1
IF $DATA(BMXERR)
QUIT
+36 IF C=0
SET BMXERR="FIELD NOT FOUND"
DO ERRTACK^BMXSQL(1)
QUIT
+37 QUIT
+38 ;
SELECT1 ;
+1 NEW BMXGNOD,BMXFILE,BMXGNOD1
+2 SET BMXFLDN=$PIECE(BMXFLD(BMXA_"."_BMXB),"^",2)
+3 SET BMXFILE=$PIECE(BMXFLD(BMXA_"."_BMXB),U)
+4 SET BMXFLDN(BMXFILE,BMXFLDN)=BMXB
+5 IF BMXFLDN=".001"
SET BMXGNOD="IEN"
SET BMXGNOD1=""
SET $PIECE(BMXGNOD1,U,2)="N"
+6 IF '$TEST
SET BMXGNOD1=^DD(BMXFILE,BMXFLDN,0)
+7 SET BMXGNOD=$PIECE(BMXGNOD1,"^",4)
+8 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",3)=$PIECE(BMXGNOD,";")
+9 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",4)=$PIECE(BMXGNOD,";",2)
+10 SET $PIECE(BMXFLD(BMXA_"."_BMXB),"^",5)=BMXINTNL
+11 SET BMXFLDO(BMXFLD)=BMXFILE_"^"_BMXFLDN_"^"_BMXINTNL
+12 ;Check for WP
IF +$PIECE(BMXGNOD1,U,2)
Begin DoDot:1
+13 SET BMXGNOD1=+$PIECE(BMXGNOD1,U,2)
+14 IF '$DATA(^DD(BMXGNOD1,.01,0))
QUIT
+15 IF $PIECE(^DD(BMXGNOD1,.01,0),U,2)["W"
SET $PIECE(BMXFLDO(BMXFLD),U,4)="W"
End DoDot:1
+16 ;HMW20030630 Modified next line to make data type of Internal[] for pointer an Integer.
+17 ;I BMXGNOD1="" then Pointed-to file doesn't exist
IF $PIECE(BMXGNOD1,U,2)["P"
SET BMXGNOD1=$$PTYPE(BMXGNOD1)
IF BMXGNOD1=""
QUIT
IF $GET(BMXINTNL)="I"
SET $PIECE(BMXGNOD1,U,2)="N"
+18 IF $PIECE(BMXGNOD1,U,2)["D"
SET $PIECE(BMXFLDO(BMXFLD),U,5)="D"
+19 IF $PIECE(BMXGNOD1,U,2)["N"
Begin DoDot:1
+20 NEW Z
+21 SET Z=$PIECE(BMXGNOD1,U,2)
+22 ;Integer
IF +$PIECE(Z,",",2)=0
SET $PIECE(BMXFLDO(BMXFLD),U,5)="I"
End DoDot:1
+23 SET BMXFLDOX(BMXFILE,BMXFLDN,BMXINTNL)=BMXFLD
+24 SET BMXFLD=BMXFLD+1
+25 SET BMXFLDO=BMXFLD
+26 DO SALIAS
+27 QUIT
+28 ;
SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXOFF,BMXOTM) ;EP
+1 ;
+2 ;BMXOTM = One-To-Many
+3 NEW BMXUPG
+4 SET BMXMFL("PARENT",BMXSUBFN)=BMXUPFN
+5 SET BMXMFL(BMXUPFN,"SUBFILE",BMXSUBFN)=""
+6 SET BMXMFL("SUBFILE",BMXUPFN,BMXSUBFN)=""
+7 ;Parent File Global Set in FROM clause
SET BMXUPG=BMXMFL(BMXUPFN,"GLOC")
+8 ;TODO: Regression test this line with OTM
SET BMXFNAM=BMXA_"."_BMXFNAM
+9 IF 'BMXOTM
SET BMXMFL(BMXSUBFN,"GLOC")=BMXUPG_"IEN"_(BMXOFF-1)_","_$CHAR(34)_BMXGL_$CHAR(34)_","
+10 IF '$TEST
SET BMXMFL(BMXSUBFN,"GLOC")=BMXGL
SET BMXMFL(BMXSUBFN,"OTM")=""
+11 SET BMXMFL(BMXSUBFN,"MULT")="S IEN"_BMXOFF_"=0 F S IEN"_BMXOFF_"=$O("_BMXMFL(BMXSUBFN,"GLOC")_"IEN"_BMXOFF_")) Q:'+IEN"_BMXOFF_" "
+12 IF $DATA(BMXMFL(BMXUPFN,"MULT"))
SET BMXMFL(BMXSUBFN,"MULT")=BMXMFL(BMXUPFN,"MULT")_" "_BMXMFL(BMXSUBFN,"MULT")
+13 IF 'BMXOTM
SET BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" F J=0:1:"_BMXOFF_" S BMXIENS=@(""IEN""_J)_"",""_BMXIENS"
+14 IF '$TEST
SET BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" S J=1 S BMXIENS=@(""IEN""_J)_"",""_BMXIENS"
+15 SET BMXMFL(BMXSUBFN,"EXEC")=BMXMFL(BMXSUBFN,"MULT")_"X BMXMFL(BMXFN,""IENS"")"_" D GETS^DIQ(BMXFN,BMXIENS,BMXGF(BMXFN),""E"",BMXA) D SETIEN(IEN"_BMXOFF_",BMXFN)"
+16 DO F1^BMXSQL(BMXF,BMXFNAM,BMXSUBFN)
+17 ;
+18 QUIT
+19 ;
PTYPE(BMXGNOD1) ;
+1 ;Traverse pointer chain to retrieve data type of pointed-to field
+2 NEW BMXFILE
+3 IF $PIECE(BMXGNOD1,U,2)'["P"
QUIT BMXGNOD1
+4 SET BMXFILE=$PIECE(BMXGNOD1,U,2)
+5 SET BMXFILE=+$PIECE(BMXFILE,"P",2)
+6 SET BMXGNOD1=$GET(^DD(BMXFILE,".01",0))
+7 SET BMXGNOD1=$$PTYPE(BMXGNOD1)
+8 QUIT BMXGNOD1
