Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMXSQL5

BMXSQL5.m

Go to the documentation of this file. 
  1. BMXSQL5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;
  1.  ;
  1. SELECT ;EP - Get field names into BMXFLD("NAME")="FILE#^FIELD#"
  1.  N BMXA,BMXB,BMXS,BMXSINGL
  1.  N BMXINTNL
  1.  S T=$G(BMXTK("SELECT"))
  1.  I '+T S BMXERR="'SELECT' CLAUSE NOT FOUND" D ERRTACK^BMXSQL(1) Q
  1.  S BMXFLD=0
  1.  N BMXOFF,BMXGS1,BMXLVL
  1.  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)
  1.  Q
  1.  ;
  1. SALIAS ;
  1.  Q:'+$O(BMXTK(T))
  1.  N V
  1.  S V=T+1
  1.  Q:$G(BMXTK(V))=","
  1.  Q:V=$G(BMXTK("FROM"))
  1.  S:BMXTK(V)["'" BMXTK(V)=$P(BMXTK(V),"'",2)
  1.  S BMXFLDA(BMXFILE,BMXFLDN)=BMXTK(V)
  1.  S $P(BMXFLDO(BMXFLDO-1),U,6)=BMXTK(V)
  1.  S T=T+1
  1.  Q
  1.  ;
  1. S1 ;
  1.  S BMXTK(T)=$TR(BMXTK(T),"_"," ")
  1.  ;Check for INTERNAL[ modifier
  1.  S BMXGS1=0
  1.  S BMXINTNL="E"
  1.  I BMXTK(T)["[" S BMXINTNL="I",BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1)
  1.  ;If explicit file name
  1.  S BMXSINGL=0
  1.  I BMXTK(T)["." D  G:BMXGS1 S1 G:BMXSINGL NOTEXP Q
  1.  . ;Before FILE.FIELD Parsing
  1.  . S BMXA=$P(BMXTK(T),".",1,BMXOFF) ;File Name
  1.  . I '$D(BMXF(BMXA)) D  Q:$D(BMXERR)  Q:BMXSINGL
  1.  . . I $D(^DD(BMXFO(1),"B",BMXTK(T))),BMXOFF=1 S BMXSINGL=1 Q
  1.  . . S BMXERR="FILE NOT FOUND" D ERRTACK^BMXSQL(1) Q
  1.  . S BMXB=$P(BMXTK(T),".",1+BMXOFF,99) ;Field Name TODO: Test here for multiple in extended pointer -- FILE.MULTIPLE.FIELD
  1.  . N BMXLAST S BMXLAST=0
  1.  . I $L(BMXB,".")>1 D  Q:'BMXLAST  ;Multiple
  1.  . . N BMXFNUM,BMXFNAM,BMXFNOD,BMXSUBFN,BMXUPFN,BMXGL,W,BMXFOUND
  1.  . . ;Multiple or Field-name with period?
  1.  . . S BMXFOUND=0
  1.  . . F W=1:1:$L(BMXTK(T),".") D  Q:BMXFOUND
  1.  . . . S BMXOFF=BMXOFF+1
  1.  . . . I $D(^DD(BMXF(BMXA),"B",$P(BMXB,".",1,W))) D
  1.  . . . . S BMXFNAM=$P(BMXB,".",1,W)
  1.  . . . . S BMXFOUND=1
  1.  . . . . S:W=$L(BMXB,".") BMXLAST=1
  1.  . . . . S BMXLVL=BMXLVL+1
  1.  . . ;
  1.  . . Q:BMXLAST
  1.  . . S BMXF=BMXF+1
  1.  . . S BMXFNUM=$O(^DD(BMXF(BMXA),"B",BMXFNAM,0)) ;FieldNumber
  1.  . . S BMXFNOD=^DD(BMXF(BMXA),BMXFNUM,0)
  1.  . . S BMXGL=$P(BMXFNOD,U,4),BMXGL=$P(BMXGL,";")
  1.  . . S BMXSUBFN=+$P(BMXFNOD,U,2) ;Subfile Number
  1.  . . S BMXUPFN=^DD(BMXSUBFN,0,"UP") ;Parent File Number
  1.  . . D SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXLVL,0)
  1.  . . S BMXGS1=1
  1.  . S:BMXB["'" BMXB=$P(BMXB,"'",2)
  1.  . I BMXB="BMXIEN" D  Q
  1.  . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
  1.  . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
  1.  . . D SELECT1
  1.  . I BMXB="*" D  Q  ;All fields in file BMXA
  1.  . . ;BMXIEN Has to be first because ADO doesn't handle it well if a DATE type column is returned first
  1.  . . S BMXB="BMXIEN"
  1.  . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
  1.  . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
  1.  . . D SELECT1
  1.  . . S BMXB=0 F  S BMXB=$O(^DD(BMXF(BMXA),"B",BMXB)) Q:BMXB=""  D
  1.  . . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
  1.  . . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
  1.  . . . D SELECT1
  1.  . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
  1.  . I '$D(^DD(BMXF(BMXA),"B",BMXB)) S BMXERR="FIELD NOT FOUND" D ERRTACK^BMXSQL(1) Q
  1.  . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
  1.  . D SELECT1
  1.  . Q
  1.  ;
  1. NOTEXP ;File not explicit so Loop through files in BMXF to locate field name
  1.  ;
  1.  I BMXTK(T)["'" S BMXTK(T)=$P(BMXTK(T),"'",2)
  1.  S C=0,BMXA=""
  1.  I BMXTK(T)="BMXIEN" D  Q
  1.  . S BMXB=BMXTK(T)
  1.  . S BMXA=BMXFO(1) ;File defaults to first named file in FROM
  1.  . S BMXA=BMXFNX(BMXA)
  1.  . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
  1.  . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
  1.  . D SELECT1
  1.  F  S BMXA=$O(BMXF(BMXA)) Q:BMXA=""  D  Q:$D(BMXERR)
  1.  . S BMXB=BMXTK(T)
  1.  . I BMXB="*" D  Q  ;All fields in file BMXA
  1.  . . S BMXB="BMXIEN"
  1.  . . S BMXA=BMXFO(1) ;File defaults to first named file in FROM
  1.  . . S BMXA=BMXFNX(BMXA)
  1.  . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
  1.  . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=".001"
  1.  . . D SELECT1
  1.  . . S BMXB=0 F  S BMXB=$O(^DD(BMXF(BMXA),"B",BMXB)) Q:BMXB=""  D
  1.  . . . S BMXS=BMXA_"."_BMXB
  1.  . . . S BMXFLD(BMXS)=BMXF(BMXA)
  1.  . . . S $P(BMXFLD(BMXS),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
  1.  . . . D SELECT1
  1.  . . . S C=1
  1.  . I $D(^DD(BMXF(BMXA),"B",BMXTK(T))) D  Q:$D(BMXERR)
  1.  . . S C=C+1
  1.  . . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERRTACK^BMXSQL(1) Q
  1.  . . S BMXB=BMXTK(T) ;Field Name
  1.  . . I BMXB["'" S BMXB=$P(BMXB,"'",2)
  1.  . . S BMXFLD(BMXA_"."_BMXB)=BMXF(BMXA)
  1.  . . S $P(BMXFLD(BMXA_"."_BMXB),"^",2)=$O(^DD(BMXF(BMXA),"B",BMXB,0))
  1.  . . D SELECT1
  1.  . . Q
  1.  . Q
  1.  I C=0 S BMXERR="FIELD NOT FOUND" D ERRTACK^BMXSQL(1) Q
  1.  Q
  1.  ;
  1. SELECT1 ;
  1.  N BMXGNOD,BMXFILE,BMXGNOD1
  1.  S BMXFLDN=$P(BMXFLD(BMXA_"."_BMXB),"^",2)
  1.  S BMXFILE=$P(BMXFLD(BMXA_"."_BMXB),U)
  1.  S BMXFLDN(BMXFILE,BMXFLDN)=BMXB
  1.  I BMXFLDN=".001" S BMXGNOD="IEN",BMXGNOD1="",$P(BMXGNOD1,U,2)="N"
  1.  E  S BMXGNOD1=^DD(BMXFILE,BMXFLDN,0)
  1.  S BMXGNOD=$P(BMXGNOD1,"^",4)
  1.  S $P(BMXFLD(BMXA_"."_BMXB),"^",3)=$P(BMXGNOD,";")
  1.  S $P(BMXFLD(BMXA_"."_BMXB),"^",4)=$P(BMXGNOD,";",2)
  1.  S $P(BMXFLD(BMXA_"."_BMXB),"^",5)=BMXINTNL
  1.  S BMXFLDO(BMXFLD)=BMXFILE_"^"_BMXFLDN_"^"_BMXINTNL
  1.  I +$P(BMXGNOD1,U,2) D  ;Check for WP
  1.  . S BMXGNOD1=+$P(BMXGNOD1,U,2)
  1.  . Q:'$D(^DD(BMXGNOD1,.01,0))
  1.  . I $P(^DD(BMXGNOD1,.01,0),U,2)["W" S $P(BMXFLDO(BMXFLD),U,4)="W"
  1.  ;HMW20030630 Modified next line to make data type of Internal[] for pointer an Integer.
  1.  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
  1.  I $P(BMXGNOD1,U,2)["D" S $P(BMXFLDO(BMXFLD),U,5)="D"
  1.  I $P(BMXGNOD1,U,2)["N" D
  1.  . N Z
  1.  . S Z=$P(BMXGNOD1,U,2)
  1.  . I +$P(Z,",",2)=0 S $P(BMXFLDO(BMXFLD),U,5)="I" ;Integer
  1.  S BMXFLDOX(BMXFILE,BMXFLDN,BMXINTNL)=BMXFLD
  1.  S BMXFLD=BMXFLD+1
  1.  S BMXFLDO=BMXFLD
  1.  D SALIAS
  1.  Q
  1.  ;
  1. SETMFL(BMXUPFN,BMXSUBFN,BMXGL,BMXOFF,BMXOTM)       ;EP
  1.  ;
  1.  ;BMXOTM = One-To-Many
  1.  N BMXUPG
  1.  S BMXMFL("PARENT",BMXSUBFN)=BMXUPFN
  1.  S BMXMFL(BMXUPFN,"SUBFILE",BMXSUBFN)=""
  1.  S BMXMFL("SUBFILE",BMXUPFN,BMXSUBFN)=""
  1.  S BMXUPG=BMXMFL(BMXUPFN,"GLOC") ;Parent File Global Set in FROM clause
  1.  S BMXFNAM=BMXA_"."_BMXFNAM ;TODO: Regression test this line with OTM
  1.  I 'BMXOTM S BMXMFL(BMXSUBFN,"GLOC")=BMXUPG_"IEN"_(BMXOFF-1)_","_$C(34)_BMXGL_$C(34)_","
  1.  E  S BMXMFL(BMXSUBFN,"GLOC")=BMXGL,BMXMFL(BMXSUBFN,"OTM")=""
  1.  S BMXMFL(BMXSUBFN,"MULT")="S IEN"_BMXOFF_"=0 F  S IEN"_BMXOFF_"=$O("_BMXMFL(BMXSUBFN,"GLOC")_"IEN"_BMXOFF_")) Q:'+IEN"_BMXOFF_"  "
  1.  I $D(BMXMFL(BMXUPFN,"MULT")) S BMXMFL(BMXSUBFN,"MULT")=BMXMFL(BMXUPFN,"MULT")_" "_BMXMFL(BMXSUBFN,"MULT")
  1.  I 'BMXOTM S BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" F J=0:1:"_BMXOFF_" S BMXIENS=@(""IEN""_J)_"",""_BMXIENS"
  1.  E  S BMXMFL(BMXSUBFN,"IENS")="N J S BMXIENS="""" S J=1 S BMXIENS=@(""IEN""_J)_"",""_BMXIENS"
  1.  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)"
  1.  D F1^BMXSQL(BMXF,BMXFNAM,BMXSUBFN)
  1.  ;
  1.  Q
  1.  ;
  1. PTYPE(BMXGNOD1) ;
  1.  ;Traverse pointer chain to retrieve data type of pointed-to field
  1.  N BMXFILE
  1.  I $P(BMXGNOD1,U,2)'["P" Q BMXGNOD1
  1.  S BMXFILE=$P(BMXGNOD1,U,2)
  1.  S BMXFILE=+$P(BMXFILE,"P",2)
  1.  S BMXGNOD1=$G(^DD(BMXFILE,".01",0))
  1.  S BMXGNOD1=$$PTYPE(BMXGNOD1)
  1.  Q BMXGNOD1