source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC3.m@ 1087

Last change on this file since 1087 was 1087, checked in by Sam Habiel, 13 years ago

BMX updated to v2.3. No actual routine changes from 2.21
File size: 6.6 KB
Line 
1BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; ; 8/30/10 2:56pm
2 ;;2.3;BMX;;Jan 25, 2011
3 ;Mods by WV/SMH
4 ;7/26/09 Removed references to ^AUTTSITE, an IHS file in GETFAC*
5 ;8/30/10 Changed GETFCRS to return a better list of user divisions
6 ; - Checks to see if there are any divisions
7 ;
8VARVAL(RESULT,VARIABLE) ;returns value of passed in variable
9 S VARIABLE=$TR(VARIABLE,"~","^")
10 S RESULT=VARIABLE ;can do this with the REFERENCE type parameter
11 Q
12 ;See GETV^XWBBRK for how we get the REFERENCE type parameter
13 ;
14USER(RESULT,D) ;
15 ;
16 I '+D S RESULT="" Q
17 S RESULT=$P($G(^VA(200,D,0)),"^")
18 Q
19 ;
20NTUSER(BMXY,BMXNTUSER) ;EP
21 ;Old code. Retain for reference
22 ;Returns NTDomain^NTUserName^RPMSName for user having DUZ=D
23 ;TODO: Move ANMC NT USERS file
24 ;from AZZWNT to BMX namespace and numberspace
25 ;
26 ;N BMX,BMXNOD,BMXDOM,BMXNAM,BMXCOL,BMXRNAM
27 ;S (BMXDOM,BMXNAM,BMXRNAM)=""
28 ;S U="^"
29 ;I '+D S RESULT="" Q
30 ;S BMXRNAM=$G(^VA(200,D,0)),BMXRNAM=$P(BMXRNAM,U)
31 ;I '$D(^AZZWNT("DUZ",D)) D NTU1 Q
32 ;S BMX=$O(^AZZWNT("DUZ",D,0))
33 ;I '+BMX D NTU1 Q
34 ;I '$D(^AZZWNT(BMX,0)) D NTU1 Q
35 ;S BMXNOD=^AZZWNT(BMX,0)
36 ;S BMXDOM=$P(BMXNOD,U,2)
37 ;S BMXNAM=$P(BMXNOD,U) ;,4)
38 ;D NTU1
39 Q
40 ;
41 ;
42NTUGETD(BMXY,BMXNTNAME) ;EP
43 ;Entry point for debugging
44 ;
45 D DEBUG^%Serenji("NTUGET^BMXRPC3(.BMXY,BMXNTNAME)")
46 Q
47 ;
48NTUGET(BMXY,BMXNTNAME) ;EP
49 ;
50 ;Returns A ENCRYPTED and V ENCRYPTED for NT User BMXNTNAME
51 ;Called by RPC BMXNetGetCodes
52 N BMXI,BMXNTID,BMXNTID,BMXNOD,BMXA,BMXV
53 S BMXI=0
54 S BMXY="^BMXTMP("_$J_")"
55 S X="NTUET^BMXRPC3",@^%ZOSF("TRAP")
56 S BMXI=BMXI+1
57 I BMXNTNAME="" S ^BMXTMP($J,BMXI)="^" Q
58 S BMXNTID=$O(^BMXUSER("B",BMXNTNAME,0))
59 I '+BMXNTID S ^BMXTMP($J,BMXI)="^" Q
60 S BMXNOD=$G(^BMXUSER(BMXNTID,0))
61 S BMXA=$P(BMXNOD,U,2)
62 S BMXV=$P(BMXNOD,U,3)
63 S ^BMXTMP($J,BMXI)=BMXA_"^"_BMXV_"^"
64 Q
65 ;
66WINUGET(BMXWINID) ;EP
67 ;Returns DUZ for user having Windows Identity BMXWINID
68 ;Returns 0 if no Windows user found
69 ;
70 N BMXIEN,BMXNOD,BMXDUZ
71 I BMXWINID="" Q 0
72 S BMXIEN=$O(^BMXUSER("B",BMXWINID,0))
73 I '+BMXIEN Q 0
74 S BMXNOD=$G(^BMXUSER(BMXIEN,0))
75 S BMXDUZ=$P(BMXNOD,U,2)
76 Q BMXDUZ
77 ;
78NTUSETD(BMXY,BMXNTNAME) ;EP
79 ;Entry point for debugging
80 ;
81 D DEBUG^%Serenji("NTUSET^BMXRPC3(.BMXY,BMXNTNAME)")
82 Q
83 ;
84NTUSET(BMXY,BMXNTNAME) ;EP
85 ;Sets NEW PERSON map entry for Windows Identity BMXNTNAME
86 ;Returns ERRORID 0 if all ok
87 ;Called by RPC BMXNetSetUser
88 ;
89 ;
90 N BMXI,BMXNTID,BMXFDA,BMXF,BMXIEN,BMXMSG,BMXAPPTID
91 S BMXI=0
92 S BMXY="^BMXTMP("_$J_")"
93 S X="NTUET^BMXRPC3",@^%ZOSF("TRAP")
94 S BMXI=BMXI+1
95 ; Quit with error if no DUZ exists
96 I '+$G(DUZ) D NTUERR(BMXI,500) Q
97 ; Create entry or file in existing entry in BMX USER
98 I $D(^BMXUSER("B",BMXNTNAME)) S BMXF="?1,"
99 E S BMXF="+1,"
100 S BMXFDA(90093.1,BMXF,.01)=BMXNTNAME
101 S BMXFDA(90093.1,BMXF,.02)=$G(DUZ)
102 K BMXIEN,BMXMSG
103 D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG")
104 S BMXAPPTID=+$G(BMXIEN(1))
105 S BMXI=BMXI+1
106 S ^BMXTMP($J,BMXI)=BMXAPPTID_"^0"
107 Q
108 ;
109NTUET ;EP
110 ;Error trap from REGEVNT
111 ;
112 I '$D(BMXI) N BMXI S BMXI=999
113 S BMXI=BMXI+1
114 D NTUERR(BMXI,99)
115 Q
116 ;
117NTUERR(BMXI,BMXERID) ;Error processing
118 S BMXI=BMXI+1
119 S ^BMXTMP($J,BMXI)="^"_BMXERID
120 Q
121 ;
122 ;
123NTU1 ;S BMXCOL="T00030NT_DOMAIN^T00030NT_USERNAME^T00030RPMS_USERNAME"_$C(30)
124 ;S RESULT=BMXCOL_BMXDOM_U_BMXNAM_U_BMXRNAM_$C(30)_$C(31)
125 Q
126 ;
127GETFC(BMXFACS,DUZ) ;Gets all facilities for a user
128 ; Input DUZ - user IEN from the NEW PERSON FILE
129 ; Output - Number of facilities;facility1 name&facility1 IEN;...facilityN&facilityN IEN
130 N BMXFN,BMXN
131 S BMXFN=0,BMXFACS=""
132 F BMXN=1:1 S BMXFN=$O(^VA(200,DUZ,2,BMXFN)) Q:BMXFN="" D
133 . S:BMXN>1 BMXFACS=BMXFACS_";" S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN
134 ;//smh I BMXN=1 S BMXFN=$P(^AUTTSITE(1,0),U,1) D
135 ;//smh . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN
136 S BMXFACS=BMXN-(BMXN>1)_";"_BMXFACS
137 Q
138 ;
139GETFCRS(BMXY,BMXDUZ) ;Gets all facilities for a user - returns RECORDSET
140 ;/mods by //smh for WV
141 N $ET S $ET="G ERFC^BMXRPC3"
142 N BMXFN ; Facility Number
143 S BMXDUZ=$TR(BMXDUZ,$C(13)) ; Strip CR,LF,tab
144 S BMXDUZ=$TR(BMXDUZ,$C(10))
145 S BMXDUZ=$TR(BMXDUZ,$C(9))
146 S BMXY="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002DEFAULT"_$C(30)
147 S BMXFN=0
148 F S BMXFN=$O(^VA(200,BMXDUZ,2,BMXFN)) Q:'BMXFN D
149 . ; DD for ^VA(200,DUZ,2,DUZ(2)) is DUZ(2)^default. DUZ(2) is dinummed.
150 . S BMXY=BMXY_$P(^DIC(4,BMXFN,0),U,1)_U_^VA(200,BMXDUZ,2,BMXFN,0)_$C(30)
151 ; Crazy line: if we have no results, then use kernel's DUZ(2) set
152 ; during sign-on
153 I $L(BMXY,$C(30))<3 S BMXY=BMXY_$P(^DIC(4,DUZ(2),0),U,1)_U_DUZ(2)_$C(30)
154 S BMXY=BMXY_$C(31)
155 Q
156 ;
157SETFCRS(BMXY,BMXFAC) ;
158 ;
159 ;Sets DUZ(2) to value in BMXFAC
160 ;Fails if BMXFAC is not one of the current user's divisions
161 ;Returns Recordset
162 ;
163 S X="ERFC^BMXRPC3",@^%ZOSF("TRAP")
164 S BMXY="T00030DUZ^T00030FACILITY_IEN^T00030FACILITY_NAME"_$C(30)
165 N BMXSUB,BMXFACN
166 I '+DUZ S BMXY=BMXY_0_"^"_0_"^"_0_$C(30)_$C(31) Q
167 I '+BMXFAC S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q
168 ; //SMH Line below is incorrect. Facility valid if not in user profile
169 ; if it is default kernel facility
170 ; I '$D(^VA(200,DUZ,2,+BMXFAC)) S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q
171 S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
172 S BMXFACN=$G(^DIC(4,+DUZ(2),0))
173 S BMXFACN=$P(BMXFACN,"^")
174 S BMXSUB="^VA(200,"_DUZ_",2,"
175 S ^DISV(DUZ,BMXSUB)=BMXFAC
176 S BMXY=BMXY_DUZ_"^"_BMXFAC_"^"_BMXFACN_$C(30)_$C(31)
177 Q
178 ;
179ERFC ;
180 D ^%ZTER
181 S BMXY=$G(BMXY)_0_"^"_0_$C(30)_$C(31) Q
182 Q
183 ;
184SETFC(BMXY,BMXFAC) ;
185 ;Sets DUZ(2) to value in BMXFAC
186 ;Fails if BMXFAC is not one of the current user's divisions
187 ;Returns 1 if successful, 0 if failed
188 ;
189 S BMXY=0
190 N BMXSUB
191 I '+DUZ S BMXY=0 Q
192 I '+BMXFAC S BMXY=0 Q
193 I '$D(^VA(200,DUZ,2,+BMXFAC)) S BMXY=0 Q
194 S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
195 S BMXSUB="^VA(200,"_DUZ_",2,"
196 S ^DISV(DUZ,BMXSUB)=BMXFAC
197 S BMXY=1
198 Q
199 ;
200APSEC(BMXY,BMXKEY) ;EP
201 ;Return IHSCD_SUCCEEDED (-1) if user has key BMXKEY
202 ;OR if user has key XUPROGMODE
203 ;Otherwise, returns IHSCD_FAILED (0)
204 N BMXIEN,BMXPROG,BMXPKEY
205 I '$G(DUZ) S BMXY=0 Q
206 I BMXKEY="" S BMXY=0 Q
207 ;
208 ;Test for programmer mode key
209 S BMXPROG=0
210 I $D(^DIC(19.1,"B","XUPROGMODE")) D
211 . S BMXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
212 . I '+BMXPKEY Q
213 . I '$D(^VA(200,DUZ,51,BMXPKEY,0)) Q
214 . S BMXPROG=1
215 I BMXPROG S BMXY=-1 Q
216 ;
217 I '$D(^DIC(19.1,"B",BMXKEY)) S BMXY=0 Q
218 S BMXIEN=$O(^DIC(19.1,"B",BMXKEY,0))
219 I '+BMXIEN S BMXY=0 Q
220 I '$D(^VA(200,DUZ,51,BMXIEN,0)) S BMXY=0 Q
221 S BMXY=-1
222 Q
223 ;
224SIGCHK(BMXY,BMXSIG) ;EP
225 ;Checks BMXSIG against hashed value in NEW PERSON
226 ;Return IHSCD_SUCCEEDED (-1) if BMXSIG matches
227 ;Otherwise, returns IHSCD_FAILED (0)
228 N X
229 S BMXY=0
230 I '$G(DUZ) Q
231 I '$D(^VA(200,DUZ,20)) Q ;TODO What if no signature?
232 S BMXHSH=$P(^VA(200,DUZ,20),U,4)
233 S X=$G(BMXSIG)
234 D HASH^XUSHSHP
235 I X=BMXHSH S BMXY=-1
236 Q
Note: See TracBrowser for help on using the repository browser.