vdw/trunk/WOU_AR.pm

package WOU_AR;

# Routines for Banner SIS Accounts Receivable
#
# Subs in this package that use DBI expect to be passed a database handle
# ($dbh) that has been granted the appropriate roles by WOU_Secure.pm.
#
# Jeremy Hickerson, 3/11/2004

use strict;

BEGIN {
    use Exporter   ();
    use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    # set the version for version checking
    $VERSION     = 1.00;
    @ISA         = qw(Exporter);
    @EXPORT      = qw(&term_balances &term_dorms &housing_chg &staff_rate &paid
                      &owed);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
    @EXPORT_OK   = qw( );
}
use vars @EXPORT_OK;
use subs qw(term_balances term_dorms housing_chg staff_rate paid owed);

use DBI;
use WOU_Person;


# ============================================================================
#                             Package-Level Stuff
# ============================================================================
my %glb_prepared_sql;  # Hash that holds $sth's for prepared sql;
                       # helps performance.  Entries are of the form:
               # ( "sth_qry_housing_chg" => $sth_qry_housing_chg, ... )

my ($sth_qry_housing_chg, $sth_qry_staff_rate, $sth_qry_paid, $sth_qry_owed);


# ============================================================================
#                                Routines
# ============================================================================

sub term_balances {
    my ($dbh, $term, $dcat_code) = @_;

    my ($pidm, $category, $balance, $level, @term_balances);

    # add fields as needed
    my $sth_qry_term_balances =  $dbh->prepare( q{
        select tbraccd_pidm,
               tbbdetc_dcat_code,
               sgbstdn_levl_code,
               sum(tbraccd_balance)
        from tbraccd,
             tbbdetc,
             sgbstdn
        where tbraccd_term_code = ?                     and
              tbbdetc_detail_code = tbraccd_detail_code and
              tbbdetc_dcat_code like ?                  and
              sgbstdn_pidm = tbraccd_pidm               and
              sgbstdn_term_code_eff = (
                  select max(sgbstdn_term_code_eff)
                  from sgbstdn
                  where sgbstdn_pidm = tbraccd_pidm and
                        sgbstdn_term_code_eff <= tbraccd_term_code)
        group by tbraccd_pidm,
                 tbbdetc_dcat_code,
                 sgbstdn_levl_code } );

    $sth_qry_term_balances->execute($term, $dcat_code);


    while ( ($pidm, $category, $level, $balance) =
        $sth_qry_term_balances->fetchrow_array) {

        push @term_balances, { "pidm"     => $pidm,
                               "term"     => $term,
                               "category" => $category,
                               "level"    => $level,
                               "ssn"      => real_ssn($dbh, $pidm),
                               "balance"  => $balance };
    }

    return \@term_balances;
}


sub term_dorms {
    my ($dbh, $term) = @_;

    my ($pidm, @term_dorms);

    my $sth_qry_term_dorms =  $dbh->prepare( q{
         select tbraccd_pidm
         from tbraccd,
              tbbdetc
         where tbraccd_term_code = ?                     and
               tbbdetc_detail_code = tbraccd_detail_code and
               tbbdetc_dcat_code = 'HOU'                 and
               tbraccd_amount > 0 } );

    $sth_qry_term_dorms->execute($term);

    while ( ($pidm) = $sth_qry_term_dorms->fetchrow_array) {

        push @term_dorms, { "pidm"     => $pidm,
                            "term"     => $term };
    }

    return \@term_dorms;

}


sub housing_chg {

    my ($dbh, $pidm, $term) = @_;

    my ($detail_code, $tran_no, $tran_date, $amount);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_housing_chg"} ) {
        $sth_qry_housing_chg = $glb_prepared_sql{"sth_qry_housing_chg"};
    }
    else {
        $sth_qry_housing_chg =  $dbh->prepare( q{
             select tbraccd_detail_code,
                    tbraccd_tran_number,
                    tbraccd_trans_date,
                    tbraccd_amount
             from tbraccd,
                  tbbdetc
             where tbraccd_pidm = ?                          and
                   tbraccd_term_code = ?                     and
                   tbbdetc_detail_code = tbraccd_detail_code and
                   tbbdetc_dcat_code = 'HOU' } );

        $glb_prepared_sql{"sth_qry_housing_chg"} = $sth_qry_housing_chg;
    }

    $sth_qry_housing_chg->execute($pidm, $term);

    ($detail_code, $tran_no, $tran_date, $amount) = 
        $sth_qry_housing_chg->fetchrow_array;

    if ( defined($detail_code) ) {
        return { "detail_code" => $detail_code,
                 "tran_no"     => $tran_no,
                 "tran_date"   => $tran_date,
                 "amount"      => $amount };
    }

    else { return { } };
    
}


sub staff_rate {

    my ($dbh, $pidm, $term) = @_;

    my ($emp_ssn, $emp_lname, $emp_fname, $emp_mname, $emp_inst, $emp_rel);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_staff_rate"} ) {
        $sth_qry_staff_rate = $glb_prepared_sql{"sth_qry_staff_rate"};
    }
    else {
        $sth_qry_staff_rate =  $dbh->prepare( q{
             select zfbstwv_emp_ssn,
                    zfbstwv_emp_last_name,
                    zfbstwv_emp_first_name,
                    zfbstwv_emp_mi,
                    zfbstwv_eins_code,
                    zfbstwv_erel_code
             from zfbstwv
             where zfbstwv_pidm = ? and
                   zfbstwv_term_code = ? } );

        $glb_prepared_sql{"sth_qry_staff_rate"} = $sth_qry_staff_rate;
    }

    $sth_qry_staff_rate->execute($pidm, $term);

    ($emp_ssn, $emp_lname, $emp_fname, $emp_mname, $emp_inst, $emp_rel) =
        $sth_qry_staff_rate->fetchrow_array;

    if ( defined($emp_ssn) ) {
        return { "pidm"     => $pidm,
                 "ssn"      => $emp_ssn,
                 "lname"    => $emp_lname,
                 "fname"    => $emp_fname,
                 "mname"    => $emp_mname,
                 "emp_inst" => $emp_inst,
                 "relation" => $emp_rel };
    }

    else { return { } };
}


sub paid {
    my ($dbh, $pidm, $term) = @_;

    my ($paid);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_paid"} ) {
        $sth_qry_paid = $glb_prepared_sql{"sth_qry_paid"};
    }
    else {
        $sth_qry_paid =  $dbh->prepare( q{
        select sum(tbraccd_amount)
        from tbraccd,
                 tbbdetc
        where tbraccd_pidm = ?                      and
              tbraccd_term_code = ?                 and
          tbbdetc_detail_code = tbraccd_detail_code and
          tbbdetc_type_ind = 'P' } );

        $glb_prepared_sql{"sth_qry_paid"} = $sth_qry_paid;
    }

    $sth_qry_paid->execute($pidm, $term);

    ($paid) = $sth_qry_paid->fetchrow_array;

    return { "pidm" => $pidm,
             "paid" => $paid  };
}


sub owed {
    my ($dbh, $pidm, $term) = @_;

    my ($owed);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_owed"} ) {
        $sth_qry_owed = $glb_prepared_sql{"sth_qry_owed"};
    }
    else {
        $sth_qry_owed =  $dbh->prepare( q{
        select sum(tbraccd_amount)
        from tbraccd,
                 tbbdetc
        where tbraccd_pidm = ?                      and
              tbraccd_term_code = ?                 and
          tbbdetc_detail_code = tbraccd_detail_code and
          tbbdetc_type_ind = 'C' } );

        $glb_prepared_sql{"sth_qry_owed"} = $sth_qry_owed;
    }

    $sth_qry_owed->execute($pidm, $term);

    ($owed) = $sth_qry_owed->fetchrow_array;

    return { "pidm" => $pidm,
             "owed" => $owed  };
}


# ============================================================================
#                               Subroutines
# ============================================================================

return 1;


1	dpavlin	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