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

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

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.
File size: 9.3 KB
Line 
1BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
2 ;;1.7T1;BSDX;;Jul 06, 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.