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

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

Mumps Routines 4 BMX4
File size: 6.7 KB
RevLine 
[1147]1BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 4/6/11 4:56pm
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
146 S BMXRCNT=0 ;cmi/maw mod 10/17/2006
147 F BMXN=1:1 S BMXFN=$O(^VA(200,BMXDUZ,2,BMXFN)) Q:'BMXFN D ;IHS/ANMC/LJF 8/9/01
148 . ;S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"^"_BMXFN_$C(30)
149 . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"^"_BMXFN
150 . ;S BMXRCNT=0 ;cmi/maw orig
151 . ;I $D(^DISV(BMXDUZ,BMXSUB)),^DISV(BMXDUZ,BMXSUB)=BMXFN S BMXRCNT=1
152 . ;I $G(DUZ(2))=BMXFN S BMXRCNT=1 ;cmi/maw orig
153 . S BMXRCNT=BMXRCNT+1 ;cmi/maw mod
154 . S BMXFACS=BMXFACS_"^"_BMXRCNT_$C(30)
155 ;//smh I BMXN=1 S BMXFN=$P(^AUTTSITE(1,0),U,1) D
156 ;//smh . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"^"_BMXFN_"^"_1_$C(30)
157 S BMXFACS=BMXFACS_$C(31)
158 Q
159 ;
160SETFCRS(BMXY,BMXFAC) ;
161 ;
162 ;Sets DUZ(2) to value in BMXFAC
163 ;Fails if BMXFAC is not one of the current user's divisions
164 ;Returns Recordset
165 ;
166 S X="ERFC^BMXRPC3",@^%ZOSF("TRAP")
167 S BMXY="T00030DUZ^T00030FACILITY_IEN^T00030FACILITY_NAME"_$C(30)
168 N BMXSUB,BMXFACN
169 I '+DUZ S BMXY=BMXY_0_"^"_0_"^"_0_$C(30)_$C(31) Q
170 I '+BMXFAC S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q
171 ;I '$D(^VA(200,DUZ,2,+BMXFAC,0)) S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q ; GIS/OIT Feb 9, 2010
172 S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
173 S BMXFACN=$G(^DIC(4,+DUZ(2),0))
174 S BMXFACN=$P(BMXFACN,"^")
175 S BMXSUB="^VA(200,"_DUZ_",2,"
176 S ^DISV(DUZ,BMXSUB)=BMXFAC
177 S BMXY=BMXY_DUZ_"^"_BMXFAC_"^"_BMXFACN_$C(30)_$C(31)
178 Q
179 ;
180ERFC ;
181 D ^%ZTER
182 S BMXY=$G(BMXY)_0_"^"_0_$C(30)_$C(31) Q
183 Q
184 ;
185SETFC(BMXY,BMXFAC) ;
186 ;Sets DUZ(2) to value in BMXFAC
187 ;Fails if BMXFAC is not one of the current user's divisions
188 ;Returns 1 if successful, 0 if failed
189 ;
190 S BMXY=0
191 N BMXSUB
192 I '+DUZ S BMXY=0 Q
193 I '+BMXFAC S BMXY=0 Q
194 I '$D(^VA(200,DUZ,2,+BMXFAC,0)) S BMXY=0 Q
195 S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
196 S BMXSUB="^VA(200,"_DUZ_",2,"
197 S ^DISV(DUZ,BMXSUB)=BMXFAC
198 S BMXY=1
199 Q
200 ;
201APSEC(BMXY,BMXKEY) ;EP
202 ;Return IHSCD_SUCCEEDED (-1) if user has key BMXKEY
203 ;OR if user has key XUPROGMODE
204 ;Otherwise, returns IHSCD_FAILED (0)
205 N BMXIEN,BMXPROG,BMXPKEY
206 I '$G(DUZ) S BMXY=0 Q
207 I BMXKEY="" S BMXY=0 Q
208 ;
209 ;Test for programmer mode key
210 S BMXPROG=0
211 I $D(^DIC(19.1,"B","XUPROGMODE")) D
212 . S BMXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
213 . I '+BMXPKEY Q
214 . I '$D(^VA(200,DUZ,51,BMXPKEY,0)) Q
215 . S BMXPROG=1
216 I BMXPROG S BMXY=-1 Q
217 ;
218 I '$D(^DIC(19.1,"B",BMXKEY)) S BMXY=0 Q
219 S BMXIEN=$O(^DIC(19.1,"B",BMXKEY,0))
220 I '+BMXIEN S BMXY=0 Q
221 I '$D(^VA(200,DUZ,51,BMXIEN,0)) S BMXY=0 Q
222 S BMXY=-1
223 Q
224 ;
225SIGCHK(BMXY,BMXSIG) ;EP
226 ;Checks BMXSIG against hashed value in NEW PERSON
227 ;Return IHSCD_SUCCEEDED (-1) if BMXSIG matches
228 ;Otherwise, returns IHSCD_FAILED (0)
229 N X
230 S BMXY=0
231 I '$G(DUZ) Q
232 I '$D(^VA(200,DUZ,20)) Q ;TODO What if no signature?
233 S BMXHSH=$P(^VA(200,DUZ,20),U,4)
234 S X=$G(BMXSIG)
235 D HASH^XUSHSHP
236 I X=BMXHSH S BMXY=-1
237 Q
Note: See TracBrowser for help on using the repository browser.