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

Last change on this file since 953 was 951, checked in by Sam Habiel, 14 years ago

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason
File size: 9.0 KB
Line 
1BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/15/10 9:09pm
2 ;;1.4;BSDX;;Sep 07, 2010
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 . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4) ; Hospital Location
123 . ; super line... if tied to hospital location,
124 . ; Hosp location exists, AND 4th piece isn't the same as
125 . ; DUZ(2), quit. Filters based on Divisions.
126 . ; . I +BSDXSC,$D(^SC(BSDXSC,0)),$P(^SC(BSDXSC,0),U,4)'=DUZ(2) QUIT
127 . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
128 . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
129 . K BSDXRDAT
130 . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
131 . S BSDXRDAT=BSDXRES_U_BSDXRDAT
132 . ;Get letter text from wp field
133 . S BSDXLTR=""
134 . I $D(^BSDXRES(BSDXRES,1)) D
135 . . S BSDXIEN=0
136 . . F S BSDXIEN=$O(^BSDXRES(BSDXRES,1,BSDXIEN)) Q:'+BSDXIEN D
137 . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXRES,1,BSDXIEN,0))
138 . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
139 . S BSDXNOS=""
140 . I $D(^BSDXRES(BSDXRES,12)) D
141 . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,12,BSDXIEN)) Q:'+BSDXIEN D
142 . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXRES,12,BSDXIEN,0))
143 . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
144 . S BSDXCAN=""
145 . I $D(^BSDXRES(BSDXRES,13)) D
146 . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,13,BSDXIEN)) Q:'+BSDXIEN D
147 . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXRES,13,BSDXIEN,0))
148 . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
149 . N BSDXACC,BSDXMGR
150 . S BSDXACC="0^0^0^0"
151 . S BSDXMGR=$O(^DIC(19.1,"B","BSDXZMGR",0))
152 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
153 . S BSDXMGR=$O(^DIC(19.1,"B","XUPROGMODE",0))
154 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
155 . I BSDXACC="0^0^0^0" D
156 . . N BSDXNOD,BSDXRUID
157 . . S BSDXRUID=0
158 . . ;Get entry for this user and resource
159 . . F S BSDXRUID=$O(^BSDXRSU("AC",BSDXDUZ,BSDXRUID)) Q:'+BSDXRUID I $D(^BSDXRSU(BSDXRUID,0)),$P(^(0),U)=BSDXRES Q
160 . . Q:'+BSDXRUID
161 . . S $P(BSDXACC,U)=1
162 . . S BSDXNOD=$G(^BSDXRSU(BSDXRUID,0))
163 . . S $P(BSDXACC,U,2)=+$P(BSDXNOD,U,3)
164 . . S $P(BSDXACC,U,3)=+$P(BSDXNOD,U,4)
165 . . S $P(BSDXACC,U,4)=+$P(BSDXNOD,U,5)
166 . S BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC
167 . S BSDXI=BSDXI+1
168 . S ^BSDXTMP($J,BSDXI)=BSDXRDAT_$C(30)
169 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
170 Q
171 ;
172DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point
173 ;
174 ;
175 ;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)")
176 ;
177 Q
178 ;
179DEPRES(BSDXY,BSDXDUZ) ;EP
180 ;Called by BSDX GROUP RESOURCE
181 ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
182 ;to which user has access based on entries in BSDX RESOURCE USER file
183 ;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
184 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
185 ;then ALL ACTIVE resource group names are returned
186 ;
187 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
188 N BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID
189 K ^BSDXTEMP($J)
190 K ^BSDXTMP($J)
191 S BSDXY="^BSDXTMP("_$J_")"
192 S BSDXI=0
193 S BSDXERR=""
194 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
195 I '+BSDXDUZ S BSDXDUZ=DUZ
196 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
197 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
198 ;
199 ;User does not have BSDXZMGR or XUPROGMODE keys, so
200 ;$O THRU AC XREF OF BSDX RESOURCE USER
201 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
202 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
203 . Q:'$D(^BSDXDEPT("AB",BSDXRES))
204 . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
205 . Q:BSDXRNOD=""
206 . ;QUIT if the resource is inactive
207 . Q:$P(BSDXRNOD,U,2)=1
208 . S BSDXRESN=$P(BSDXRNOD,U)
209 . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
210 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
211 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
212 . . S BSDXSUBID=$O(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0))
213 . . S BSDXI=BSDXI+1
214 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$C(30)
215 . Q
216 ;
217 ;User does have BSDXZMGR or XUPROGMODE keys, so
218 ;$O THRU BSDX RESOURCE GROUP file directly
219 I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
220 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
221 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
222 . S BSDXDEPN=$P(BSDXNOD,U)
223 . S BSDXRES=0 F S BSDXRES=$O(^BSDXDEPT(BSDXIEN,1,BSDXRES)) Q:'+BSDXRES D
224 . . N BSDXRESD
225 . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0))
226 . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
227 . . Q:'$D(^BSDXRES(BSDXRESD,0))
228 . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
229 . . Q:BSDXRNOD=""
230 . . ;QUIT if the resource is inactive
231 . . Q:$P(BSDXRNOD,U,2)=1
232 . . S BSDXRESN=$P(BSDXRNOD,U)
233 . . S BSDXI=BSDXI+1
234 . . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$C(30)
235 . . Q
236 . Q
237 ;
238 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
239 Q
240 ;
241APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0)
242 ;
243 N BSDXIEN,BSDXPROG,BSDXPKEY
244 I '$G(BSDXDUZ) Q 0
245 ;
246 ;Test for programmer mode key
247 S BSDXPROG=0
248 I $D(^DIC(19.1,"B","XUPROGMODE")) D
249 . S BSDXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
250 . I '+BSDXPKEY Q
251 . I '$D(^VA(200,BSDXDUZ,51,BSDXPKEY,0)) Q
252 . S BSDXPROG=1
253 I BSDXPROG Q 1
254 ;
255 I BSDXKEY="" Q 0
256 I '$D(^DIC(19.1,"B",BSDXKEY)) Q 0
257 S BSDXIEN=$O(^DIC(19.1,"B",BSDXKEY,0))
258 I '+BSDXIEN Q 0
259 I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
260 Q 1
Note: See TracBrowser for help on using the repository browser.