BMXSQL1 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;4.0;BMX;;JUN 28, 2010
;
;
KW(BMXTK) ;EP
;Identify and mark keywords in BMXTK
;MODIFIES BMXTK
;
N J,BMXSTOP,BMXTMP
;Combine ORDER BY and GROUP BY into a single token
;
S J=0
F S J=$O(BMXTK(J)) Q:'+J D
. S BMXTMP=$$UCASE(BMXTK(J))
. I BMXTMP="ORDER"!(BMXTMP="GROUP") D
. . I $D(BMXTK(J+1)),$$UCASE(BMXTK(J+1))="BY" D
. . . S BMXTK(J)=BMXTK(J)_" "_BMXTK(J+1)
. . . S BMXTK(J)=$$UCASE(BMXTK(J))
. . . S BMXTK(BMXTK(J))=J
. . . K BMXTK(J+1)
. . . Q
. . Q
. Q
;
;Find SELECT
S J=0,BMXSTOP=0
F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
. I $$UCASE(BMXTK(J))="SELECT" D
. . S BMXTK(J)=$$UCASE(BMXTK(J))
. . S BMXTK("SELECT")=J
. . S BMXSTOP=1
. . Q
. Q
I '+J S BMXERR="SELECT KEYWORD NOT FOUND" Q
;
;DISTINCT
S BMXSTOP=0
F S J=$O(BMXTK(J)) Q:'+J Q:$$UCASE(BMXTK(J))="FROM" D Q:BMXSTOP
. I $$UCASE(BMXTK(J))="DISTINCT" D
. . S BMXTK("DISTINCT")="TRUE"
. . K BMXTK(J)
. . S J=J-1
. . S BMXSTOP=1
. Q
;
;FROM
S BMXSTOP=0
S J=J-1
F S J=$O(BMXTK(J)) Q:'+J Q:$$UCASE(BMXTK(J))="WHERE" D Q:BMXSTOP
. I $$UCASE(BMXTK(J))="FROM" D
. . S BMXTK(J)=$$UCASE(BMXTK(J))
. . S BMXTK("FROM")=J
. . S BMXSTOP=1
. . Q
. Q
;
I '$D(BMXTK("FROM")) S BMXERR="'FROM' KEYWORD NOT FOUND" Q
;
;WHERE
S BMXSTOP=0
F S J=$O(BMXTK(J)) Q:'+J Q:BMXTK(J)="ORDER BY" Q:BMXTK(J)="GROUP BY" D Q:BMXSTOP
. I $$UCASE(BMXTK(J))="WHERE" D
. . S BMXTK(J)=$$UCASE(BMXTK(J))
. . S BMXTK("WHERE")=J
. . S BMXSTOP=1
. Q
;
;SHOWPLAN
S J=BMXTK("FROM")
S BMXSTOP=0
F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
. I $$UCASE(BMXTK(J))="SHOWPLAN" D
. . S BMXTK("SHOWPLAN")="TRUE"
. . K BMXTK(J)
. . S J=J-1
. . S BMXSTOP=1
. Q
;
;MAXRECORDS
S J=BMXTK("FROM")
S BMXSTOP=0
F S J=$O(BMXTK(J)) Q:'+J D Q:BMXSTOP
. I $$UCASE(BMXTK(J))["MAXRECORDS" D
. . S BMXXMAX=+$P(BMXTK(J),":",2)-1
. . S:+BMXXMAX<0 BMXXMAX=0
. . K BMXTK(J)
. . S J=J-1
. . S BMXSTOP=1
. Q
Q
;
SCREEN ;EP
;Set up BMXFG() array of executable screen code
N F,BMXNOD,BMXFNUM,BMXFLDNM,BMXHIT,BMXREF
N BMXRNAM,BMXRET,BMXOP,Q,BMXPC,BMXV,BMXFLDLO,BMXFLDNO
N BMXGL
S BMXRET=""
S Q=$C(34)
S BMXFG=BMXFF
S BMXFG("C")=0
I 'BMXFF Q
S F=0,BMXHIT=0
F F=1:1:BMXFF S BMXNOD=BMXFF(F) D Q:$D(BMXERR) Q:BMXHIT
. I $G(BMXFF(F,"INDEXED"))=1 D Q
. . S BMXFG(F)="1"
. . Q
. I $D(BMXFF(F,"JOIN")) D Q
. . S BMXFG(F)="1"
. . Q
. I "(^)"[BMXFF(F) D Q
. . S BMXFG(F)=BMXFF(F)
. . Q
. I "AND^OR"[BMXFF(F) D Q
. . I BMXFF(F)="AND" S BMXFG(F)="&" Q
. . S BMXFG(F)="!"
. . Q
. S BMXFNUM=$S(+$P(BMXNOD,U):$P(BMXNOD,U),1:$O(^DIC("B",$P(BMXNOD,U),0)))
. I '+BMXFNUM D ;Not a fileman field
. . S BMXFLDNM=0,BMXFLDNO=""
. . S BMXFLDLO=$P(BMXFF(F),U,2)
. . ;
. E D ;Get fileman field data
. . S BMXGL=^DIC(BMXFNUM,0,"GL")
. . I $D(BMXFF(F,"IEN")) D
. . . S BMXFLDNM=".001"
. . . S BMXFLDNO="IEN"
. . E D
. . . S BMXFLDNM=$O(^DD(BMXFNUM,"B",$P(BMXNOD,U,2),0))
. . . S BMXFLDNO=^DD(BMXFNUM,BMXFLDNM,0)
. I BMXFLDNO="IEN" D ;BMXIEN field
. . N BMXEXT,C S BMXEXT=0
. . ;S BMXPC=$P(BMXFLDNO,U,4)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
. . S BMXFLDLO="D0"
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
. I $P(BMXFLDNO,U,2)["D" D ;Date field
. . N BMXEXT,C S BMXEXT=0
. . S BMXPC=$P(BMXFLDNO,U,4)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
. . S BMXFLDLO="$P($G("_BMXGL_"D0,"_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
. I $P(BMXFLDNO,U,2)["S" D ;Set field
. . N BMXEXT,C S BMXEXT=0
. . S BMXPC=$P(BMXFLDNO,U,4)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
. . S BMXFLDLO="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
. ;
. I $P(BMXFLDNO,U,2)["P" D ;Pointer field
. . N C,BMXEXT
. . S BMXEXT=0
. . I $P(BMXFF(F),U,5)'=BMXFO(1) D
. . . N R,G,BMXJN,BMXMSCR
. . . S BMXMXCR=1 ;Remove after testing. Find out if the field is from a subfile.
. . . I BMXMXCR D Q
. . . . ;Set up a screen in BMXSCR and in BMXMFL(
. . . . Q
. . . ;
. . . ;Find the node of BMXFF that has the join info
. . . S BMXEXT=1
. . . S BMXFG("C")=BMXFG("C")+1
. . . S C=BMXFG("C")
. . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
. . . S BMXJN=BMXFF(G,"JOIN")
. . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
. . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X="
. . . S BMXFG("C",C)=BMXJN
. . S BMXFLDLO=$$SCRNP(F,BMXGL,BMXFLDNM,BMXFLDNO)
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
. I $P(BMXFLDNO,U,2)["C" D ;Computed field
. . N C
. . S BMXPC=$P(BMXFLDNO,U,5,99)
. . S BMXFG("C")=BMXFG("C")+1
. . S C=BMXFG("C")
. . ;If computed field not in primary file, connect navigation code
. . I $P(BMXFF(F),U,5)'=BMXFO(1) D
. . . ;Find the node of BMXFF that has the join info
. . . N R,G,BMXJN
. . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
. . . S BMXJN=BMXFF(G,"JOIN")
. . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
. . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 "
. . . S BMXJN=BMXJN_BMXPC
. . . S BMXFF(F,0)=$P(BMXFF(F,0),U,1,4)
. . . S $P(BMXFF(F,0),U,5)=BMXJN
. . . S BMXPC=BMXJN
. . S BMXFG("C",C)=BMXPC
. . S BMXFLDLO="BMXSCR(""X"","_C_")"
. I $P(BMXFLDNO,U,2)["N" D ;Numeric field
. . N BMXEXT,C S BMXEXT=0
. . S BMXPC=$P(BMXFLDNO,U,4)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D EXP ;Extended pointer
. . S BMXFLDLO="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
. . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO,BMXFLDLO="BMXSCR(""X"","_C_")"
. ;
. I $P(BMXFLDNO,U,2)["F" D ;Free Text field
. . N BMXEXT,C S BMXEXT=0,C=0
. . S BMXPC=$P(BMXFLDNO,U,4)
. . I $P(BMXFF(F),U,5)'=BMXFO(1) S BMXEXT=1 D
. . . N R,G,BMXJN
. . . S BMXFG("C")=BMXFG("C")+1
. . . S C=BMXFG("C")
. . . S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
. . . S BMXJN=BMXFF(G,"JOIN")
. . . S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
. . . S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN
. . . S BMXJN=BMXJN_"I +D0 S X="
. . . S BMXFG("C",C)=BMXJN
. . . S BMXFLDLO="BMXSCR(""X"","_C_")"
. . I $P(BMXFLDNO,U,4)["E" D
. . . N BMXPC2,BMXTMP
. . . S BMXPC2=$P(BMXPC,"E",2)
. . . S BMXTMP="$E("_BMXGL_"D0,"_$P(BMXPC,";")_"),"_$P(BMXPC2,",")_","_$P(BMXPC2,",",2)_")"
. . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXTMP
. . . E S BMXFLDLO=BMXTMP
. . E D
. . . N BMXTMP
. . . S BMXTMP="$P("_BMXGL_"D0,"_$P(BMXPC,";")_"),U,"_$P(BMXPC,";",2)_")"
. . . S BMXTMP="$S($D("_BMXGL_"D0,"_$P(BMXPC,";")_")):"_BMXTMP_",1:"""")"
. . . I BMXEXT S BMXFG("C",C)=BMXFG("C",C)_BMXTMP
. . . E S BMXFLDLO=BMXTMP
. ;
. S BMXOP=$P(BMXNOD,U,3)
. S BMXV=$P(BMXFF(F),U,4)
. I "<^>^=^["[BMXOP D
. . I BMXOP=">",BMXV?.A S BMXOP="]"
. . I BMXOP="<",BMXV?.A S BMXOP="']"
. . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
. . Q
. I "<>"=BMXOP D
. . S BMXOP="'="
. . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
. I ">="=BMXOP D
. . I BMXV="" S BMXRET="(I 1)" Q
. . I +BMXV=BMXV D Q
. . . S BMXOP="'<"
. . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
. . S BMXV=$$DECSTR^BMXSQL2(BMXV)
. . S BMXOP="]"
. . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
. I "<="=BMXOP D
. . I BMXV="" S BMXRET="(I 0)" Q
. . I +BMXV=BMXV D Q
. . . S BMXOP="'>"
. . . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
. . S BMXV=$$INCSTR^BMXSQL2(BMXV)
. . S BMXOP="']"
. . S BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
. I BMXOP="BETWEEN" D
. . I +$P(BMXV,"~")'=$P(BMXV,"~") D ;BMXV a string
. . . N W,X,Y,Z
. . . S X=$P(BMXV,"~")
. . . S Y=$E(X,1,$L(X)-1)
. . . S Z=$E(X,$L(X))
. . . S Z=$A(Z)
. . . S Z=Z-1
. . . S Z=$C(Z)
. . . S W=Y_Z
. . . S $P(BMXV,"~")=W
. . . S BMXRET="(("_BMXFLDLO_"]"_Q_$P(BMXV,"~")_Q_")&("_BMXFLDLO_"']"_Q_$P(BMXV,"~",2)_Q_"))"
. . E D ;BMXV a number
. . . S BMXRET="(("_BMXFLDLO_"'<"_$P(BMXV,"~")_")&("_BMXFLDLO_"'>"_$P(BMXV,"~",2)_"))"
. . Q
. I BMXOP="LIKE" D
. . S BMXRET="("_BMXFLDLO_"?1"_Q_BMXV_Q_".E)"
. I BMXRET]"" D
. . S BMXFG(F)=BMXRET
. . Q
. ;TODO: Pointer fields
. ;TODO: Computed fields
. ;TODO: Sets of codes
. ;TODO: Dates
. Q
Q
;
SCRNP(F,BMXGL,BMXFLDNU,BMXFLDNO) ;
;Requires BMXFF()
;Sets up expression for pointer field
N BMX,BMXCOR,BMXRET,BMXPC
S BMXPC=$P(BMXFLDNO,U,4)
S BMXCOR="$P($G("_BMXGL_"D0,"_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
S BMXRET=BMXCOR
Q:$D(BMXFF(F,"INTERNAL")) BMXRET
S BMXFNUM=$P(BMXFLDNO,U,2)
S BMXFNUM=+$P(BMXFNUM,"P",2)
S BMXGL=^DIC(BMXFNUM,0,"GL")
S BMXFLDNM=".01"
S BMXFLDNO=^DD(BMXFNUM,BMXFLDNM,0)
F D:$P(BMXFLDNO,U,2)["P" Q:$P(BMXFLDNO,U,2)'["P"
. S BMXPC=$P(BMXFLDNO,U,4)
. S BMXRET="$P($G("_BMXGL_BMXRET_","_Q_$P(BMXPC,";")_Q_")),U,"_$P(BMXPC,";",2)_")"
. S BMXFNUM=$P(BMXFLDNO,U,2)
. S BMXFNUM=+$P(BMXFNUM,"P",2)
. S BMXGL=^DIC(BMXFNUM,0,"GL")
. S BMXFLDNM=".01"
. S BMXFLDNO=^DD(BMXFNUM,BMXFLDNM,0)
;B ;SCRN2 After chain
;I 0 D ;$P(BMXFLDNO,U,2)["D" D ;Pointer to a date
;. Q:+$G(BMXFF(F,"INDEXED")) ;Dates converted when iterator built
;. N BMXD,J
;. S BMXD=$P(BMXFF(F),U,4)
;. S %DT="T"
;. F J=1:1:$L(BMXD,"~") D
;. . S X=$P(BMXD,"~",J)
;. . D ^%DT
;. . S $P(BMXD,"~",J)=Y
;. S $P(BMXFF(F),U,4)=BMXD
S BMXRET="$P($G("_BMXGL_BMXRET_",0)),U,1)"
S BMXRET="$S(+"_BMXCOR_":"_BMXRET_",1:"""")"
Q BMXRET
;
CASE(BMXTK) ;EP
;Convert keywords to uppercase
N J
S J=0
F S J=$O(BMXTK(J)) Q:'+J D
. F K="DISTINCT","SELECT","WHERE","FROM","SHOWPLAN" D
. . I $$UCASE(BMXTK(J))=K S BMXTK(J)=$$UCASE(BMXTK(J))
. Q
Q
;
UCASE(X) ;EP Convert X to uppercase
F %=1:1:$L(X) S:$E(X,%)?1L X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999)
Q X
;
EXP ;Extended pointer
N R,G,BMXJN
S BMXEXT=1
S BMXFG("C")=BMXFG("C")+1
S C=BMXFG("C")
S R=0 F S R=$O(BMXFJ("JOIN",R)) Q:'+R I R=$P(BMXFF(F),U,5) S G=BMXFJ("JOIN",R) Q
S BMXJN=BMXFF(G,"JOIN")
S BMXJN=$P(BMXJN,"IEN0",1)_"D0"_$P(BMXJN,"IEN0",2)
S BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X="
S BMXFG("C",C)=BMXJN
Q
BMXSQL1 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
KW(BMXTK) ;EP
+1 ;Identify and mark keywords in BMXTK
+2 ;MODIFIES BMXTK
+3 ;
+4 NEW J,BMXSTOP,BMXTMP
+5 ;Combine ORDER BY and GROUP BY into a single token
+6 ;
+7 SET J=0
+8 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
Begin DoDot:1
+9 SET BMXTMP=$$UCASE(BMXTK(J))
+10 IF BMXTMP="ORDER"!(BMXTMP="GROUP")
Begin DoDot:2
+11 IF $DATA(BMXTK(J+1))
IF $$UCASE(BMXTK(J+1))="BY"
Begin DoDot:3
+12 SET BMXTK(J)=BMXTK(J)_" "_BMXTK(J+1)
+13 SET BMXTK(J)=$$UCASE(BMXTK(J))
+14 SET BMXTK(BMXTK(J))=J
+15 KILL BMXTK(J+1)
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 ;
+20 ;Find SELECT
+21 SET J=0
SET BMXSTOP=0
+22 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
Begin DoDot:1
+23 IF $$UCASE(BMXTK(J))="SELECT"
Begin DoDot:2
+24 SET BMXTK(J)=$$UCASE(BMXTK(J))
+25 SET BMXTK("SELECT")=J
+26 SET BMXSTOP=1
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
IF BMXSTOP
QUIT
+29 IF '+J
SET BMXERR="SELECT KEYWORD NOT FOUND"
QUIT
+30 ;
+31 ;DISTINCT
+32 SET BMXSTOP=0
+33 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
IF $$UCASE(BMXTK(J))="FROM"
QUIT
Begin DoDot:1
+34 IF $$UCASE(BMXTK(J))="DISTINCT"
Begin DoDot:2
+35 SET BMXTK("DISTINCT")="TRUE"
+36 KILL BMXTK(J)
+37 SET J=J-1
+38 SET BMXSTOP=1
End DoDot:2
+39 QUIT
End DoDot:1
IF BMXSTOP
QUIT
+40 ;
+41 ;FROM
+42 SET BMXSTOP=0
+43 SET J=J-1
+44 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
IF $$UCASE(BMXTK(J))="WHERE"
QUIT
Begin DoDot:1
+45 IF $$UCASE(BMXTK(J))="FROM"
Begin DoDot:2
+46 SET BMXTK(J)=$$UCASE(BMXTK(J))
+47 SET BMXTK("FROM")=J
+48 SET BMXSTOP=1
+49 QUIT
End DoDot:2
+50 QUIT
End DoDot:1
IF BMXSTOP
QUIT
+51 ;
+52 IF '$DATA(BMXTK("FROM"))
SET BMXERR="'FROM' KEYWORD NOT FOUND"
QUIT
+53 ;
+54 ;WHERE
+55 SET BMXSTOP=0
+56 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
IF BMXTK(J)="ORDER BY"
QUIT
IF BMXTK(J)="GROUP BY"
QUIT
Begin DoDot:1
+57 IF $$UCASE(BMXTK(J))="WHERE"
Begin DoDot:2
+58 SET BMXTK(J)=$$UCASE(BMXTK(J))
+59 SET BMXTK("WHERE")=J
+60 SET BMXSTOP=1
End DoDot:2
+61 QUIT
End DoDot:1
IF BMXSTOP
QUIT
+62 ;
+63 ;SHOWPLAN
+64 SET J=BMXTK("FROM")
+65 SET BMXSTOP=0
+66 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
Begin DoDot:1
+67 IF $$UCASE(BMXTK(J))="SHOWPLAN"
Begin DoDot:2
+68 SET BMXTK("SHOWPLAN")="TRUE"
+69 KILL BMXTK(J)
+70 SET J=J-1
+71 SET BMXSTOP=1
End DoDot:2
+72 QUIT
End DoDot:1
IF BMXSTOP
QUIT
+73 ;
+74 ;MAXRECORDS
+75 SET J=BMXTK("FROM")
+76 SET BMXSTOP=0
+77 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
Begin DoDot:1
+78 IF $$UCASE(BMXTK(J))["MAXRECORDS"
Begin DoDot:2
+79 SET BMXXMAX=+$PIECE(BMXTK(J),":",2)-1
+80 IF +BMXXMAX<0
SET BMXXMAX=0
+81 KILL BMXTK(J)
+82 SET J=J-1
+83 SET BMXSTOP=1
End DoDot:2
+84 QUIT
End DoDot:1
IF BMXSTOP
QUIT
+85 QUIT
+86 ;
SCREEN ;EP
+1 ;Set up BMXFG() array of executable screen code
+2 NEW F,BMXNOD,BMXFNUM,BMXFLDNM,BMXHIT,BMXREF
+3 NEW BMXRNAM,BMXRET,BMXOP,Q,BMXPC,BMXV,BMXFLDLO,BMXFLDNO
+4 NEW BMXGL
+5 SET BMXRET=""
+6 SET Q=$CHAR(34)
+7 SET BMXFG=BMXFF
+8 SET BMXFG("C")=0
+9 IF 'BMXFF
QUIT
+10 SET F=0
SET BMXHIT=0
+11 FOR F=1:1:BMXFF
SET BMXNOD=BMXFF(F)
Begin DoDot:1
+12 IF $GET(BMXFF(F,"INDEXED"))=1
Begin DoDot:2
+13 SET BMXFG(F)="1"
+14 QUIT
End DoDot:2
QUIT
+15 IF $DATA(BMXFF(F,"JOIN"))
Begin DoDot:2
+16 SET BMXFG(F)="1"
+17 QUIT
End DoDot:2
QUIT
+18 IF "(^)"[BMXFF(F)
Begin DoDot:2
+19 SET BMXFG(F)=BMXFF(F)
+20 QUIT
End DoDot:2
QUIT
+21 IF "AND^OR"[BMXFF(F)
Begin DoDot:2
+22 IF BMXFF(F)="AND"
SET BMXFG(F)="&"
QUIT
+23 SET BMXFG(F)="!"
+24 QUIT
End DoDot:2
QUIT
+25 SET BMXFNUM=$SELECT(+$PIECE(BMXNOD,U):$PIECE(BMXNOD,U),1:$ORDER(^DIC("B",$PIECE(BMXNOD,U),0)))
+26 ;Not a fileman field
IF '+BMXFNUM
Begin DoDot:2
+27 SET BMXFLDNM=0
SET BMXFLDNO=""
+28 SET BMXFLDLO=$PIECE(BMXFF(F),U,2)
+29 ;
End DoDot:2
+30 ;Get fileman field data
IF '$TEST
Begin DoDot:2
+31 SET BMXGL=^DIC(BMXFNUM,0,"GL")
+32 IF $DATA(BMXFF(F,"IEN"))
Begin DoDot:3
+33 SET BMXFLDNM=".001"
+34 SET BMXFLDNO="IEN"
End DoDot:3
+35 IF '$TEST
Begin DoDot:3
+36 SET BMXFLDNM=$ORDER(^DD(BMXFNUM,"B",$PIECE(BMXNOD,U,2),0))
+37 SET BMXFLDNO=^DD(BMXFNUM,BMXFLDNM,0)
End DoDot:3
End DoDot:2
+38 ;BMXIEN field
IF BMXFLDNO="IEN"
Begin DoDot:2
+39 NEW BMXEXT,C
SET BMXEXT=0
+40 ;S BMXPC=$P(BMXFLDNO,U,4)
+41 ;Extended pointer
IF $PIECE(BMXFF(F),U,5)'=BMXFO(1)
SET BMXEXT=1
DO EXP
+42 SET BMXFLDLO="D0"
+43 IF BMXEXT
SET BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO
SET BMXFLDLO="BMXSCR(""X"","_C_")"
End DoDot:2
+44 ;Date field
IF $PIECE(BMXFLDNO,U,2)["D"
Begin DoDot:2
+45 NEW BMXEXT,C
SET BMXEXT=0
+46 SET BMXPC=$PIECE(BMXFLDNO,U,4)
+47 ;Extended pointer
IF $PIECE(BMXFF(F),U,5)'=BMXFO(1)
SET BMXEXT=1
DO EXP
+48 SET BMXFLDLO="$P($G("_BMXGL_"D0,"_Q_$PIECE(BMXPC,";")_Q_")),U,"_$PIECE(BMXPC,";",2)_")"
+49 IF BMXEXT
SET BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO
SET BMXFLDLO="BMXSCR(""X"","_C_")"
End DoDot:2
+50 ;Set field
IF $PIECE(BMXFLDNO,U,2)["S"
Begin DoDot:2
+51 NEW BMXEXT,C
SET BMXEXT=0
+52 SET BMXPC=$PIECE(BMXFLDNO,U,4)
+53 ;Extended pointer
IF $PIECE(BMXFF(F),U,5)'=BMXFO(1)
SET BMXEXT=1
DO EXP
+54 SET BMXFLDLO="$P("_BMXGL_"D0,"_$PIECE(BMXPC,";")_"),U,"_$PIECE(BMXPC,";",2)_")"
+55 IF BMXEXT
SET BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO
SET BMXFLDLO="BMXSCR(""X"","_C_")"
End DoDot:2
+56 ;
+57 ;Pointer field
IF $PIECE(BMXFLDNO,U,2)["P"
Begin DoDot:2
+58 NEW C,BMXEXT
+59 SET BMXEXT=0
+60 IF $PIECE(BMXFF(F),U,5)'=BMXFO(1)
Begin DoDot:3
+61 NEW R,G,BMXJN,BMXMSCR
+62 ;Remove after testing. Find out if the field is from a subfile.
SET BMXMXCR=1
+63 IF BMXMXCR
Begin DoDot:4
+64 ;Set up a screen in BMXSCR and in BMXMFL(
+65 QUIT
End DoDot:4
QUIT
+66 ;
+67 ;Find the node of BMXFF that has the join info
+68 SET BMXEXT=1
+69 SET BMXFG("C")=BMXFG("C")+1
+70 SET C=BMXFG("C")
+71 SET R=0
FOR
SET R=$ORDER(BMXFJ("JOIN",R))
IF '+R
QUIT
IF R=$PIECE(BMXFF(F),U,5)
SET G=BMXFJ("JOIN",R)
QUIT
+72 SET BMXJN=BMXFF(G,"JOIN")
+73 SET BMXJN=$PIECE(BMXJN,"IEN0",1)_"D0"_$PIECE(BMXJN,"IEN0",2)
+74 SET BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X="
+75 SET BMXFG("C",C)=BMXJN
End DoDot:3
+76 SET BMXFLDLO=$$SCRNP(F,BMXGL,BMXFLDNM,BMXFLDNO)
+77 IF BMXEXT
SET BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO
SET BMXFLDLO="BMXSCR(""X"","_C_")"
End DoDot:2
+78 ;Computed field
IF $PIECE(BMXFLDNO,U,2)["C"
Begin DoDot:2
+79 NEW C
+80 SET BMXPC=$PIECE(BMXFLDNO,U,5,99)
+81 SET BMXFG("C")=BMXFG("C")+1
+82 SET C=BMXFG("C")
+83 ;If computed field not in primary file, connect navigation code
+84 IF $PIECE(BMXFF(F),U,5)'=BMXFO(1)
Begin DoDot:3
+85 ;Find the node of BMXFF that has the join info
+86 NEW R,G,BMXJN
+87 SET R=0
FOR
SET R=$ORDER(BMXFJ("JOIN",R))
IF '+R
QUIT
IF R=$PIECE(BMXFF(F),U,5)
SET G=BMXFJ("JOIN",R)
QUIT
+88 SET BMXJN=BMXFF(G,"JOIN")
+89 SET BMXJN=$PIECE(BMXJN,"IEN0",1)_"D0"_$PIECE(BMXJN,"IEN0",2)
+90 SET BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 "
+91 SET BMXJN=BMXJN_BMXPC
+92 SET BMXFF(F,0)=$PIECE(BMXFF(F,0),U,1,4)
+93 SET $PIECE(BMXFF(F,0),U,5)=BMXJN
+94 SET BMXPC=BMXJN
End DoDot:3
+95 SET BMXFG("C",C)=BMXPC
+96 SET BMXFLDLO="BMXSCR(""X"","_C_")"
End DoDot:2
+97 ;Numeric field
IF $PIECE(BMXFLDNO,U,2)["N"
Begin DoDot:2
+98 NEW BMXEXT,C
SET BMXEXT=0
+99 SET BMXPC=$PIECE(BMXFLDNO,U,4)
+100 ;Extended pointer
IF $PIECE(BMXFF(F),U,5)'=BMXFO(1)
SET BMXEXT=1
DO EXP
+101 SET BMXFLDLO="$P("_BMXGL_"D0,"_$PIECE(BMXPC,";")_"),U,"_$PIECE(BMXPC,";",2)_")"
+102 IF BMXEXT
SET BMXFG("C",C)=BMXFG("C",C)_BMXFLDLO
SET BMXFLDLO="BMXSCR(""X"","_C_")"
End DoDot:2
+103 ;
+104 ;Free Text field
IF $PIECE(BMXFLDNO,U,2)["F"
Begin DoDot:2
+105 NEW BMXEXT,C
SET BMXEXT=0
SET C=0
+106 SET BMXPC=$PIECE(BMXFLDNO,U,4)
+107 IF $PIECE(BMXFF(F),U,5)'=BMXFO(1)
SET BMXEXT=1
Begin DoDot:3
+108 NEW R,G,BMXJN
+109 SET BMXFG("C")=BMXFG("C")+1
+110 SET C=BMXFG("C")
+111 SET R=0
FOR
SET R=$ORDER(BMXFJ("JOIN",R))
IF '+R
QUIT
IF R=$PIECE(BMXFF(F),U,5)
SET G=BMXFJ("JOIN",R)
QUIT
+112 SET BMXJN=BMXFF(G,"JOIN")
+113 SET BMXJN=$PIECE(BMXJN,"IEN0",1)_"D0"_$PIECE(BMXJN,"IEN0",2)
+114 SET BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN
+115 SET BMXJN=BMXJN_"I +D0 S X="
+116 SET BMXFG("C",C)=BMXJN
+117 SET BMXFLDLO="BMXSCR(""X"","_C_")"
End DoDot:3
+118 IF $PIECE(BMXFLDNO,U,4)["E"
Begin DoDot:3
+119 NEW BMXPC2,BMXTMP
+120 SET BMXPC2=$PIECE(BMXPC,"E",2)
+121 SET BMXTMP="$E("_BMXGL_"D0,"_$PIECE(BMXPC,";")_"),"_$PIECE(BMXPC2,",")_","_$PIECE(BMXPC2,",",2)_")"
+122 IF BMXEXT
SET BMXFG("C",C)=BMXFG("C",C)_BMXTMP
+123 IF '$TEST
SET BMXFLDLO=BMXTMP
End DoDot:3
+124 IF '$TEST
Begin DoDot:3
+125 NEW BMXTMP
+126 SET BMXTMP="$P("_BMXGL_"D0,"_$PIECE(BMXPC,";")_"),U,"_$PIECE(BMXPC,";",2)_")"
+127 SET BMXTMP="$S($D("_BMXGL_"D0,"_$PIECE(BMXPC,";")_")):"_BMXTMP_",1:"""")"
+128 IF BMXEXT
SET BMXFG("C",C)=BMXFG("C",C)_BMXTMP
+129 IF '$TEST
SET BMXFLDLO=BMXTMP
End DoDot:3
End DoDot:2
+130 ;
+131 SET BMXOP=$PIECE(BMXNOD,U,3)
+132 SET BMXV=$PIECE(BMXFF(F),U,4)
+133 IF "<^>^=^["[BMXOP
Begin DoDot:2
+134 IF BMXOP=">"
IF BMXV?.A
SET BMXOP="]"
+135 IF BMXOP="<"
IF BMXV?.A
SET BMXOP="']"
+136 SET BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
+137 QUIT
End DoDot:2
+138 IF "<>"=BMXOP
Begin DoDot:2
+139 SET BMXOP="'="
+140 SET BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
End DoDot:2
+141 IF ">="=BMXOP
Begin DoDot:2
+142 IF BMXV=""
SET BMXRET="(I 1)"
QUIT
+143 IF +BMXV=BMXV
Begin DoDot:3
+144 SET BMXOP="'<"
+145 SET BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
End DoDot:3
QUIT
+146 SET BMXV=$$DECSTR^BMXSQL2(BMXV)
+147 SET BMXOP="]"
+148 SET BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
End DoDot:2
+149 IF "<="=BMXOP
Begin DoDot:2
+150 IF BMXV=""
SET BMXRET="(I 0)"
QUIT
+151 IF +BMXV=BMXV
Begin DoDot:3
+152 SET BMXOP="'>"
+153 SET BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
End DoDot:3
QUIT
+154 SET BMXV=$$INCSTR^BMXSQL2(BMXV)
+155 SET BMXOP="']"
+156 SET BMXRET="("_BMXFLDLO_BMXOP_Q_BMXV_Q_")"
End DoDot:2
+157 IF BMXOP="BETWEEN"
Begin DoDot:2
+158 ;BMXV a string
IF +$PIECE(BMXV,"~")'=$PIECE(BMXV,"~")
Begin DoDot:3
+159 NEW W,X,Y,Z
+160 SET X=$PIECE(BMXV,"~")
+161 SET Y=$EXTRACT(X,1,$LENGTH(X)-1)
+162 SET Z=$EXTRACT(X,$LENGTH(X))
+163 SET Z=$ASCII(Z)
+164 SET Z=Z-1
+165 SET Z=$CHAR(Z)
+166 SET W=Y_Z
+167 SET $PIECE(BMXV,"~")=W
+168 SET BMXRET="(("_BMXFLDLO_"]"_Q_$PIECE(BMXV,"~")_Q_")&("_BMXFLDLO_"']"_Q_$PIECE(BMXV,"~",2)_Q_"))"
End DoDot:3
+169 ;BMXV a number
IF '$TEST
Begin DoDot:3
+170 SET BMXRET="(("_BMXFLDLO_"'<"_$PIECE(BMXV,"~")_")&("_BMXFLDLO_"'>"_$PIECE(BMXV,"~",2)_"))"
End DoDot:3
+171 QUIT
End DoDot:2
+172 IF BMXOP="LIKE"
Begin DoDot:2
+173 SET BMXRET="("_BMXFLDLO_"?1"_Q_BMXV_Q_".E)"
End DoDot:2
+174 IF BMXRET]""
Begin DoDot:2
+175 SET BMXFG(F)=BMXRET
+176 QUIT
End DoDot:2
+177 ;TODO: Pointer fields
+178 ;TODO: Computed fields
+179 ;TODO: Sets of codes
+180 ;TODO: Dates
+181 QUIT
End DoDot:1
IF $DATA(BMXERR)
QUIT
IF BMXHIT
QUIT
+182 QUIT
+183 ;
SCRNP(F,BMXGL,BMXFLDNU,BMXFLDNO) ;
+1 ;Requires BMXFF()
+2 ;Sets up expression for pointer field
+3 NEW BMX,BMXCOR,BMXRET,BMXPC
+4 SET BMXPC=$PIECE(BMXFLDNO,U,4)
+5 SET BMXCOR="$P($G("_BMXGL_"D0,"_Q_$PIECE(BMXPC,";")_Q_")),U,"_$PIECE(BMXPC,";",2)_")"
+6 SET BMXRET=BMXCOR
+7 IF $DATA(BMXFF(F,"INTERNAL"))
QUIT BMXRET
+8 SET BMXFNUM=$PIECE(BMXFLDNO,U,2)
+9 SET BMXFNUM=+$PIECE(BMXFNUM,"P",2)
+10 SET BMXGL=^DIC(BMXFNUM,0,"GL")
+11 SET BMXFLDNM=".01"
+12 SET BMXFLDNO=^DD(BMXFNUM,BMXFLDNM,0)
+13 FOR
IF $PIECE(BMXFLDNO,U,2)["P"
Begin DoDot:1
+14 SET BMXPC=$PIECE(BMXFLDNO,U,4)
+15 SET BMXRET="$P($G("_BMXGL_BMXRET_","_Q_$PIECE(BMXPC,";")_Q_")),U,"_$PIECE(BMXPC,";",2)_")"
+16 SET BMXFNUM=$PIECE(BMXFLDNO,U,2)
+17 SET BMXFNUM=+$PIECE(BMXFNUM,"P",2)
+18 SET BMXGL=^DIC(BMXFNUM,0,"GL")
+19 SET BMXFLDNM=".01"
+20 SET BMXFLDNO=^DD(BMXFNUM,BMXFLDNM,0)
End DoDot:1
IF $PIECE(BMXFLDNO,U,2)'["P"
QUIT
+21 ;B ;SCRN2 After chain
+22 ;I 0 D ;$P(BMXFLDNO,U,2)["D" D ;Pointer to a date
+23 ;. Q:+$G(BMXFF(F,"INDEXED")) ;Dates converted when iterator built
+24 ;. N BMXD,J
+25 ;. S BMXD=$P(BMXFF(F),U,4)
+26 ;. S %DT="T"
+27 ;. F J=1:1:$L(BMXD,"~") D
+28 ;. . S X=$P(BMXD,"~",J)
+29 ;. . D ^%DT
+30 ;. . S $P(BMXD,"~",J)=Y
+31 ;. S $P(BMXFF(F),U,4)=BMXD
+32 SET BMXRET="$P($G("_BMXGL_BMXRET_",0)),U,1)"
+33 SET BMXRET="$S(+"_BMXCOR_":"_BMXRET_",1:"""")"
+34 QUIT BMXRET
+35 ;
CASE(BMXTK) ;EP
+1 ;Convert keywords to uppercase
+2 NEW J
+3 SET J=0
+4 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
Begin DoDot:1
+5 FOR K="DISTINCT","SELECT","WHERE","FROM","SHOWPLAN"
Begin DoDot:2
+6 IF $$UCASE(BMXTK(J))=K
SET BMXTK(J)=$$UCASE(BMXTK(J))
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
UCASE(X) ;EP Convert X to uppercase
+1 FOR %=1:1:$LENGTH(X)
IF $EXTRACT(X,%)?1L
SET X=$EXTRACT(X,0,%-1)_$CHAR($ASCII(X,%)-32)_$EXTRACT(X,%+1,999)
+2 QUIT X
+3 ;
EXP ;Extended pointer
+1 NEW R,G,BMXJN
+2 SET BMXEXT=1
+3 SET BMXFG("C")=BMXFG("C")+1
+4 SET C=BMXFG("C")
+5 SET R=0
FOR
SET R=$ORDER(BMXFJ("JOIN",R))
IF '+R
QUIT
IF R=$PIECE(BMXFF(F),U,5)
SET G=BMXFJ("JOIN",R)
QUIT
+6 SET BMXJN=BMXFF(G,"JOIN")
+7 SET BMXJN=$PIECE(BMXJN,"IEN0",1)_"D0"_$PIECE(BMXJN,"IEN0",2)
+8 SET BMXJN="S X="""","_BMXFF(G,"JOIN","IEN")_"=D0 N D0 "_BMXJN_"I +D0 S X="
+9 SET BMXFG("C",C)=BMXJN
+10 QUIT
