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

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

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