source: Scheduling/trunk/m/BSDX07.m@ 1792

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

Ayman Ghaith : adding the correct routines which not has the transactions.
File size: 10.5 KB
Line 
1BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:02pm
2 ;;1.7;BSDX;;Jun 01, 2013;Build 24
3 ; Licensed under LGPL
4 ;
5 ; Change Log:
6 ; UJO/SMH
7 ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
8 ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
9 ; v1.42 Oct 30 2010 - Extensive refactoring.
10 ; v1.5 Mar 15 2011 - End time does not have to have time anymore.
11 ; It could be midnight of the next day
12 ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
13 ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes
14 ; - AVUPDT moved to AVUPDTMK in BSDXAPI1
15 ;
16 ; Error Reference:
17 ; -1: Patient Record is locked. This means something is wrong!!!!
18 ; -2: Start Time is not a valid Fileman date
19 ; -3: End Time is not a valid Fileman date
20 ; v1.5:obsolete::-4: End Time does not have time inside of it.
21 ; -5: BSDXPATID is not numeric
22 ; -6: Patient Does not exist in ^DPT
23 ; -7: Resource Name does not exist in B index of BSDX RESOURCE
24 ; -8: Resouce doesn't exist in ^BSDXRES
25 ; -9: Couldn't add appointment to BSDX APPOINTMENT
26 ; -10: Couldn't add appointment to files 2 and/or 44
27 ; -100: Mumps Error
28 ;
29APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
30 ;Entry point for debugging
31 ; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
32 Q
33 ;
34APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP
35 ;
36 ;Called by RPC: BSDX ADD NEW APPOINTMENT
37 ;
38 ;Add new appointment to 3 files
39 ; - BSDX APPOINTMENT
40 ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
41 ; - Patient Appointment Subfile if Resource is linked to clinic
42 ;
43 ;Paramters:
44 ;BSDXY: Global Return (RPC must be set to Global Array)
45 ;BSDXSTART: FM Start Date
46 ;BSDXEND: FM End Date
47 ;BSDXPATID: Patient DFN
48 ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
49 ;BSDXLEN is the appointment duration in minutes
50 ;BSDXNOTE is the Appiontment Note
51 ;BSDXATID is used for 2 purposes:
52 ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
53 ; if BSDXATID = a number, then it is the access type id (used for rebooking)
54 ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
55 ;
56 ;Return:
57 ; ADO.net Recordset having fields:
58 ; AppointmentID and ErrorNumber
59 ;
60 ; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
61 ; to sort out. Needs changes on client.
62 ;
63 ;Test lines:
64 ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
65 ;
66 ; Deal with optional arguments
67 S BSDXRADEXAM=$G(BSDXRADEXAM)
68 ;
69 ; Return Array; set Return and clear array
70 S BSDXY=$NA(^BSDXTMP($J))
71 K ^BSDXTMP($J)
72 ;
73 ; $ET
74 N $ET S $ET="G ETRAP^BSDX07"
75 ;
76 ; Counter
77 N BSDXI S BSDXI=0
78 ;
79 ; Lock BSDX node, only to synchronize access to the globals.
80 ; It's not expected that the error will ever happen as no filing
81 ; is supposed to take 5 seconds.
82 L +^BSDXPAT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
83 ;
84 ; Header Node
85 S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
86 ;
87 ; Turn off SDAM APPT PROTOCOL BSDX Entries
88 N BSDXNOEV
89 S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
90 ;
91 ; Set Error Message to be empty
92 N BSDXERR S BSDXERR=0
93 ;
94 ;;;test for error. See if %ZTER works
95 I $G(BSDXDIE) N X S X=1/0
96 ;;;test
97 ;
98 ; -- Start and End Date Processing --
99 ; If C# sends the dates with extra zeros, remove them
100 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
101 ; Are the dates valid? Must be FM Dates > than 2010
102 I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
103 I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
104 ;
105 ;; If Ending date doesn't have a time, this is an error --rm 1.5
106 ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
107 ;
108 ; If the Start Date is greater than the end date, swap dates
109 N BSDXTMP
110 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
111 ;
112 ; Check if the patient exists:
113 ; - DFN valid number?
114 ; - Valid Patient in file 2?
115 I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
116 I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
117 ;
118 ;Validate Resource entry
119 I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
120 N BSDXRESD ; Resource IEN
121 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
122 N BSDXRNOD ; Resouce zero node
123 S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
124 I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
125 ;
126 ; Walk-in (Unscheduled) Appointment?
127 N BSDXWKIN S BSDXWKIN=0
128 I BSDXATID="WALKIN" S BSDXWKIN=1
129 ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
130 I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
131 ;
132 ; Now, check if PIMS has any issues with us making the appt using MAKECK
133 N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN
134 N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
135 N BSDXC ; Array to send to MAKE and MAKECK APIs
136 ; Only if we have a valid Hosp Location
137 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D
138 . S BSDXC("PAT")=BSDXPATID
139 . S BSDXC("CLN")=BSDXSCD
140 . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
141 . S:BSDXWKIN BSDXC("TYP")=4
142 . S BSDXC("ADT")=BSDXSTART
143 . S BSDXC("LEN")=BSDXLEN
144 . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
145 . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
146 . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
147 . S BSDXC("USR")=DUZ
148 . S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC)
149 I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q ; no need for roll back
150 ;
151 ; Done with all checks, let's make appointment in BSDX APPOINTMENT
152 N BSDXAPPTID
153 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
154 I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q ; no roll back needed! No appts made.
155 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here
156 ; I don't think it's important b/c users can detect right away if the WP
157 ; filing fails.
158 ;
159 I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q ; UT Line
160 ;
161 ; Only if we have a valid Hosp Loc can we make an appointment in 2/44
162 ; Use BSDXC array from before.
163 ; FYI: $$MAKE itself calls $$MAKECK to check again for being okay.
164 ; If an error happens here, we roll back both ^BSDXAPPT and 2/44 by deleting
165 N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
166 I +BSDXSCD,$D(^SC(BSDXSCD,0)) S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
167 I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
168 ;
169 ; Unlock
170 L -^BSDXPAT(BSDXPATID)
171 ;
172 ;Return Recordset
173 S BSDXI=BSDXI+1
174 S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
175 S BSDXI=BSDXI+1
176 S ^BSDXTMP($J,BSDXI)=$C(31)
177 Q
178STRIP(BSDXZ) ;Replace control characters with spaces
179 N BSDXI
180 F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
181 Q BSDXZ
182 ;
183BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY
184 ;Returns ien in BSDXAPPT or 0 if failed
185 ;Create entry in BSDX APPOINTMENT
186 N BSDXAPPTID,BSDXFDA
187 S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
188 S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
189 S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
190 S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
191 S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
192 S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
193 S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
194 S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
195 S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM)
196 N BSDXIEN,BSDXMSG
197 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
198 S BSDXAPPTID=+$G(BSDXIEN(1))
199 Q BSDXAPPTID
200 ;
201BSDXWP(BSDXAPPTID,BSDXNOTE) ;
202 ;Add WP field
203 N BSDXMSG
204 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
205 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
206 I $D(BSDXNOTE(.5)) D
207 . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
208 Q
209 ;
210ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
211 ;Called by BSDX ADD APPOINTMENT protocol
212 ;BSDXSC=IEN of clinic in ^SC
213 ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
214 ;
215 N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES,BSDXNOTE,BSDXEND
216 Q:+$G(BSDXNOEV)
217 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
218 E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
219 Q:'+$G(BSDXRES)
220 S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
221 Q:BSDXNOD=""
222 S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
223 S BSDXWKIN=""
224 S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
225 S BSDXLEN=$P(BSDXNOD,U,2)
226 Q:'+BSDXLEN
227 S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
228 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
229 Q:'+BSDXAPPTID
230 S BSDXNOTE=$P(BSDXNOD,U,4)
231 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
232 D ADDEVT3(BSDXRES)
233 Q
234 ;
235ADDEVT3(BSDXRES) ;
236 ;Call RaiseEvent to notify GUI clients
237 N BSDXRESN
238 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
239 Q:BSDXRESN=""
240 S BSDXRESN=$P(BSDXRESN,"^")
241 ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
242 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
243 Q
244 ;
245ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
246 ; DO NOT USE except as an emergency measure - only if unforseen error occurs
247 ; Input:
248 ; Appointment ID to remove from ^BSDXAPPT
249 ; BSDXC array (see array format in $$MAKE^BSDXAPI)
250 N %
251 D BSDXDEL^BSDX07(BSDXAPPTID)
252 S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
253 QUIT
254 ;
255BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT
256 ; DO NOT USE except in emergencies to roll back an appointment set
257 N DA,DIK
258 S DIK="^BSDXAPPT(",DA=BSDXAPPTID
259 D ^DIK
260 Q
261 ;
262ERR(BSDXI,BSDXERR) ;Error processing - different from error trap.
263 ; Unlock first
264 L -^BSDXPAT(BSDXPATID)
265 ; If last line is $C(31), we are done. No more errors to send to client.
266 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
267 S BSDXI=BSDXI+1
268 S BSDXERR=$TR(BSDXERR,"^","~")
269 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
270 S BSDXI=BSDXI+1
271 S ^BSDXTMP($J,BSDXI)=$C(31)
272 Q
273 ;
274ETRAP ;EP Error trap entry
275 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
276 D ^%ZTER
277 ;
278 I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists
279 ;
280 ; Log error message and send to client
281 I '$D(BSDXI) N BSDXI S BSDXI=0
282 D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
283 Q:$Q 1_U_"Mumps Error" Q
284 ;
Note: See TracBrowser for help on using the repository browser.