source: Scheduling/trunk/m/BSDX01.m@ 963

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

Updated files to intelligently deal with mulitple divisions issue
File size: 11.0 KB
Line 
1BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/28/10 4:47pm
2 ;;1.4;BSDX;;Sep 07, 2010
3 ; Change Log:
4 ; V 1.4.1 (Sep 28 2010): Separate user divisions based on $$INDIV.
5 ; Affects:
6 ; - RESUSR
7 ; - DEPUSR
8 ; - DEPRES
9 ;
10 ;
11SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
12 ;
13 ;
14 ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
15 ;
16 Q
17 ;
18SUINFO(BSDXY,BSDXDUZ) ;EP
19 ;Called by BSDX SCHEDULING USER INFO
20 ;Returns ADO Recordset having column MANAGER
21 ;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE
22 ;
23 N BSDXMGR,BSDXERR
24 K ^BSDXTMP($J)
25 S BSDXY="^BSDXTMP("_$J_")"
26 S BSDXI=0
27 S BSDXERR=""
28 S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30)
29 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
30 I '+BSDXDUZ S BSDXDUZ=DUZ
31 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
32 S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO")
33 S BSDXI=BSDXI+1
34 S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30)
35 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
36 Q
37DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
38 ;
39 ;
40 ;D DEBUG^%Serenji("DEPUSR^BSDX01(.BSDXY,BSDXDUZ)")
41 ;
42 Q
43 ;
44DEPUSR(BSDXY,BSDXDUZ) ;EP
45 ;Called by BSDX RESOURCE GROUPS BY USER
46 ;Returns ADO Recordset with all ACTIVE resource group names to which user has access
47 ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!)
48 ;If BSDXDUZ=0 then returns all department names for current DUZ
49 ;What is returned depends if it is in the same divsion as the hosptial location if it is linked
50 ;if not linked, always returned.
51 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
52 ;then ALL resource group names are returned regardless of whether any active resources
53 ;are associated with the group or not.
54 ;
55 ;
56 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
57 N BSDXMGR,BSDXNOD
58 K ^BSDXTEMP($J)
59 K ^BSDXTMP($J)
60 S BSDXY="^BSDXTMP("_$J_")"
61 S BSDXI=0
62 S BSDXERR=""
63 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$C(30)
64 I '+BSDXDUZ S BSDXDUZ=DUZ
65 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
66 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
67 ;
68 ;User does not have BSDXZMGR or XUPROGMODE keys, so
69 ;$O THRU AC XREF OF BSDX RESOURCE USER
70 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
71 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
72 . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; If not part of a group, quit ("AB" is the whole file index for the resource multiple in Group file)
73 . Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit
74 . S BSDXRNOD=^BSDXRES(BSDXRES,0)
75 . ;QUIT if the resource is inactive
76 . Q:$P(BSDXRNOD,U,2)=1
77 . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
78 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
79 . . Q:$D(^BSDXTEMP($J,BSDXDEP))
80 . . S ^BSDXTEMP($J,BSDXDEP)=""
81 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
82 . . S BSDXI=BSDXI+1
83 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_$C(30)
84 . . Q
85 . Q
86 ;
87 ;User does have BSDXZMGR or XUPROGMODE keys, so
88 ;$O THRU BSDX RESOURCE GROUP file directly
89 I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
90 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
91 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
92 . S BSDXDEPN=$P(BSDXNOD,U)
93 . S BSDXI=BSDXI+1
94 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_$C(30)
95 . Q
96 ;
97 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
98 Q
99 ;
100 ;
101RESUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
102 ;
103 ;
104 ;D DEBUG^%Serenji("RESUSR^BSDX01(.BSDXY,BSDXDUZ)")
105 ;
106 Q
107 ;
108RESUSR(BSDXY,BSDXDUZ) ;EP
109 ;Returns ADO Recordset with ALL RESOURCE names
110 ;Inactive RESOURCES are NOT filtered out
111 ;Called by BSDX RESOURCES BY USER
112 ;
113 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI,BSDX,BSDXLTR
114 N BSDXNOS,BSDXCAN
115 K ^BSDXTMP($J)
116 S BSDXY="^BSDXTMP("_$J_")"
117 S BSDXI=0
118 S BSDXERR=""
119 S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"
120 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"_$C(30)
121 I '+BSDXDUZ S BSDXDUZ=DUZ
122 ;$O THRU AC XREF OF BSDX RESOURCE USER
123 ;Rmoved these lines in order to just return all resource names
124 ;I $D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
125 ;. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
126 ;
127 ;$O THRU BSDX RESOURCE File
128 S BSDXRES=0 F S BSDXRES=$O(^BSDXRES(BSDXRES)) Q:'+BSDXRES D
129 . Q:'$D(^BSDXRES(BSDXRES,0))
130 . S BSDXRNOD=^BSDXRES(BSDXRES,0)
131 . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4) ; Hospital Location
132 . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
133 . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
134 . I '$$INDIV(BSDXSC) QUIT ; If not in division, quit
135 . K BSDXRDAT
136 . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
137 . S BSDXRDAT=BSDXRES_U_BSDXRDAT
138 . ;Get letter text from wp field
139 . S BSDXLTR=""
140 . I $D(^BSDXRES(BSDXRES,1)) D
141 . . S BSDXIEN=0
142 . . F S BSDXIEN=$O(^BSDXRES(BSDXRES,1,BSDXIEN)) Q:'+BSDXIEN D
143 . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXRES,1,BSDXIEN,0))
144 . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
145 . S BSDXNOS=""
146 . I $D(^BSDXRES(BSDXRES,12)) D
147 . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,12,BSDXIEN)) Q:'+BSDXIEN D
148 . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXRES,12,BSDXIEN,0))
149 . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
150 . S BSDXCAN=""
151 . I $D(^BSDXRES(BSDXRES,13)) D
152 . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,13,BSDXIEN)) Q:'+BSDXIEN D
153 . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXRES,13,BSDXIEN,0))
154 . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
155 . N BSDXACC,BSDXMGR
156 . S BSDXACC="0^0^0^0"
157 . S BSDXMGR=$O(^DIC(19.1,"B","BSDXZMGR",0))
158 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
159 . S BSDXMGR=$O(^DIC(19.1,"B","XUPROGMODE",0))
160 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
161 . I BSDXACC="0^0^0^0" D
162 . . N BSDXNOD,BSDXRUID
163 . . S BSDXRUID=0
164 . . ;Get entry for this user and resource
165 . . F S BSDXRUID=$O(^BSDXRSU("AC",BSDXDUZ,BSDXRUID)) Q:'+BSDXRUID I $D(^BSDXRSU(BSDXRUID,0)),$P(^(0),U)=BSDXRES Q
166 . . Q:'+BSDXRUID
167 . . S $P(BSDXACC,U)=1
168 . . S BSDXNOD=$G(^BSDXRSU(BSDXRUID,0))
169 . . S $P(BSDXACC,U,2)=+$P(BSDXNOD,U,3)
170 . . S $P(BSDXACC,U,3)=+$P(BSDXNOD,U,4)
171 . . S $P(BSDXACC,U,4)=+$P(BSDXNOD,U,5)
172 . S BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC
173 . S BSDXI=BSDXI+1
174 . S ^BSDXTMP($J,BSDXI)=BSDXRDAT_$C(30)
175 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
176 Q
177 ;
178DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point
179 ;
180 ;
181 ;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)")
182 ;
183 Q
184 ;
185DEPRES(BSDXY,BSDXDUZ) ;EP
186 ;Called by BSDX GROUP RESOURCE
187 ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
188 ;to which user has access based on entries in BSDX RESOURCE USER file
189 ;by Division (set in DUZ(2))
190 ;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
191 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
192 ;then ALL ACTIVE resource group names are returned
193 ;
194 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
195 N BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID
196 K ^BSDXTEMP($J)
197 K ^BSDXTMP($J)
198 S BSDXY="^BSDXTMP("_$J_")"
199 S BSDXI=0
200 S BSDXERR=""
201 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
202 I '+BSDXDUZ S BSDXDUZ=DUZ
203 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
204 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
205 ;
206 ;User does not have BSDXZMGR or XUPROGMODE keys, so
207 ;$O THRU AC XREF OF BSDX RESOURCE USER
208 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
209 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
210 . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; Quit if Resource isn't part of any Group
211 . Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user.
212 . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
213 . Q:BSDXRNOD=""
214 . ;QUIT if the resource is inactive
215 . Q:$P(BSDXRNOD,U,2)=1
216 . S BSDXRESN=$P(BSDXRNOD,U)
217 . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
218 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
219 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
220 . . S BSDXSUBID=$O(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0))
221 . . S BSDXI=BSDXI+1
222 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$C(30)
223 . Q
224 ;
225 ;User does have BSDXZMGR or XUPROGMODE keys, so
226 ;$O THRU BSDX RESOURCE GROUP file directly
227 I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
228 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
229 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
230 . S BSDXDEPN=$P(BSDXNOD,U)
231 . S BSDXRES=0 F S BSDXRES=$O(^BSDXDEPT(BSDXIEN,1,BSDXRES)) Q:'+BSDXRES D
232 . . N BSDXRESD
233 . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0)) ; Quit if zero node is invalid in multiple
234 . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
235 . . Q:'$D(^BSDXRES(BSDXRESD,0)) ; Quit if zero node of resouce file is invalid
236 . . Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division
237 . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
238 . . Q:BSDXRNOD=""
239 . . ;QUIT if the resource is inactive
240 . . Q:$P(BSDXRNOD,U,2)=1
241 . . S BSDXRESN=$P(BSDXRNOD,U)
242 . . S BSDXI=BSDXI+1
243 . . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$C(30)
244 . . Q
245 . Q
246 ;
247 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
248 Q
249 ;
250APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0)
251 ;
252 N BSDXIEN,BSDXPROG,BSDXPKEY
253 I '$G(BSDXDUZ) Q 0
254 ;
255 ;Test for programmer mode key
256 S BSDXPROG=0
257 I $D(^DIC(19.1,"B","XUPROGMODE")) D
258 . S BSDXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
259 . I '+BSDXPKEY Q
260 . I '$D(^VA(200,BSDXDUZ,51,BSDXPKEY,0)) Q
261 . S BSDXPROG=1
262 I BSDXPROG Q 1
263 ;
264 I BSDXKEY="" Q 0
265 I '$D(^DIC(19.1,"B",BSDXKEY)) Q 0
266 S BSDXIEN=$O(^DIC(19.1,"B",BSDXKEY,0))
267 I '+BSDXIEN Q 0
268 I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
269 Q 1
270INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
271 ; Input: BSDXSC - Hospital Location IEN
272 ; Output: True or False
273 I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
274 I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
275 ; Jump to Division:Medical Center Division:Inst File Pointer for
276 ; Institution IEN (and get its internal value)
277 N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
278 I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
279 I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
280 E Q 0 ; Otherwise, no
281 QUIT
282INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
283 ; Input BSDXRES - BSDX RESOURCE IEN
284 ; Output: True of False
285 Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
286UnitTestINDIV
287 W "Testing if they are the same",!
288 S DUZ(2)=67
289 I '$$INDIV(1) W "ERROR",!
290 I '$$INDIV(2) W "ERROR",!
291 W "Testing if Div not defined in 44, should be true",!
292 I '$$INDIV(3) W "ERROR",!
293 W "Testing empty string. Should be true",!
294 I '$$INDIV("") W "ERROR",!
295 W "Testing if they are different",!
296 S DUZ(2)=899
297 I $$INDIV(1) W "ERROR",!
298 I $$INDIV(2) W "ERROR",!
299 QUIT
300UnitTestINDIV2
301 W "Testing if they are the same",!
302 S DUZ(2)=69
303 I $$INDIV2(22)'=0 W "ERROR",!
304 I $$INDIV2(25)'=1 W "ERROR",!
305 I $$INDIV2(26)'=1 W "ERROR",!
306 I $$INDIV2(27)'=1 W "ERROR",!
307 QUIT
Note: See TracBrowser for help on using the repository browser.