source: Scheduling/trunk/m/BSDX27.m@ 1261

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 11.4 KB
Line 
1BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
2 ;;1.6T2;BSDX;;May 16, 2011
3 ; Licensed under LGPL
4 ;
5 ; Change Log: July 15, 2010
6 ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP ta
7 ; v 1.42 - 3101208 - SMH
8 ; - Added check to skip cancelled appointments. Check was forgotten
9 ; in original code.
10 ; . N BSDXFLAGS S BSDXFLAGS=$P(BSDXNOD,U,2) ; No show and Cancel Flags
11 ; . Q:BSDXFLAGS["C" ; if appt is cancelled, quit
12 ;
13 Q
14 ;
15PADISPD(BSDXY,BSDXPAT) ;EP
16 ;Entry point for debugging
17 ;
18 ;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)")
19 Q
20 ;
21PADISP(BSDXY,BSDXPAT) ;EP
22 ;Return recordset of patient appointments used in listing
23 ;a patient's appointments and generating patient letters.
24 ;Called by rpc BSDX PATIENT APPT DISPLAY
25 ;
26 ; Sam's Notes:
27 ; Relatively complex algorithm.
28 ; 1. First, loop through ^DPT(DA,"S", and get all appointments.
29 ; Exclude cancelled appts. Store in BSDXDPT array.
30 ; 2. Go through ^BSDXAPPT("CPAT", (patient index) .
31 ; Get the info from there and compar with BSDXDPT array. If
32 ; they are the same, get all info, and rm entry from BSDXDPT array.
33 ; 3. If there are any remaining entries in BSDXDPT (PIMS leftovers),
34 ; Get the data from file 2 and 44.
35 ;
36 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ
37 N BSDXSTRT
38 N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
39 S BSDXY="^BSDXTMP("_$J_")"
40 S BSDXI=0
41 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
42 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
43 S X="ERROR^BSDX27",@^%ZOSF("TRAP")
44 ;Get patient info
45 ;
46 I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
47 I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
48 S BSDXNOD=$$PATINFO(BSDXPAT)
49 S BSDXNAM=$P(BSDXNOD,U) ;NAME
50 S BSDXSEX=$P(BSDXNOD,U,2) ;SEX
51 S BSDXDOB=$P(BSDXNOD,U,3) ;DOB
52 S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)
53 S BSDXSTRE=$P(BSDXNOD,U,5) ;Street
54 S BSDXCITY=$P(BSDXNOD,U,6) ;City
55 S BSDXST=$P(BSDXNOD,U,7) ;State
56 S BSDXZIP=$P(BSDXNOD,U,8) ;zip
57 S BSDXPHON=$P(BSDXNOD,U,9) ;homephone
58 ;
59 ;Organize ^DPT(BSDXPAT,"S," nodes
60 ; into BSDXDPT(CLINIC,DATE)
61 ;
62 I $D(^DPT(BSDXPAT,"S")) S BSDXDT=0 F S BSDXDT=$O(^DPT(BSDXPAT,"S",BSDXDT)) Q:'+BSDXDT D
63 . S BSDXNOD=$G(^DPT(BSDXPAT,"S",BSDXDT,0))
64 . S BSDXCID=$P(BSDXNOD,U)
65 . Q:'+BSDXCID
66 . Q:'$D(^SC(BSDXCID,0))
67 . N BSDXFLAGS S BSDXFLAGS=$P(BSDXNOD,U,2) ; No show and Cancel Flags
68 . Q:BSDXFLAGS["C" ; if appt is cancelled, quit
69 . S BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD
70 ;
71 ;$O Through ^BSDX("CPAT",
72 S BSDXIEN=0
73 I $D(^BSDXAPPT("CPAT",BSDXPAT)) F S BSDXIEN=$O(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN)) Q:'BSDXIEN D
74 . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN
75 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
76 . Q:BSDXNOD=""
77 . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
78 . S Y=$P(BSDXNOD,U)
79 . Q:'+Y
80 . X ^DD("DD") S Y=$TR(Y,"@"," ")
81 . S BSDXAPT=Y ;Appointment date time
82 . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by
83 . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
84 . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made
85 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
86 . S BSDXMADE=Y
87 . ;NOTE
88 . S BSDXNOT=""
89 . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D
90 . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
91 . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
92 . . S BSDXNOT=BSDXNOT_BSDXLIN
93 . ;Resource
94 . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE
95 . Q:'+BSDXCID
96 . Q:'$D(^BSDXRES(BSDXCID,0))
97 . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node
98 . Q:BSDXCNOD=""
99 . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource
100 . S BSDX44=$P(BSDXCNOD,U,4) ;File 44 pointer
101 . ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from
102 . ;the BSDXDPT array and delete the BSDXDPT node
103 . S BSDXTYPE=""
104 . I +BSDX44,$D(BSDXDPT(BSDX44,$P(BSDXNOD,U))) D ;BSDXNOD is the BSDX APPOINTMENT node
105 . . S BSDXDNOD=BSDXDPT(BSDX44,$P(BSDXNOD,U)) ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node
106 . . S BSDXTYPE=$$STATUS(BSDXPAT,$P(BSDXNOD,U),BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
107 . . K BSDXDPT(BSDX44,$P(BSDXNOD,U))
108 . S BSDXI=BSDXI+1
109 . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
110 . Q
111 ;
112 ;Go through remaining BSDXDPT( entries
113 I $D(BSDXDPT) S BSDX44=0 D
114 . F S BSDX44=$O(BSDXDPT(BSDX44)) Q:'+BSDX44 S BSDXDT=0 D
115 . . F S BSDXDT=$O(BSDXDPT(BSDX44,BSDXDT)) Q:'+BSDXDT D
116 . . . S BSDXDNOD=BSDXDPT(BSDX44,BSDXDT)
117 . . . S Y=BSDXDT
118 . . . Q:'+Y
119 . . . X ^DD("DD") S Y=$TR(Y,"@"," ")
120 . . . S BSDXAPT=Y
121 . . . S BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
122 . . . S BSDXCLN=$P($G(^SC(BSDX44,0)),U)
123 . . . S BSDXCLRK=$P(BSDXDNOD,U,18)
124 . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
125 . . . S Y=$P(BSDXDNOD,U,19)
126 . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
127 . . . S BSDXMADE=Y
128 . . . S BSDXNOT=""
129 . . . S BSDXI=BSDXI+1
130 . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
131 . . . K BSDXDPT(BSDX44,BSDXDT)
132 ;
133 S BSDXI=BSDXI+1
134 S ^BSDXTMP($J,BSDXI)=$C(31)
135 Q
136 ;
137STATUS(PAT,DATE,NODE) ; returns appt status
138 ;IHS/OIT/HMW 20050208 Added from BSDDPA
139 NEW TYP
140 S TYP=$$APPTYP^BSDXAPI(PAT,DATE) ;sched vs. walkin
141 I $P(NODE,U,2)["C" Q TYP_" - CANCELLED"
142 I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW"
143 I $$CO^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
144 I $$CI^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
145 Q TYP
146 ;
147ERROR ;
148 D ERR(BSDXI,"RPMS Error")
149 Q
150 ;
151ERR(BSDXI,ERRNO,MSG) ;Error processing
152 S:'$D(BSDXI) BSDXI=999
153 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
154 E S BSDXERR=ERRNO
155 S BSDXI=BSDXI+1
156 S ^BSDXTMP($J,BSDXI)=MSG_"^^^^^^^^^^^^^^^"_$C(30)
157 S BSDXI=BSDXI+1
158 S ^BSDXTMP($J,BSDXI)=$C(31)
159 Q
160PATINFO(BSDXPAT) ;EP
161 ;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT
162 ;DOB is in external format
163 ;HRN depends on existence of DUZ(2)
164 ;
165 N BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
166 S BSDXNOD=^DPT(+BSDXPAT,0)
167 S BSDXNAM=$P(BSDXNOD,U) ;NAME
168 S BSDXSEX=$P(BSDXNOD,U,2)
169 S BSDXSEX=$S(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"")
170 S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ")
171 S BSDXDOB=Y ;DOB
172 S BSDXHRN=""
173 I $D(DUZ(2)) I DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN
174 ;
175 S BSDXNOD=$G(^DPT(+BSDXPAT,.11))
176 S (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)=""
177 I BSDXNOD]"" D
178 . S BSDXSTRT=$E($P(BSDXNOD,U),1,50) ;STREET
179 . S BSDXCITY=$P(BSDXNOD,U,4) ;CITY
180 . S BSDXST=$P(BSDXNOD,U,5) ;STATE
181 . I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
182 . S BSDXZIP=$P(BSDXNOD,U,6) ;ZIP
183 ;
184 S BSDXNOD=$G(^DPT(+BSDXPAT,.13)) ;PHONE
185 S BSDXPHON=$P(BSDXNOD,U)
186 ;
187 Q BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON
188 ;
189CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
190 ;Entry point for debugging
191 ;
192 ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
193 Q
194 ;
195CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
196 ;
197 ;Return recordset of patient appointments
198 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
199 ;Used in listing a patient's appointments and generating patient letters.
200 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
201 ;BSDXBEG and BSDXEND are in external date form.
202 ;Called by BSDX CLINIC LETTERS
203 ;
204 ; July 10, 2010 -- to support i18n, we pass dates from client in
205 ; locale-neutral Fileman format. No need to convert it.
206 N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
207 N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
208 N BSDXSTRT
209 N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
210 S BSDXY="^BSDXTMP("_$J_")"
211 K ^BSDXTMP($J)
212 S BSDXI=0
213 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
214 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
215 S X="ERROR^BSDX27",@^%ZOSF("TRAP")
216 ;
217 ;Convert beginning and ending dates
218 ;
219 S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
220 S BSDXEND=BSDXEND_".9999"
221 I BSDXCLST="" D ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list") Q
222 ;
223 ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
224 ;
225 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D
226 . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""
227 . S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D
228 . . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D
229 . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
230 . . . Q:BSDXNOD=""
231 . . . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
232 . . . Q:$P(BSDXNOD,U,13)="y" ;WALKIN
233 . . . S Y=$P(BSDXNOD,U)
234 . . . Q:'+Y
235 . . . X ^DD("DD") S Y=$TR(Y,"@"," ")
236 . . . S BSDXAPT=Y ;Appointment date time
237 . . . ;
238 . . . ;NOTE
239 . . . S BSDXNOT=""
240 . . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ D
241 . . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0))
242 . . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
243 . . . . S BSDXNOT=BSDXNOT_BSDXLIN
244 . . . ;
245 . . . S BSDXPAT=$P(BSDXNOD,U,5)
246 . . . S BSDXPNOD=$$PATINFO(BSDXPAT)
247 . . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME
248 . . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX
249 . . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB
250 . . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2)
251 . . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street
252 . . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City
253 . . . S BSDXST=$P(BSDXPNOD,U,7) ;State
254 . . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip
255 . . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone
256 . . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters
257 . . . S BSDXCLRK=$P(BSDXNOD,U,8)
258 . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
259 . . . S Y=$P(BSDXNOD,U,9)
260 . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
261 . . . S BSDXMADE=Y
262 . . . S BSDXI=BSDXI+1
263 . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
264 ;
265 S BSDXI=BSDXI+1
266 S ^BSDXTMP($J,BSDXI)=$C(31)
267 Q
Note: See TracBrowser for help on using the repository browser.