source: Scheduling/trunk/m/BSDX18.m@ 1484

Last change on this file since 1484 was 1481, checked in by Sam Habiel, 12 years ago

Updated routine version numbers to 1.7T2.
Changes the Writes in the post-init to MESXPDUTL in BSDX2E.
Changed the check for BMX to be for BMX 4 rather than BMX 2.

File size: 9.3 KB
Line 
1BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
2 ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
3 ; Licensed under LGPL
4 ;
5 ;
6DELRUD(BSDXY,BSDXIEN) ;EP
7 ;Entry point for debugging
8 ;
9 ;D DEBUG^%Serenji("DELRU^BSDX18(.BSDXY,BSDXIEN)")
10 Q
11 ;
12DELRU(BSDXY,BSDXIEN) ;EP
13 ;Deletes entry BSDXIEN from RESOURCE USERS file
14 ;Return recordset containing error message or "" if no error
15 ;Called by BSDX DELETE RESOURCEUSER
16 ;Test Line:
17 ;D DELRU^BSDX18(.RES,99)
18 ;
19 N BSDXI,DIK,DA
20 S BSDXI=0
21 S BSDXY="^BSDXTMP("_$J_")"
22 S ^BSDXTMP($J,0)="I00020RESOURCEUSERID^I00020ERRORID"_$C(30)
23 I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q
24 I '$D(^BSDXRSU(BSDXIEN,0)) D ERR(BSDXI,BSDXIEN,70) Q
25 ;Delete entry BSDXIEN
26 S DIK="^BSDXRSU("
27 S DA=BSDXIEN
28 D ^DIK
29 ;
30 S BSDXI=BSDXI+1
31 S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_"-1"_$C(30)_$C(31)
32 Q
33 ;
34ADDRUD(BSDXY,BSDXVAL) ;EP
35 ;Entry point for debugging
36 ;
37 ;D DEBUG^%Serenji("ADDRU^BSDX18(.BSDXY,BSDXVAL)")
38 Q
39 ;
40ADDRU(BSDXY,BSDXVAL) ;EP
41 ;
42 ;Called by BSDX ADD/EDIT RESOURCEUSER
43 ;Add/Edit BSDX RESOURCEUSER entry
44 ;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments
45 ;If IEN=0 Then this is a new ResourceUser entry
46 ;Test Line:
47 ;D ADDRU^BSDX18(.RES,"sResourceUserID|sOverbook|sModifySchedule|sResourceID|sUserID|sModifyAppointments")
48 ;
49 N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID
50 N BSDXRES,BSDXRSU,BSDXF,BSDXAPPT
51 S BSDXY="^BSDXTMP("_$J_")"
52 S BSDXI=0
53 S ^BSDXTMP($J,BSDXI)="I00020RESOURCEID^I00020ERRORID"_$C(30)
54 S BSDXIEN=$P(BSDXVAL,"|")
55 I +BSDXIEN D
56 . S BSDX="EDIT"
57 . S BSDXIENS=BSDXIEN_","
58 E D
59 . S BSDX="ADD"
60 . S BSDXIENS="+1,"
61 ;
62 I '+$P(BSDXVAL,"|",4) D ERR(BSDXI,BSDXIEN,70) Q
63 I '+$P(BSDXVAL,"|",5) D ERR(BSDXI,BSDXIEN,70) Q
64 ;
65 S BSDXRID=$P(BSDXVAL,"|",4) ;ResourceID
66 S BSDXUID=$P(BSDXVAL,"|",5) ;UserID
67 S BSDXRSU=0 ;ResourceUserID
68 S BSDXF=0 ;flag
69 ;If this is an add, check if the user is already assigned to the resource.
70 ;If so, then change to an edit
71 I BSDX="ADD" F S BSDXRSU=$O(^BSDXRSU("AC",BSDXUID,BSDXRSU)) Q:'+BSDXRSU D Q:BSDXF
72 . S BSDXRES=$G(^BSDXRSU(BSDXRSU,0))
73 . S BSDXRES=$P(BSDXRES,U) ;ResourceID
74 . S:BSDXRES=BSDXRID BSDXF=1
75 I BSDXF S BSDX="EDIT",BSDXIEN=BSDXRSU,BSDXIENS=BSDXIEN_","
76 ;
77 S BSDXOVB=$P(BSDXVAL,"|",2)
78 S BSDXOVB=$S(BSDXOVB="YES":1,1:0)
79 S BSDXMOD=$P(BSDXVAL,"|",3)
80 S BSDXMOD=$S(BSDXMOD="YES":1,1:0)
81 S BSDXAPPT=$P(BSDXVAL,"|",6)
82 S BSDXAPPT=$S(BSDXAPPT="YES":1,1:0)
83 ;
84 S BSDXFDA(9002018.15,BSDXIENS,.01)=$P(BSDXVAL,"|",4) ;RESOURCE ID
85 S BSDXFDA(9002018.15,BSDXIENS,.02)=$P(BSDXVAL,"|",5) ;USERID
86 S BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB ;OVERBOOK
87 S BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD ;MODIFY SCHEDULE
88 S BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT ;ADD, EDIT, DELETE APPOINMENTS
89 K BSDXMSG
90 I BSDX="ADD" D
91 . K BSDXIEN
92 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
93 . S BSDXIEN=+$G(BSDXIEN(1))
94 E D
95 . D FILE^DIE("","BSDXFDA","BSDXMSG")
96 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(31)
97 Q
98 ;
99ERR(BSDXI,BSDXID,BSDXERR) ;Error processing
100 S BSDXERR=BSDXERR+134234112 ;vbObjectError
101 S BSDXI=BSDXI+1
102 S ^BSDXTMP($J,BSDXI)=BSDXID_"^"_BSDXERR_$C(30)
103 S BSDXI=BSDXI+1
104 S ^BSDXTMP($J,BSDXI)=$C(31)
105 Q
106 ;
107MADERR(BSDXMSG) ;
108 W !,BSDXMSG
109 Q
110 ;
111MADSCR(BSDXDUZ,BSDXZMGR,BSDXZMENU,BSDXZPROG) ;EP - File 200 screening code for MADDRU
112 ;Called from DIR to screen for scheduling users
113 I $D(^VA(200,BSDXDUZ,51,"B",BSDXZMENU)) Q 1
114 I $D(^VA(200,BSDXDUZ,51,"B",BSDXZMGR)) Q 1
115 I $D(^VA(200,BSDXDUZ,51,"B",BSDXZPROG)) Q 1
116 Q 0
117 ;
118MADDRU ;EP -Command line utility to bulk-add users and set access rights IHS/HMW 20060420 **1**
119 ;Main entry point
120 ;
121 N BSDX,BSDXZMENU,BSDXZMGR,BSDXZPROG,DIR
122 ;
123 ;INIT
124 K ^TMP($J)
125 S BSDXZMENU=$O(^DIC(19.1,"B","BSDXZMENU",0)) I '+BSDXZMENU D MADERR("Error: BSDXZMENU KEY NOT FOUND.") Q
126 S BSDXZMGR=$O(^DIC(19.1,"B","BSDXZMGR",0)) I '+BSDXZMGR D MADERR("Error: BSDXZMGR KEY NOT FOUND.") Q
127 S BSDXZPROG=$O(^DIC(19.1,"B","XUPROGMODE",0)) I '+BSDXZPROG D MADERR("Error: XUPROGMODE KEY NOT FOUND.") Q
128 ;
129 D MADUSR
130 I '$D(^TMP($J,"BSDX MADDRU","USER")) D MADERR("Cancelled: No Users selected.") Q
131 D MADRES
132 I '$D(^TMP($J,"BSDX MADDRU","RESOURCE")) D MADERR("Cancelled: No Resources selected.") Q
133 I '$$MADACC(.BSDX) ;D MADERR("Selected users will have no access to the selected clinics.")
134 I '$$MADCONF(.BSDX) W ! D MADERR("--Cancelled") Q
135 D MADASS(.BSDX)
136 W ! D MADERR("--Done")
137 ;
138 Q
139 ;
140MADUSR ;Prompt for users from file 200 who have BSDXUSER key
141 ;Store results in ^TMP($J,"BSDX MADDRU","USER",DUZ) array
142 N DIRUT,Y,DIR
143 S DIR(0)="PO^200:EMZ",DIR("S")="I $$MADSCR^BSDX18(Y,BSDXZMGR,BSDXZMENU,BSDXZPROG)"
144 S Y=0
145 K ^TMP($J,"BSDX MADDRU","USER")
146 W !!,"-------Select Users-------"
147 F D ^DIR Q:$G(DIRUT) Q:'Y D
148 . S ^TMP($J,"BSDX MADDRU","USER",+Y)=""
149 Q
150 ;
151MADRES ;Prompt for Resources
152 ;Store results in ^TMP($J,"BSDX MADDRU","RESOURCE",ResourceID) array
153 N DIRUT,Y,DIR
154 S DIR(0)="PO^9002018.1:EMZ"
155 S Y=0
156 K ^TMP($J,"BSDX MADDRU","RESOURCE")
157 W !!,"-------Select Resources-------"
158 F D ^DIR Q:$G(DIRUT) Q:'Y D
159 . S ^TMP($J,"BSDX MADDRU","RESOURCE",+Y)=""
160 Q
161 ;
162MADACC(BSDX) ;Prompt for access level.
163 ;Start with Overbook and go to read-only access.
164 ;Store results in variables for:
165 ;sOverbook, sModifySchedule, sModifyAppointments
166 ;
167 N DIRUT,Y,DIR,J
168 W !!,"-------Select Access Level-------"
169 S Y=0
170 F J="MODIFY","OVERBOOK","WRITE","READ" S BSDX(J)=1
171 S DIR(0)="Y"
172 ;
173 S DIR("A")="Allow users to Modify Clinic Availability"
174 D ^DIR
175 Q:$G(DIRUT) 0
176 Q:Y 1
177 S BSDX("MODIFY")=0
178 ;
179 S DIR("A")="Allow users to Overbook the selected clinics"
180 D ^DIR
181 Q:$G(DIRUT) 0
182 Q:Y 1
183 S BSDX("OVERBOOK")=0
184 ;
185 S DIR("A")="Allow users to Add, Edit and Delete appointments in the selected resources"
186 D ^DIR
187 Q:$G(DIRUT)
188 Q:Y 1
189 S BSDX("WRITE")=0
190 ;
191 S DIR("A")="Allow users to View appointments in the selected resources"
192 D ^DIR
193 Q:$G(DIRUT)
194 Q:Y 1
195 S BSDX("READ")=0
196 ;
197 Q 0
198 ;
199MADCONF(BSDX) ;Confirm selections
200 N DIR,DIRUT,Y
201 S DIR(0)="Y"
202 W !!,"-------Confirm Selections-------"
203 I BSDX("READ")=0 D
204 . S DIR("A")="Are you sure you want to remove all access to these clinics for these users"
205 E D
206 . W !,"Selected users will be assigned the following access:"
207 . W !,"Modify clinic availability: ",?50,BSDX("MODIFY")
208 . W !,"Overbook Appointments: ",?50,BSDX("OVERBOOK")
209 . W !,"Add, Edit and Delete Appointments: ",?50,BSDX("WRITE")
210 . W !,"View Clinic Appointments: ",?50,BSDX("READ")
211 . S DIR("A")="Are you sure you want to assign these access rights to the selected users"
212 D ^DIR
213 Q:$G(DIRUT) 0
214 Q:$G(Y) 1
215 Q 0
216 ;
217MADASS(BSDX) ;
218 ;Assign access level to selected users and resources
219 ;Loop through selected users
220 ;. Loop through selected resources
221 ; . . If an entry in ^BSDXRSU for this user/resource combination exists, then
222 ; . . . S sResourceUserID = to it
223 ; . . Else
224 ; . . . S sResourceUserID = 0
225 ; . . Call MADFILE
226 N BSDXU,BSDXR,BSDXRUID,BSDXVAL
227 S BSDXU=0
228 F S BSDXU=$O(^TMP($J,"BSDX MADDRU","USER",BSDXU)) Q:'+BSDXU D
229 . S BSDXR=0 F S BSDXR=$O(^TMP($J,"BSDX MADDRU","RESOURCE",BSDXR)) Q:'+BSDXR D
230 . . S BSDXRUID=$$MADEXST(BSDXU,BSDXR)
231 . . S BSDXVAL=BSDXRUID_"|"_BSDX("OVERBOOK")_"|"_BSDX("MODIFY")_"|"_BSDXR_"|"_BSDXU_"|"_BSDX("WRITE")
232 . . I +BSDXRUID,BSDX("READ")=0 D MADDEL(BSDXRUID)
233 . . Q:BSDX("READ")=0
234 . . D MADFILE(BSDXVAL)
235 . . Q
236 . Q
237 Q
238 ;
239MADDEL(BSDXRUID) ;
240 ;Delete entry BSDXRUID from BSDX RESOURCE USER file
241 N DIK,DA
242 Q:'+BSDXRUID
243 Q:'$D(^BSDXRSU(BSDXRUID))
244 S DIK="^BSDXRSU("
245 S DA=BSDXRUID
246 D ^DIK
247 Q
248 ;
249MADFILE(BSDXVAL) ;
250 ;
251 ;Add/Edit BSDX RESOURCEUSER entry
252 ;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments
253 ;If sResourceUserID=0 Then this is a new ResourceUser entry
254 ;
255 N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID
256 N BSDXRES,BSDXRSU,BSDXF,BSDXAPPT
257 S BSDXIEN=$P(BSDXVAL,"|")
258 I +BSDXIEN D
259 . S BSDX="EDIT"
260 . S BSDXIENS=BSDXIEN_","
261 E D
262 . S BSDX="ADD"
263 . S BSDXIENS="+1,"
264 ;
265 I '+$P(BSDXVAL,"|",4) D MADERR("Error in MADFILE^BSDX18: No Resource ID") Q
266 I '+$P(BSDXVAL,"|",5) D MADERR("Error in MADFILE^BSDX18: No User ID") Q
267 ;
268 S BSDXRID=$P(BSDXVAL,"|",4) ;ResourceID
269 S BSDXUID=$P(BSDXVAL,"|",5) ;UserID
270 S BSDXRSU=0 ;ResourceUserID
271 S BSDXF=0 ;flag
272 ;If this is an add, check if the user is already assigned to the resource.
273 ;If so, then change to an edit
274 I BSDX="ADD" F S BSDXRSU=$O(^BSDXRSU("AC",BSDXUID,BSDXRSU)) Q:'+BSDXRSU D Q:BSDXF
275 . S BSDXRES=$G(^BSDXRSU(BSDXRSU,0))
276 . S BSDXRES=$P(BSDXRES,U) ;ResourceID
277 . S:BSDXRES=BSDXRID BSDXF=1
278 I BSDXF S BSDX="EDIT",BSDXIEN=BSDXRSU,BSDXIENS=BSDXIEN_","
279 ;
280 S BSDXOVB=$P(BSDXVAL,"|",2)
281 S BSDXMOD=$P(BSDXVAL,"|",3)
282 S BSDXAPPT=$P(BSDXVAL,"|",6)
283 ;
284 S BSDXFDA(9002018.15,BSDXIENS,.01)=$P(BSDXVAL,"|",4) ;RESOURCE ID
285 S BSDXFDA(9002018.15,BSDXIENS,.02)=$P(BSDXVAL,"|",5) ;USERID
286 S BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB ;OVERBOOK
287 S BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD ;MODIFY SCHEDULE
288 S BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT ;ADD, EDIT, DELETE APPOINMENTS
289 K BSDXMSG
290 I BSDX="ADD" D
291 . K BSDXIEN
292 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
293 . S BSDXIEN=+$G(BSDXIEN(1))
294 E D
295 . D FILE^DIE("","BSDXFDA","BSDXMSG")
296 Q
297 ;
298MADEXST(BSDXU,BSDXR) ;
299 ;Returns BSDX RESOURCE USER ID
300 ;if there is a BSDX RESOURCE USER entry for
301 ;user BSDXU and resource BSDXR
302 ;Otherwise, returns 0
303 ;
304 N BSDXID,BSDXFOUND,BSDXNOD
305 I '$D(^BSDXRSU("AC",BSDXU)) Q 0
306 S BSDXID=0,BSDXFOUND=0
307 F S BSDXID=$O(^BSDXRSU("AC",BSDXU,BSDXID)) Q:'+BSDXID D Q:BSDXFOUND
308 . S BSDXNOD=$G(^BSDXRSU(BSDXID,0))
309 . I +BSDXNOD=BSDXR S BSDXFOUND=BSDXID
310 . Q
311 Q BSDXFOUND
Note: See TracBrowser for help on using the repository browser.