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

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

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