[645] | 1 | BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
|
---|
[931] | 2 | ;;2.2;BMX;;Sep 07, 2010
|
---|
[645] | 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | FLDFILE(BMXIN) ;EP - Returns name of file containing field BMXIN
|
---|
| 6 | ;in the form FILE^FIELD^FILENUMBER^FIELDNUMBER
|
---|
| 7 | ;Based on data contained in the BMXF() array
|
---|
| 8 | ;BMXIN can be either an unambiguous field name or FILE.FIELDNAME
|
---|
| 9 | ;
|
---|
| 10 | N C,BMXA,BMXB,BMXRET,BMXFILN,BMXFLDN,BMXFILNA
|
---|
| 11 | S BMXRET=""
|
---|
| 12 | I BMXTMPLT D Q BMXRET
|
---|
| 13 | . S BMXFILNA=BMXIN
|
---|
| 14 | . I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q
|
---|
| 15 | . I BMXF(BMXFILNA)'=BMXFO(1) S BMXERR="TEMPLATES ONLY SUPPORTED ON PRIMARY FILE" D ERROR^BMXSQL Q
|
---|
| 16 | . S BMXRET=BMXFILNA_U_"BMXIEN"_U_BMXF(BMXFILNA)_U_".001"
|
---|
| 17 | ;
|
---|
| 18 | I BMXIN["." D Q BMXRET
|
---|
| 19 | . S BMXFILNA=$P(BMXIN,".") ;File Name
|
---|
| 20 | . I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q
|
---|
| 21 | . S BMXRET=BMXFILNA_U_$P(BMXIN,".",2)
|
---|
| 22 | . S $P(BMXRET,U,3)=BMXF(BMXFILNA)
|
---|
| 23 | . S BMXFLDN=0
|
---|
| 24 | . I $P(BMXIN,".",2)'="",$D(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2))) D
|
---|
| 25 | . . S BMXFLDN=$O(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2),0))
|
---|
| 26 | . I BMXIN["BMXIEN" S BMXFLDN=".001"
|
---|
| 27 | . I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q
|
---|
| 28 | . S $P(BMXRET,U,4)=BMXFLDN
|
---|
| 29 | . Q
|
---|
| 30 | ;Loop through files in BMXF to locate field name
|
---|
| 31 | S C=0,BMXA=""
|
---|
| 32 | I 'BMXIEN F S BMXA=$O(BMXF(BMXA)) Q:BMXA="" D Q:$D(BMXERR)
|
---|
| 33 | . I $D(^DD(BMXF(BMXA),"B",BMXIN)) S BMXRET=BMXA_U_BMXIN D Q:$D(BMXERR)
|
---|
| 34 | . . S C=C+1
|
---|
| 35 | . . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERROR^BMXSQL Q
|
---|
| 36 | . . Q
|
---|
| 37 | . Q
|
---|
| 38 | I BMXIEN D
|
---|
| 39 | . S BMXA=BMXFO(1)
|
---|
| 40 | . S BMXA=BMXFNX(BMXA)
|
---|
| 41 | . S BMXRET=BMXA_U_BMXIN
|
---|
| 42 | . S C=1
|
---|
| 43 | I C=0 D Q BMXRET
|
---|
| 44 | . S BMXRET="0^"_BMXIN ;String or numeric literal
|
---|
| 45 | S BMXFILNA=$P(BMXRET,U)
|
---|
| 46 | S BMXFILN=BMXF(BMXFILNA)
|
---|
| 47 | S $P(BMXRET,U,3)=BMXFILN
|
---|
| 48 | I $D(^DD(BMXFILN,"B",BMXIN)) D
|
---|
| 49 | . S BMXFLDN=$O(^DD(BMXFILN,"B",BMXIN,0))
|
---|
| 50 | I BMXIEN S BMXFLDN=".001"
|
---|
| 51 | I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q
|
---|
| 52 | S $P(BMXRET,U,4)=BMXFLDN
|
---|
| 53 | Q BMXRET
|
---|
| 54 | ;
|
---|
| 55 | DECSTR(BMXSTR) ;EP
|
---|
| 56 | ;Decrements string collation value by 1
|
---|
| 57 | ;
|
---|
| 58 | N A,E,S,L,BMXRET
|
---|
| 59 | I BMXSTR="" Q BMXSTR
|
---|
| 60 | S L=$L(BMXSTR)
|
---|
| 61 | S E=$E(BMXSTR,L)
|
---|
| 62 | S B=$E(BMXSTR,1,L-1)
|
---|
| 63 | S A=$A(E)
|
---|
| 64 | S A=A-1
|
---|
| 65 | S E=$C(A)
|
---|
| 66 | S BMXRET=B_E
|
---|
| 67 | Q BMXRET
|
---|
| 68 | ;
|
---|
| 69 | INCSTR(BMXSTR) ;EP
|
---|
| 70 | ;Increments string collation value by 1
|
---|
| 71 | Q BMXSTR_$C(1)
|
---|
| 72 | ;
|
---|
| 73 | SETX(BMXX,BMXFG,BMXSCR) ;EP
|
---|
| 74 | ;Set up executable screen code
|
---|
| 75 | ;by assembling pieces in BMXFG
|
---|
| 76 | ;and attach to executable iterator(s)
|
---|
| 77 | ;
|
---|
| 78 | ;IN: BMXFG()
|
---|
| 79 | ; BMXX() -- modified
|
---|
| 80 | ;OUT: BMXSCR
|
---|
| 81 | ;
|
---|
| 82 | N J
|
---|
| 83 | Q:'$D(BMXFG)
|
---|
| 84 | S BMXSCR=""
|
---|
| 85 | S J=0 F S J=$O(BMXX(J)) Q:'+J D
|
---|
| 86 | . S BMXX(J)=BMXX(J)_"X BMXSCR"
|
---|
| 87 | F J=1:1:BMXFG S BMXSCR=BMXSCR_BMXFG(J)
|
---|
| 88 | S BMXSCR=$S(BMXSCR]"":"I "_BMXSCR_" ",1:"")
|
---|
| 89 | S BMXSCR=BMXSCR_"D:'$D(^BMXTMP($J,""O"",D0)) OUT^BMXSQL"
|
---|
| 90 | I BMXFG("C") D
|
---|
| 91 | . N C
|
---|
| 92 | . S C=BMXFG("C")
|
---|
| 93 | . S BMXSCR("C")="F BMXC=1:1:"_C_" X BMXSCR(""C"",BMXC) S BMXSCR(""X"",BMXC)=X"
|
---|
| 94 | . F C=1:1:BMXFG("C") S BMXSCR("C",C)=BMXFG("C",C)
|
---|
| 95 | . S BMXSCR="X BMXSCR(""C"") "_BMXSCR
|
---|
| 96 | ;
|
---|
| 97 | Q
|
---|