1 |
package WOU_AR; |
2 |
|
3 |
# Routines for Banner SIS Accounts Receivable |
4 |
# |
5 |
# Subs in this package that use DBI expect to be passed a database handle |
6 |
# ($dbh) that has been granted the appropriate roles by WOU_Secure.pm. |
7 |
# |
8 |
# Jeremy Hickerson, 3/11/2004 |
9 |
|
10 |
use strict; |
11 |
|
12 |
BEGIN { |
13 |
use Exporter (); |
14 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
15 |
|
16 |
# set the version for version checking |
17 |
$VERSION = 1.00; |
18 |
@ISA = qw(Exporter); |
19 |
@EXPORT = qw(&term_balances &term_dorms &housing_chg &staff_rate &paid |
20 |
&owed); |
21 |
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], |
22 |
@EXPORT_OK = qw( ); |
23 |
} |
24 |
use vars @EXPORT_OK; |
25 |
use subs qw(term_balances term_dorms housing_chg staff_rate paid owed); |
26 |
|
27 |
use DBI; |
28 |
use WOU_Person; |
29 |
|
30 |
|
31 |
# ============================================================================ |
32 |
# Package-Level Stuff |
33 |
# ============================================================================ |
34 |
my %glb_prepared_sql; # Hash that holds $sth's for prepared sql; |
35 |
# helps performance. Entries are of the form: |
36 |
# ( "sth_qry_housing_chg" => $sth_qry_housing_chg, ... ) |
37 |
|
38 |
my ($sth_qry_housing_chg, $sth_qry_staff_rate, $sth_qry_paid, $sth_qry_owed); |
39 |
|
40 |
|
41 |
# ============================================================================ |
42 |
# Routines |
43 |
# ============================================================================ |
44 |
|
45 |
sub term_balances { |
46 |
my ($dbh, $term, $dcat_code) = @_; |
47 |
|
48 |
my ($pidm, $category, $balance, $level, @term_balances); |
49 |
|
50 |
# add fields as needed |
51 |
my $sth_qry_term_balances = $dbh->prepare( q{ |
52 |
select tbraccd_pidm, |
53 |
tbbdetc_dcat_code, |
54 |
sgbstdn_levl_code, |
55 |
sum(tbraccd_balance) |
56 |
from tbraccd, |
57 |
tbbdetc, |
58 |
sgbstdn |
59 |
where tbraccd_term_code = ? and |
60 |
tbbdetc_detail_code = tbraccd_detail_code and |
61 |
tbbdetc_dcat_code like ? and |
62 |
sgbstdn_pidm = tbraccd_pidm and |
63 |
sgbstdn_term_code_eff = ( |
64 |
select max(sgbstdn_term_code_eff) |
65 |
from sgbstdn |
66 |
where sgbstdn_pidm = tbraccd_pidm and |
67 |
sgbstdn_term_code_eff <= tbraccd_term_code) |
68 |
group by tbraccd_pidm, |
69 |
tbbdetc_dcat_code, |
70 |
sgbstdn_levl_code } ); |
71 |
|
72 |
$sth_qry_term_balances->execute($term, $dcat_code); |
73 |
|
74 |
|
75 |
while ( ($pidm, $category, $level, $balance) = |
76 |
$sth_qry_term_balances->fetchrow_array) { |
77 |
|
78 |
push @term_balances, { "pidm" => $pidm, |
79 |
"term" => $term, |
80 |
"category" => $category, |
81 |
"level" => $level, |
82 |
"ssn" => real_ssn($dbh, $pidm), |
83 |
"balance" => $balance }; |
84 |
} |
85 |
|
86 |
return \@term_balances; |
87 |
} |
88 |
|
89 |
|
90 |
sub term_dorms { |
91 |
my ($dbh, $term) = @_; |
92 |
|
93 |
my ($pidm, @term_dorms); |
94 |
|
95 |
my $sth_qry_term_dorms = $dbh->prepare( q{ |
96 |
select tbraccd_pidm |
97 |
from tbraccd, |
98 |
tbbdetc |
99 |
where tbraccd_term_code = ? and |
100 |
tbbdetc_detail_code = tbraccd_detail_code and |
101 |
tbbdetc_dcat_code = 'HOU' and |
102 |
tbraccd_amount > 0 } ); |
103 |
|
104 |
$sth_qry_term_dorms->execute($term); |
105 |
|
106 |
while ( ($pidm) = $sth_qry_term_dorms->fetchrow_array) { |
107 |
|
108 |
push @term_dorms, { "pidm" => $pidm, |
109 |
"term" => $term }; |
110 |
} |
111 |
|
112 |
return \@term_dorms; |
113 |
|
114 |
} |
115 |
|
116 |
|
117 |
sub housing_chg { |
118 |
|
119 |
my ($dbh, $pidm, $term) = @_; |
120 |
|
121 |
my ($detail_code, $tran_no, $tran_date, $amount); |
122 |
|
123 |
# for performance we will only prepare repeated sql once |
124 |
if (exists $glb_prepared_sql{"sth_qry_housing_chg"} ) { |
125 |
$sth_qry_housing_chg = $glb_prepared_sql{"sth_qry_housing_chg"}; |
126 |
} |
127 |
else { |
128 |
$sth_qry_housing_chg = $dbh->prepare( q{ |
129 |
select tbraccd_detail_code, |
130 |
tbraccd_tran_number, |
131 |
tbraccd_trans_date, |
132 |
tbraccd_amount |
133 |
from tbraccd, |
134 |
tbbdetc |
135 |
where tbraccd_pidm = ? and |
136 |
tbraccd_term_code = ? and |
137 |
tbbdetc_detail_code = tbraccd_detail_code and |
138 |
tbbdetc_dcat_code = 'HOU' } ); |
139 |
|
140 |
$glb_prepared_sql{"sth_qry_housing_chg"} = $sth_qry_housing_chg; |
141 |
} |
142 |
|
143 |
$sth_qry_housing_chg->execute($pidm, $term); |
144 |
|
145 |
($detail_code, $tran_no, $tran_date, $amount) = |
146 |
$sth_qry_housing_chg->fetchrow_array; |
147 |
|
148 |
if ( defined($detail_code) ) { |
149 |
return { "detail_code" => $detail_code, |
150 |
"tran_no" => $tran_no, |
151 |
"tran_date" => $tran_date, |
152 |
"amount" => $amount }; |
153 |
} |
154 |
|
155 |
else { return { } }; |
156 |
|
157 |
} |
158 |
|
159 |
|
160 |
sub staff_rate { |
161 |
|
162 |
my ($dbh, $pidm, $term) = @_; |
163 |
|
164 |
my ($emp_ssn, $emp_lname, $emp_fname, $emp_mname, $emp_inst, $emp_rel); |
165 |
|
166 |
# for performance we will only prepare repeated sql once |
167 |
if (exists $glb_prepared_sql{"sth_qry_staff_rate"} ) { |
168 |
$sth_qry_staff_rate = $glb_prepared_sql{"sth_qry_staff_rate"}; |
169 |
} |
170 |
else { |
171 |
$sth_qry_staff_rate = $dbh->prepare( q{ |
172 |
select zfbstwv_emp_ssn, |
173 |
zfbstwv_emp_last_name, |
174 |
zfbstwv_emp_first_name, |
175 |
zfbstwv_emp_mi, |
176 |
zfbstwv_eins_code, |
177 |
zfbstwv_erel_code |
178 |
from zfbstwv |
179 |
where zfbstwv_pidm = ? and |
180 |
zfbstwv_term_code = ? } ); |
181 |
|
182 |
$glb_prepared_sql{"sth_qry_staff_rate"} = $sth_qry_staff_rate; |
183 |
} |
184 |
|
185 |
$sth_qry_staff_rate->execute($pidm, $term); |
186 |
|
187 |
($emp_ssn, $emp_lname, $emp_fname, $emp_mname, $emp_inst, $emp_rel) = |
188 |
$sth_qry_staff_rate->fetchrow_array; |
189 |
|
190 |
if ( defined($emp_ssn) ) { |
191 |
return { "pidm" => $pidm, |
192 |
"ssn" => $emp_ssn, |
193 |
"lname" => $emp_lname, |
194 |
"fname" => $emp_fname, |
195 |
"mname" => $emp_mname, |
196 |
"emp_inst" => $emp_inst, |
197 |
"relation" => $emp_rel }; |
198 |
} |
199 |
|
200 |
else { return { } }; |
201 |
} |
202 |
|
203 |
|
204 |
sub paid { |
205 |
my ($dbh, $pidm, $term) = @_; |
206 |
|
207 |
my ($paid); |
208 |
|
209 |
# for performance we will only prepare repeated sql once |
210 |
if (exists $glb_prepared_sql{"sth_qry_paid"} ) { |
211 |
$sth_qry_paid = $glb_prepared_sql{"sth_qry_paid"}; |
212 |
} |
213 |
else { |
214 |
$sth_qry_paid = $dbh->prepare( q{ |
215 |
select sum(tbraccd_amount) |
216 |
from tbraccd, |
217 |
tbbdetc |
218 |
where tbraccd_pidm = ? and |
219 |
tbraccd_term_code = ? and |
220 |
tbbdetc_detail_code = tbraccd_detail_code and |
221 |
tbbdetc_type_ind = 'P' } ); |
222 |
|
223 |
$glb_prepared_sql{"sth_qry_paid"} = $sth_qry_paid; |
224 |
} |
225 |
|
226 |
$sth_qry_paid->execute($pidm, $term); |
227 |
|
228 |
($paid) = $sth_qry_paid->fetchrow_array; |
229 |
|
230 |
return { "pidm" => $pidm, |
231 |
"paid" => $paid }; |
232 |
} |
233 |
|
234 |
|
235 |
sub owed { |
236 |
my ($dbh, $pidm, $term) = @_; |
237 |
|
238 |
my ($owed); |
239 |
|
240 |
# for performance we will only prepare repeated sql once |
241 |
if (exists $glb_prepared_sql{"sth_qry_owed"} ) { |
242 |
$sth_qry_owed = $glb_prepared_sql{"sth_qry_owed"}; |
243 |
} |
244 |
else { |
245 |
$sth_qry_owed = $dbh->prepare( q{ |
246 |
select sum(tbraccd_amount) |
247 |
from tbraccd, |
248 |
tbbdetc |
249 |
where tbraccd_pidm = ? and |
250 |
tbraccd_term_code = ? and |
251 |
tbbdetc_detail_code = tbraccd_detail_code and |
252 |
tbbdetc_type_ind = 'C' } ); |
253 |
|
254 |
$glb_prepared_sql{"sth_qry_owed"} = $sth_qry_owed; |
255 |
} |
256 |
|
257 |
$sth_qry_owed->execute($pidm, $term); |
258 |
|
259 |
($owed) = $sth_qry_owed->fetchrow_array; |
260 |
|
261 |
return { "pidm" => $pidm, |
262 |
"owed" => $owed }; |
263 |
} |
264 |
|
265 |
|
266 |
|
267 |
# ============================================================================ |
268 |
# Subroutines |
269 |
# ============================================================================ |
270 |
|
271 |
return 1; |
272 |
|
273 |
|