source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXGETS.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: 4.4 KB
Line 
1BMXGETS ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ;
4 ;;Horace Whitt
5 ;;Interface to GETS^DIQ
6 ;
7 ;----------
8GETS(BMXGBL,BMXFL,BMXIENS,BMXFLDS,BMXFLG,BMXMC,BMXNUM) ;EP
9 ;---> The final record (node) contains Error Delimiter,
10 ; $C(31)_$C(31), followed by error text, if any.
11 ;
12 ;---> Parameters:
13 ; 1 - BMXGBL (ret) Name of result global for Broker.
14 ; 2 - BMXFL (req) File number for lookup.
15 ; 3 - BMXFLDS (req) Fields to return w/each entry in IENS format.
16 ; 4 - BMXFLG (opt) Flags - See GETS^DIQ documentation
17 ; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change.
18 ; (Converts data in uppercase to mixed case.)
19 ; 6 - BMXNUM (opt) Include IEN as first returned field (1=true)
20 ;
21 ;---> Set variables, kill temp globals.
22 N BMX31
23 S BMX31=$C(31)_$C(31)
24 S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^"
25 K ^BMXTMP($J),^BMXTEMP($J)
26 ;
27 ;---> If file number not provided, return error.
28 I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
29 ;
30 I $G(BMXFLDS)="" S BMXFLDS=".01"
31 ;
32 ;---> Set Target Global for output and errors.
33 S BMXG="^BMXTMP($J)"
34 ;
35 ;---> If Mixed Case not set, set to No Change.
36 I '$D(BMXMC) S BMXMC=0
37 ;
38 ;---> If Return IEN not set, set to No
39 I '$D(BMXNUM) S BMXNUM=0
40 S BMXNUM=+BMXNUM
41 ;
42 ;---> Fileman call
43 D GETS^DIQ(BMXFL,BMXIENS,BMXFLDS,BMXFLG,BMXG,BMXG)
44 ;
45 D WRITE
46 Q
47 ;
48 ;
49 ;----------
50WRITE ;EP
51 ;---> Collect data for matching records and write in result global.
52 ;
53 ;---> First, check for errors.
54 ;---> If errors exist, write them and quit.
55 N I,N,X,F,ASDX,ASDC,ASDXFNUM,ASDXFNAM
56 I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D Q
57 .S N=0,X=""
58 .F S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N D
59 ..N M S M=0
60 ..F S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M D
61 ...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_" "
62 .D ERROUT(X,1)
63 ;
64 ;
65 ;---> Write Field Names
66 I BMXNUM S $P(ASDX,"^",1)="IEN"
67 ;F ASDC=1:1:$L(BMXFLDS,";") D
68 S ASDC=1
69 S ASDXFNUM=0
70 F S ASDXFNUM=$O(^BMXTMP($J,BMXFL,BMXIENS,ASDXFNUM)) Q:'ASDXFNUM D
71 . ;S ASDXFNUM=$P(BMXFLDS,";",ASDC)
72 . S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^")
73 . S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_ASDC
74 . S $P(ASDX,"^",ASDC+BMXNUM)=ASDXFNAM
75 . S ASDC=ASDC+1
76 S ^BMXTEMP($J,1)=ASDX_$C(30)
77 ;---> Write valid results.
78AAA ;---> Loop through results global
79 S I=2,N=0 F S N=$O(^BMXTMP($J,BMXFL,N)) Q:'N D
80 . S X="",F=0
81 . I BMXNUM S X=+N
82 . F S F=$O(^BMXTMP($J,BMXFL,N,F)) Q:'F D
83 . . S:X'="" X=X_U
84 . . I $P(^DD(BMXFL,F,0),U,2) D I 1 ;Multiple or WP
85 . . . ;Get the subfile number into FL1
86 . . . S FL1=+$P(^DD(BMXFL,F,0),U,2)
87 . . . S FLD1=$O(^DD(FL1,0))
88 . . . I $P(^DD(FL1,FLD1,0),U,2)["W" D ;WP
89 . . . . S WPL=0 F S WPL=$O(^BMXTMP($J,BMXFL,N,F,WPL)) Q:'WPL D
90 . . . . . S X=X_^BMXTMP($J,BMXFL,N,F,WPL)_" "
91 . . . . . Q
92 . . . . Q
93 . . . D ;It's a multiple. Implement in next phase
94 . . . . Q ;
95 . . . Q
96 . . E D ;Not a multiple
97 . . . S X=X_^BMXTMP($J,BMXFL,N,F)
98 . . . Q
99 . . Q
100 . ;---> Convert data to mixed case if BMXMC=1.
101ZZZ . S:BMXMC X=$$T^BMXTRS(X)
102 . ;
103 . ;---> Set data in result global.
104 . S ^BMXTEMP($J,I)=X_$C(30)
105 . S I=I+1
106 ;
107 ;---> If no results, report it as an error.
108 D:'$O(^BMXTEMP($J,0))
109 .I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q
110 .S BMXERR="Either the lookup file is empty"
111 .S BMXERR=BMXERR_" or all entries are screened (software error)."
112 ;
113 ;---> Tack on Error Delimiter and any error.
114 S ^BMXTEMP($J,I)=BMX31_BMXERR
115 Q
116 ;
117 ;
118 ;----------
119ERROUT(BMXERR,I) ;EP
120 ;---> Save next line for Error Code File if ever used.
121 ;---> If necessary, use I>1 to avoid overwriting valid data.
122 S:'$G(I) I=1
123 S ^BMXTEMP($J,I)=BMX31_BMXERR
124 Q
125 ;
126 ;
127PASSERR(BMXGBL,BMXERR) ;EP
128 ;---> If the RPC routine calling the BMX Generic Lookup above
129 ;---> detects a specific error prior to the call and wants to pass
130 ;---> that error in the result global rather than a generic error,
131 ;---> then a call to this function (PASSERR) can be made.
132 ;---> This call will store the error text passed in the result global.
133 ;---> The calling routine should then quit (abort its call to the
134 ;---> BMX Generic Lookup function above).
135 ;
136 ;---> Parameters:
137 ; 1 - BMXGBL (ret) Name of result global for Broker.
138 ; 2 - BMXERR (req) Text of error to be stored in result global.
139 ;
140 S:$G(BMXERR)="" BMXERR="Error not passed (software error)."
141 ;
142 N BMX31 S BMX31=$C(31)_$C(31)
143 K ^BMXTMP($J),^BMXTEMP($J)
144 S BMXGBL="^BMXTEMP("_$J_")"
145 S ^BMXTEMP($J,1)=BMX31_BMXERR
146 Q
Note: See TracBrowser for help on using the repository browser.