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

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

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