source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXRPC3.m@ 1396

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

BMXMON now gets the port number for GT.M in BMX CONNECT STATUS RPC
BMXRPC3 now correctly deals with zero divisions in
VISTA and fixes HTG bug in getting the last selected division from DISV
File size: 7.0 KB
Line 
1BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 5/22/11 4:33pm
2 ;;4.1000;BMX;;Apr 17, 2011
3 ;
4 ; Changed for .1000 by WV/SMH on April 6 2011
5 ; - References to ^AUTTSITE in GETFC & GETFCRS removed, as VISTA doesn't use this file
6 ; -
7 ;
8 ;
9 ;
10VARVAL(RESULT,VARIABLE) ;returns value of passed in variable
11 S VARIABLE=$TR(VARIABLE,"~","^")
12 S RESULT=VARIABLE ;can do this with the REFERENCE type parameter
13 Q
14 ;See GETV^XWBBRK for how we get the REFERENCE type parameter
15 ;
16USER(RESULT,D) ;
17 ;
18 I '+D S RESULT="" Q
19 S RESULT=$P($G(^VA(200,D,0)),"^")
20 Q
21 ;
22NTUSER(BMXY,BMXNTUSE) ;EP
23 ;Old code. Retain for reference
24 ;Returns NTDomain^NTUserName^RPMSName for user having DUZ=D
25 ;TODO: Move ANMC NT USERS file
26 ;from AZZWNT to BMX namespace and numberspace
27 ;
28 ;N BMX,BMXNOD,BMXDOM,BMXNAM,BMXCOL,BMXRNAM
29 ;S (BMXDOM,BMXNAM,BMXRNAM)=""
30 ;S U="^"
31 ;I '+D S RESULT="" Q
32 ;S BMXRNAM=$G(^VA(200,D,0)),BMXRNAM=$P(BMXRNAM,U)
33 ;I '$D(^AZZWNT("DUZ",D)) D NTU1 Q
34 ;S BMX=$O(^AZZWNT("DUZ",D,0))
35 ;I '+BMX D NTU1 Q
36 ;I '$D(^AZZWNT(BMX,0)) D NTU1 Q
37 ;S BMXNOD=^AZZWNT(BMX,0)
38 ;S BMXDOM=$P(BMXNOD,U,2)
39 ;S BMXNAM=$P(BMXNOD,U) ;,4)
40 ;D NTU1
41 Q
42 ;
43 ;
44NTUGETD(BMXY,BMXNTNAM) ;EP
45 ;Entry point for debugging
46 ;
47 ;D DEBUG^%Serenji("NTUGETD^BMXRPC3(.BMXY,BMXNTNAM)")
48 Q
49 ;
50NTUGET(BMXY,BMXNTNAM) ;EP
51 ;
52 ;Returns A ENCRYPTED and V ENCRYPTED for NT User BMXNTNM
53 ;Called by RPC BMXNetGetCodes
54 N BMXI,BMXNTID,BMXNTID,BMXNOD,BMXA,BMXV
55 S BMXI=0
56 S BMXY="^BMXTMP("_$J_")"
57 S X="NTUET^BMXRPC3",@^%ZOSF("TRAP")
58 S BMXI=BMXI+1
59 I BMXNTNM="" S ^BMXTMP($J,BMXI)="^" Q
60 S BMXNTID=$O(^BMXUSER("B",BMXNTNAM,0))
61 I '+BMXNTID S ^BMXTMP($J,BMXI)="^" Q
62 S BMXNOD=$G(^BMXUSER(BMXNTID,0))
63 S BMXA=$P(BMXNOD,U,2)
64 S BMXV=$P(BMXNOD,U,3)
65 S ^BMXTMP($J,BMXI)=BMXA_"^"_BMXV_"^"
66 Q
67 ;
68WINUGET(BMXWINID) ;EP
69 ;Returns DUZ for user having Windows Identity BMXWINID
70 ;Returns 0 if no Windows user found
71 ;
72 N BMXIEN,BMXNOD,BMXDUZ
73 I BMXWINID="" Q 0
74 S BMXIEN=$O(^BMXUSER("B",BMXWINID,0))
75 I '+BMXIEN Q 0
76 S BMXNOD=$G(^BMXUSER(BMXIEN,0))
77 S BMXDUZ=$P(BMXNOD,U,2)
78 Q BMXDUZ
79 ;
80NTUSET(BMXY,BMXNTNAM) ;EP
81 ;Sets NEW PERSON map entry for Windows Identity BMXNTNM
82 ;Returns ERRORID 0 if all ok
83 ;Called by RPC BMXNetSetUser
84 ;
85 ;
86 N BMXI,BMXNTID,BMXFDA,BMXF,BMXIEN,BMXMSG,BMXAPPTD
87 S BMXI=0
88 S BMXY="^BMXTMP("_$J_")"
89 S X="NTUET^BMXRPC3",@^%ZOSF("TRAP")
90 S BMXI=BMXI+1
91 ; Quit with error if no DUZ exists
92 I '+$G(DUZ) D NTUERR(BMXI,500) Q
93 ; Create entry or file in existing entry in BMX USER
94 I $D(^BMXUSER("B",BMXNTNAM)) S BMXF="?1,"
95 E S BMXF="+1,"
96 S BMXFDA(90093.1,BMXF,.01)=BMXNTNAM
97 S BMXFDA(90093.1,BMXF,.02)=$G(DUZ)
98 K BMXIEN,BMXMSG
99 D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG")
100 S BMXAPPTD=+$G(BMXIEN(1))
101 S BMXI=BMXI+1
102 S ^BMXTMP($J,BMXI)=BMXAPPTD_"^0"
103 Q
104 ;
105NTUET ;EP
106 ;Error trap from REGEVNT
107 ;
108 I '$D(BMXI) N BMXI S BMXI=999
109 S BMXI=BMXI+1
110 D NTUERR(BMXI,99)
111 Q
112 ;
113NTUERR(BMXI,BMXERID) ;Error processing
114 S BMXI=BMXI+1
115 S ^BMXTMP($J,BMXI)="^"_BMXERID
116 Q
117 ;
118 ;
119NTU1 ;S BMXCOL="T00030NT_DOMAIN^T00030NT_USERNAME^T00030RPMS_USERNAME"_$C(30)
120 ;S RESULT=BMXCOL_BMXDOM_U_BMXNAM_U_BMXRNAM_$C(30)_$C(31)
121 Q
122 ;
123GETFC(BMXFACS,DUZ) ;Gets all facilities for a user -- *1000 - Changes to support VISTA
124 ; Input DUZ - user IEN from the NEW PERSON FILE
125 ; Output - Number of facilities;facility1 name&facility1 IEN;...facilityN&facilityN IEN
126 N BMXFN,BMXN
127 S BMXFN=0,BMXFACS=""
128 F BMXN=1:1 S BMXFN=$O(^VA(200,DUZ,2,BMXFN)) Q:BMXFN="" D
129 . S:BMXN>1 BMXFACS=BMXFACS_";" S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN
130 ;//smh I BMXN=1 S BMXFN=$P(^AUTTSITE(1,0),U,1) D
131 ;//smh . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN
132 S BMXFACS=BMXN-(BMXN>1)_";"_BMXFACS
133 Q
134 ;
135GETFCRS(BMXFACS,BMXDUZ) ;Gets all facilities for a user - returns RECORDSET -- *1000 - Changes to support VISTA
136 ;
137 ;TODO: return as global array, add error checking
138 N BMXFN,BMXN,BMXSUB,BMXRCNT
139 S BMXDUZ=$TR(BMXDUZ,$C(13),"")
140 S BMXDUZ=$TR(BMXDUZ,$C(10),"")
141 S BMXDUZ=$TR(BMXDUZ,$C(9),"")
142 S BMXFN=0
143 S BMXSUB="^VA(200,"_BMXDUZ_",2,"
144 S BMXFACS="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002MOST_RECENT_LOOKUP"_$C(30)
145 F BMXN=1:1 S BMXFN=$O(^VA(200,BMXDUZ,2,BMXFN)) Q:'BMXFN D ;IHS/ANMC/LJF 8/9/01
146 . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"^"_BMXFN
147 . ; S BMXRCNT=BMXRCNT+1 ;cmi/maw mod ; /smh WRONG WRONG WRONG WRONG. MOST RECENT LOOKUP is 1 or 0, not an increment
148 . N BMXSUB S BMXSUB="^VA(200,"_DUZ_",2," ; ^DISV subscript
149 . N BMXLAST S BMXLAST=(^DISV(DUZ,BMXSUB)=BMXFN) ; 1 or 0 if division is the same as the one in the subscript
150 . S BMXFACS=BMXFACS_"^"_BMXLAST_$C(30) ; append that and add eor
151 ; IF RPMS, RUN THESE
152 ;//smh I BMXN=1 S BMXFN=$P(^AUTTSITE(1,0),U,1) D ; rpms only!
153 ;//smh . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"^"_BMXFN_"^"_1_$C(30) ; rpms only!
154 ; ELSE IF VISTA, RUN THESE
155 ; VISTA Only: If we have no results, use kernel's DUZ(2) set during sign-on
156 ; Equivalent to the RPMS lines above...
157 I BMXN=1 S BMXFACS=BMXFACS_$P(^DIC(4,DUZ(2),0),U,1)_U_DUZ(2)_U_1_$C(30)
158 S BMXFACS=BMXFACS_$C(31)
159 Q
160 ;
161SETFCRS(BMXY,BMXFAC) ;
162 ;
163 ;Sets DUZ(2) to value in BMXFAC
164 ;Fails if BMXFAC is not one of the current user's divisions
165 ;Returns Recordset
166 ;
167 S X="ERFC^BMXRPC3",@^%ZOSF("TRAP")
168 S BMXY="T00030DUZ^T00030FACILITY_IEN^T00030FACILITY_NAME"_$C(30)
169 N BMXSUB,BMXFACN
170 I '+DUZ S BMXY=BMXY_0_"^"_0_"^"_0_$C(30)_$C(31) Q
171 I '+BMXFAC S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q
172 ;I '$D(^VA(200,DUZ,2,+BMXFAC,0)) S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q ; GIS/OIT Feb 9, 2010
173 S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
174 S BMXFACN=$G(^DIC(4,+DUZ(2),0))
175 S BMXFACN=$P(BMXFACN,"^")
176 S BMXSUB="^VA(200,"_DUZ_",2,"
177 S ^DISV(DUZ,BMXSUB)=BMXFAC
178 S BMXY=BMXY_DUZ_"^"_BMXFAC_"^"_BMXFACN_$C(30)_$C(31)
179 Q
180 ;
181ERFC ;
182 D ^%ZTER
183 S BMXY=$G(BMXY)_0_"^"_0_$C(30)_$C(31) Q
184 Q
185 ;
186SETFC(BMXY,BMXFAC) ;
187 ;Sets DUZ(2) to value in BMXFAC
188 ;Fails if BMXFAC is not one of the current user's divisions
189 ;Returns 1 if successful, 0 if failed
190 ;
191 S BMXY=0
192 N BMXSUB
193 I '+DUZ S BMXY=0 Q
194 I '+BMXFAC S BMXY=0 Q
195 I '$D(^VA(200,DUZ,2,+BMXFAC,0)) S BMXY=0 Q
196 S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
197 S BMXSUB="^VA(200,"_DUZ_",2,"
198 S ^DISV(DUZ,BMXSUB)=BMXFAC
199 S BMXY=1
200 Q
201 ;
202APSEC(BMXY,BMXKEY) ;EP
203 ;Return IHSCD_SUCCEEDED (-1) if user has key BMXKEY
204 ;OR if user has key XUPROGMODE
205 ;Otherwise, returns IHSCD_FAILED (0)
206 N BMXIEN,BMXPROG,BMXPKEY
207 I '$G(DUZ) S BMXY=0 Q
208 I BMXKEY="" S BMXY=0 Q
209 ;
210 ;Test for programmer mode key
211 S BMXPROG=0
212 I $D(^DIC(19.1,"B","XUPROGMODE")) D
213 . S BMXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
214 . I '+BMXPKEY Q
215 . I '$D(^VA(200,DUZ,51,BMXPKEY,0)) Q
216 . S BMXPROG=1
217 I BMXPROG S BMXY=-1 Q
218 ;
219 I '$D(^DIC(19.1,"B",BMXKEY)) S BMXY=0 Q
220 S BMXIEN=$O(^DIC(19.1,"B",BMXKEY,0))
221 I '+BMXIEN S BMXY=0 Q
222 I '$D(^VA(200,DUZ,51,BMXIEN,0)) S BMXY=0 Q
223 S BMXY=-1
224 Q
225 ;
226SIGCHK(BMXY,BMXSIG) ;EP
227 ;Checks BMXSIG against hashed value in NEW PERSON
228 ;Return IHSCD_SUCCEEDED (-1) if BMXSIG matches
229 ;Otherwise, returns IHSCD_FAILED (0)
230 N X
231 S BMXY=0
232 I '$G(DUZ) Q
233 I '$D(^VA(200,DUZ,20)) Q ;TODO What if no signature?
234 S BMXHSH=$P(^VA(200,DUZ,20),U,4)
235 S X=$G(BMXSIG)
236 D HASH^XUSHSHP
237 I X=BMXHSH S BMXY=-1
238 Q
Note: See TracBrowser for help on using the repository browser.