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

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

Added LGPL license to routines
File size: 11.4 KB
Line 
1BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
2 ;;1.5;BSDX;;Apr 28, 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.