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

Last change on this file since 1474 was 1472, checked in by Sam Habiel, 12 years ago

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.
File size: 14.7 KB
Line 
1BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:52am
2 ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
3 ; Licensed under LGPL
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
39 ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!)
40 ;If BSDXDUZ=0 then returns all department names for current DUZ
41 ;if not linked, always returned.
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)
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)
64 . ; Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit
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 . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
124 . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
125 . ;I '$$INDIV(BSDXSC) QUIT ; If not in division, quit
126 . K BSDXRDAT
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)
200 . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; Quit if Resource isn't part of any Group
201 . ;Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user.
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
223 . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0)) ; Quit if zero node is invalid in multiple
224 . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
225 . . Q:'$D(^BSDXRES(BSDXRESD,0)) ; Quit if zero node of resouce file is invalid
226 . . ;Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division
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
260SP(BSDXY,PARAM,YESNO) ; Save Param at User Level - EP
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 ;
275GP(BSDXY,PARAM) ; Get Param - EP
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 ;
283INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
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
294INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
295 ; Input BSDXRES - BSDX RESOURCE IEN
296 ; Output: True of False
297 Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
298UTINDIV ; Unit Test $$INDIV
299 W "Testing if they are the same",!
300 S DUZ(2)=67
301 I '$$INDIV(1) W "ERROR",!
302 I '$$INDIV(2) W "ERROR",!
303 W "Testing if Div not defined in 44, should be true",!
304 I '$$INDIV(3) W "ERROR",!
305 W "Testing empty string. Should be true",!
306 I '$$INDIV("") W "ERROR",!
307 W "Testing if they are different",!
308 S DUZ(2)=899
309 I $$INDIV(1) W "ERROR",!
310 I $$INDIV(2) W "ERROR",!
311 QUIT
312UTINDIV2 ; Unit Test $$INDIV2
313 W "Testing if they are the same",!
314 S DUZ(2)=69
315 I $$INDIV2(22)'=0 W "ERROR",!
316 I $$INDIV2(25)'=1 W "ERROR",!
317 I $$INDIV2(26)'=1 W "ERROR",!
318 I $$INDIV2(27)'=1 W "ERROR",!
319 QUIT
320 ;
321GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
322 ; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
323 ;
324 ; Input: DFN - you should know; SCIEN - IEN of Hospital Location
325 ; Output: ADO Datatable with the following columns:
326 ; - BMXIEN: Radiology Exam IEN in file 75.1 (RAD/NUC MED ORDERS)
327 ; - STATUS: Pending Or Hold Status
328 ; - PROCEDURE: Text Procedure Name
329 ; - REQUEST_DATE: Date Procedure was requested
330 ;
331 ; Error Processing: Silent failure.
332 ;
333 S BSDXY=$NA(^BMXTEMP($J))
334 K @BSDXY
335 ;
336 N BSDXI S BSDXI=0
337 S @BSDXY@(BSDXI)="I00015BMXIEN^T00015STATUS^T00100PROCEDURE^D00030REQUEST_DATE"_$C(30)
338 ;
339 N BSDXRLIEN S BSDXRLIEN=$ORDER(^RA(79.1,"B",SCIEN,"")) ; IEN of HL in file 79.1, to get Radiology Imaging IEN
340 I 'BSDXRLIEN GOTO END
341 ;
342 N BSDXOUT,BSDXERR ; Out, Error
343 ;
344 ; File 75.1 = RAD/NUC MED ORDERS
345 ; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time
346 ; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested
347 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")
348 ;
349 IF $DATA(BSDXERR) GOTO END
350 ;
351 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
352 . N BMXIEN,BMXSTAUS,BMXPROC,BMXDATE ; Proc IEN, Proc Status, Proc Name
353 . S BMXIEN=$P(BSDXOUT("DILIST",BSDXI,0),U) ; IEN
354 . S BMXSTATUS=$P(BSDXOUT("DILIST",BSDXI,0),U,2) ; Status
355 . S BMXPROC=$P(BSDXOUT("DILIST",BSDXI,0),U,3) ; Procedure Name
356 . S BMXDATE=$TR($P(BSDXOUT("DILIST",BSDXI,0),U,4),"@"," ") ; Request Entered Date Time
357 . S @BSDXY@(BSDXI)=BMXIEN_U_BMXSTATUS_U_BMXPROC_U_BMXDATE_$C(30)
358END ; Errors Jump Here...
359 S @BSDXY@(BSDXI+1)=$C(31)
360 QUIT
361 ;
362SCHRAEX(BSDXY,RADFN,RAOIFN,RAOSCH) ; Schedule a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
363 ; RPC: BSDX SCHEDULE RAD EXAM; Return: Single Value
364 ;
365 ; Input:
366 ; - RADFN -> DFN
367 ; - RAOIFN -> Radiology Order IEN in file 75.1
368 ; - RAOSCH -> Scheduled Time for Exam
369 ; Output: Always "1"
370 ;
371 S RAOSCH=+RAOSCH ; Strip the trailing zeros from the Fileman Date produced by C#
372 N RAOSTS S RAOSTS=8 ; Status of Scheduled
373 D ^RAORDU ; API in Rad expects RADFN, RAOIFN, RAOSCH, and RAOSTS
374 S BSDXY=1 ; Success
375 QUIT
376 ;
377HOLDRAEX(BSDXY,RADFN,RAOIFN) ; Hold a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
378 ; RPC: BSDX HOLD RAD EXAM; Return: Single Value
379 ;
380 ; Input:
381 ; - RADFN -> DFN
382 ; - RAOIFN -> Radiology Order IEN in file 75.1
383 ; Output: 1 OR 0 for success or failure.
384 ; Can we hold?
385 N CANHOLD
386 D CANHOLD(.CANHOLD,RAOIFN)
387 I 'CANHOLD S BSDXY=0 QUIT
388 ;
389 N RAOSTS S RAOSTS=3 ; Status of Hold
390 N RAOREA ; Reason, stored in file 75.2
391 I $D(^RA(75.2,100)) S RAOREA=100 ; Custom site Reason
392 E I $D(^RA(75.2,20)) S RAOREA=20 ; Reason: Exam Cancelled
393 E ; Else is empty. I won't set RAOREA at all.
394 D ^RAORDU
395 S BSDXY=1 ; Success
396 QUIT
397 ;
398CANHOLD(BSDXY,RAOIFN) ; Can we hold this Exam? RPC EP; UJO/SMH new in 1.6
399 ; RPC: BSDX CAN HOLD RAD EXAM; Return: Single Value
400 ;
401 ; Input:
402 ; - RAOIFN -> Radiology Order IEN in file 75.1
403 ; Output: 0 or 1 for false or true
404 ;
405 N STATUS S STATUS=$$GET1^DIQ(75.1,RAOIFN,"REQUEST STATUS","I")
406 ; 1 = discontinued; 2 = Complete; 6 = Active
407 ; if any one of these, cannot hold exam; otherwise, we can
408 I 126[STATUS S BSDXY=0 QUIT
409 ELSE S BSDXY=1 QUIT
410 QUIT
Note: See TracBrowser for help on using the repository browser.