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

BMXSQL91.m

Go to the documentation of this file. 
  1. BMXSQL91 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;
  1.  ;Below is dead code, but keep for later
  1. SETX2 ;Don't need this unless porting to machine with
  1.  ;local variable size limitations
  1.  N F,LVL,ROOT,START
  1.  S LVL=1,START=1
  1.  S ROOT="BMXY"
  1.  F F=1:1:BMXFF D  Q:$D(BMXERR)
  1.  . S BMX=BMXFF(F)
  1.  . I BMX="(" D  Q  ;Increment level
  1.  . . S LVL=LVL+1
  1.  . . ;S ROOT=$S(ROOT["(":$P(ROOT,")")_","_0_")",1:ROOT_"("_0_")")
  1.  . . ;Get operator following close paren corresponding to this open
  1.  . . ;If op = OR then set up FOR loop in zeroeth node
  1.  . . ;if op = AND then set up
  1.  . I BMX=")" D  Q  ;Decrement level
  1.  . . S LVL=LVL-1
  1.  . . I LVL=1,$D(BMXFF(F+1)),BMXFF(F+1)="&" D  Q
  1.  . . . S BMXX=BMXX+1
  1.  . . . S BMXX(BMXX)=""
  1.  . . . F J=START:1:F S BMXX(BMXX)=BMXX(BMXX)_BMXFF(J)
  1.  . . . S START=F+2
  1.  . . . ;S BMXX(BMXX)="I "_BMXX(BMXX)_" X BMXX("_BMXX+1_")"
  1.  . ; I BMX="AND" D  Q  ;Chain to previous expression at current level
  1.  . ; I BMX="OR" D  Q  ;Create FOR-loop to execute screens
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;S F=0 F  S F=$O(BMXMFL(F)) Q:'+F  S:'$D(BMXMFL(F,"SUBFILE")) BMXMFL("NOSUBFILE",F)=""
  1.  ;I $D(BMXMFL("NOSUBFILE")) S F=0 F  S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F  D MAKEC1
  1.  ;I $D(BMXMFL("SUBFILE")) S F=0 F  S F=$O(BMXMFL("SUBFILE",F)) Q:'+F  D MAKEC1 ;S BMXROOTZ=BMXZ+100
  1.  ;
  1.  Q
  1. MAKEC1 ;
  1.  I '$D(BMXMFL(F,"SUBFILE")),'$D(BMXMFL(F,"MULT")) S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" Q
  1.  Q:'$D(BMXMFL(F,"SUBFILE"))
  1.  Q:$D(BMXMFL(F,"MULT"))
  1.  S BMXROOT=F
  1.  S BMXROOTZ=BMXZ+100
  1.  S BMXROOTC=BMXCID
  1.  D MCNT(F)
  1.  Q
  1.  ;
  1. MCNT(F) ;
  1.  N S
  1.  ;B  ;MCNT
  1.  I '$D(BMXMFL(F,"SUBFILE")) D MCNT2 Q
  1.  S S=0 F  S S=$O(BMXMFL(F,"SUBFILE",S)) Q:'+S  S:'$D(BMXCFN(BMXCID,BMXZ,F)) BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,S)="",BMXCFNX(S,F)="" D MCNT(S)
  1.  Q
  1.  ;
  1. MCNT2 ;
  1.  ;B  ;Back-chain
  1.  ;TODO: RESTART HERE -- $O(BMXCFN(BMXCID,0)) NEEDS TO BE CHANGED TO SOMETHING BESIDES 0
  1.  N BMXFTOP,BMXFBACK
  1.  F  S BMXFTOP=$O(BMXCFN(BMXROOTC,BMXROOTZ,0)) Q:BMXFTOP=BMXROOT  S BMXFBACK=$O(BMXCFNX(BMXFTOP,0)) S BMXROOTZ=BMXROOTZ-1,BMXCFN(BMXCID,BMXROOTZ,BMXFBACK)=""
  1.  S BMXCID=BMXCID+1,BMXROOTC=BMXCID
  1.  ;Get the root files
  1.  I $D(BMXMFL("NOSUBFILE")) D
  1.  . N F
  1.  . S F=0 F  S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F  D
  1.  . . Q:$D(BMXMFL(F,"MULT"))
  1.  . . Q:F=BMXROOT
  1.  . . S BMXZ=BMXZ+100
  1.  . . S BMXCFN(BMXCID,BMXZ,F)=""
  1.  S BMXROOTZ=BMXZ+100
  1.  Q
  1.  ;
  1.  ;
  1. ITER ;Iterate through result array A
  1.  S BMXCNT=BMXFLDO ;Field count
  1.  S F=0
  1.  S:BMXNUM ^BMXTEMP($J,I)=IEN0_"^"
  1.  S BMXCNTB=0
  1.  S BMXORD=BMXNUM
  1.  N BMXONOD
  1.  N BMXINT
  1.  ;B  ;WRITE Before REORG
  1.  N M,N S N=0
  1.  D REORG
  1.  ;B  ;WRITE After REORG
  1.  F  S N=$O(M(N)) Q:'+N  D
  1.  . S O=0
  1.  . F O=1:1:$L(M(N),U) S BMXFLDO(O-1,"IEN0")=$P(M(N),U,O)
  1.  . S BMXORD=BMXNUM
  1.  . D OA
  1.  Q
  1.  ;
  1. REORG N R,IEN,J,CONT,TEST
  1.  F R=0:1:BMXFLDO-1 S IEN(R)=0
  1.  F J=1:1 D  Q:'CONT
  1.  . S CONT=0
  1.  . F R=1:1:BMXFLDO D
  1.  . . S TEST=$O(A(+BMXFLDO(R-1),IEN(R-1)))
  1.  . . I +TEST S IEN(R-1)=TEST,CONT=1
  1.  . . S $P(M(J),U,R)=IEN(R-1)
  1.  . Q
  1.  I M(J)=M(J-1) K M(J)
  1.  Q
  1.  ;
  1.  ;
  1. OA ;
  1.  I $D(A) F R=0:1:(BMXFLDO-1) S F=$P(BMXFLDO(R),U,2),BMXFN=$P(BMXFLDO(R),U),BMXINT=$P(BMXFLDO(R),U,3) D  S:(R+1)<BMXFLDO ^BMXTEMP($J,I)=^BMXTEMP($J,I)_U
  1.  . ;S IEN0=BMXFLDO(R,"IEN0") F  S IEN0=$O(A(BMXFN,IEN0)) Q:'+IEN0  Q:$D(A(BMXFN,IEN0,F,BMXINT))
  1.  . S IEN0=BMXFLDO(R,"IEN0")
  1.  . Q:'+IEN0
  1.  . S BMXORD=BMXORD+1
  1.  . I $D(^DD(BMXFN,F,0)),$P(^DD(BMXFN,F,0),U,2) D  I 1 ;Multiple or WP
  1.  . . ;Get the subfile number into FL1
  1.  . . S FL1=+$P(^DD(BMXFN,F,0),U,2)
  1.  . . S FLD1=$O(^DD(FL1,0))
  1.  . . I $P(^DD(FL1,FLD1,0),U,2)["W" D  ;WP
  1.  . . . S WPL=0,BMXLTMP=0
  1.  . . . F  S WPL=$O(A(BMXFN,IEN0,F,WPL)) Q:'WPL  S I=I+1 D
  1.  . . . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,WPL)_" "
  1.  . . . . S BMXLTMP=BMXLTMP+$L(A(BMXFN,IEN0,F,WPL))+1
  1.  . . . . Q
  1.  . . . S:BMXLTMP>BMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP
  1.  . . . Q
  1.  . . D  ;It's a multiple.  Implement in next phase
  1.  . . . ;S BMXMCT=BMXMCT+1
  1.  . . . ;S BMXMCT(BMXMCT)=BMXFN_U_F
  1.  . . . Q  ;Process A( for multiple field
  1.  . . Q
  1.  . E  D  ;Not a multiple
  1.  . . S I=I+1
  1.  . . I $G(BMXTK("DISTINCT"))="TRUE" D  Q
  1.  . . . Q:A(BMXFN,IEN0,F,BMXINT)=""
  1.  . . . I $D(^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))) Q
  1.  . . . S ^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))=""
  1.  . . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT)
  1.  . . . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT))
  1.  . . . Q
  1.  . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT)
  1.  . . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT))
  1.  . Q
  1.  ;---> Set data in result global.
  1.  I $D(^BMXTEMP($J,I)) S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30)
  1. ZZZ Q