source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC2.m@ 832

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

Initial Import of BMX.net code
File size: 3.6 KB
RevLine 
[645]1BMXRPC2 ; IHS/OIT/HMW - FIELD LIST ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ;
4FLDLIST(BMXGBL,BMXFL,BMXATTR,BMXSCR) ;EP
5 ;TODO: Change all this to be a hard-coded $O thru ^DD
6 ;Returns info in BMXATTR for all fields in file number BMXFL
7 ;BMXSCR is executable code to set $T
8 ; When BMXSCR is executed, the field number is in BMXFLD
9 ;See FileMan documentation for FIELD^DD for description
10 ;of Attributes
11 ;
12 ;---> Set variables, kill temp globals.
13 ;S ^HW("F",BMXFL)=""
14 ;S ^HW("F",BMXATTR)=""
15 N BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT
16 S BMX31=$C(31)_$C(31)
17 S BMXGBL="BMXTMP("_$J_")",BMXERR="",U="^"
18 K BMXTMP($J)
19 ;
20 ;---> If file number not provided, return error.
21 ;I '+BMXFL D ERROUT^BMXRPC("File number not provided.",1) Q
22 ;---> If file number not provided check for file name.
23 I +BMXFL'=BMXFL D
24 . S BMXFL=$TR(BMXFL,"_"," ")
25 . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
26 . S BMXFL=$O(^DIC("B",BMXFL,0))
27 I '$G(BMXFL) D ERROUT^BMXRPC("File number not provided.",1) Q
28 ;
29 ;---> If no such file, return error.
30 I '$D(^DD(BMXFL,0)) D ERROUT^BMXRPC("File does not exist.",1) Q
31 ;
32 ;---> Validate screen code
33 I $G(BMXSCR)="" S BMXSCR="I 1"
34 S X=$G(BMXSCR)
35 I X]"" D ^DIM
36 I '$D(X) S BMXSCR="I 1" ;Default to no screen
37 ;
38 ;---> Set Target Global for output and errors.
39 S BMXG="BMXTMP($J,""DID"")"
40 ;
41 ;---> Loop through ^DD(FileNumber,FieldNumber,0) to get field names
42 K BMXTMP($J)
43 I $G(BMXATTR)="" S BMXATTR="LABEL" ;Changed from NAME to LABEL
44 ;---> Attribute Names
45 F I=1:1:$L(BMXATTR,";") S BMXT($P(BMXATTR,";",I))=""
46 S (BMX,BMXC)=0 F S BMX=$O(BMXT(BMX)) Q:BMX="" D
47 . S BMXC=BMXC+1
48 . S $P(BMXT,U,BMXC)="T00030"_BMX
49 S BMXTMP($J,1)="T00030NUMBER"_U_BMXT_$C(30)
50 ;
51 ;S BMXFLD=0 F I=2:1 S BMXFLD=$O(^DD(BMXFL,BMXFLD)) Q:'+BMXFLD D
52 S BMXTMP($J,2)=".001^BMXIEN"_$C(30)
53 S BMXFLDN=0 F I=3:1 S BMXFLDN=$O(^DD(BMXFL,"B",BMXFLDN)) Q:BMXFLDN="" D
54 . S BMXFLD=$O(^DD(BMXFL,"B",BMXFLDN,0)) Q:'+BMXFLD
55 . X BMXSCR Q:'$T
56 . D FIELD^DID(BMXFL,BMXFLD,,BMXATTR,BMXG,BMXG)
57 . K BMXT S (BMXC,BMX)=0
58 . F S BMX=$O(BMXTMP($J,"DID",BMX)) Q:BMX="" D
59 . . S BMXC=BMXC+1
60 . . S $P(BMXT,U,BMXC)=BMXTMP($J,"DID",BMX)
61 . S BMXTMP($J,I)=BMXFLD_U_$TR(BMXT," ","_")_$C(30)
62 ;S I=I+1,BMXTMP($J,I)=".001^BMXIEN"_$C(30)
63 S I=I+1
64 K BMXTMP($J,"DID")
65 ;---> Tack on Error Delimiter and any error.
66 S BMXTMP($J,I)=BMX31_BMXERR
67 Q
68 ;
69MLTLIST(BMXGBL,BMXFL,BMXONEOK) ;EP
70 ;Returns list of multiple fields in file BMXFL, returns only one field
71 ;if BMXONEOK is TRUE
72 ;S ^HW($H,"MLTLIST","FL")=BMXFL
73 ;S ^HW($H,"MLTLIST","ONE")=BMXONEOK
74 N BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT,I
75 S BMX31=$C(31)_$C(31)
76 S BMXGBL="BMXTMP("_$J_")",BMXERR="",U="^"
77 K BMXTMP($J)
78 ;
79 ;---> If file number not provided check for file name.
80 I +BMXFL'=BMXFL D
81 . S BMXFL=$TR(BMXFL,"_"," ")
82 . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
83 . S BMXFL=$O(^DIC("B",BMXFL,0))
84 I '$G(BMXFL) D ERROUT^BMXRPC("File number not provided.",1) Q
85 ;
86 ;---> If no such file, return error.
87 I '$D(^DD(BMXFL,0)) D ERROUT^BMXRPC("File does not exist.",1) Q
88 ;
89 ;---> Column Headers
90 S BMXTMP($J,1)="T00030NUMBER"_U_"T00030NAME"_$C(30)
91 ;
92 ;---> $O thru ^DD(BMXFL,"SB" to get subfile numbers and names
93 S I=2
94 N BMXSB,BMXSBN,BMXSBF,BMXFOUND
95 S BMXFOUND=0
96 I $D(^DD(BMXFL,"SB")) D
97 . S BMXSB=0
98 . F S BMXSB=$O(^DD(BMXFL,"SB",BMXSB)) Q:'+BMXSB D I BMXFOUND Q:BMXONEOK=1
99 . . S BMXSBF=$O(^DD(BMXFL,"SB",BMXSB,0))
100 . . Q:'+BMXSBF
101 . . S BMXSBN=$G(^DD(BMXFL,BMXSBF,0))
102 . . Q:BMXSBN=""
103 . . S BMXZ=$G(^DD(BMXSB,.01,0))
104 . . Q:$P(BMXZ,U,2)["W"
105 . . S BMXFOUND=1
106 . . S BMXSBN=$P(BMXSBN,U)
107 . . S BMXTMP($J,I)=BMXSB_U_BMXSBN_$C(30)
108 . . S I=I+1
109 ;
110 ;---> Tack on Error Delimiter and any error.
111 S BMXTMP($J,I)=BMX31_BMXERR
112 Q
Note: See TracBrowser for help on using the repository browser.