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

Last change on this file since 1728 was 1625, checked in by Tariq Hamkari, 11 years ago

Ayman Ghaith : adding the correct routines which not has the transactions.
File size: 15.7 KB
Line 
1BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 1/29/13 12:53pm
2 ;;1.7;BSDX;;Jun 01, 2013;Build 2
3 ; Licensed under LGPL
4 ;
5SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
6 ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
7 ;
8 Q
9 ;EHS/WAT;UJOK*1.0*4 ;JAN 24,2013;Update [Updating the SUINFO function by adding a new parameter "USERKEY" that holds the name of the user key].
10 ;EHS/WAT;UJO*2.0*31 ;JAN 24,2013;Update [Updating the SUINFO function by adding a new parameter "USERKEY" that holds the name of the user key].
11 ;SUINFO(BSDXY,BSDXDUZ) ;EP
12SUINFO(BSDXY,BSDXDUZ,USERKEY) ;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 ;EHS/WAT;UJOK*1.0*4 ;JAN 24,2013; Update [Updating the argument sent to $$APSEC function from hard coded string "BSDXZMGR" to "USERKEY" variable].
26 ;EHS/WAT;UJO*2.0*31 ;JAN 24,2013; Update [Updating the argument sent to $$APSEC function from hard coded string "BSDXZMGR" to "USERKEY" variable].
27 ;S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ);
28 S BSDXMGR=$$APSEC(USERKEY,BSDXDUZ)
29 S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO")
30 S BSDXI=BSDXI+1
31 S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30)
32 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
33 Q
34DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
35 ;
36 ;
37 ;D DEBUG^%Serenji("DEPUSR^BSDX01(.BSDXY,BSDXDUZ)")
38 ;
39 Q
40 ;
41DEPUSR(BSDXY,BSDXDUZ) ;EP
42 ;Called by BSDX RESOURCE GROUPS BY USER
43 ;Returns ADO Recordset with all ACTIVE resource group names to which user has access
44 ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!)
45 ;If BSDXDUZ=0 then returns all department names for current DUZ
46 ;if not linked, always returned.
47 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
48 ;then ALL resource group names are returned regardless of whether any active resources
49 ;are associated with the group or not.
50 ;
51 ;
52 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
53 N BSDXMGR,BSDXNOD
54 K ^BSDXTEMP($J)
55 K ^BSDXTMP($J)
56 S BSDXY="^BSDXTMP("_$J_")"
57 S BSDXI=0
58 S BSDXERR=""
59 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$C(30)
60 I '+BSDXDUZ S BSDXDUZ=DUZ
61 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
62 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
63 ;
64 ;User does not have BSDXZMGR or XUPROGMODE keys, so
65 ;$O THRU AC XREF OF BSDX RESOURCE USER
66 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
67 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
68 . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; If not part of a group, quit ("AB" is the whole file index for the resource multiple in Group file)
69 . ; Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit
70 . S BSDXRNOD=^BSDXRES(BSDXRES,0)
71 . ;QUIT if the resource is inactive
72 . Q:$P(BSDXRNOD,U,2)=1
73 . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
74 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
75 . . Q:$D(^BSDXTEMP($J,BSDXDEP))
76 . . S ^BSDXTEMP($J,BSDXDEP)=""
77 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
78 . . S BSDXI=BSDXI+1
79 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_$C(30)
80 . . Q
81 . Q
82 ;
83 ;User does have BSDXZMGR or XUPROGMODE keys, so
84 ;$O THRU BSDX RESOURCE GROUP file directly
85 I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
86 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
87 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
88 . S BSDXDEPN=$P(BSDXNOD,U)
89 . S BSDXI=BSDXI+1
90 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_$C(30)
91 . Q
92 ;
93 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
94 Q
95 ;
96 ;
97RESUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
98 ;
99 ;
100 ;D DEBUG^%Serenji("RESUSR^BSDX01(.BSDXY,BSDXDUZ)")
101 ;
102 Q
103 ;
104RESUSR(BSDXY,BSDXDUZ) ;EP
105 ;Returns ADO Recordset with ALL RESOURCE names
106 ;Inactive RESOURCES are NOT filtered out
107 ;Called by BSDX RESOURCES BY USER
108 ;
109 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI,BSDX,BSDXLTR
110 N BSDXNOS,BSDXCAN
111 K ^BSDXTMP($J)
112 S BSDXY="^BSDXTMP("_$J_")"
113 S BSDXI=0
114 S BSDXERR=""
115 S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"
116 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"_$C(30)
117 I '+BSDXDUZ S BSDXDUZ=DUZ
118 ;$O THRU AC XREF OF BSDX RESOURCE USER
119 ;Rmoved these lines in order to just return all resource names
120 ;I $D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
121 ;. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
122 ;
123 ;$O THRU BSDX RESOURCE File
124 S BSDXRES=0 F S BSDXRES=$O(^BSDXRES(BSDXRES)) Q:'+BSDXRES D
125 . Q:'$D(^BSDXRES(BSDXRES,0))
126 . S BSDXRNOD=^BSDXRES(BSDXRES,0)
127 . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4) ; Hospital Location
128 . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
129 . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
130 . ;I '$$INDIV(BSDXSC) QUIT ; If not in division, quit
131 . K BSDXRDAT
132 . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
133 . S BSDXRDAT=BSDXRES_U_BSDXRDAT
134 . ;Get letter text from wp field
135 . S BSDXLTR=""
136 . I $D(^BSDXRES(BSDXRES,1)) D
137 . . S BSDXIEN=0
138 . . F S BSDXIEN=$O(^BSDXRES(BSDXRES,1,BSDXIEN)) Q:'+BSDXIEN D
139 . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXRES,1,BSDXIEN,0))
140 . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
141 . S BSDXNOS=""
142 . I $D(^BSDXRES(BSDXRES,12)) D
143 . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,12,BSDXIEN)) Q:'+BSDXIEN D
144 . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXRES,12,BSDXIEN,0))
145 . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
146 . S BSDXCAN=""
147 . I $D(^BSDXRES(BSDXRES,13)) D
148 . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,13,BSDXIEN)) Q:'+BSDXIEN D
149 . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXRES,13,BSDXIEN,0))
150 . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
151 . N BSDXACC,BSDXMGR
152 . S BSDXACC="0^0^0^0"
153 . S BSDXMGR=$O(^DIC(19.1,"B","BSDXZMGR",0))
154 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
155 . S BSDXMGR=$O(^DIC(19.1,"B","XUPROGMODE",0))
156 . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
157 . I BSDXACC="0^0^0^0" D
158 . . N BSDXNOD,BSDXRUID
159 . . S BSDXRUID=0
160 . . ;Get entry for this user and resource
161 . . F S BSDXRUID=$O(^BSDXRSU("AC",BSDXDUZ,BSDXRUID)) Q:'+BSDXRUID I $D(^BSDXRSU(BSDXRUID,0)),$P(^(0),U)=BSDXRES Q
162 . . Q:'+BSDXRUID
163 . . S $P(BSDXACC,U)=1
164 . . S BSDXNOD=$G(^BSDXRSU(BSDXRUID,0))
165 . . S $P(BSDXACC,U,2)=+$P(BSDXNOD,U,3)
166 . . S $P(BSDXACC,U,3)=+$P(BSDXNOD,U,4)
167 . . S $P(BSDXACC,U,4)=+$P(BSDXNOD,U,5)
168 . S BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC
169 . S BSDXI=BSDXI+1
170 . S ^BSDXTMP($J,BSDXI)=BSDXRDAT_$C(30)
171 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
172 Q
173 ;
174DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point
175 ;
176 ;
177 ;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)")
178 ;
179 Q
180 ;
181DEPRES(BSDXY,BSDXDUZ) ;EP
182 ;Called by BSDX GROUP RESOURCE
183 ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
184 ;to which user has access based on entries in BSDX RESOURCE USER file
185 ;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
186 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
187 ;then ALL ACTIVE resource group names are returned
188 ;
189 N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
190 N BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID
191 K ^BSDXTEMP($J)
192 K ^BSDXTMP($J)
193 S BSDXY="^BSDXTMP("_$J_")"
194 S BSDXI=0
195 S BSDXERR=""
196 S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
197 I '+BSDXDUZ S BSDXDUZ=DUZ
198 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
199 S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
200 ;
201 ;User does not have BSDXZMGR or XUPROGMODE keys, so
202 ;$O THRU AC XREF OF BSDX RESOURCE USER
203 I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
204 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
205 . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; Quit if Resource isn't part of any Group
206 . ;Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user.
207 . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
208 . Q:BSDXRNOD=""
209 . ;QUIT if the resource is inactive
210 . Q:$P(BSDXRNOD,U,2)=1
211 . S BSDXRESN=$P(BSDXRNOD,U)
212 . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
213 . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
214 . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
215 . . S BSDXSUBID=$O(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0))
216 . . S BSDXI=BSDXI+1
217 . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$C(30)
218 . Q
219 ;
220 ;User does have BSDXZMGR or XUPROGMODE keys, so
221 ;$O THRU BSDX RESOURCE GROUP file directly
222 I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
223 . Q:'$D(^BSDXDEPT(BSDXIEN,0))
224 . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
225 . S BSDXDEPN=$P(BSDXNOD,U)
226 . S BSDXRES=0 F S BSDXRES=$O(^BSDXDEPT(BSDXIEN,1,BSDXRES)) Q:'+BSDXRES D
227 . . N BSDXRESD
228 . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0)) ; Quit if zero node is invalid in multiple
229 . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
230 . . Q:'$D(^BSDXRES(BSDXRESD,0)) ; Quit if zero node of resouce file is invalid
231 . . ;Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division
232 . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
233 . . Q:BSDXRNOD=""
234 . . ;QUIT if the resource is inactive
235 . . Q:$P(BSDXRNOD,U,2)=1
236 . . S BSDXRESN=$P(BSDXRNOD,U)
237 . . S BSDXI=BSDXI+1
238 . . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$C(30)
239 . . Q
240 . Q
241 ;
242 S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
243 Q
244 ;
245APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0)
246 ;
247 N BSDXIEN,BSDXPROG,BSDXPKEY
248 I '$G(BSDXDUZ) Q 0
249 ;
250 ;Test for programmer mode key
251 S BSDXPROG=0
252 I $D(^DIC(19.1,"B","XUPROGMODE")) D
253 . S BSDXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
254 . I '+BSDXPKEY Q
255 . I '$D(^VA(200,BSDXDUZ,51,BSDXPKEY,0)) Q
256 . S BSDXPROG=1
257 I BSDXPROG Q 1
258 ;
259 I BSDXKEY="" Q 0
260 I '$D(^DIC(19.1,"B",BSDXKEY)) Q 0
261 S BSDXIEN=$O(^DIC(19.1,"B",BSDXKEY,0))
262 I '+BSDXIEN Q 0
263 I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
264 Q 1
265SP(BSDXY,PARAM,YESNO) ; Save Param at User Level - EP
266 ; Called by RPC: BSDX SET PARAM
267 ; Input:
268 ; - Param: Name of Parameter (prog name of course)
269 ; - Yes/No: 1 or 0
270 ; Output: Error Code as string; 0 is good
271 ;
272 ; Security Protection
273 IF $EXTRACT(PARAM,1,4)'="BSDX" S BSDXY="-1^BSDX Params only allowed" QUIT
274 ;
275 N ERROR
276 D PUT^XPAR("USR",PARAM,1,YESNO,.ERROR)
277 S BSDXY=$G(ERROR)
278 QUIT
279 ;
280GP(BSDXY,PARAM) ; Get Param - EP
281 ; Called by RPC: BSDX GET PARAM
282 ; Input: Name of Parameter
283 ; Output: Value of parameter: 0 or 1, for now.
284 ;
285 S BSDXY=$$GET^XPAR("USR^LOC^SYS^PKG",PARAM,1,"I")
286 QUIT
287 ;
288INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
289 ; Input: BSDXSC - Hospital Location IEN
290 ; Output: True or False
291 I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
292 I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
293 ; Jump to Division:Medical Center Division:Inst File Pointer for
294 ; Institution IEN (and get its internal value)
295 N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
296 I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
297 I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
298 E Q 0 ; Otherwise, no
299INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
300 ; Input BSDXRES - BSDX RESOURCE IEN
301 ; Output: True of False
302 Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
303UTINDIV ; Unit Test $$INDIV
304 W "Testing if they are the same",!
305 S DUZ(2)=67
306 I '$$INDIV(1) W "ERROR",!
307 I '$$INDIV(2) W "ERROR",!
308 W "Testing if Div not defined in 44, should be true",!
309 I '$$INDIV(3) W "ERROR",!
310 W "Testing empty string. Should be true",!
311 I '$$INDIV("") W "ERROR",!
312 W "Testing if they are different",!
313 S DUZ(2)=899
314 I $$INDIV(1) W "ERROR",!
315 I $$INDIV(2) W "ERROR",!
316 QUIT
317UTINDIV2 ; Unit Test $$INDIV2
318 W "Testing if they are the same",!
319 S DUZ(2)=69
320 I $$INDIV2(22)'=0 W "ERROR",!
321 I $$INDIV2(25)'=1 W "ERROR",!
322 I $$INDIV2(26)'=1 W "ERROR",!
323 I $$INDIV2(27)'=1 W "ERROR",!
324 QUIT
325 ;
326GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
327 ; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
328 ;
329 ; Input: DFN - you should know; SCIEN - IEN of Hospital Location
330 ; Output: ADO Datatable with the following columns:
331 ; - BMXIEN: Radiology Exam IEN in file 75.1 (RAD/NUC MED ORDERS)
332 ; - STATUS: Pending Or Hold Status
333 ; - PROCEDURE: Text Procedure Name
334 ; - REQUEST_DATE: Date Procedure was requested
335 ;
336 ; Error Processing: Silent failure.
337 ;
338 S BSDXY=$NA(^BMXTEMP($J))
339 K @BSDXY
340 ;
341 N BSDXI S BSDXI=0
342 S @BSDXY@(BSDXI)="I00015BMXIEN^T00015STATUS^T00100PROCEDURE^D00030REQUEST_DATE"_$C(30)
343 ;
344 N BSDXRLIEN S BSDXRLIEN=$ORDER(^RA(79.1,"B",SCIEN,"")) ; IEN of HL in file 79.1, to get Radiology Imaging IEN
345 I 'BSDXRLIEN GOTO END
346 ;
347 N BSDXOUT,BSDXERR ; Out, Error
348 ;
349 ; File 75.1 = RAD/NUC MED ORDERS
350 ; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time
351 ; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested
352 ;;EHS/MKH,BAH;;BSDX 1.7;;30/09/2012;; Update [Fix the performance issue in SchedGUI]
353 ; START OF CODE CHANGES FOR [BSDX 1.7]
354 ; Commented old Line
355 ;D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXE>>RR")
356 DO FIND^DIC(75.1,"","@;5;2;16","QP",DFN,"","B","IF 35[$PIECE(^(0),U,5)&($PIECE(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR")
357 ; END OF CODE CHANGES FOR [BSDX 1.7]
358 ;
359 IF $DATA(BSDXERR) GOTO END
360 ;
361 I +BSDXOUT("DILIST",0)>0 FOR BSDXI=1:1:+BSDXOUT("DILIST",0) DO ; if we have data, fetch the data in each row and store it in the return variable
362 . N BMXIEN,BMXSTAUS,BMXPROC,BMXDATE ; Proc IEN, Proc Status, Proc Name
363 . S BMXIEN=$P(BSDXOUT("DILIST",BSDXI,0),U) ; IEN
364 . S BMXSTATUS=$P(BSDXOUT("DILIST",BSDXI,0),U,2) ; Status
365 . S BMXPROC=$P(BSDXOUT("DILIST",BSDXI,0),U,3) ; Procedure Name
366 . S BMXDATE=$TR($P(BSDXOUT("DILIST",BSDXI,0),U,4),"@"," ") ; Request Entered Date Time
367 . S @BSDXY@(BSDXI)=BMXIEN_U_BMXSTATUS_U_BMXPROC_U_BMXDATE_$C(30)
368END ; Errors Jump Here...
369 S @BSDXY@(BSDXI+1)=$C(31)
370 QUIT
371 ;
372SCHRAEX(BSDXY,RADFN,RAOIFN,RAOSCH) ; Schedule a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
373 ; RPC: BSDX SCHEDULE RAD EXAM; Return: Single Value
374 ;
375 ; Input:
376 ; - RADFN -> DFN
377 ; - RAOIFN -> Radiology Order IEN in file 75.1
378 ; - RAOSCH -> Scheduled Time for Exam
379 ; Output: Always "1"
380 ;
381 S RAOSCH=+RAOSCH ; Strip the trailing zeros from the Fileman Date produced by C#
382 N RAOSTS S RAOSTS=8 ; Status of Scheduled
383 D ^RAORDU ; API in Rad expects RADFN, RAOIFN, RAOSCH, and RAOSTS
384 S BSDXY=1 ; Success
385 QUIT
386 ;
387HOLDRAEX(BSDXY,RADFN,RAOIFN) ; Hold a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
388 ; RPC: BSDX HOLD RAD EXAM; Return: Single Value
389 ;
390 ; Input:
391 ; - RADFN -> DFN
392 ; - RAOIFN -> Radiology Order IEN in file 75.1
393 ; Output: 1 OR 0 for success or failure.
394 ; Can we hold?
395 N CANHOLD
396 D CANHOLD(.CANHOLD,RAOIFN)
397 I 'CANHOLD S BSDXY=0 QUIT
398 ;
399 N RAOSTS S RAOSTS=3 ; Status of Hold
400 N RAOREA ; Reason, stored in file 75.2
401 I $D(^RA(75.2,100)) S RAOREA=100 ; Custom site Reason
402 E I $D(^RA(75.2,20)) S RAOREA=20 ; Reason: Exam Cancelled
403 E ; Else is empty. I won't set RAOREA at all.
404 D ^RAORDU
405 S BSDXY=1 ; Success
406 QUIT
407 ;
408CANHOLD(BSDXY,RAOIFN) ; Can we hold this Exam? RPC EP; UJO/SMH new in 1.6
409 ; RPC: BSDX CAN HOLD RAD EXAM; Return: Single Value
410 ;
411 ; Input:
412 ; - RAOIFN -> Radiology Order IEN in file 75.1
413 ; Output: 0 or 1 for false or true
414 ;
415 N STATUS S STATUS=$$GET1^DIQ(75.1,RAOIFN,"REQUEST STATUS","I")
416 ; 1 = discontinued; 2 = Complete; 6 = Active
417 ; if any one of these, cannot hold exam; otherwise, we can
418 I 126[STATUS S BSDXY=0 QUIT
419 ELSE S BSDXY=1 QUIT
420 QUIT
Note: See TracBrowser for help on using the repository browser.