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

BMXSQL6.m

Go to the documentation of this file.
  1. BMXSQL6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
  1. ;;4.0;BMX;;JUN 28, 2010
  1. ;
  1. ;
  1. WRITE ;EP
  1. N BMXFN,C,BMXN,BMXGF,BMXA,BMXFLDF,N,A,IEN0,I
  1. N BMXCNT,BMXCNTB,BMXLEN,BMXLTMP,BMXNUM,BMXORD,BMXTYP
  1. N BMXCFN,BMXCFNX,F,BMXROOT,BMXCID,BMXZ ;From MAKEC
  1. N BMXREC,BMXCHAIN ;TODO: COMMENT AFTER TESTING
  1. N BMXIENS
  1. ;Set up FIELD value for GETS^DIQ call
  1. ; BMXFLD("NAME")="FILE#^FIELD#"
  1. ; Need: BMXFLDN(FieldNumber)
  1. ; and : BMXFLDO(SelectOrder)
  1. ; Get file number -- for now just use first file in array
  1. ; TODO: Set up same main file and related files here and in enumerator
  1. S C=0,BMXN=""
  1. N F
  1. S BMXGF=0
  1. S F=0 F S F=$O(BMXF(F)) Q:F="" S BMXFN=BMXF(F) D
  1. . S C=0,BMXN=-1 F S BMXN=$O(BMXFLDO(BMXN)) Q:BMXN="" D
  1. . . Q:$P(BMXFLDO(BMXN),U)'=BMXFN
  1. . . I $P(BMXFLDO(BMXN),U,2)=".001" S BMXGF=BMXGF+1 Q
  1. . . S C=C+1
  1. . . S $P(BMXGF(BMXFN),";",C)=$P(BMXFLDO(BMXN),U,2)
  1. . . S:'$D(BMXGF(BMXFN,"INTERNAL")) BMXGF(BMXFN,"INTERNAL")="E"
  1. . . I $P(BMXFLDO(BMXN),U,3)="I" S BMXGF(BMXFN,"INTERNAL")="IE"
  1. . . S BMXGF=BMXGF+1
  1. . . Q
  1. . Q
  1. ;
  1. I BMXGF>1 K BMXTK("DISTINCT") ;Distinct supported for only one field
  1. S N=0,BMXFLDF=0,I=1,BMXNUM=0
  1. D FIELDS
  1. D MAKEC
  1. ;
  1. ;
  1. I BMXCOL D COLTYPE^BMXSQL,ERRTACK^BMXSQL(I) Q ;Column info only
  1. ;
  1. S BMXA="A"
  1. N G,R
  1. ;---> Loop through results global
  1. F S N=$O(^BMXTMP($J,N)) Q:'+N D
  1. . K A
  1. . S R=0 F S R=$O(BMXFO(R)) Q:'+R D ;For each file in ORDER array
  1. . . S IEN0=0
  1. . . S BMXFN=BMXFO(R)
  1. . . Q:$D(BMXMFL(BMXFN,"MULT"))
  1. . . I R=1 S IEN0=^BMXTMP($J,N) ;Primary file
  1. . . I R>1,$D(BMXFJ("JOIN",BMXFN)) D ;Joined file
  1. . . . S IEN0=0
  1. . . . S G=BMXFJ("JOIN",BMXFN)
  1. . . . S V=BMXFF(G,"JOIN","IEN")
  1. . . . S @V=^BMXTMP($J,N)
  1. . . . X BMXFF(G,"JOIN")
  1. . . I +IEN0 D ;Removed $D(BMXGF(BMXFN)) for mult fld on extdnd ptr
  1. . . . D SUBFILE(BMXFN)
  1. . . I +IEN0,$D(BMXFLDN(BMXFN,.001)) D SETIEN(IEN0,BMXFN)
  1. . . ;
  1. . . I 0,R>1,$D(BMXMFL(BMXFN,"MULT")) D ;Multiple field
  1. . . . Q:'+IEN0
  1. . . . Q:'$D(BMXGF(BMXFN)) ;Intervening multiple
  1. . . . ;Call GETS for each subentry in multiple
  1. . . . X BMXMFL(BMXFN,"EXEC")
  1. . S F=0,BMXCNT=0
  1. . ;
  1. . D RECORD
  1. . D OUT
  1. ;
  1. ;
  1. ;---> Tack on Error Delimiter and any error.
  1. S I=I+1
  1. D ERRTACK^BMXSQL(I)
  1. D COLTYPE^BMXSQL
  1. Q
  1. ;
  1. SETIEN(BMXIEN,BMXFN) ;
  1. ;B ;SETIEN
  1. Q:'$D(BMXFLDN(BMXFN,.001))
  1. Q:'+BMXIEN
  1. S A(BMXFN,BMXIEN_",",.001,"E")=BMXIEN
  1. Q
  1. ;
  1. SUBFILE(BMXFN) ;
  1. ;Execute GETS for Any fields in BMXGF(SUBFILE)
  1. ;
  1. ;If the subfile itself has subfiles, call SUBFILE(BMXSUBFN)
  1. ; (Loop through BMXMFL(BMXFN,"SUBFILE",BMXSUBFN))
  1. I $D(BMXMFL(BMXFN,"SUBFILE")) D
  1. . N BMXSUBFN
  1. . S BMXSUBFN=0
  1. . F S BMXSUBFN=$O(BMXMFL(BMXFN,"SUBFILE",BMXSUBFN)) Q:'+BMXSUBFN D SUBFILE(BMXSUBFN)
  1. . Q
  1. ;
  1. I $D(BMXGF(BMXFN)) D
  1. . I '$D(BMXMFL(BMXFN,"MULT")) S BMXMSCR=1 D GETS^DIQ(BMXFN,IEN0_",",BMXGF(BMXFN),BMXGF(BMXFN,"INTERNAL"),BMXA) Q
  1. . E X BMXMFL(BMXFN,"EXEC") Q
  1. ;
  1. ;
  1. Q
  1. ;
  1. FIELDS ;---> Write Field Names
  1. ;Field name is TAAAAANAME
  1. ;Where T is the field type (T=Text; D=Date)
  1. ; AAAAA is the field size (see NUMCHAR routine)
  1. ; NAME is the field name
  1. N BMXNUM,BMXFNUM,BMXFNAM,R
  1. K BMXLEN,BMXTYP
  1. S BMXFLDF=1
  1. S BMXNUM=0
  1. ;B ;In FIELDS sub
  1. D ;:$D(A)
  1. . I BMXNUM S ^BMXTEMP($J,I)="IEN^",BMXLEN(I)=10,BMXTYP(I)="T",I=I+1 ;TODO: Change from text to number
  1. . S BMXFNUM=0
  1. . S BMXFNAM=0
  1. . F R=0:1:(BMXFLDO-1) S BMXFN=$P(BMXFLDO(R),U),BMXFNUM=$P(BMXFLDO(R),U,2) D
  1. . . ;S BMXFNAM=$P(^DD(BMXFN,BMXFNUM,0),"^") ;Get type here
  1. . . S BMXFNAM=BMXFLDN(BMXFN,BMXFNUM)
  1. . . I $P(BMXFLDO(R),U,3)="I" S BMXFNAM="INTERNAL["_BMXFNAM_"]"
  1. . . S BMXFNAM=$TR(BMXFNAM," ","_")
  1. . . I BMXF>1 S BMXFNAM=$TR($P(BMXFNX(BMXFN),".")," ","_")_"."_BMXFNAM
  1. . . S BMXTYP(I)="T"
  1. . . S:$P(BMXFLDO(R),U,5)="D" BMXTYP(I)="D"
  1. . . S:$P(BMXFLDO(R),U,5)="I" BMXTYP(I)="I"
  1. . . S BMXLEN(I)=0 ;Start with length zero
  1. . . ;I $D(BMXFLDA(BMXFN,BMXFNUM)) S BMXFNAM=BMXFLDA(BMXFN,BMXFNUM)
  1. . . I $P(BMXFLDO(R),U,6)]"" S BMXFNAM=$P(BMXFLDO(R),U,6)
  1. . . S ^BMXTEMP($J,I)=BMXFNAM_"^"
  1. . . S I=I+1
  1. . S ^BMXTEMP($J,I-1)=$E(^BMXTEMP($J,I-1),1,$L(^BMXTEMP($J,I-1))-1)_$C(30)
  1. Q
  1. ;
  1. OUT ;
  1. ;Output to BMXTEMP($J
  1. Q:'$D(BMXREC)
  1. N J,K,L,BMXLENT
  1. S J=0 F S J=$O(BMXREC(J)) Q:'+J D
  1. . S K=0 F S K=$O(BMXREC(J,K)) Q:'+K D
  1. . . I +$O(BMXREC(J,K,0)) D Q ;WP
  1. . . . S L=0,BMXLENT=0 F S L=$O(BMXREC(J,K,L)) Q:'+L D
  1. . . . . S:'$D(^BMXTEMP($J,I)) ^BMXTEMP($J,I)=""
  1. . . . . S:$L(^BMXTEMP($J,I))>250 I=I+1,^BMXTEMP($J,I)=""
  1. . . . . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXREC(J,K,L)
  1. . . . . S BMXLENT=BMXLENT+$L(BMXREC(J,K,L))
  1. . . . I BMXLEN(K)<BMXLENT S BMXLEN(K)=BMXLENT
  1. . . S:'$D(^BMXTEMP($J,I)) ^BMXTEMP($J,I)=""
  1. . . S:$L(^BMXTEMP($J,I))>250 I=I+1,^BMXTEMP($J,I)=""
  1. . . I $G(BMXTK("DISTINCT"))="TRUE",BMXREC(J,K)]"" Q:$D(^BMXTEMP($J,"DISTINCT",BMXREC(J,K)))
  1. . . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_BMXREC(J,K)
  1. . . S:$L(BMXREC(J,K))>BMXLEN(K) BMXLEN(K)=$L(BMXREC(J,K))
  1. . . I $G(BMXTK("DISTINCT"))="TRUE" S ^BMXTEMP($J,"DISTINCT",BMXREC(J,K))=""
  1. Q
  1. ;
  1. RECORD ;
  1. ;For each chain
  1. N C,BMXCQ,BMXLCQ,BMXCQN,BMXLCQN,BMXTRACK,BMXNODE,BMXCNAME,BMXWP
  1. K BMXREC,BMXCHAIN ;TODO: REMOVE AFTER TESTING
  1. D BLDCHN
  1. S BMXREC=0
  1. D RECINI
  1. S C=0 F S C=$O(BMXCHAIN(C)) Q:'+C D
  1. . ;New chain
  1. . ;Go to the end of the chain, writing record pieces as you go
  1. . ;At the end of the chain, write end-of-record marker,increment record counter, copy previous record
  1. . K BMXTRACK
  1. . S BMXCNAME="BMXCHAIN("_C_")"
  1. . S BMXCQN=""
  1. . S BMXCQ=BMXCNAME F S BMXCQ=$Q(@BMXCQ) Q:BMXCQ="" Q:$P(BMXCQ,",")'=("BMXCHAIN("_C) D
  1. . . S BMXNODE=@BMXCQ
  1. . . I $P(BMXNODE,U,2)="" Q
  1. . . S BMXWP=$P(BMXNODE,U,3)
  1. . . S BMXLCQ=$L(BMXCQ,",")
  1. . . S BMXCQN=$Q(@BMXCQ)
  1. . . S BMXLCQN=$L(BMXCQN,",")
  1. . . I BMXWP="W" D
  1. . . . S BMXREC(BMXREC,$P(BMXNODE,U,2),$P(BMXNODE,U,4))=$P(BMXNODE,U)
  1. . . . S BMXTRACK(BMXLCQ-1,$P(BMXNODE,U,2))=BMXNODE
  1. . . E D
  1. . . . S BMXREC(BMXREC,$P(BMXNODE,U,2))=$P(BMXNODE,U)_U
  1. . . . S BMXTRACK(BMXLCQ,$P(BMXNODE,U,2))=BMXNODE
  1. . . I BMXCQN="" D EOR Q
  1. . . I $P(BMXCQN,",")'=("BMXCHAIN("_C) D EOR Q
  1. . . I BMXLCQN>BMXLCQ Q
  1. . . I (BMXLCQN>$S(BMXWP="W":7,1:6)) D Q
  1. . . . I ($P(BMXCQ,",",1,BMXLCQ-2)=$P(BMXCQN,",",1,BMXLCQN-2)) Q
  1. . . . D EOR ;End of chain
  1. Q
  1. ;
  1. RECINI ;
  1. N J
  1. S BMXREC=BMXREC+1
  1. F J=1:1:BMXFLDO D
  1. . I $P(BMXFLDO(J-1),U,4)="W" S BMXREC(BMXREC,J,999999)="^" Q
  1. . S BMXREC(BMXREC,J)="^"
  1. Q
  1. ;
  1. EOR ;
  1. ;B ;EOR
  1. N J,K,L,M,I,N
  1. S M=$Q(BMXREC(9999999),-1)
  1. S @M=$TR(@M,"^",$C(30))
  1. Q:BMXCQN=""
  1. I BMXCQN'="" D RECINI
  1. ;K BMXTRACK(BMXLCQ) ;Also kill all track levels between current and next level
  1. F K BMXTRACK($O(BMXTRACK(999999),-1)) Q:$O(BMXTRACK(9999999),-1)'>BMXLCQN
  1. S J=0 F S J=$O(BMXTRACK(J)) Q:'+J D ;Level
  1. . S K=0 F S K=$O(BMXTRACK(J,K)) Q:'+K D ;Order
  1. . . I $D(BMXTRACK(J,K)) S BMXNODE=BMXTRACK(J,K) S BMXREC(BMXREC,$P(BMXNODE,U,2))=$P(BMXNODE,U)_U
  1. . . S L=0 F S L=$O(BMXTRACK(J,K,L)) Q:'+L D ;wp node
  1. . . . I $D(BMXTRACK(J,K,L)) S BMXNODE=BMXTRACK(J,K,L) S BMXREC(BMXREC,$P(BMXNODE,U,2),L)=$P(BMXNODE,U)
  1. Q
  1. ;
  1. BLDCHN ;
  1. N B
  1. D MAKEB
  1. ;D MAKEC
  1. D BUILD
  1. Q
  1. ;
  1. MAKEC ;
  1. ;MAKE Chain
  1. ;How many chains are there?
  1. S BMXZ=0 S BMXCID=1 K BMXCFN
  1. ;
  1. ;
  1. ;Create BMXCHNP(BMXCID)
  1. S F=0 F S F=$O(BMXMFL(F)) Q:'+F I '$D(BMXMFL("SUBFILE",F)),$D(BMXMFL("PARENT",F)) S BMXMFL("BOTTOM",F)=""
  1. N BMXCB,BMXCHNP,BMXP
  1. S BMXCID=0,BMXCB=0,BMXCHNP=0
  1. I $D(BMXMFL("BOTTOM")) F S BMXCB=$O(BMXMFL("BOTTOM",BMXCB)) Q:'BMXCB D
  1. . S BMXCID=BMXCID+1,BMXCHNP=BMXCID
  1. . S BMXCHNP(BMXCID)=BMXCB
  1. . S BMXP=BMXCB
  1. . F Q:'$D(BMXMFL("PARENT",BMXP)) S BMXP=BMXMFL("PARENT",BMXP) S BMXCHNP(BMXCID)=BMXP_U_BMXCHNP(BMXCID)
  1. ;
  1. N J,K,L,M
  1. ;Create BMXMFL("BASE")="FILE1^FILE2^...^FILEN"
  1. 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
  1. ;
  1. ;Create BMXCFN(BMXCID,BMXZ,FILE)
  1. I BMXCID=0 S BMXCID=1
  1. S J=0,BMXZ=0 F J=1:1:BMXCID D
  1. . I BMXMFL("BASE")]"" F L=1:1:$L(BMXMFL("BASE"),"^") S F=$P(BMXMFL("BASE"),"^",L) D
  1. . . S BMXZ=BMXZ+100
  1. . . S BMXCFN(J,BMXZ,F)=""
  1. . I +BMXCHNP F K=1:1:$L(BMXCHNP(J),"^") S F=$P(BMXCHNP(J),"^",K) D
  1. . . Q:F=BMXFO(1) ;BMXFO(1) Is always a member of the base
  1. . . S BMXZ=BMXZ+100
  1. . . S BMXCFN(J,BMXZ,F)=""
  1. ;
  1. ;
  1. ;B ;FIXCFN
  1. D FIXCFN
  1. Q
  1. ;
  1. BUILD ;Building BMXCHAIN(
  1. N BMXIEN,BMXCID,BMXFLD,BMXCS,BMXINT,BMXCFNC,BMXCFIEN
  1. S BMXCID=0,BMXIEN=0
  1. F S BMXCID=$O(BMXCFN(BMXCID)) Q:'+BMXCID D
  1. . S BMXCFNC=0 F S BMXCFNC=$O(BMXCFN(BMXCID,BMXCFNC)) Q:'+BMXCFNC S BMXCFN=+BMXCFN(BMXCID,BMXCFNC) D
  1. . . S BMXIEN=0 F S BMXIEN=$O(B(BMXCFN,BMXIEN)) Q:BMXIEN="" D
  1. . . . S $P(BMXCFN(BMXCID,BMXCFNC),U,2)=BMXIEN
  1. . . . S BMXFLD=0 F S BMXFLD=$O(B(BMXCFN,BMXIEN,BMXFLD)) Q:'+BMXFLD D
  1. . . . . S BMXINT="D" F S BMXINT=$O(B(BMXCFN,BMXIEN,BMXFLD,BMXINT)) Q:BMXINT="" D
  1. . . . . . Q:'$D(BMXFLDOX(BMXCFN,BMXFLD,BMXINT))
  1. . . . . . I $P(BMXFLDO(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)),U,4)="W" D MCWP Q
  1. . . . . . D FIXIEN
  1. . . . . . S BMXCS="BMXCHAIN("_BMXCID_","_$S($L(BMXIEN,",")=2:1,1:2)_","_BMXCFIEN_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_")"
  1. . . . . . S @BMXCS=B(BMXCFN,BMXIEN,BMXFLD,BMXINT)_U_(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)+1)
  1. Q
  1. ;
  1. FIXIEN ;
  1. N BMXC,BMXCFN1,BMXOFF
  1. S BMXC=BMXCFNC
  1. S BMXCFIEN=BMXCFN_","_$P(BMXIEN,",",$L(BMXIEN,","))
  1. S BMXOFF=1
  1. F S BMXC=$O(BMXCFN(BMXCID,BMXC),-1) Q:'+BMXC D
  1. . S BMXCFN1=+BMXCFN(BMXCID,BMXC)
  1. . I '$D(BMXMFL(BMXCFN,"OTM")) D
  1. . . I '$D(BMXMFL(BMXCFN1,"SUBFILE",BMXCFN)) Q
  1. . . S BMXCFIEN=BMXCFN1_","_$P(BMXIEN,",",$L(BMXIEN,",")-BMXOFF)_","_BMXCFIEN
  1. . I $D(BMXMFL(BMXCFN,"OTM")) D
  1. . . I '$D(BMXMFL(BMXCFN1,"SUBFILE",BMXCFN)) Q
  1. . . S BMXCFIEN=BMXCFN1_$P(BMXCFN(BMXCID,BMXC),U,2)_","_BMXCFIEN
  1. . S BMXOFF=BMXOFF+1
  1. ;
  1. ;
  1. Q
  1. ;
  1. FIXCFN ;
  1. N J,K,L
  1. S J=0 F S J=$O(BMXCFN(J)) Q:'+J D
  1. . S K=0 F S K=$O(BMXCFN(J,K)) Q:'+K D
  1. . . S L=0 F S L=$O(BMXCFN(J,K,L)) Q:'+L D
  1. . . . K BMXCFN(J,K,L)
  1. . . . S BMXCFN(J,K)=L
  1. ;
  1. Q
  1. ;
  1. MCWP ;
  1. ;MAKEC Process WP Field
  1. N BMXIENL,BMXWP
  1. S BMXIENL=1
  1. S:$L(BMXIEN,",")>2 BMXIENL=2
  1. S BMXWP=0
  1. ;
  1. F S BMXWP=$O(B(BMXCFN,BMXIEN,BMXFLD,BMXWP)) Q:'+BMXWP D
  1. . S BMXCS="BMXCHAIN("_BMXCID_","_BMXIENL_","_BMXCFN_BMXIEN_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_","_BMXWP_")"
  1. . S @BMXCS=B(BMXCFN,BMXIEN,BMXFLD,BMXWP)_U_(BMXFLDOX(BMXCFN,BMXFLD,BMXINT)+1)_U_"W"_U_BMXWP
  1. Q
  1. ;
  1. ;
  1. MAKEB ;
  1. N BMXFILE,BMXIEN,BMXFLD,BMXINT
  1. N BMXSUB,BMXIENR
  1. S BMXFILE=0 F S BMXFILE=$O(A(BMXFILE)) Q:'+BMXFILE D
  1. . S BMXIEN=0 F S BMXIEN=$O(A(BMXFILE,BMXIEN)) Q:'+BMXIEN D
  1. . . S BMXFLD=0 F S BMXFLD=$O(A(BMXFILE,BMXIEN,BMXFLD)) Q:'+BMXFLD D
  1. . . . S BMXINT=0 F S BMXINT=$O(A(BMXFILE,BMXIEN,BMXFLD,BMXINT)) Q:BMXINT="" D
  1. . . . . S BMXIENR=$$REVERSE(BMXIEN)
  1. . . . . S BMXSUB="B("_BMXFILE_","_$C(34)_BMXIENR_$C(34)_","_BMXFLD_","_$C(34)_BMXINT_$C(34)_")"
  1. . . . . I $D(BMXFLDOX(BMXFILE,BMXFLD,BMXINT)),$P(BMXFLDO(BMXFLDOX(BMXFILE,BMXFLD,BMXINT)),U,5)="D" D Q
  1. . . . . . S @BMXSUB=$TR(A(BMXFILE,BMXIEN,BMXFLD,BMXINT),"@"," ")
  1. . . . . S @BMXSUB=A(BMXFILE,BMXIEN,BMXFLD,BMXINT)
  1. Q
  1. ;
  1. REVERSE(BMXIEN) ;
  1. N J,T,C
  1. S C=1
  1. F J=$L(BMXIEN,","):-1:1 D
  1. . S $P(T,",",C)=$P(BMXIEN,",",J)
  1. . S C=C+1
  1. Q T