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

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

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