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

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

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