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

Last change on this file since 1226 was 1187, checked in by Sam Habiel, 13 years ago

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 14.7 KB
RevLine 
[1187]1BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:46pm
2 ;;1.6T2;BSDX;;May 16, 2011
[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?
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
295INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
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
[1172]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 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")
349 ;
350 IF $DATA(BSDXERR) GOTO END
351 ;
352 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
353 . N BMXIEN,BMXSTAUS,BMXPROC,BMXDATE ; Proc IEN, Proc Status, Proc Name
354 . S BMXIEN=$P(BSDXOUT("DILIST",BSDXI,0),U) ; IEN
355 . S BMXSTATUS=$P(BSDXOUT("DILIST",BSDXI,0),U,2) ; Status
356 . S BMXPROC=$P(BSDXOUT("DILIST",BSDXI,0),U,3) ; Procedure Name
357 . S BMXDATE=$TR($P(BSDXOUT("DILIST",BSDXI,0),U,4),"@"," ") ; Request Entered Date Time
358 . S @BSDXY@(BSDXI)=BMXIEN_U_BMXSTATUS_U_BMXPROC_U_BMXDATE_$C(30)
359END ; Errors Jump Here...
360 S @BSDXY@(BSDXI+1)=$C(31)
361 QUIT
362 ;
363SCHRAEX(BSDXY,RADFN,RAOIFN,RAOSCH) ; Schedule a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
364 ; RPC: BSDX SCHEDULE RAD EXAM; Return: Single Value
365 ;
366 ; Input:
367 ; - RADFN -> DFN
368 ; - RAOIFN -> Radiology Order IEN in file 75.1
369 ; - RAOSCH -> Scheduled Time for Exam
370 ; Output: Always "1"
371 ;
372 S RAOSCH=+RAOSCH ; Strip the trailing zeros from the Fileman Date produced by C#
373 N RAOSTS S RAOSTS=8 ; Status of Scheduled
374 D ^RAORDU ; API in Rad expects RADFN, RAOIFN, RAOSCH, and RAOSTS
375 S BSDXY=1 ; Success
376 QUIT
377 ;
378HOLDRAEX(BSDXY,RADFN,RAOIFN) ; Hold a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
[1187]379 ; RPC: BSDX HOLD RAD EXAM; Return: Single Value
[1177]380 ;
381 ; Input:
382 ; - RADFN -> DFN
383 ; - RAOIFN -> Radiology Order IEN in file 75.1
[1187]384 ; Output: 1 OR 0 for success or failure.
385 ; Can we hold?
386 N CANHOLD
387 D CANHOLD(.CANHOLD,RAOIFN)
388 I 'CANHOLD S BSDXY=0 QUIT
389 ;
[1177]390 N RAOSTS S RAOSTS=3 ; Status of Hold
[1187]391 N RAOREA ; Reason, stored in file 75.2
392 I $D(^RA(75.2,100)) S RAOREA=100 ; Custom site Reason
393 E I $D(^RA(75.2,20)) S RAOREA=20 ; Reason: Exam Cancelled
394 E ; Else is empty. I won't set RAOREA at all.
[1177]395 D ^RAORDU
396 S BSDXY=1 ; Success
397 QUIT
[1187]398 ;
399CANHOLD(BSDXY,RAOIFN) ; Can we hold this Exam? RPC EP; UJO/SMH new in 1.6
400 ; RPC: BSDX CAN HOLD RAD EXAM; Return: Single Value
401 ;
402 ; Input:
403 ; - RAOIFN -> Radiology Order IEN in file 75.1
404 ; Output: 0 or 1 for false or true
405 ;
406 N STATUS S STATUS=$$GET1^DIQ(75.1,RAOIFN,"REQUEST STATUS","I")
407 ; 1 = discontinued; 2 = Complete; 6 = Active
408 ; if any one of these, cannot hold exam; otherwise, we can
409 I 126[STATUS S BSDXY=0 QUIT
410 ELSE S BSDXY=1 QUIT
411 QUIT
Note: See TracBrowser for help on using the repository browser.