source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL2.m@ 645

Last change on this file since 645 was 645, checked in by Sam Habiel, 14 years ago

Initial Import of BMX.net code
File size: 2.8 KB
Line 
1BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ;
4 ;
5FLDFILE(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 ;
55DECSTR(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 ;
69INCSTR(BMXSTR) ;EP
70 ;Increments string collation value by 1
71 Q BMXSTR_$C(1)
72 ;
73SETX(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
Note: See TracBrowser for help on using the repository browser.