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

Last change on this file since 1575 was 1563, checked in by Tariq Hamkari, 12 years ago

updated the BSDX version to 1.7

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