source: Scheduling/trunk/m/BSDX34.m@ 851

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

Fixes to support i18n (Receive FM dates from C# instead of culture specific date).Also, fix for Rebooking. Now it works.
File size: 6.2 KB
Line 
1BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/11/10 11:28am
2 ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
3 ;
4 ;
5 Q
6 ;
7RBCLIND(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
8 ;Entry point for debugging
9 ;
10 ;D DEBUG^%Serenji("RBCLIN^BSDX34(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
11 Q
12 ;
13RBERR ;
14 ;Called from RBCLIN on error to set up header
15 K ^BSDXTMP($J)
16 S ^BSDXTMP($J,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID"
17 S ^BSDXTMP($J,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
18 D ERR(999)
19 Q
20 ;
21CANCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
22 ;
23 ;Return recordset of CANCELLED patient appointments
24 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
25 ;Used in generating cancellation letters for a clinic
26 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
27 ;BSDXBEG and BSDXEND are in external date form.
28 ;Called by BSDX CANCEL CLINIC LIST
29 N BSDXCAN
30 S BSDXCAN=1
31 D RBCLIN(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)
32 ;
33 Q
34 ;
35RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
36 ;
37 ;Return recordset of rebooked patient appointments
38 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
39 ;Used in generating rebook letters for a clinic
40 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
41 ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above
42 ;Jul 11 2010 (smh):
43 ;for i18n, pass BSDXBEG and BSDXEND in FM format.
44 ;
45 S X="RBERR^BSDX34",@^%ZOSF("TRAP")
46 ;
47 S BSDXY="^BSDXTMP("_$J_")"
48 N %DT,Y,BSDXJ,BSDXCID,BSDXCLN,BSDXSTRT,BSDXAID,BSDXNOD,BSDXLIST,BSDX,BSDY
49 ;Convert beginning and ending dates
50 ;TODO: Validation of date to make sure it's a right FM Date
51 S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
52 S BSDXEND=BSDXEND_".9999"
53 ;
54 I BSDXCLST="" D RBERR Q
55 ;
56 ;
57 ;If BSDXCLST is a list of resource NAMES, look up each name and convert to IEN
58 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDX=$P(BSDXCLST,"|",BSDXJ) D S $P(BSDXCLST,"|",BSDXJ)=BSDY
59 . S BSDY=""
60 . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q
61 . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q
62 . Q
63 ;
64 ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
65 ;
66 S BSDXLIST=""
67 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D:+BSDXCID
68 . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""
69 . S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D
70 . . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D
71 . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
72 . . . I $D(BSDXCAN) D Q
73 . . . . I $P(BSDXNOD,U,12) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Cancelled appt
74 . . . I $P(BSDXNOD,U,11) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Rebooked appt
75 D RBLETT(.BSDXY,BSDXLIST)
76 Q
77 ;
78RBLETTD(BSDXY,BSDXLIST) ;EP
79 ;Entry point for debugging
80 ;
81 ;D DEBUG^%Serenji("RBLETT^BSDX34(.BSDXY,BSDXLIST)")
82 Q
83 ;
84RBLETT(BSDXY,BSDXLIST) ;EP
85 ;Return recordset of patient appointments used in listing
86 ;REBOOKED appointments for a list of appointmentIDs.
87 ;Called by rpc BSDX REBOOK LIST
88 ;BSDXLIST is a |-delimited list of BSDX APPOINTMENT iens (the last |-piece is null)
89 ;
90 N BSDXI,BSDXIEN,BSDXNOD,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ,BSDX
91 S BSDXY="^BSDXTMP("_$J_")"
92 S BSDXI=0
93 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus"
94 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
95 S X="ERROR^BSDX34",@^%ZOSF("TRAP")
96 ;
97 ;Iterate through BSDXLIST
98 S BSDXIEN=0
99 F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D
100 . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN,BSDXPAT
101 . N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
102 . N BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX
103 . N BSDXREBK
104 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
105 . Q:BSDXNOD=""
106 . S BSDXPAT=$P(BSDXNOD,U,5) ;PATIENT ien
107 . Q:'+BSDXPAT
108 . Q:'$D(^DPT(BSDXPAT))
109 . D PINFO(BSDXPAT)
110 . S Y=$P(BSDXNOD,U)
111 . Q:'+Y
112 . X ^DD("DD") S Y=$TR(Y,"@"," ")
113 . S BSDXAPT=Y ;Appointment date time
114 . S BSDXREBK=""
115 . S Y=$P(BSDXNOD,U,11)
116 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") S BSDXREBK=Y ;Rebook date time
117 . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by
118 . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
119 . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made
120 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
121 . S BSDXMADE=Y
122 . ;NOTE
123 . S BSDXNOT=""
124 . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D
125 . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
126 . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
127 . . S BSDXNOT=BSDXNOT_BSDXLIN
128 . ;Resource
129 . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE
130 . Q:'+BSDXCID
131 . Q:'$D(^BSDXRES(BSDXCID,0))
132 . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node
133 . Q:BSDXCNOD=""
134 . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource
135 . S BSDXTYPE="" ;Unused in this recordset
136 . S BSDXI=BSDXI+1
137 . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXREBK_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_"^"_BSDXAPT_$C(30)
138 . Q
139 ;
140 S BSDXI=BSDXI+1
141 S ^BSDXTMP($J,BSDXI)=$C(31)
142 Q
143 ;
144PINFO(BSDXPAT) ;
145 ;Get patient info
146 N BSDXNOD
147 S BSDXNOD=$$PATINFO^BSDX27(BSDXPAT)
148 S BSDXNAM=$P(BSDXNOD,U) ;NAME
149 S BSDXSEX=$P(BSDXNOD,U,2) ;SEX
150 S BSDXDOB=$P(BSDXNOD,U,3) ;DOB
151 S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)
152 S BSDXSTRE=$P(BSDXNOD,U,5) ;Street
153 S BSDXCITY=$P(BSDXNOD,U,6) ;City
154 S BSDXST=$P(BSDXNOD,U,7) ;State
155 S BSDXZIP=$P(BSDXNOD,U,8) ;zip
156 S BSDXPHON=$P(BSDXNOD,U,9) ;homephone
157 Q
158 ;
159ERROR ;
160 D ERR("RPMS Error")
161 Q
162 ;
163ERR(ERRNO) ;Error processing
164 S:'$D(BSDXI) BSDXI=999
165 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
166 E S BSDXERR=ERRNO
167 S BSDXI=BSDXI+1
168 S ^BSDXTMP($J,BSDXI)="^^^^^^^^^^^^^^^^"_$C(30)
169 S BSDXI=BSDXI+1
170 S ^BSDXTMP($J,BSDXI)=$C(31)
171 Q
Note: See TracBrowser for help on using the repository browser.