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

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

Initial committ of scheduling package
File size: 8.7 KB
Line 
1BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
2 ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
3 ;
4 ;
5SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
6 ;
7 ;
8 ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
9 ;
10 Q
11 ;
12SUINFO(BSDXY,BSDXDUZ) ;EP
13 ;Called by BSDX SCHEDULING USER INFO
14 ;Returns ADO Recordset having column MANAGER
15 ;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE
16 ;
17 N BSDXMGR,BSDXERR
18 K ^BSDXTMP($J)
19 S BSDXY="^BSDXTMP("_$J_")"
20 S BSDXI=0
21 S BSDXERR=""
22 S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30)
23 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
24 I '+BSDXDUZ S BSDXDUZ=DUZ
25 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
26 S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO")
27 S BSDXI=BSDXI+1
28 S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30)
29 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
30 Q
31DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
32 ;
33 ;
34 ;D DEBUG^%Serenji("DEPUSR^BSDX01(.BSDXY,BSDXDUZ)")
35 ;
36 Q
37 ;
38DEPUSR(BSDXY,BSDXDUZ) ;EP
39 ;Called by BSDX RESOURCE GROUPS BY USER
40 ;Returns ADO Recordset with all ACTIVE resource group names to which user has access
41 ;based on entries in BSDX RESOURCE USER file
42 ;If BSDXDUZ=0 then returns all department names for current DUZ
43 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
44 ;then ALL resource group names are returned regardless of whether any active resources
45 ;are associated with the group or not.
46 ;
47 ;
48 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
49 N BSDXMGR,BSDXNOD
50 K ^BSDXTEMP($J)
51 K ^BSDXTMP($J)
52 S BSDXY="^BSDXTMP("_$J_")"
53 S BSDXI=0
54 S BSDXERR=""
55 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$C(30)
56 I '+BSDXDUZ S BSDXDUZ=DUZ
57 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
58 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
59 ;
60 ;User does not have BSDXZMGR or XUPROGMODE keys, so
61 ;$O THRU AC XREF OF BSDX RESOURCE USER
62 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
63 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
64 . Q:'$D(^BSDXDEPT("AB",BSDXRES))
65 . S BSDXRNOD=^BSDXRES(BSDXRES,0)
66 . ;QUIT if the resource is inactive
67 . Q:$P(BSDXRNOD,U,2)=1
68 . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
69 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
70 . . Q:$D(^BSDXTEMP($J,BSDXDEP))
71 . . S ^BSDXTEMP($J,BSDXDEP)=""
72 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
73 . . S BSDXI=BSDXI+1
74 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_$C(30)
75 . . Q
76 . Q
77 ;
78 ;User does have BSDXZMGR or XUPROGMODE keys, so
79 ;$O THRU BSDX RESOURCE GROUP file directly
80 I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
81 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
82 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
83 . S BSDXDEPN=$P(BSDXNOD,U)
84 . S BSDXI=BSDXI+1
85 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_$C(30)
86 . Q
87 ;
88 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
89 Q
90 ;
91 ;
92RESUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
93 ;
94 ;
95 ;D DEBUG^%Serenji("RESUSR^BSDX01(.BSDXY,BSDXDUZ)")
96 ;
97 Q
98 ;
99RESUSR(BSDXY,BSDXDUZ) ;EP
100 ;Returns ADO Recordset with ALL RESOURCE names
101 ;Inactive RESOURCES are NOT filtered out
102 ;Called by BSDX RESOURCES BY USER
103 ;
104 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI,BSDX,BSDXLTR
105 N BSDXNOS,BSDXCAN
106 K ^BSDXTMP($J)
107 S BSDXY="^BSDXTMP("_$J_")"
108 S BSDXI=0
109 S BSDXERR=""
110 S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"
111 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"_$C(30)
112 I '+BSDXDUZ S BSDXDUZ=DUZ
113 ;$O THRU AC XREF OF BSDX RESOURCE USER
114 ;Rmoved these lines in order to just return all resource names
115 ;I $D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
116 ;. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
117 ;
118 ;$O THRU BSDX RESOURCE File
119 S BSDXRES=0 F S BSDXRES=$O(^BSDXRES(BSDXRES)) Q:'+BSDXRES D
120 . Q:'$D(^BSDXRES(BSDXRES,0))
121 . S BSDXRNOD=^BSDXRES(BSDXRES,0)
122 . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
123 . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
124 . K BSDXRDAT
125 . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
126 . S BSDXRDAT=BSDXRES_U_BSDXRDAT
127 . ;Get letter text from wp field
128 . S BSDXLTR=""
129 . I $D(^BSDXRES(BSDXRES,1)) D
130 . . S BSDXIEN=0
131 . . F S BSDXIEN=$O(^BSDXRES(BSDXRES,1,BSDXIEN)) Q:'+BSDXIEN D
132 . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXRES,1,BSDXIEN,0))
133 . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
134 . S BSDXNOS=""
135 . I $D(^BSDXRES(BSDXRES,12)) D
136 . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,12,BSDXIEN)) Q:'+BSDXIEN D
137 . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXRES,12,BSDXIEN,0))
138 . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
139 . S BSDXCAN=""
140 . I $D(^BSDXRES(BSDXRES,13)) D
141 . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,13,BSDXIEN)) Q:'+BSDXIEN D
142 . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXRES,13,BSDXIEN,0))
143 . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
144 . N BSDXACC,BSDXMGR
145 . S BSDXACC="0^0^0^0"
146 . S BSDXMGR=$O(^DIC(19.1,"B","BSDXZMGR",0))
147 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
148 . S BSDXMGR=$O(^DIC(19.1,"B","XUPROGMODE",0))
149 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
150 . I BSDXACC="0^0^0^0" D
151 . . N BSDXNOD,BSDXRUID
152 . . S BSDXRUID=0
153 . . ;Get entry for this user and resource
154 . . F S BSDXRUID=$O(^BSDXRSU("AC",BSDXDUZ,BSDXRUID)) Q:'+BSDXRUID I $D(^BSDXRSU(BSDXRUID,0)),$P(^(0),U)=BSDXRES Q
155 . . Q:'+BSDXRUID
156 . . S $P(BSDXACC,U)=1
157 . . S BSDXNOD=$G(^BSDXRSU(BSDXRUID,0))
158 . . S $P(BSDXACC,U,2)=+$P(BSDXNOD,U,3)
159 . . S $P(BSDXACC,U,3)=+$P(BSDXNOD,U,4)
160 . . S $P(BSDXACC,U,4)=+$P(BSDXNOD,U,5)
161 . S BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC
162 . S BSDXI=BSDXI+1
163 . S ^BSDXTMP($J,BSDXI)=BSDXRDAT_$C(30)
164 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
165 Q
166 ;
167DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point
168 ;
169 ;
170 ;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)")
171 ;
172 Q
173 ;
174DEPRES(BSDXY,BSDXDUZ) ;EP
175 ;Called by BSDX GROUP RESOURCE
176 ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
177 ;to which user has access based on entries in BSDX RESOURCE USER file
178 ;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
179 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
180 ;then ALL ACTIVE resource group names are returned
181 ;
182 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
183 N BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID
184 K ^BSDXTEMP($J)
185 K ^BSDXTMP($J)
186 S BSDXY="^BSDXTMP("_$J_")"
187 S BSDXI=0
188 S BSDXERR=""
189 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
190 I '+BSDXDUZ S BSDXDUZ=DUZ
191 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
192 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
193 ;
194 ;User does not have BSDXZMGR or XUPROGMODE keys, so
195 ;$O THRU AC XREF OF BSDX RESOURCE USER
196 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
197 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
198 . Q:'$D(^BSDXDEPT("AB",BSDXRES))
199 . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
200 . Q:BSDXRNOD=""
201 . ;QUIT if the resource is inactive
202 . Q:$P(BSDXRNOD,U,2)=1
203 . S BSDXRESN=$P(BSDXRNOD,U)
204 . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
205 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
206 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
207 . . S BSDXSUBID=$O(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0))
208 . . S BSDXI=BSDXI+1
209 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$C(30)
210 . Q
211 ;
212 ;User does have BSDXZMGR or XUPROGMODE keys, so
213 ;$O THRU BSDX RESOURCE GROUP file directly
214 I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
215 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
216 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
217 . S BSDXDEPN=$P(BSDXNOD,U)
218 . S BSDXRES=0 F S BSDXRES=$O(^BSDXDEPT(BSDXIEN,1,BSDXRES)) Q:'+BSDXRES D
219 . . N BSDXRESD
220 . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0))
221 . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
222 . . Q:'$D(^BSDXRES(BSDXRESD,0))
223 . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
224 . . Q:BSDXRNOD=""
225 . . ;QUIT if the resource is inactive
226 . . Q:$P(BSDXRNOD,U,2)=1
227 . . S BSDXRESN=$P(BSDXRNOD,U)
228 . . S BSDXI=BSDXI+1
229 . . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$C(30)
230 . . Q
231 . Q
232 ;
233 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
234 Q
235 ;
236APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0)
237 ;
238 N BSDXIEN,BSDXPROG,BSDXPKEY
239 I '$G(BSDXDUZ) Q 0
240 ;
241 ;Test for programmer mode key
242 S BSDXPROG=0
243 I $D(^DIC(19.1,"B","XUPROGMODE")) D
244 . S BSDXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
245 . I '+BSDXPKEY Q
246 . I '$D(^VA(200,BSDXDUZ,51,BSDXPKEY,0)) Q
247 . S BSDXPROG=1
248 I BSDXPROG Q 1
249 ;
250 I BSDXKEY="" Q 0
251 I '$D(^DIC(19.1,"B",BSDXKEY)) Q 0
252 S BSDXIEN=$O(^DIC(19.1,"B",BSDXKEY,0))
253 I '+BSDXIEN Q 0
254 I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
255 Q 1
Note: See TracBrowser for help on using the repository browser.