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

Last change on this file since 1475 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: 10.3 KB
Line 
1BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:57pm
2 ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
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) ;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 ; NB: 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 +^BSDXAPPT(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 inside transaction. See if %ZTER works
95 I $G(BSDXDIE) 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 ; 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 I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q ; no need for roll back
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 ;
150 ; Done with all checks, let's make appointment in BSDX APPOINTMENT
151 N BSDXAPPTID
152 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
153 I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q ; no roll back needed! No appts made.
154 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here
155 ; I don't think it's important b/c users can detect right away if the WP
156 ; filing fails.
157 ;
158 I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q ; UT Line
159 ;
160 ; Only if we have a valid Hosp Loc can we make an appointment in 2/44
161 ; Use BSDXC array from before.
162 ; NB: $$MAKE itself calls $$MAKECK to check again for being okay.
163 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
164 . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
165 ;
166 ;Return Recordset
167 L -^BSDXAPPT(BSDXPATID)
168 S BSDXI=BSDXI+1
169 S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
170 S BSDXI=BSDXI+1
171 S ^BSDXTMP($J,BSDXI)=$C(31)
172 Q
173STRIP(BSDXZ) ;Replace control characters with spaces
174 N BSDXI
175 F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
176 Q BSDXZ
177 ;
178BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY
179 ;Returns ien in BSDXAPPT or 0 if failed
180 ;Create entry in BSDX APPOINTMENT
181 N BSDXAPPTID
182 S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
183 S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
184 S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
185 S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
186 S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
187 S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
188 S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
189 S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
190 S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM)
191 N BSDXIEN,BSDXMSG
192 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
193 S BSDXAPPTID=+$G(BSDXIEN(1))
194 Q BSDXAPPTID
195 ;
196BSDXWP(BSDXAPPTID,BSDXNOTE) ;
197 ;Add WP field
198 N BSDXMSG
199 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
200 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
201 I $D(BSDXNOTE(.5)) D
202 . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
203 Q
204 ;
205ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
206 ;Called by BSDX ADD APPOINTMENT protocol
207 ;BSDXSC=IEN of clinic in ^SC
208 ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
209 ;
210 N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
211 Q:+$G(BSDXNOEV)
212 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
213 E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
214 Q:'+$G(BSDXRES)
215 S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
216 Q:BSDXNOD=""
217 S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
218 S BSDXWKIN=""
219 S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
220 S BSDXLEN=$P(BSDXNOD,U,2)
221 Q:'+BSDXLEN
222 S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
223 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
224 Q:'+BSDXAPPTID
225 S BSDXNOTE=$P(BSDXNOD,U,4)
226 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
227 D ADDEVT3(BSDXRES)
228 Q
229 ;
230ADDEVT3(BSDXRES) ;
231 ;Call RaiseEvent to notify GUI clients
232 N BSDXRESN
233 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
234 Q:BSDXRESN=""
235 S BSDXRESN=$P(BSDXRESN,"^")
236 ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
237 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
238 Q
239 ;
240ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
241 ; DO NOT USE except as an emergency measure - only if unforseen error occurs
242 ; Input:
243 ; Appointment ID to remove from ^BSDXAPPT
244 ; BSDXC array (see array format in $$MAKE^BSDXAPI)
245 ; NB: I am not sure whether I want to do $G to protect against undefs?
246 ; I send the variables to this EP from the Symbol Table in ETRAP
247 D BSDXDEL^BSDX07(BSDXAPPTID)
248 S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
249 QUIT
250 ;
251BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT
252 ; DO NOT USE except in emergencies to roll back an appointment set
253 N DA,DIK
254 S DIK="^BSDXAPPT(",DA=BSDXAPPTID
255 D ^DIK
256 Q
257 ;
258ERR(BSDXI,BSDXERR) ;Error processing - different from error trap.
259 S BSDXI=BSDXI+1
260 S BSDXERR=$TR(BSDXERR,"^","~")
261 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
262 S BSDXI=BSDXI+1
263 S ^BSDXTMP($J,BSDXI)=$C(31)
264 L -^BSDXAPPT(BSDXPATID)
265 Q
266 ;
267ETRAP ;EP Error trap entry
268 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
269 D ^%ZTER
270 S $EC="" ; Clear Error
271 I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists
272 ; Log error message and send to client
273 I '$D(BSDXI) N BSDXI S BSDXI=0
274 D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
275 Q:$Q 1_U_"Mumps Error" Q
276 ;
Note: See TracBrowser for help on using the repository browser.