BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;4.0;BMX;;JUN 28, 2010
;
;
FLDFILE(BMXIN) ;EP - Returns name of file containing field BMXIN
;in the form FILE^FIELD^FILENUMBER^FIELDNUMBER
;Based on data contained in the BMXF() array
;BMXIN can be either an unambiguous field name or FILE.FIELDNAME
;
N C,BMXA,BMXB,BMXRET,BMXFILN,BMXFLDN,BMXFILNA
S BMXRET=""
I BMXTMPLT D Q BMXRET
. S BMXFILNA=BMXIN
. I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q
. I BMXF(BMXFILNA)'=BMXFO(1) S BMXERR="TEMPLATES ONLY SUPPORTED ON PRIMARY FILE" D ERROR^BMXSQL Q
. S BMXRET=BMXFILNA_U_"BMXIEN"_U_BMXF(BMXFILNA)_U_".001"
;
I BMXIN["." D Q BMXRET
. S BMXFILNA=$P(BMXIN,".") ;File Name
. I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q
. S BMXRET=BMXFILNA_U_$P(BMXIN,".",2)
. S $P(BMXRET,U,3)=BMXF(BMXFILNA)
. S BMXFLDN=0
. I $P(BMXIN,".",2)'="",$D(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2))) D
. . S BMXFLDN=$O(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2),0))
. I BMXIN["BMXIEN" S BMXFLDN=".001"
. I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q
. S $P(BMXRET,U,4)=BMXFLDN
. Q
;Loop through files in BMXF to locate field name
S C=0,BMXA=""
I 'BMXIEN F S BMXA=$O(BMXF(BMXA)) Q:BMXA="" D Q:$D(BMXERR)
. I $D(^DD(BMXF(BMXA),"B",BMXIN)) S BMXRET=BMXA_U_BMXIN D Q:$D(BMXERR)
. . S C=C+1
. . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERROR^BMXSQL Q
. . Q
. Q
I BMXIEN D
. S BMXA=BMXFO(1)
. S BMXA=BMXFNX(BMXA)
. S BMXRET=BMXA_U_BMXIN
. S C=1
I C=0 D Q BMXRET
. S BMXRET="0^"_BMXIN ;String or numeric literal
S BMXFILNA=$P(BMXRET,U)
S BMXFILN=BMXF(BMXFILNA)
S $P(BMXRET,U,3)=BMXFILN
I $D(^DD(BMXFILN,"B",BMXIN)) D
. S BMXFLDN=$O(^DD(BMXFILN,"B",BMXIN,0))
I BMXIEN S BMXFLDN=".001"
I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q
S $P(BMXRET,U,4)=BMXFLDN
Q BMXRET
;
DECSTR(BMXSTR) ;EP
;Decrements string collation value by 1
;
N A,E,S,L,BMXRET
I BMXSTR="" Q BMXSTR
S L=$L(BMXSTR)
S E=$E(BMXSTR,L)
S B=$E(BMXSTR,1,L-1)
S A=$A(E)
S A=A-1
S E=$C(A)
S BMXRET=B_E
Q BMXRET
;
INCSTR(BMXSTR) ;EP
;Increments string collation value by 1
Q BMXSTR_$C(1)
;
SETX(BMXX,BMXFG,BMXSCR) ;EP
;Set up executable screen code
;by assembling pieces in BMXFG
;and attach to executable iterator(s)
;
;IN: BMXFG()
; BMXX() -- modified
;OUT: BMXSCR
;
N J
Q:'$D(BMXFG)
S BMXSCR=""
S J=0 F S J=$O(BMXX(J)) Q:'+J D
. S BMXX(J)=BMXX(J)_"X BMXSCR"
F J=1:1:BMXFG S BMXSCR=BMXSCR_BMXFG(J)
S BMXSCR=$S(BMXSCR]"":"I "_BMXSCR_" ",1:"")
S BMXSCR=BMXSCR_"D:'$D(^BMXTMP($J,""O"",D0)) OUT^BMXSQL"
I BMXFG("C") D
. N C
. S C=BMXFG("C")
. S BMXSCR("C")="F BMXC=1:1:"_C_" X BMXSCR(""C"",BMXC) S BMXSCR(""X"",BMXC)=X"
. F C=1:1:BMXFG("C") S BMXSCR("C",C)=BMXFG("C",C)
. S BMXSCR="X BMXSCR(""C"") "_BMXSCR
;
Q
BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
FLDFILE(BMXIN) ;EP - Returns name of file containing field BMXIN
+1 ;in the form FILE^FIELD^FILENUMBER^FIELDNUMBER
+2 ;Based on data contained in the BMXF() array
+3 ;BMXIN can be either an unambiguous field name or FILE.FIELDNAME
+4 ;
+5 NEW C,BMXA,BMXB,BMXRET,BMXFILN,BMXFLDN,BMXFILNA
+6 SET BMXRET=""
+7 IF BMXTMPLT
Begin DoDot:1
+8 SET BMXFILNA=BMXIN
+9 IF '$DATA(BMXF(BMXFILNA))
SET BMXERR="FILE NOT FOUND"
SET BMXRET=""
DO ERROR^BMXSQL
QUIT
+10 IF BMXF(BMXFILNA)'=BMXFO(1)
SET BMXERR="TEMPLATES ONLY SUPPORTED ON PRIMARY FILE"
DO ERROR^BMXSQL
QUIT
+11 SET BMXRET=BMXFILNA_U_"BMXIEN"_U_BMXF(BMXFILNA)_U_".001"
End DoDot:1
QUIT BMXRET
+12 ;
+13 IF BMXIN["."
Begin DoDot:1
+14 ;File Name
SET BMXFILNA=$PIECE(BMXIN,".")
+15 IF '$DATA(BMXF(BMXFILNA))
SET BMXERR="FILE NOT FOUND"
SET BMXRET=""
DO ERROR^BMXSQL
QUIT
+16 SET BMXRET=BMXFILNA_U_$PIECE(BMXIN,".",2)
+17 SET $PIECE(BMXRET,U,3)=BMXF(BMXFILNA)
+18 SET BMXFLDN=0
+19 IF $PIECE(BMXIN,".",2)'=""
IF $DATA(^DD(BMXF(BMXFILNA),"B",$PIECE(BMXIN,".",2)))
Begin DoDot:2
+20 SET BMXFLDN=$ORDER(^DD(BMXF(BMXFILNA),"B",$PIECE(BMXIN,".",2),0))
End DoDot:2
+21 IF BMXIN["BMXIEN"
SET BMXFLDN=".001"
+22 IF '+BMXFLDN
SET BMXERR="FIELD NOT FOUND"
SET BMXRET=""
DO ERROR^BMXSQL
QUIT
+23 SET $PIECE(BMXRET,U,4)=BMXFLDN
+24 QUIT
End DoDot:1
QUIT BMXRET
+25 ;Loop through files in BMXF to locate field name
+26 SET C=0
SET BMXA=""
+27 IF 'BMXIEN
FOR
SET BMXA=$ORDER(BMXF(BMXA))
IF BMXA=""
QUIT
Begin DoDot:1
+28 IF $DATA(^DD(BMXF(BMXA),"B",BMXIN))
SET BMXRET=BMXA_U_BMXIN
Begin DoDot:2
+29 SET C=C+1
+30 IF C>1
SET BMXERR="AMBIGUOUS FIELD NAME"
DO ERROR^BMXSQL
QUIT
+31 QUIT
End DoDot:2
IF $DATA(BMXERR)
QUIT
+32 QUIT
End DoDot:1
IF $DATA(BMXERR)
QUIT
+33 IF BMXIEN
Begin DoDot:1
+34 SET BMXA=BMXFO(1)
+35 SET BMXA=BMXFNX(BMXA)
+36 SET BMXRET=BMXA_U_BMXIN
+37 SET C=1
End DoDot:1
+38 IF C=0
Begin DoDot:1
+39 ;String or numeric literal
SET BMXRET="0^"_BMXIN
End DoDot:1
QUIT BMXRET
+40 SET BMXFILNA=$PIECE(BMXRET,U)
+41 SET BMXFILN=BMXF(BMXFILNA)
+42 SET $PIECE(BMXRET,U,3)=BMXFILN
+43 IF $DATA(^DD(BMXFILN,"B",BMXIN))
Begin DoDot:1
+44 SET BMXFLDN=$ORDER(^DD(BMXFILN,"B",BMXIN,0))
End DoDot:1
+45 IF BMXIEN
SET BMXFLDN=".001"
+46 IF '+BMXFLDN
SET BMXERR="FIELD NOT FOUND"
SET BMXRET=""
DO ERROR^BMXSQL
QUIT
+47 SET $PIECE(BMXRET,U,4)=BMXFLDN
+48 QUIT BMXRET
+49 ;
DECSTR(BMXSTR) ;EP
+1 ;Decrements string collation value by 1
+2 ;
+3 NEW A,E,S,L,BMXRET
+4 IF BMXSTR=""
QUIT BMXSTR
+5 SET L=$LENGTH(BMXSTR)
+6 SET E=$EXTRACT(BMXSTR,L)
+7 SET B=$EXTRACT(BMXSTR,1,L-1)
+8 SET A=$ASCII(E)
+9 SET A=A-1
+10 SET E=$CHAR(A)
+11 SET BMXRET=B_E
+12 QUIT BMXRET
+13 ;
INCSTR(BMXSTR) ;EP
+1 ;Increments string collation value by 1
+2 QUIT BMXSTR_$CHAR(1)
+3 ;
SETX(BMXX,BMXFG,BMXSCR) ;EP
+1 ;Set up executable screen code
+2 ;by assembling pieces in BMXFG
+3 ;and attach to executable iterator(s)
+4 ;
+5 ;IN: BMXFG()
+6 ; BMXX() -- modified
+7 ;OUT: BMXSCR
+8 ;
+9 NEW J
+10 IF '$DATA(BMXFG)
QUIT
+11 SET BMXSCR=""
+12 SET J=0
FOR
SET J=$ORDER(BMXX(J))
IF '+J
QUIT
Begin DoDot:1
+13 SET BMXX(J)=BMXX(J)_"X BMXSCR"
End DoDot:1
+14 FOR J=1:1:BMXFG
SET BMXSCR=BMXSCR_BMXFG(J)
+15 SET BMXSCR=$SELECT(BMXSCR]"":"I "_BMXSCR_" ",1:"")
+16 SET BMXSCR=BMXSCR_"D:'$D(^BMXTMP($J,""O"",D0)) OUT^BMXSQL"
+17 IF BMXFG("C")
Begin DoDot:1
+18 NEW C
+19 SET C=BMXFG("C")
+20 SET BMXSCR("C")="F BMXC=1:1:"_C_" X BMXSCR(""C"",BMXC) S BMXSCR(""X"",BMXC)=X"
+21 FOR C=1:1:BMXFG("C")
SET BMXSCR("C",C)=BMXFG("C",C)
+22 SET BMXSCR="X BMXSCR(""C"") "_BMXSCR
End DoDot:1
+23 ;
+24 QUIT
