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

BMXSQL7.m

Go to the documentation of this file. 
  1. BMXSQL7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;
  1.  ;
  1. CHKCR(BMXFNUM,BMXFLDNU,BMXRET) ;Returns cross reference to iterate on for related file
  1.  N BMXREF,BMXHIT,BMXRNOD,BMXTMP,BMXTMPV,BMXTMPI,BMXTMPP,BMXPFFN,BMXPFF,Q
  1.  N BMXHIT,BMXREF,BMXGL,BMXNOD,BMXRNAM,BMXTMPL,BMXTMPN,BMXTST
  1.  ;
  1.  S BMXNOD=^DD(BMXFNUM,BMXFLDNU,0)
  1.  S BMXGL=^DIC(BMXFNUM,0,"GL") ;Subfile global
  1.  S BMXREF=0,BMXHIT=0,Q=$C(34),BMXRET=""
  1.  F  S BMXREF=$O(^DD(BMXFNUM,BMXFLDNU,1,BMXREF)) Q:'+BMXREF  D  Q:BMXHIT
  1.  . Q:'$D(^DD(BMXFNUM,BMXFLDNU,1,BMXREF,0))
  1.  . S BMXRNOD=^DD(BMXFNUM,BMXFLDNU,1,BMXREF,0)
  1.  . Q:$P(BMXRNOD,U,3)]""
  1.  . S BMXRNAM=$P(BMXRNOD,U,2)
  1.  . S BMXTMP=BMXGL_Q_BMXRNAM_Q_")"
  1.  . S BMXTST=$P(BMXTMP,")")_",IEN0,"
  1.  . Q:'$D(@BMXTMP)
  1.  . S BMXTMPV=0,BMXTMPV=$O(@BMXTMP@(BMXTMPV))
  1.  . Q:BMXTMPV=""
  1.  . S BMXTMP=BMXGL_Q_BMXRNAM_Q_","_Q_BMXTMPV_Q_")"
  1.  . S BMXTMPI=0,BMXTMPI=$O(@BMXTMP@(BMXTMPI))
  1.  . S BMXTMP=$S(BMXGL[",":$P(BMXGL,",")_")",1:$P(BMXGL,"("))
  1.  . Q:'$D(@BMXTMP@(BMXTMPI))
  1.  . S BMXTMPL=$P(BMXNOD,U,4)
  1.  . S BMXTMPP=$P(BMXTMPL,";",2)
  1.  . S BMXTMPL=$P(BMXTMPL,";")
  1.  . Q:BMXTMPL=""
  1.  . S BMXTMP=BMXGL_BMXTMPI_")"
  1.  . Q:'$D(@BMXTMP@(BMXTMPL))
  1.  . S BMXTMPN=@BMXTMP@(BMXTMPL)
  1.  . S BMXTMPP=$P(BMXTMPN,"^",BMXTMPP)
  1.  . I BMXTMPP=BMXTMPV S BMXRET=BMXTST,BMXHIT=1
  1.  Q BMXHIT
  1.  ;
  1.  ;
  1. WHERE ;EP - WHERE-clause processing
  1.  ;
  1.  ;Set up the defualt iterator in BMXX(1) to scan the entire file.
  1.  ;For now, just use first file in the FROM group
  1.  ;Later, pick the smallest file if more than one file
  1.  ;
  1.  ;Set up BMXFF array for each expression element
  1.  ;  BMXFF(n)=FILENAME^FIELDNAME^OPERATOR^VALUE^FILENUMBER^FIELDNUMBER
  1.  ;           ^FILE GLOBAL^FIELD DATA LOCATION
  1.  ;  BMXFF(n,0)=Field descriptor ^DD(FILE,FIELD,0)
  1.  ;
  1.  N BMXGL,BMXOP,BMXTYP,BMXV,BMXV1,BMXV2,BMXFILE,BMXTMP
  1.  N BMXINTNL,BMXTMPLT
  1.  N BMXIEN
  1.  S BMXGL=^DIC(BMXFO(1),0,"GL")
  1.  S BMXX=1
  1.  S BMXX(1)="S D0=0 F  S D0=$O("_BMXGL_"D0)) Q:'+D0  Q:BMXM>BMXXMAX  "
  1.  S BMXTMP=BMXGL
  1.  I BMXTMP["," S BMXTMP=$TR(BMXTMP,",",")")
  1.  E  S BMXTMP=$P(BMXTMP,"(",1)
  1.  I $D(@BMXTMP@("B")) D
  1.  . S BMXX(1)="S BMXTMP=0 F  S BMXTMP=$O("_BMXGL_$C(34)_"B"_$C(34)_",BMXTMP)) Q:BMXTMP=""""  S D0=0 F  S D0=$O("_BMXGL_$C(34)_"B"_$C(34)_",BMXTMP,D0)) Q:'+D0  Q:BMXM>BMXXMAX  "
  1.  ;
  1.  ;--->BMXFF array:
  1.  ;
  1.  S T=$G(BMXTK("WHERE"))
  1.  S BMXFF=0,C=0
  1.  Q:'+T
  1.  F  S T=$O(BMXTK(T)) Q:'+T  Q:T=$G(BMXTK("ORDER BY"))  Q:T=$G(BMXTK("GROUP BY"))  D  Q:$D(BMXERR)
  1.  . ;Get the file of the field
  1.  . I "AND^OR^(^)"[BMXTK(T) D  Q
  1.  . . S C=C+1
  1.  . . S BMXFF(C)=BMXTK(T)
  1.  . . S BMXFF=C
  1.  . S BMXTK(T)=$TR(BMXTK(T),"_"," ")
  1.  . S BMXTK(T)=$TR(BMXTK(T),"'","")
  1.  . S BMXINTNL=0
  1.  . S BMXTMPLT=0
  1.  . S BMXIEN=0
  1.  . I BMXTK(T)["INTERNAL[" S BMXINTNL=1,BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1)
  1.  . I BMXTK(T)["TEMPLATE[" S BMXTMPLT=1,BMXTK(T)=$P(BMXTK(T),"[",2),BMXTK(T)=$P(BMXTK(T),"]",1),BMXIEN=1
  1.  . I BMXTK(T)["BMXIEN" S BMXIEN=1
  1.  . S BMXFILE=$$FLDFILE^BMXSQL2(BMXTK(T))
  1.  . Q:$D(BMXERR)
  1.  . S C=C+1
  1.  . S BMXFF=C ;This is a count of the where fields
  1.  . I BMXFILE]"" D
  1.  . . S $P(BMXFF(C),U,1)=$P(BMXFILE,U,1) ;FILENAME
  1.  . . S $P(BMXFF(C),U,2)=$P(BMXFILE,U,2) ;FIELDNAME
  1.  . . S $P(BMXFF(C),U,5)=$P(BMXFILE,U,3) ;FILENUMBER
  1.  . . S $P(BMXFF(C),U,6)=$P(BMXFILE,U,4) ;FIELDNUMBER
  1.  . . I $P(BMXFILE,U,3),$D(^DIC($P(BMXFILE,U,3),0,"GL")) S $P(BMXFF(C),U,7)=^DIC($P(BMXFILE,U,3),0,"GL")
  1.  . . I BMXIEN S BMXFF(C,0)="IEN",BMXFF(C,"IEN")=1,BMXFF(C,"TYPE")="IEN"
  1.  . . E  S BMXFF(C,0)=$S(+$P(BMXFILE,U,3):^DD($P(BMXFILE,U,3),$P(BMXFILE,U,4),0),1:"")
  1.  . . I BMXINTNL S BMXFF(C,"INTERNAL")=1
  1.  . ;
  1.  . ;If BMXFF(C) is a pointer, traverse pointer chain to retrieve type
  1.  . I $P(BMXFF(C,0),U,2)["P" D
  1.  . . ;B  ;WHERE Pointer Type
  1.  . . N BMXFILN,BMXFLDN,BMXDD
  1.  . . S BMXDD=BMXFF(C,0)
  1.  . . F  Q:$P(BMXDD,U,2)'["P"  D:$P(BMXDD,U,2)["P"
  1.  . . . S BMXFILN=$P(BMXDD,U,2)
  1.  . . . S BMXFILN=+$P(BMXFILN,"P",2)
  1.  . . . S BMXDD=^DD(BMXFILN,".01",0)
  1.  . . S BMXFF(C,"TYPE")=$S($P(BMXDD,U,2)["D":"DATE",$P(BMXDD,U,2)["S":"SET",1:"OTHER")
  1.  . . I BMXFF(C,"TYPE")="SET" S $P(BMXFF(C,"TYPE"),U,2)=$P(BMXDD,U,3)
  1.  . ;B  ;WHERE Set Type
  1.  . I ($P(BMXFF(C,0),U,2)["S")!($P($G(BMXFF(C,"TYPE")),U)="SET") D  ;Set
  1.  . . N BMXSET,BMXSETP
  1.  . . I $P(BMXFF(C,0),U,2)["S" D
  1.  . . . S BMXFF(C,"TYPE")="SET"
  1.  . . . S $P(BMXFF(C,"TYPE"),U,2)=$P(BMXFF(C,0),U,3)
  1.  . . S BMXSET=$P(BMXFF(C,"TYPE"),U,2)
  1.  . . F J=1:1:$L(BMXSET,";") D
  1.  . . . S BMXSETP=$P(BMXSET,";",J)
  1.  . . . Q:BMXSETP=""
  1.  . . . S BMXFF(C,"SET",$P(BMXSETP,":",2))=$P(BMXSETP,":")
  1.  . ;
  1.  . ;Set up comparisons based on operators
  1.  . S T=T+1
  1.  . S BMXOP=BMXTK(T)
  1.  . I BMXTMPLT S BMXOP="="
  1.  . I "^<^>^=^[^<>^>=^<=^LIKE"[BMXOP D  Q
  1.  . . S $P(BMXFF(C),U,3)=BMXTK(T)
  1.  . . ;Get the comparison value
  1.  . . S T=T+1
  1.  . . S BMXTMP=BMXTK(T)
  1.  . . S BMXTMP=$TR(BMXTMP,"'","")
  1.  . . I BMXOP="LIKE" S BMXTMP=$P(BMXTMP,"%"),$P(BMXFF(C),U,4)=BMXTMP Q
  1.  . . I BMXTMPLT D TMPLATE Q
  1.  . . I BMXTMP="*" S T=T+1,BMXTMP=BMXTK(T) D OTM Q
  1.  . . I BMXTMP[".",BMXTK(T)'["'" D  ;This is a join  ;TODO: Extended pointers
  1.  . . . ;Setting BMXFJ("JOIN"
  1.  . . . S BMXTMP=BMXTK(T)
  1.  . . . I $D(BMXF($P(BMXTMP,"."))),BMXF($P(BMXTMP,"."))=BMXFO(1) D  Q
  1.  . . . . S BMXTMP=BMXTK(T-2)
  1.  . . . . D OTM
  1.  . . . N BMXJN
  1.  . . . S BMXFF(C,"JOIN")="Pointer chain"
  1.  . . . S BMXJN=+$P($P(BMXFF(C,0),U,2),"P",2)
  1.  . . . S BMXFJ("JOIN",+$P($P(BMXFF(C,0),U,2),"P",2))=C
  1.  . . . S:+$P($P(BMXFF(C,0),U,2),"P",2)=2 BMXFJ("JOIN",9000001)=C ;IHS Only -- auto join PATIENT to VA PATIENT
  1.  . . I ($P(BMXFF(C,0),U,2)["D")!($G(BMXFF(C,"TYPE"))="DATE") D  ;Date
  1.  . . . Q:$D(BMXFF(C,"INTERNAL"))
  1.  . . . I BMXTMP]"" S X=BMXTMP,%DT="T" D ^%DT S BMXTMP=Y
  1.  . . I $P($G(BMXFF(C,"TYPE")),U)="SET" D
  1.  . . . Q:$D(BMXFF(C,"INTERNAL"))
  1.  . . . Q:BMXTMP=""
  1.  . . . I $G(BMXFF(C,"SET",BMXTMP))="" S BMXTMP="ZZZZZZ" Q
  1.  . . . S BMXTMP=$G(BMXFF(C,"SET",BMXTMP))
  1.  . . S $P(BMXFF(C),U,4)=BMXTMP
  1.  . . Q
  1.  . I BMXOP="BETWEEN" D
  1.  . . S $P(BMXFF(C),U,3)="BETWEEN"
  1.  . . ;Get the comparison value
  1.  . . S T=T+1
  1.  . . S BMXV1=BMXTK(T)
  1.  . . S:BMXV1["'" BMXV1=$P(BMXV1,"'",2)
  1.  . . S T=T+1
  1.  . . I BMXTK(T)'="AND" S BMXERR="'BETWEEN' VALUES NOT SPECIFIED" D ERROR Q
  1.  . . S T=T+1
  1.  . . S BMXV2=BMXTK(T)
  1.  . . S:BMXV2["'" BMXV2=$P(BMXV2,"'",2)
  1.  . . I ($P(BMXFF(C,0),U,2)["D")!($G(BMXFF(C,"TYPE"))="DATE") D  ;Date
  1.  . . . Q:$D(BMXFF(C,"INTERNAL"))
  1.  . . . S X=BMXV1,%DT="T" D ^%DT S BMXV1=Y
  1.  . . . S X=BMXV2,%DT="T" D ^%DT S BMXV2=Y
  1.  . . I BMXV1>BMXV2 S BMXTMP=BMXV1,BMXV1=BMXV2,BMXV2=BMXTMP
  1.  . . S $P(BMXFF(C),U,4)=BMXV1_"~"_BMXV2
  1.  . . Q
  1.  . I $P(BMXFF(C),U,3)="" S BMXERR="INVALID OPERATOR" D ERROR Q
  1.  . I $D(BMXTK(T+1)),BMXTK(T+1)["[INDEX:" D
  1.  . . S T=T+1
  1.  . . N BMXIND
  1.  . . S BMXIND=$P(BMXTK(T),"INDEX:",2)
  1.  . . S:BMXIND["]" BMXIND=$P(BMXIND,"]")
  1.  . . S:BMXIND["'" BMXIND=$P(BMXIND,"'",2)
  1.  . . S BMXFF("INDEX")=BMXIND
  1.  . Q
  1.  ;
  1.  Q:$D(BMXERR)
  1.  D JOIN^BMXSQL4
  1.  Q
  1.  ;
  1. TMPLATE ;
  1.  N BMXTNUM,BMXTNOD
  1.  I BMXTMP["[" S BMXTMP=$P(BMXTMP,"[",2),BMXTMP=$P(BMXTMP,"]")
  1.  S BMXTMP=$TR(BMXTMP,"_"," ")
  1.  ;Test template validity
  1.  I '$D(^DIBT("B",BMXTMP)) S BMXERR="TEMPLATE NOT FOUND" D ERROR Q
  1.  S BMXTNUM=$O(^DIBT("B",BMXTMP,0))
  1.  I '$D(^DIBT(BMXTNUM,0)) S BMXERR="TEMPLATE NOT FOUND" D ERROR Q
  1.  S BMXTNOD=^DIBT(BMXTNUM,0)
  1.  I $P(BMXTNOD,U,4)'=$P(BMXFF(C),U,5) S BMXERR="TEMPLATE DOES NOT MATCH FILE" D ERROR Q
  1.  I '$D(^DIBT(BMXTNUM,1)) S BMXERR="TEMPLATE HAS NO ENTRIES" D ERROR Q
  1.  S BMXFF(C,0)="IEN",BMXFF(C,"IEN")="TEMPLATE",BMXFF(C,"TYPE")="IEN"
  1.  S $P(BMXFF(C),U,4)=BMXTMP
  1.  ;
  1.  Q
  1.  ;
  1. OTM ;One-To-Many
  1.  N BMXUPFN,BMXSUBFN,BMXA,BMXB,BMXSBFLD,BMXFNAM
  1.  I BMXTMP["INTERNAL[" S BMXTMP=$P(BMXTMP,"INTERNAL[",2),BMXTMP=$P(BMXTMP,"]")
  1.  S BMXUPFN=BMXFO(1)
  1.  S BMXA=$TR($P(BMXTMP,"."),"_"," ")
  1.  S BMXB=$TR($P(BMXTMP,".",2),"_"," ")
  1.  S BMXFNAM=BMXB ;Required by SETMFL.  Won't work if filename BMXB [ "."
  1.  ;Get the subfile
  1.  I '$D(BMXF(BMXA)) S BMXERR="Related File Not Found" Q
  1.  S BMXSUBFN=BMXF(BMXA)
  1.  I '$D(^DD(BMXSUBFN,0)) S BMXERR="Related file not found" Q
  1.  ;Get the field that points to the main file
  1.  I '$D(^DD(BMXSUBFN,"B",BMXB)) S BMXERR="Related field not found" Q
  1.  S BMXSBFLD=$O(^DD(BMXSUBFN,"B",BMXB,0))
  1.  I '+BMXSBFLD S BMXERR="Related field not found" Q
  1.  ;
  1.  ;Find a normal index on that field
  1.  ;Set up for call to CHKCR^BMXSQL7
  1.  N BMXEXEC
  1.  I '$$CHKCR^BMXSQL7(BMXSUBFN,BMXSBFLD,.BMXEXEC) S BMXERR="Related File not indexed" Q
  1.  ;
  1.  ;
  1.  S BMXFF(C,"JOIN")="One-to-many Join"
  1.  ;
  1.  ;Call SETMFL^BMXSQL5 to set up the iteration code
  1.  D SETMFL^BMXSQL5(BMXUPFN,BMXSUBFN,BMXEXEC,1,1)
  1.  ;
  1.  ;
  1.  ;Upfile is the mainfile, Subfile is the related file
  1.  ;BMXOFF is 1 but What is BMXGL?
  1.  ;
  1.  Q
  1.  ;
  1. ERROR Q