BMXSQL91 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;4.0;BMX;;JUN 28, 2010
;
;Below is dead code, but keep for later
SETX2 ;Don't need this unless porting to machine with
;local variable size limitations
N F,LVL,ROOT,START
S LVL=1,START=1
S ROOT="BMXY"
F F=1:1:BMXFF D Q:$D(BMXERR)
. S BMX=BMXFF(F)
. I BMX="(" D Q ;Increment level
. . S LVL=LVL+1
. . ;S ROOT=$S(ROOT["(":$P(ROOT,")")_","_0_")",1:ROOT_"("_0_")")
. . ;Get operator following close paren corresponding to this open
. . ;If op = OR then set up FOR loop in zeroeth node
. . ;if op = AND then set up
. I BMX=")" D Q ;Decrement level
. . S LVL=LVL-1
. . I LVL=1,$D(BMXFF(F+1)),BMXFF(F+1)="&" D Q
. . . S BMXX=BMXX+1
. . . S BMXX(BMXX)=""
. . . F J=START:1:F S BMXX(BMXX)=BMXX(BMXX)_BMXFF(J)
. . . S START=F+2
. . . ;S BMXX(BMXX)="I "_BMXX(BMXX)_" X BMXX("_BMXX+1_")"
. ; I BMX="AND" D Q ;Chain to previous expression at current level
. ; I BMX="OR" D Q ;Create FOR-loop to execute screens
;
Q
;
;
;S F=0 F S F=$O(BMXMFL(F)) Q:'+F S:'$D(BMXMFL(F,"SUBFILE")) BMXMFL("NOSUBFILE",F)=""
;I $D(BMXMFL("NOSUBFILE")) S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D MAKEC1
;I $D(BMXMFL("SUBFILE")) S F=0 F S F=$O(BMXMFL("SUBFILE",F)) Q:'+F D MAKEC1 ;S BMXROOTZ=BMXZ+100
;
Q
MAKEC1 ;
I '$D(BMXMFL(F,"SUBFILE")),'$D(BMXMFL(F,"MULT")) S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" Q
Q:'$D(BMXMFL(F,"SUBFILE"))
Q:$D(BMXMFL(F,"MULT"))
S BMXROOT=F
S BMXROOTZ=BMXZ+100
S BMXROOTC=BMXCID
D MCNT(F)
Q
;
MCNT(F) ;
N S
;B ;MCNT
I '$D(BMXMFL(F,"SUBFILE")) D MCNT2 Q
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)
Q
;
MCNT2 ;
;B ;Back-chain
;TODO: RESTART HERE -- $O(BMXCFN(BMXCID,0)) NEEDS TO BE CHANGED TO SOMETHING BESIDES 0
N BMXFTOP,BMXFBACK
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)=""
S BMXCID=BMXCID+1,BMXROOTC=BMXCID
;Get the root files
I $D(BMXMFL("NOSUBFILE")) D
. N F
. S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D
. . Q:$D(BMXMFL(F,"MULT"))
. . Q:F=BMXROOT
. . S BMXZ=BMXZ+100
. . S BMXCFN(BMXCID,BMXZ,F)=""
S BMXROOTZ=BMXZ+100
Q
;
;
ITER ;Iterate through result array A
S BMXCNT=BMXFLDO ;Field count
S F=0
S:BMXNUM ^BMXTEMP($J,I)=IEN0_"^"
S BMXCNTB=0
S BMXORD=BMXNUM
N BMXONOD
N BMXINT
;B ;WRITE Before REORG
N M,N S N=0
D REORG
;B ;WRITE After REORG
F S N=$O(M(N)) Q:'+N D
. S O=0
. F O=1:1:$L(M(N),U) S BMXFLDO(O-1,"IEN0")=$P(M(N),U,O)
. S BMXORD=BMXNUM
. D OA
Q
;
REORG N R,IEN,J,CONT,TEST
F R=0:1:BMXFLDO-1 S IEN(R)=0
F J=1:1 D Q:'CONT
. S CONT=0
. F R=1:1:BMXFLDO D
. . S TEST=$O(A(+BMXFLDO(R-1),IEN(R-1)))
. . I +TEST S IEN(R-1)=TEST,CONT=1
. . S $P(M(J),U,R)=IEN(R-1)
. Q
I M(J)=M(J-1) K M(J)
Q
;
;
OA ;
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
. ;S IEN0=BMXFLDO(R,"IEN0") F S IEN0=$O(A(BMXFN,IEN0)) Q:'+IEN0 Q:$D(A(BMXFN,IEN0,F,BMXINT))
. S IEN0=BMXFLDO(R,"IEN0")
. Q:'+IEN0
. S BMXORD=BMXORD+1
. I $D(^DD(BMXFN,F,0)),$P(^DD(BMXFN,F,0),U,2) D I 1 ;Multiple or WP
. . ;Get the subfile number into FL1
. . S FL1=+$P(^DD(BMXFN,F,0),U,2)
. . S FLD1=$O(^DD(FL1,0))
. . I $P(^DD(FL1,FLD1,0),U,2)["W" D ;WP
. . . S WPL=0,BMXLTMP=0
. . . F S WPL=$O(A(BMXFN,IEN0,F,WPL)) Q:'WPL S I=I+1 D
. . . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,WPL)_" "
. . . . S BMXLTMP=BMXLTMP+$L(A(BMXFN,IEN0,F,WPL))+1
. . . . Q
. . . S:BMXLTMP>BMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP
. . . Q
. . D ;It's a multiple. Implement in next phase
. . . ;S BMXMCT=BMXMCT+1
. . . ;S BMXMCT(BMXMCT)=BMXFN_U_F
. . . Q ;Process A( for multiple field
. . Q
. E D ;Not a multiple
. . S I=I+1
. . I $G(BMXTK("DISTINCT"))="TRUE" D Q
. . . Q:A(BMXFN,IEN0,F,BMXINT)=""
. . . I $D(^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))) Q
. . . S ^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))=""
. . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT)
. . . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT))
. . . Q
. . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT)
. . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT))
. Q
;---> Set data in result global.
I $D(^BMXTEMP($J,I)) S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30)
ZZZ Q
BMXSQL91 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;Below is dead code, but keep for later
SETX2 ;Don't need this unless porting to machine with
+1 ;local variable size limitations
+2 NEW F,LVL,ROOT,START
+3 SET LVL=1
SET START=1
+4 SET ROOT="BMXY"
+5 FOR F=1:1:BMXFF
Begin DoDot:1
+6 SET BMX=BMXFF(F)
+7 ;Increment level
IF BMX="("
Begin DoDot:2
+8 SET LVL=LVL+1
+9 ;S ROOT=$S(ROOT["(":$P(ROOT,")")_","_0_")",1:ROOT_"("_0_")")
+10 ;Get operator following close paren corresponding to this open
+11 ;If op = OR then set up FOR loop in zeroeth node
+12 ;if op = AND then set up
End DoDot:2
QUIT
+13 ;Decrement level
IF BMX=")"
Begin DoDot:2
+14 SET LVL=LVL-1
+15 IF LVL=1
IF $DATA(BMXFF(F+1))
IF BMXFF(F+1)="&"
Begin DoDot:3
+16 SET BMXX=BMXX+1
+17 SET BMXX(BMXX)=""
+18 FOR J=START:1:F
SET BMXX(BMXX)=BMXX(BMXX)_BMXFF(J)
+19 SET START=F+2
+20 ;S BMXX(BMXX)="I "_BMXX(BMXX)_" X BMXX("_BMXX+1_")"
End DoDot:3
QUIT
End DoDot:2
QUIT
+21 ; I BMX="AND" D Q ;Chain to previous expression at current level
+22 ; I BMX="OR" D Q ;Create FOR-loop to execute screens
End DoDot:1
IF $DATA(BMXERR)
QUIT
+23 ;
+24 QUIT
+25 ;
+26 ;
+27 ;S F=0 F S F=$O(BMXMFL(F)) Q:'+F S:'$D(BMXMFL(F,"SUBFILE")) BMXMFL("NOSUBFILE",F)=""
+28 ;I $D(BMXMFL("NOSUBFILE")) S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D MAKEC1
+29 ;I $D(BMXMFL("SUBFILE")) S F=0 F S F=$O(BMXMFL("SUBFILE",F)) Q:'+F D MAKEC1 ;S BMXROOTZ=BMXZ+100
+30 ;
+31 QUIT
MAKEC1 ;
+1 IF '$DATA(BMXMFL(F,"SUBFILE"))
IF '$DATA(BMXMFL(F,"MULT"))
SET BMXZ=BMXZ+100
SET BMXCFN(BMXCID,BMXZ,F)=""
QUIT
+2 IF '$DATA(BMXMFL(F,"SUBFILE"))
QUIT
+3 IF $DATA(BMXMFL(F,"MULT"))
QUIT
+4 SET BMXROOT=F
+5 SET BMXROOTZ=BMXZ+100
+6 SET BMXROOTC=BMXCID
+7 DO MCNT(F)
+8 QUIT
+9 ;
MCNT(F) ;
+1 NEW S
+2 ;B ;MCNT
+3 IF '$DATA(BMXMFL(F,"SUBFILE"))
DO MCNT2
QUIT
+4 SET S=0
FOR
SET S=$ORDER(BMXMFL(F,"SUBFILE",S))
IF '+S
QUIT
IF '$DATA(BMXCFN(BMXCID,BMXZ,F))
SET BMXZ=BMXZ+100
SET BMXCFN(BMXCID,BMXZ,F)=""
SET BMXZ=BMXZ+100
SET BMXCFN(BMXCID,BMXZ,S)=""
SET BMXCFNX(S,F)=""
DO MCNT(S)
+5 QUIT
+6 ;
MCNT2 ;
+1 ;B ;Back-chain
+2 ;TODO: RESTART HERE -- $O(BMXCFN(BMXCID,0)) NEEDS TO BE CHANGED TO SOMETHING BESIDES 0
+3 NEW BMXFTOP,BMXFBACK
+4 FOR
SET BMXFTOP=$ORDER(BMXCFN(BMXROOTC,BMXROOTZ,0))
IF BMXFTOP=BMXROOT
QUIT
SET BMXFBACK=$ORDER(BMXCFNX(BMXFTOP,0))
SET BMXROOTZ=BMXROOTZ-1
SET BMXCFN(BMXCID,BMXROOTZ,BMXFBACK)=""
+5 SET BMXCID=BMXCID+1
SET BMXROOTC=BMXCID
+6 ;Get the root files
+7 IF $DATA(BMXMFL("NOSUBFILE"))
Begin DoDot:1
+8 NEW F
+9 SET F=0
FOR
SET F=$ORDER(BMXMFL("NOSUBFILE",F))
IF '+F
QUIT
Begin DoDot:2
+10 IF $DATA(BMXMFL(F,"MULT"))
QUIT
+11 IF F=BMXROOT
QUIT
+12 SET BMXZ=BMXZ+100
+13 SET BMXCFN(BMXCID,BMXZ,F)=""
End DoDot:2
End DoDot:1
+14 SET BMXROOTZ=BMXZ+100
+15 QUIT
+16 ;
+17 ;
ITER ;Iterate through result array A
+1 ;Field count
SET BMXCNT=BMXFLDO
+2 SET F=0
+3 IF BMXNUM
SET ^BMXTEMP($JOB,I)=IEN0_"^"
+4 SET BMXCNTB=0
+5 SET BMXORD=BMXNUM
+6 NEW BMXONOD
+7 NEW BMXINT
+8 ;B ;WRITE Before REORG
+9 NEW M,N
SET N=0
+10 DO REORG
+11 ;B ;WRITE After REORG
+12 FOR
SET N=$ORDER(M(N))
IF '+N
QUIT
Begin DoDot:1
+13 SET O=0
+14 FOR O=1:1:$LENGTH(M(N),U)
SET BMXFLDO(O-1,"IEN0")=$PIECE(M(N),U,O)
+15 SET BMXORD=BMXNUM
+16 DO OA
End DoDot:1
+17 QUIT
+18 ;
REORG NEW R,IEN,J,CONT,TEST
+1 FOR R=0:1:BMXFLDO-1
SET IEN(R)=0
+2 FOR J=1:1
Begin DoDot:1
+3 SET CONT=0
+4 FOR R=1:1:BMXFLDO
Begin DoDot:2
+5 SET TEST=$ORDER(A(+BMXFLDO(R-1),IEN(R-1)))
+6 IF +TEST
SET IEN(R-1)=TEST
SET CONT=1
+7 SET $PIECE(M(J),U,R)=IEN(R-1)
End DoDot:2
+8 QUIT
End DoDot:1
IF 'CONT
QUIT
+9 IF M(J)=M(J-1)
KILL M(J)
+10 QUIT
+11 ;
+12 ;
OA ;
+1 IF $DATA(A)
FOR R=0:1:(BMXFLDO-1)
SET F=$PIECE(BMXFLDO(R),U,2)
SET BMXFN=$PIECE(BMXFLDO(R),U)
SET BMXINT=$PIECE(BMXFLDO(R),U,3)
Begin DoDot:1
+2 ;S IEN0=BMXFLDO(R,"IEN0") F S IEN0=$O(A(BMXFN,IEN0)) Q:'+IEN0 Q:$D(A(BMXFN,IEN0,F,BMXINT))
+3 SET IEN0=BMXFLDO(R,"IEN0")
+4 IF '+IEN0
QUIT
+5 SET BMXORD=BMXORD+1
+6 ;Multiple or WP
IF $DATA(^DD(BMXFN,F,0))
IF $PIECE(^DD(BMXFN,F,0),U,2)
Begin DoDot:2
+7 ;Get the subfile number into FL1
+8 SET FL1=+$PIECE(^DD(BMXFN,F,0),U,2)
+9 SET FLD1=$ORDER(^DD(FL1,0))
+10 ;WP
IF $PIECE(^DD(FL1,FLD1,0),U,2)["W"
Begin DoDot:3
+11 SET WPL=0
SET BMXLTMP=0
+12 FOR
SET WPL=$ORDER(A(BMXFN,IEN0,F,WPL))
IF 'WPL
QUIT
SET I=I+1
Begin DoDot:4
+13 SET ^BMXTEMP($JOB,I)=A(BMXFN,IEN0,F,WPL)_" "
+14 SET BMXLTMP=BMXLTMP+$LENGTH(A(BMXFN,IEN0,F,WPL))+1
+15 QUIT
End DoDot:4
+16 IF BMXLTMP>BMXLEN(BMXORD)
SET BMXLEN(BMXORD)=BMXLTMP
+17 QUIT
End DoDot:3
+18 ;It's a multiple. Implement in next phase
Begin DoDot:3
+19 ;S BMXMCT=BMXMCT+1
+20 ;S BMXMCT(BMXMCT)=BMXFN_U_F
+21 ;Process A( for multiple field
QUIT
End DoDot:3
+22 QUIT
End DoDot:2
IF 1
+23 ;Not a multiple
IF '$TEST
Begin DoDot:2
+24 SET I=I+1
+25 IF $GET(BMXTK("DISTINCT"))="TRUE"
Begin DoDot:3
+26 IF A(BMXFN,IEN0,F,BMXINT)=""
QUIT
+27 IF $DATA(^BMXTMPD($JOB,A(BMXFN,IEN0,F,BMXINT)))
QUIT
+28 SET ^BMXTMPD($JOB,A(BMXFN,IEN0,F,BMXINT))=""
+29 SET ^BMXTEMP($JOB,I)=A(BMXFN,IEN0,F,BMXINT)
+30 IF $LENGTH(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD)
SET BMXLEN(BMXORD)=$LENGTH(A(BMXFN,IEN0,F,BMXINT))
+31 QUIT
End DoDot:3
QUIT
+32 SET ^BMXTEMP($JOB,I)=A(BMXFN,IEN0,F,BMXINT)
+33 IF $LENGTH(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD)
SET BMXLEN(BMXORD)=$LENGTH(A(BMXFN,IEN0,F,BMXINT))
End DoDot:2
+34 QUIT
End DoDot:1
IF (R+1)<BMXFLDO
SET ^BMXTEMP($JOB,I)=^BMXTEMP($JOB,I)_U
+35 ;---> Set data in result global.
+36 IF $DATA(^BMXTEMP($JOB,I))
SET ^BMXTEMP($JOB,I)=^BMXTEMP($JOB,I)_$CHAR(30)
ZZZ QUIT
