vdw/trunk/WOU_Admit.pm

package WOU_Admit;

# Routines for Banner SIS Admit
#
# 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/2002

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(&admit &admit_for_term &tests &hs_gpa &appls_for_term
                      &app_decision &appl &app_dec_detl &hs_subj &tr_coll
                      &scarf_tests &term_admits &SAT &ACT &last_tr_coll
                      &term_recruits &recruit &recr_status &sbgi_info &coll_info
                      &app_decsn &contact);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
    @EXPORT_OK   = qw( );

    ( grep /gen\$com/i, @INC ) || unshift @INC, "gen\$com";
}
use vars @EXPORT_OK;
use subs qw(admit admit_for_term tests hs_gpa appls_for_term app_decision appl 
            app_dec_detl hs_subj tr_coll scarf_tests term_admits SAT ACT
            last_tr_coll term_recruits recruit recr_status sbgi_info coll_info
            app_decsn contact);

use DBI;
use WOU_Util;


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

my ($sth_qry_admit, $sth_qry_appl, $sth_qry_admit_for_term, $sth_qry_tests,
    $sth_qry_hs_gpa, $sth_qry_appls_for_term1, $sth_qry_appls_for_term2,
    $sth_qry_app_decision, $sth_qry_hs_subj, $sth_qry_tr_coll1,
    $sth_qry_tr_coll2, $sth_qry_scarf_tests, $sth_qry_term_admits,
    $sth_qry_recr_status1, $sth_qry_recr_status2, $sth_qry_sbgi_info,
    $sth_qry_recruit, $sth_qry_contact);


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

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

    my (@row, $appl_term, $level, $app_decision, %applications, $ra_row,
        $min_term);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_admit"} ) {
        $sth_qry_admit = $glb_prepared_sql{"sth_qry_admit"};
    }
    else {
    # add fields as needed
    $sth_qry_admit =  $dbh->prepare( q{
    select sarappd_term_code_entry,
           saradap_levl_code,
           sarappd_apdc_code
    from saradap a,
         sarappd
    where saradap_pidm = ?                                      AND
          decode(saradap_levl_code, 'GR', 'GR',
                                    'UG') = ?                   AND
          saradap_term_code_entry <= ?                          AND
          saradap_appl_no = (
          select max(saradap_appl_no)
          from saradap b
          where b.saradap_pidm = a.saradap_pidm and
            b.saradap_term_code_entry = a.saradap_term_code_entry
                                            and
                    decode(b.saradap_levl_code, 'GR', 'GR',
                                                'UG') = 
                        decode(a.saradap_levl_code, 'GR', 'GR',
                                                    'UG') )     AND
          sarappd_pidm = saradap_pidm                           AND
          sarappd_term_code_entry = saradap_term_code_entry     AND
          sarappd_appl_no = saradap_appl_no                     AND 
          TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
        LPAD(TO_CHAR(sarappd_seq_no),2,'0') = (
          SELECT MAX(TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
            LPAD(TO_CHAR(sarappd_seq_no),2,'0'))
          FROM sarappd
          WHERE sarappd_pidm = saradap_pidm                        and
            sarappd_term_code_entry = saradap_term_code_entry  and
            sarappd_appl_no = saradap_appl_no) } );

        $glb_prepared_sql{"sth_qry_admit"} = $sth_qry_admit;
    }

    $sth_qry_admit->execute($pidm, $levl, $term);

    # handle multiple applications for admission
    while (@row = $sth_qry_admit->fetchrow_array) {

        ($appl_term, $level, $app_decision) = @row;

    # track min term admitted
    if ( (!defined($min_term) ) || $appl_term < $min_term) {
        if (substr($app_decision, 0, 1) eq "A") { $min_term = $appl_term }
    }

        $ra_row = [ ];  # alloc new memory
        push @{$ra_row}, @row;
        $applications{$appl_term} = $ra_row;
    }

    if (defined($min_term) ) {

        ($appl_term, $level, $app_decision) = @{$applications{$min_term} };

    return { "admit_term" => $appl_term,
         "level"      => $level,
         "decision"   => $app_decision };  # return ref to anon hash
    }

    # fall-through means not admitted
    return;
}


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

    my ($appl_term, $level, $app_decision, %applications, $ra_row,
        $min_term, @today, $today, $appl_no, $rh_app_dec, $last_appl_term);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_appl"} ) {
        $sth_qry_appl = $glb_prepared_sql{"sth_qry_appl"};
    }
    else {
    # add fields as needed
    $sth_qry_appl =  $dbh->prepare( q{
    select saradap_term_code_entry,
           saradap_levl_code,
               saradap_appl_no
    from saradap a
    where saradap_pidm = ?                                      AND
          decode(saradap_levl_code, 'GR', 'GR',
                                    'UG') = ?                   AND
          saradap_term_code_entry <= ?                          AND
          saradap_appl_no = (
          select max(saradap_appl_no)
          from saradap b
          where b.saradap_pidm = a.saradap_pidm and
            b.saradap_term_code_entry = a.saradap_term_code_entry
                                            and
                    decode(b.saradap_levl_code, 'GR', 'GR',
                                                'UG') = 
                        decode(a.saradap_levl_code, 'GR', 'GR',
                                                    'UG') )
        order by saradap_term_code_entry } );

        $glb_prepared_sql{"sth_qry_appl"} = $sth_qry_appl;

    }

    $sth_qry_appl->execute($pidm, $levl, $term);

    @today = localtime;
    $today = sprintf "%.2d/%.2d/%.4d",
                 $today[4] + 1,
                 $today[3],
                 1900 + $today[5];

    # handle multiple applications for admission
    # take the min term admitted, otherwise the max term applied
    while ( ($appl_term, $level, $appl_no) = $sth_qry_appl->fetchrow_array ) {

        $last_appl_term = $appl_term;

        $rh_app_dec = app_dec_detl($dbh, $pidm, $appl_term, $appl_no, $today);

    # track min term admitted
    if ( !defined($min_term) ) {
        if ( $rh_app_dec->{accepted} ) { $min_term = $appl_term }
    }

        push @{ $applications{$appl_term} },
            ($appl_term, $level, $rh_app_dec->{decision} );
    }

    if (defined($min_term) ) {
        ($appl_term, $level, $app_decision) = @{$applications{$min_term} };
    }
    else {
        # student may not have been admitted in SAAADMS
        if ( defined($last_appl_term) ) {
            ($appl_term, $level, $app_decision) = 
            @{$applications{$last_appl_term} };
        }
        else {  ($appl_term, $level, $app_decision) = ("", "", "")  }
    }

    return { "admit_term" => $appl_term,
         "level"      => $level,
         "decision"   => $app_decision };
}


sub admit_for_term {
    my ($dbh, $stu_pidm, $level, $term) = @_;

    my (@row, $decision, $apdc_date, $appl_date, $admt_code, $accepted, $resd);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_admit_for_term"} ) {
        $sth_qry_admit_for_term = $glb_prepared_sql{"sth_qry_admit_for_term"};
    }
    else {
    # add fields to below as needed
    $sth_qry_admit_for_term = $dbh->prepare( q{
    select sarappd_apdc_code,
           to_char(sarappd_apdc_date, 'mm/dd/yyyy'),
           to_char(saradap_appl_date, 'mm/dd/yyyy'),
           saradap_admt_code,
               decode(nvl(stvapdc_inst_acc_ind, 0), 'Y', 1, 0),
               saradap_resd_code
    from saradap a,
         sarappd,
             stvapdc
    where saradap_pidm = ?                                  AND
          saradap_levl_code = ?                             AND
          saradap_term_code_entry = ?                       AND
          saradap_appl_no = (
          select max(saradap_appl_no)
          from saradap b
          where b.saradap_pidm = a.saradap_pidm and
            b.saradap_term_code_entry = a.saradap_term_code_entry)
                                AND
          sarappd_pidm = saradap_pidm                       AND
          sarappd_term_code_entry = saradap_term_code_entry AND
          sarappd_appl_no = saradap_appl_no                 AND
          TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
        LPAD(TO_CHAR(sarappd_seq_no),2,'0') = (
          SELECT MAX(TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
            LPAD(TO_CHAR(sarappd_seq_no),2,'0'))
          FROM sarappd
          WHERE sarappd_pidm = saradap_pidm                        and
            sarappd_term_code_entry = saradap_term_code_entry  and
            sarappd_appl_no = saradap_appl_no)      AND
              stvapdc_code = sarappd_apdc_code } );
          
        $glb_prepared_sql{"sth_qry_admit_for_term"} = $sth_qry_admit_for_term;
    }

    $sth_qry_admit_for_term->execute($stu_pidm, $level, $term);

    if (@row = $sth_qry_admit_for_term->fetchrow_array) {

    ($decision, $apdc_date, $appl_date, $admt_code, $accepted,
         $resd) = @row;

    # add fields to below as needed
    return { "pidm"          => $stu_pidm,
                 "level"         => $level,
                 "decision"      => $decision,
             "decision_date" => $apdc_date,
         "appl_date"     => $appl_date,
         "admt_code"     => $admt_code,
                 "accepted"      => $accepted,
                 "resident"      => $resd };
    }

    # fall-through means no admission info
    return;
}

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

    my (@row, $decision, $apdc_date, $appl_date, $admt_code, $accepted, $resd,
        $pidm, @term_admits, $levl);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_term_admits"} ) {
        $sth_qry_term_admits = $glb_prepared_sql{"sth_qry_term_admits"};
    }
    else {
    # add fields to below as needed
    $sth_qry_term_admits = $dbh->prepare( q{
    select sarappd_pidm,
               saradap_levl_code,
               sarappd_apdc_code,
           to_char(sarappd_apdc_date, 'mm/dd/yyyy'),
           to_char(saradap_appl_date, 'mm/dd/yyyy'),
           saradap_admt_code,
               decode(nvl(stvapdc_inst_acc_ind, 0), 'Y', 1, 0),
               saradap_resd_code
    from saradap a,
         sarappd,
             stvapdc
    where saradap_levl_code like ?                          AND
          saradap_term_code_entry = ?                       AND
          saradap_appl_no = (
          select max(saradap_appl_no)
          from saradap b
          where b.saradap_pidm = a.saradap_pidm and
            b.saradap_term_code_entry = a.saradap_term_code_entry)
                                AND
          sarappd_pidm = saradap_pidm                       AND
          sarappd_term_code_entry = saradap_term_code_entry AND
          sarappd_appl_no = saradap_appl_no                 AND
          TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
        LPAD(TO_CHAR(sarappd_seq_no),2,'0') = (
          SELECT MAX(TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
            LPAD(TO_CHAR(sarappd_seq_no),2,'0'))
          FROM sarappd
          WHERE sarappd_pidm = saradap_pidm                        and
            sarappd_term_code_entry = saradap_term_code_entry  and
            sarappd_appl_no = saradap_appl_no)      AND
              stvapdc_code = sarappd_apdc_code } );
          
        $glb_prepared_sql{"sth_qry_term_admits"} = $sth_qry_term_admits;
    }

    $sth_qry_term_admits->execute($level, $term);

    while ( (@row = $sth_qry_term_admits->fetchrow_array) ) {

    ($pidm, $levl, $decision, $apdc_date, $appl_date, $admt_code, $accepted,
         $resd) = @row;

    # add fields to below as needed
    push @term_admits, { "pidm"          => $pidm,
                             "term"          => $term,
                             "level"         => $levl,
                             "decision"      => $decision,
                         "decision_date" => $apdc_date,
                         "appl_date"     => $appl_date,
                     "admt_code"     => $admt_code,
                             "accepted"      => $accepted,
                             "accepted_flg"  => $accepted ? "Y" : "N",
                             "resident"      => $resd };
    }

    return \@term_admits;
}


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

    my ($pidm, $levl, $resd, $appl_date, $admt_code, $appl_no, $state, $sbgi,
        $college, @appls, $major);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_appls_for_term1"} ) {
        $sth_qry_appls_for_term1 = $glb_prepared_sql{"sth_qry_appls_for_term1"};
    }
    else {

    # add fields to below as needed
    $sth_qry_appls_for_term1 = $dbh->prepare( q{
    select saradap_pidm,
               saradap_levl_code,
               saradap_resd_code,
           to_char(saradap_appl_date, 'mm/dd/yyyy'),
           saradap_admt_code,
               saradap_appl_no,
               stvmajr_desc
    from saradap a,
             stvmajr
    where saradap_term_code_entry = ?      AND
              saradap_levl_code like ?         AND
          saradap_appl_no = (
          select max(saradap_appl_no)
          from saradap b
          where b.saradap_pidm = a.saradap_pidm and
            b.saradap_term_code_entry = a.saradap_term_code_entry)
                                               AND
             stvmajr_code (+)= saradap_majr_code_1 } );
          
        $glb_prepared_sql{"sth_qry_appls_for_term1"} = $sth_qry_appls_for_term1;
    }

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_appls_for_term2"} ) {
        $sth_qry_appls_for_term2 = $glb_prepared_sql{"sth_qry_appls_for_term2"};
    }
    else {

    # add fields to below as needed
    $sth_qry_appls_for_term2 = $dbh->prepare( q{
            select shrtrit_sbgi_code,
                   stvsbgi_desc,
                   nvl(sobsbgi_stat_code, '')
            from shrtrit a,
                 sobsbgi,
                 stvsbgi
            where shrtrit_pidm = ?                           AND
                  shrtrit_seq_no = (
                      select max(shrtrit_seq_no)
                      from shrtrit b
                      where b.shrtrit_pidm = a.shrtrit_pidm) AND
                  sobsbgi_sbgi_code (+)= shrtrit_sbgi_code   AND
                  stvsbgi_code = shrtrit_sbgi_code } );

        $glb_prepared_sql{"sth_qry_appls_for_term2"} = $sth_qry_appls_for_term2;
    }

    $sth_qry_appls_for_term1->execute($term, $level);

    while ( ($pidm, $levl, $resd, $appl_date, $admt_code, $appl_no, $major) =
                 $sth_qry_appls_for_term1->fetchrow_array ) {

        $sth_qry_appls_for_term2->execute($pidm);
        ($sbgi, $college, $state) = $sth_qry_appls_for_term2->fetchrow_array;

    # add fields to below as needed
    push @appls, { "pidm"          => $pidm,
                       "term"          => $term,
               "level"         => $levl,
               "residence"     => $resd,
               "appl_date"     => $appl_date,
               "admt_code"     => $admt_code,
                       "appl_no"       => $appl_no,
                       "major"         => $major,
               "college_code"  => defined($sbgi)  ? $sbgi        : "",
               "college"       => defined($college)  ? $college  : "",
               "college_state" => defined($state) ? $state       : "" };
    }

    return \@appls;
}


sub app_decision {
    my ($dbh, $pidm, $term, $appl_no, $max_date) = @_;

    my ($decision, $accepted);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_app_decision"} ) {
        $sth_qry_app_decision = $glb_prepared_sql{"sth_qry_app_decision"};
    }
    else {

    # add fields to below as needed
    $sth_qry_app_decision = $dbh->prepare( q{
        select sarappd_apdc_code,
                   decode(nvl(stvapdc_inst_acc_ind, 0), 'Y', 1, 0)
        from sarappd a,
                 stvapdc
        where sarappd_pidm = ?                                     AND
                  sarappd_appl_no = ?                                  AND
                  sarappd_term_code_entry = ?                          AND
                  TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
           LPAD(TO_CHAR(sarappd_seq_no),2,'0') = (
            select MAX(TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
                   LPAD(TO_CHAR(sarappd_seq_no),2,'0'))
            from sarappd b
            where b.sarappd_term_code_entry = 
                                  a.sarappd_term_code_entry                  and
                  b.sarappd_pidm = a.sarappd_pidm                and
                  sarappd_apdc_date <= TO_DATE(?, 'mm/dd/yyyy') and
                  b.sarappd_appl_no = a.sarappd_appl_no)   AND
                  stvapdc_code = sarappd_apdc_code } );
          
        $glb_prepared_sql{"sth_qry_app_decision"} = $sth_qry_app_decision;
    }

    $sth_qry_app_decision->execute($pidm, $appl_no, $term, $max_date);

    ($decision, $accepted) = $sth_qry_app_decision->fetchrow_array;


    if ($accepted) { $decision = "A" }

    $decision = $decision ? $decision : "P";
                                        # pending
    return $decision;
}


sub app_dec_detl {
    my ($dbh, $pidm, $term, $appl_no, $max_date) = @_;

    my ($decision, $accepted);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_app_decision"} ) {
        $sth_qry_app_decision = $glb_prepared_sql{"sth_qry_app_decision"};
    }
    else {

    # add fields to below as needed
    $sth_qry_app_decision = $dbh->prepare( q{
        select sarappd_apdc_code,
                   decode(nvl(stvapdc_inst_acc_ind, 0), 'Y', 1, 0)
        from sarappd a,
                 stvapdc
        where sarappd_pidm = ?                                     AND
                  sarappd_appl_no = ?                                  AND
                  sarappd_term_code_entry = ?                          AND
                  TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
           LPAD(TO_CHAR(sarappd_seq_no),2,'0') = (
            select MAX(TO_CHAR(sarappd_apdc_date,'YYYYMMDD')||
                   LPAD(TO_CHAR(sarappd_seq_no),2,'0'))
            from sarappd b
            where b.sarappd_term_code_entry = 
                                  a.sarappd_term_code_entry                  and
                  b.sarappd_pidm = a.sarappd_pidm                and
                  sarappd_apdc_date <= TO_DATE(?, 'mm/dd/yyyy') and
                  b.sarappd_appl_no = a.sarappd_appl_no)   AND
                  stvapdc_code = sarappd_apdc_code } );
          
        $glb_prepared_sql{"sth_qry_app_decision"} = $sth_qry_app_decision;
    }

    $sth_qry_app_decision->execute($pidm, $appl_no, $term, $max_date);

    ($decision, $accepted) = $sth_qry_app_decision->fetchrow_array;

    $decision = $decision ? $decision : "P";  # pending

    return { "decision" => $decision,
             "accepted" => $accepted };
}


# wrapper for app_dec_detl that returns Y/N instead of 1/0 for accepted
sub app_decsn {
    my ($dbh, $pidm, $term, $appl_no, $max_date) = @_;

    my $rh_app_decsn = app_dec_detl($dbh, $pidm, $term, $appl_no, $max_date);

    if ( defined($rh_app_decsn->{accepted} ) ) {

        $rh_app_decsn->{accepted} =~ s/1/Y/;
        $rh_app_decsn->{accepted} =~ s/0/N/;
    }
    else {
        $rh_app_decsn->{accepted} = "N";
    }

    return $rh_app_decsn;
}


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

    my (@row, $test, $score, %tests);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_tests"} ) {
        $sth_qry_tests = $glb_prepared_sql{"sth_qry_tests"};
    }
    else {
    # add fields to below as needed
        $sth_qry_tests = $dbh->prepare( q{
        select stvtesc_desc,
           sortest_test_score
        from sortest a,
             stvtesc
        where sortest_pidm = ?                                     AND
          sortest_test_score = (
              select max(to_number(sortest_test_score) )
              from sortest b
              where b.sortest_pidm = a.sortest_pidm and
                b.sortest_tesc_code = a.sortest_tesc_code) AND
              stvtesc_code = sortest_tesc_code } );

        $glb_prepared_sql{"sth_qry_tests"} = $sth_qry_tests;
    }

    $sth_qry_tests->execute($pidm);
    while (@row = $sth_qry_tests->fetchrow_array) {

        ($test, $score) = @row;

        $tests{$test} = $score;
    }

    return \%tests;
}


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

    my (@tests, $test_code, $test, $test_date, $raw_score, $score, $assess_mthd);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_scarf_tests"} ) {
        $sth_qry_scarf_tests = $glb_prepared_sql{"sth_qry_scarf_tests"};
    }
    else {
    # add fields to below as needed
        $sth_qry_scarf_tests = $dbh->prepare( q{
        select sortest_tesc_code,
        stvtesc_desc,
        to_char(sortest_test_date, 'mm/dd/yyyy'),
        sortest_test_score,
        sortest_teac_code,
        sortest_tein_code
        from sortest a,
             stvtesc
        where sortest_pidm = ?                                     AND
          sortest_test_score = (
              select max(to_number(sortest_test_score) )
              from sortest b
              where b.sortest_pidm = a.sortest_pidm and
                b.sortest_tesc_code = a.sortest_tesc_code) AND
              stvtesc_code = sortest_tesc_code } );

        $glb_prepared_sql{"sth_qry_scarf_tests"} = $sth_qry_scarf_tests;
    }

    $sth_qry_scarf_tests->execute($pidm);
    while ( ($test_code, $test, $test_date, $raw_score, $score, $assess_mthd) =
        $sth_qry_scarf_tests->fetchrow_array ) {

        push @tests, { "pidm"        => $pidm,
                       "test_code"   => $test_code,
                       "test"        => $test,
                       "test_date"   => $test_date,
                       "raw_score"   => $raw_score,
                       "score"       => $score,
                       "assess_mthd" => $assess_mthd };
    }

    return \@tests;
}


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

    my (@row);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_hs_gpa"} ) {
        $sth_qry_hs_gpa = $glb_prepared_sql{"sth_qry_hs_gpa"};
    }
    else {
    # add fields to below as needed
    $sth_qry_hs_gpa = $dbh->prepare( q{
        select sorhsch_sbgi_code,
               stvsbgi_desc,
               sorhsch_gpa,
               sorhsch_class_rank,
               sorhsch_percentile,
               to_char(sorhsch_graduation_date, 'mm/dd/yyyy')
        from  sorhsch a,
              stvsbgi
        where sorhsch_pidm = ?                           AND
              sorhsch_activity_date = (
              select max(sorhsch_activity_date)
              from sorhsch b
              where b.sorhsch_pidm = a.sorhsch_pidm) AND
              stvsbgi_code = sorhsch_sbgi_code } );

        $glb_prepared_sql{"sth_qry_hs_gpa"} = $sth_qry_hs_gpa;
    }

    $sth_qry_hs_gpa->execute($pidm);

    @row = $sth_qry_hs_gpa->fetchrow_array;

    if (@row) {
        # add fields to below as needed
        return { "hs_code"    => $row[0],
                 "hs_desc"    => $row[1],
                 "gpa"        => $row[2],
                 "rank"       => $row[3],
                 "percentile" => $row[4],
                 "grad_date"  => $row[5] };
    }

    # fall-through
    return { "hs_code"    => "",
             "hs_desc"    => "",
             "gpa"        => "",
             "rank"       => "",
             "percentile" => "",
             "grad_date"  => "" };
}


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

    my (@row, @hs_subj);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_hs_subj"} ) {
        $sth_qry_hs_subj = $glb_prepared_sql{"sth_qry_hs_subj"};
    }
    else {
    # add fields to below as needed
    $sth_qry_hs_subj = $dbh->prepare( q{
            select sorhsbj_sbgi_code,
                   sorhsbj_sbjc_code,
                   nvl(sorhsbj_subj_years, 0)
        from  sorhsbj
        where sorhsbj_pidm = ? } );

        $glb_prepared_sql{"sth_qry_hs_subj"} = $sth_qry_hs_subj;
    }

    $sth_qry_hs_subj->execute($pidm);

    while (@row = $sth_qry_hs_subj->fetchrow_array ) {

        if ( $row[2] ) {  # subj_years

        push @hs_subj, { "pidm"       => $pidm,
                 "hs_code"    => $row[0],
                 "subj_code"  => $row[1],
                 "subj_years" => $row[2] };
        }
    }

    return \@hs_subj;
}


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

    my (%tr_coll, @tr_coll, $sbgi, $degc, $acat, $end_date, $hrs_earned,
        $gpa_hrs, $qual_pts, $gpa, $term, $activity_date, $seq,
        $coll_desc);

    # for performance we will only prepare repeated sql once
    # shrtrit/shrtram
    if (exists $glb_prepared_sql{"sth_qry_tr_coll1"} ) {
        $sth_qry_tr_coll1 = $glb_prepared_sql{"sth_qry_tr_coll1"};
    }
    else {
    $sth_qry_tr_coll1 = $dbh->prepare( q{
            select shrtrit_sbgi_code, 
                   shrtram_degc_code,
           stvdegc_acat_code,
           to_char(shrtram_attn_end_date, 'mm/dd/yyyy'), 
           shrtgpa_hours_earned,
           shrtgpa_gpa_hours,
           shrtgpa_quality_points,
                   shrtram_term_code_entered,
                   shrtrit_seq_no,
                   stvsbgi_desc
        from shrtrit,
             shrtram,
                 stvdegc,
         shrtgpa,
                 stvsbgi
        where shrtrit_pidm = ?                                  and
                  /* exclude Credit by Exam, CLEP, and Advanced Placement */
                  shrtrit_sbgi_code not in ('CBE', 'CLEP', 'AP')    and
              shrtram_pidm (+)= shrtrit_pidm                    and
          shrtram_trit_seq_no (+)= shrtrit_seq_no           and 
                  stvdegc_code (+)= shrtram_degc_code               and
          shrtgpa_pidm (+)= shrtram_pidm                    and
          shrtgpa_trit_seq_no (+)= shrtram_trit_seq_no      and
          shrtgpa_gpa_type_ind (+)= 'T'                     and
          shrtgpa_levl_code (+)= shrtram_levl_code          and
          shrtgpa_tram_seq_no (+)= shrtram_seq_no           and
                  stvsbgi_code (+)= shrtrit_sbgi_code } );

        $glb_prepared_sql{"sth_qry_tr_coll1"} = $sth_qry_tr_coll1;
    }

    # sorpcol
    if (exists $glb_prepared_sql{"sth_qry_tr_coll2"} ) {
        $sth_qry_tr_coll2 = $glb_prepared_sql{"sth_qry_tr_coll2"};
    }
    else {
    $sth_qry_tr_coll2 = $dbh->prepare( q{
            select sorpcol_sbgi_code,
                   sordegr_degc_code,
           stvdegc_acat_code,
           to_char(sordegr_attend_to, 'mm/dd/yyyy'), 
           sordegr_hours_transferred,
           sordegr_gpa_transferred,
           to_char(sorpcol_activity_date, 'mm/dd/yyyy'),
                   stvsbgi_desc
        from sorpcol,
                 sordegr,
                 stvdegc,
                 stvsbgi
        where sorpcol_pidm = ?                         and
                  sordegr_pidm (+)= sorpcol_pidm           and
                  sordegr_sbgi_code (+)= sorpcol_sbgi_code and
                  stvdegc_code (+)= sordegr_degc_code      and
                  stvsbgi_code (+)= sorpcol_sbgi_code } );

        $glb_prepared_sql{"sth_qry_tr_coll2"} = $sth_qry_tr_coll2;
    }

    # shrtrit/shrtram
    $sth_qry_tr_coll1->execute($pidm);

    while ( ( $sbgi, $degc, $acat, $end_date, $hrs_earned, $gpa_hrs, $qual_pts,
        $term, $seq, $coll_desc) = $sth_qry_tr_coll1->fetchrow_array ) {

    $degc = defined($degc)             ? $degc       : "";
    $acat = defined($acat)             ? $acat       : "";
    $end_date = defined($end_date)     ? $end_date   : "";
    $hrs_earned = defined($hrs_earned) ? $hrs_earned : 0;
    $gpa_hrs = defined($gpa_hrs)       ? $gpa_hrs    : 0;
    $qual_pts = defined($qual_pts)     ? $qual_pts   : 0;

        # sum by school and degree code (including "" degree code)
        # should probably just be one attendance period per school/non-null degree,
        # but null degree could have several attendance periods per school
        if ( !exists ( $tr_coll{$sbgi}->{$degc} )  ) {
        $tr_coll{$sbgi}->{$degc} = { "acat"          => $acat,
                     "end_date"      => $end_date,
                     "hrs_earned"    => $hrs_earned,
                     "gpa_hrs"       => $gpa_hrs,
                     "qual_pts"      => $qual_pts,
                                         "term"          => $term,
                                         "max_seq"       => $seq,
                                         "coll_desc"     => $coll_desc,
                                         "activity_date" => "" };
        }
        else {
            if ( $tr_coll{$sbgi}->{$degc}->{end_date} ) {
        if ( $end_date and
             date_compare($end_date, ">",
             $tr_coll{$sbgi}->{$degc}->{end_date} ) ) {

            $tr_coll{$sbgi}->{$degc}->{end_date} = $end_date;
        }
            }
            else { $tr_coll{$sbgi}->{$degc}->{end_date} = $end_date }

        $tr_coll{$sbgi}->{$degc}->{hrs_earned} += $hrs_earned;
        $tr_coll{$sbgi}->{$degc}->{gpa_hrs}    += $gpa_hrs;
        $tr_coll{$sbgi}->{$degc}->{qual_pts}   += $qual_pts;

            
            if ($seq > $tr_coll{$sbgi}->{$degc}->{max_seq} ) {
            $tr_coll{$sbgi}->{$degc}->{max_seq} = $seq;
            }

        }
    }


    # sorpcol/sordegr
    $sth_qry_tr_coll2->execute($pidm);

    while ( ( $sbgi, $degc, $acat, $end_date, $hrs_earned, $gpa, $activity_date,
        $coll_desc) = $sth_qry_tr_coll2->fetchrow_array ) {

    $degc = defined($degc)             ? $degc       : "";
    $acat = defined($acat)             ? $acat       : "";
    $end_date = defined($end_date)     ? $end_date   : "";
    $hrs_earned = defined($hrs_earned) ? $hrs_earned : 0;
    $gpa = defined($gpa)               ? $gpa        : 0;

        if ( defined($sbgi) and
             !exists ( $tr_coll{$sbgi}->{$degc} )  ) {
        $tr_coll{$sbgi}->{$degc} = { "acat"          => $acat,
                         "end_date"      => $end_date,
                         "hrs_earned"    => $hrs_earned,
                                         "gpa"           => $gpa,
                                         "term"          => "",
                                         "coll_desc"     => $coll_desc,
                                         "activity_date" => $activity_date };
        }
    }


    # put results on @tr_coll and calculate gpa
    foreach $sbgi (keys %tr_coll) {
        foreach $degc (keys %{ $tr_coll{$sbgi} } ) {

            # shrtrit/shrtram
            if ( exists($tr_coll{$sbgi}->{$degc}->{gpa_hrs} ) ) {
        if ( $tr_coll{$sbgi}->{$degc}->{gpa_hrs} > 0 ) {
            $gpa = sprintf("%.2f", $tr_coll{$sbgi}->{$degc}->{qual_pts} /
            $tr_coll{$sbgi}->{$degc}->{gpa_hrs} );
        }
        else { $gpa = "" };
            }
            # sorpcol/sordegr
            else { $gpa = $tr_coll{$sbgi}->{$degc}->{gpa} }

        push @tr_coll, { "pidm"       => $pidm,
                 "prior_coll" => $sbgi,
                 "degree"     => $degc,
                 "acat"       => $tr_coll{$sbgi}->{$degc}->{acat},
                 "attend_to_date"  =>
                                             $tr_coll{$sbgi}->{$degc}->{end_date},
                 "hrs_trans"  => $tr_coll{$sbgi}->{$degc}->{hrs_earned},
                 "gpa_trans"  => $gpa,
                             "term"       => $tr_coll{$sbgi}->{$degc}->{term},
                             "max_seq"    =>
                                 defined($tr_coll{$sbgi}->{$degc}->{max_seq} ) ?
                                 $tr_coll{$sbgi}->{$degc}->{max_seq}           :
                                 undef,
                             "coll_desc"  => $tr_coll{$sbgi}->{$degc}->{coll_desc},
                             "activity_date" =>
                                 $tr_coll{$sbgi}->{$degc}->{activity_date} };
        }
    }

    return \@tr_coll;
}


sub last_tr_coll {

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

    my ($ra_tr_coll, $rh_tr_coll, $max_seq, $rh_last_tr_coll);

    $ra_tr_coll = tr_coll($dbh, $pidm);

    $max_seq = 0;
    foreach $rh_tr_coll ( @{$ra_tr_coll} ) {

        if ( defined($rh_tr_coll->{max_seq} ) and
             $rh_tr_coll->{max_seq} > $max_seq ) {

             $rh_last_tr_coll = $rh_tr_coll;
             $max_seq         = $rh_tr_coll->{max_seq};
        }
    }

    if ($max_seq) {
        return $rh_last_tr_coll;
    }
    else {
        # ignore if only sorpcol/sordegr, since can't determine which one
        # was last, and need to pick just one (don't want to randomly pick).
        return { "pidm"           => $pidm,
                 "prior_coll"     => "",
                 "degree"         => "",
                 "acat"           => "",
                 "attend_to_date" => "",
                 "hrs_trans"      => "",
                 "gpa_trans"      => "",
                 "term"           => "",
                 "max_seq"        => "",
                 "coll_desc"      => "",
                 "activity_date"  => "" };
    }
}


# SAT Scores
sub SAT {
    my ($dbh, $pidm) = @_;

    my ($rh_tests, $test, $SAT, $SATM, $SATV);


    $rh_tests = tests($dbh, $pidm);

    foreach $test (keys %{$rh_tests} ) {
    if ( $test eq "SAT Composite" ) {
           $SAT = $rh_tests->{$test};
        }
    elsif ( $test eq "SAT Mathematics" ) {
           $SATM = $rh_tests->{$test};
        }
    elsif ( $test eq "SAT Verbal" ) {
           $SATV = $rh_tests->{$test};
        }
    }

    $SAT  = defined($SAT)  ? $SAT  : 0;
    $SATM = defined($SATM) ? $SATM : 0;
    $SATV = defined($SATV) ? $SATV : 0;

    return { "pidm"  => $pidm,
             "SAT"   => $SAT,
             "SATM"  => $SATM,
             "SATV"  => $SATV };
}


# ACT Scores
sub ACT {
    my ($dbh, $pidm) = @_;

    my ($rh_tests, $test, $ACT, $ACTE, $ACTM, $ACTN, $ACTS);


    $rh_tests = tests($dbh, $pidm);

    foreach $test (keys %{$rh_tests} ) {
    if ( $test eq "ACT Composite" ) {
           $ACT = $rh_tests->{$test};
        }
    elsif ( $test eq "ACT English" ) {
           $ACTE = $rh_tests->{$test};
        }
    elsif ( $test eq "ACT Math" ) {
           $ACTM = $rh_tests->{$test};
        }
    elsif ( $test eq "ACT Natural Science" ) {
           $ACTN = $rh_tests->{$test};
        }
    elsif ( $test eq "ACT Social Science" ) {
           $ACTS = $rh_tests->{$test};
        }
    }

    $ACT  = defined($ACT)  ? $ACT  : 0;
    $ACTE = defined($ACTE) ? $ACTE : 0;
    $ACTM = defined($ACTM) ? $ACTM : 0;
    $ACTN = defined($ACTN) ? $ACTN : 0;
    $ACTS = defined($ACTS) ? $ACTS : 0;

    return { "pidm"  => $pidm,
             "ACT"   => $ACT,
             "ACTE"  => $ACTE,
             "ACTM"  => $ACTM,
             "ACTN"  => $ACTN,
             "ACTS"  => $ACTS };
}


# =======================================================================
#  term_recruits - All recruits and applicants for given term and level.
#                  Level may use wildcards.
# =======================================================================
sub term_recruits {
    my ($dbh, $term, $level) = @_;

    my (@row, @recruits);


    my $sth_qry_term_recruits = $dbh->prepare( q{
        select SRBRECR_PIDM,
           srbrecr_levl_code,
           upper(nvl(spbpers_confid_ind, 'N') ),
           stvmajr_desc,
           sorhsch_sbgi_code,
           nvl(stvsbgi_desc, 'NONE'),
           nvl(decode(substr(spbpers_ethn_code, 1, 1),
              'A', 'Asian',
              'B', 'Black African',
              'H', 'Hispanic',
              'I', 'American Indian',
              'M', 'Middle Easterner',
              'N', 'North African',
              'O', 'none of the above',
              'P', 'Pacific Islander',
              'W', 'White-Euro-American',
              'X', 'Multiple ethnics',
              'D', 'Declined to Respond ',
              'none of the above'),
           'none of the above'),
           substr(sorhsch_gpa, 1, 4),  /* bad data if longer than this */
           nvl(stvrtyp_desc, 'Unknown'),
           nvl(stvrsta_desc, 'N/A'),
           srbrecr_resd_code
    from srbrecr a,
         spbpers,
         stvmajr,
         sorhsch,
         stvsbgi,
         stvrtyp,
         stvrsta
    where srbrecr_term_code = ?                                      AND
              srbrecr_levl_code like ?                               AND
          srbrecr_admin_seqno = (
          select max(srbrecr_admin_seqno)
          from srbrecr b
          where b.srbrecr_pidm = a.srbrecr_pidm                and
                b.srbrecr_levl_code = a.srbrecr_levl_code      and
            b.srbrecr_term_code = a.srbrecr_term_code)               AND
          spbpers_pidm = srbrecr_pidm                                AND
          stvmajr_code (+)= srbrecr_majr_code                        AND
          sorhsch_pidm (+)= srbrecr_pidm                             AND
          stvsbgi_code (+) = sorhsch_sbgi_code                       AND
          stvrtyp_code (+) = srbrecr_rtyp_code                       AND
          stvrsta_code (+) = srbrecr_rsta_code
    UNION
    select saradap_pidm,
           saradap_levl_code,
           upper(nvl(spbpers_confid_ind, 'N') ),
           stvmajr_desc,
           sorhsch_sbgi_code,
           nvl(stvsbgi_desc, 'NONE'),
           nvl(decode(substr(spbpers_ethn_code, 1, 1),
              'A', 'Asian',
              'B', 'Black African',
              'H', 'Hispanic',
              'I', 'American Indian',
              'M', 'Middle Easterner',
              'N', 'North African',
              'O', 'none of the above',
              'P', 'Pacific Islander',
              'W', 'White-Euro-American',
              'X', 'Multiple ethnics',
              'D', 'Declined to Respond ',
              'none of the above'),
           'none of the above'),
           substr(sorhsch_gpa, 1, 4),
           stvadmt_desc,
            'Unknown',
           saradap_resd_code
    from saradap a,
         spbpers,
         stvmajr,
         sorhsch,
         stvsbgi,
         stvadmt
    where saradap_term_code_entry = ?                              AND
          saradap_levl_code like ?                                 AND
          saradap_appl_no = (
          select max(saradap_appl_no)
          from saradap b
          where b.saradap_pidm = a.saradap_pidm           and
            b.saradap_levl_code = a.saradap_levl_code     and
            b.saradap_term_code_entry = a.saradap_term_code_entry) AND
          spbpers_pidm = saradap_pidm                              AND
          stvmajr_code (+)= nvl(saradap_majr_code_1, saradap_majr_code_2)
                                                                   AND
          sorhsch_pidm (+)= saradap_pidm                           AND
          stvsbgi_code (+) = sorhsch_sbgi_code                     AND
          stvadmt_code (+) = saradap_admt_code                     AND
          not exists (
          select 'x'
          from srbrecr
          where srbrecr_pidm = saradap_pidm           and
                srbrecr_levl_code = saradap_levl_code and
            srbrecr_term_code = saradap_term_code_entry) } );

    $sth_qry_term_recruits->execute($term, $level, $term, $level);

    while (@row = $sth_qry_term_recruits->fetchrow_array) {
        push @recruits, { "pidm"              => $row[0],  # for obj_srvr
                          "term"              => $term,    # for obj_srvr
                          "level"             => $row[1],
                          "confidential"      => $row[2],
                          "major"             => $row[3],
                          "hs_code"           => $row[4],
                          "high_school"       => $row[5],
                          "ethnicity"         => $row[6],
                          "hs_gpa"            => $row[7],
                          "recruit_type"      => $row[8],
                          "level_of_interest" => $row[9],
                          "residence"         => $row[10]  };
    }
    return \@recruits;
}

# =======================================================================
#  contact - first contact for pidm
# =======================================================================
sub contact {
    my ($dbh, $pidm) = @_;

    my (@row);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_contact"} ) {
        $sth_qry_contact = $glb_prepared_sql{"sth_qry_contact"};
    }
    else {
        $sth_qry_contact = $dbh->prepare( q{
        select stvctyp_desc
        from sorcont a,
             stvctyp 
        where sorcont_pidm = ?                              AND
              sorcont_contact_date = (
                  select min(b.sorcont_contact_date)
                  from sorcont b
                  where b.sorcont_pidm = a.sorcont_pidm)    AND
              stvctyp_code = sorcont_ctyp_code } );
    }

    $sth_qry_contact->execute($pidm);

    if (@row = $sth_qry_contact->fetchrow_array) {
        return { "contact"           => $row[0] };
    }
    else {
        return { "contact"           => "" };
    }
}


# =======================================================================
#  recruit - most recent (<= $term) recruit record for pidm/level
# =======================================================================
sub recruit {
    my ($dbh, $pidm, $term, $level) = @_;

    my (@row);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_recruit"} ) {
        $sth_qry_recruit = $glb_prepared_sql{"sth_qry_recruit"};
    }
    else {
        $sth_qry_recruit = $dbh->prepare( q{
        select upper(nvl(spbpers_confid_ind, 'N') ),
               stvmajr_desc,
               sorhsch_sbgi_code,
               nvl(stvsbgi_desc, 'NONE'),
               nvl(decode(substr(spbpers_ethn_code, 1, 1),
                  'A', 'Asian',
                  'B', 'Black African',
                  'H', 'Hispanic',
                  'I', 'American Indian',
                  'M', 'Middle Easterner',
                  'N', 'North African',
                  'O', 'none of the above',
                  'P', 'Pacific Islander',
                  'W', 'White-Euro-American',
                  'X', 'Multiple ethnics',
                  'D', 'Declined to Respond ',
                  'none of the above'),
               'none of the above'),
               substr(sorhsch_gpa, 1, 4),  /* bad data if longer than this */
               nvl(stvrtyp_desc, 'Unknown'),
               nvl(stvrsta_desc, 'N/A'),
               srbrecr_resd_code
        from srbrecr a,
             spbpers,
             stvmajr,
             sorhsch,
             stvsbgi,
             stvrtyp,
             stvrsta
        where srbrecr_pidm = ?                                           AND
              srbrecr_levl_code = ?                                      AND
              srbrecr_term_code = (
                  select max(srbrecr_term_code)
                  from srbrecr b
                  where b.srbrecr_pidm = a.srbrecr_pidm           and
                        b.srbrecr_levl_code = a.srbrecr_levl_code and
                        b.srbrecr_term_code <= ?)                        AND
              srbrecr_admin_seqno = (
                  select max(srbrecr_admin_seqno)
                  from srbrecr c
                  where c.srbrecr_pidm = a.srbrecr_pidm           and
                        c.srbrecr_levl_code = a.srbrecr_levl_code and
                        c.srbrecr_term_code = a.srbrecr_term_code)       AND
              spbpers_pidm = srbrecr_pidm                                AND
              stvmajr_code (+)= srbrecr_majr_code                        AND
              sorhsch_pidm (+)= srbrecr_pidm                             AND
              stvsbgi_code (+) = sorhsch_sbgi_code                       AND
              stvrtyp_code (+) = srbrecr_rtyp_code                       AND
              stvrsta_code (+) = srbrecr_rsta_code } );
    }

    $sth_qry_recruit->execute($pidm, $level, $term);

    if (@row = $sth_qry_recruit->fetchrow_array) {
        return { "confidential"      => $row[0],
                 "major"             => $row[1],
                 "hs_code"           => $row[2],
                 "high_school"       => $row[3],
                 "ethnicity"         => $row[4],
                 "hs_gpa"            => $row[5],
                 "recruit_type"      => $row[6],
                 "level_of_interest" => $row[7],
                 "residence"         => $row[8]  };
    }
    else { return { "confidential"      => "",
                     "major"             => "",
                    "hs_code"           => "",
                    "high_school"       => "",
                    "ethnicity"         => "",
                    "hs_gpa"            => 0,
                    "recruit_type"      => "",
                    "level_of_interest" => "",
                    "residence"         => ""  };
    }
}


sub recr_status {
    my ($dbh, $pidm, $level, $term_code) = @_;

    my (@row, $status);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_recr_status1"} ) {
        $sth_qry_recr_status1 = $glb_prepared_sql{"sth_qry_recr_status1"};
        $sth_qry_recr_status2 = $glb_prepared_sql{"sth_qry_recr_status2"};
    }
    else {

        $sth_qry_recr_status1 = $dbh->prepare( q{
        select 1
        from saradap a
        where saradap_pidm = ?            AND
              saradap_levl_code = ?       AND
              saradap_term_code_entry = ? AND
              saradap_appl_no = (
                  select max(saradap_appl_no)
                  from saradap b
                  where b.saradap_pidm = a.saradap_pidm             and
                        b.saradap_levl_code = a.saradap_levl_code   and
                        b.saradap_term_code_entry = a.saradap_term_code_entry) } );

        $glb_prepared_sql{"sth_qry_recr_status1"} = $sth_qry_recr_status1;

        $sth_qry_recr_status2 = $dbh->prepare( q{
        select sarappd_apdc_code
        from saradap a,
             sarappd
        where saradap_pidm = ?                                  AND
              saradap_levl_code = ?                             AND
              saradap_term_code_entry = ?                       AND
              saradap_appl_no = (
                  select max(saradap_appl_no)
                  from saradap b
                  where b.saradap_pidm = a.saradap_pidm and
                        b.saradap_term_code_entry = a.saradap_term_code_entry)
                                                                AND
              sarappd_pidm = saradap_pidm                       AND
              sarappd_term_code_entry = saradap_term_code_entry AND
              sarappd_appl_no = saradap_appl_no                 AND
              to_char(sarappd_apdc_date,'YYYYMMDD')||
                  lpad(to_char(sarappd_seq_no),2,'0') = (
                      select max(to_char(sarappd_apdc_date,'YYYYMMDD')||
                          lpad(to_char(sarappd_seq_no),2,'0'))
                      from sarappd
                      where sarappd_pidm = saradap_pidm                        and
                            sarappd_term_code_entry = saradap_term_code_entry  and
                            sarappd_appl_no = saradap_appl_no) } );

        $glb_prepared_sql{"sth_qry_recr_status2"} = $sth_qry_recr_status2;
    }


    # check if they applied; if not, status is "Recruit"
    $sth_qry_recr_status1->execute($pidm, $level, $term_code);
    @row = $sth_qry_recr_status1->fetchrow_array;
    if ($row[0] ) {

        # check if they have an admission decision; if not, status is "Applied"
        $sth_qry_recr_status2->execute($pidm, $level, $term_code);
        @row = $sth_qry_recr_status2->fetchrow_array;
        if ($row[0] ) {

            if (substr($row[0], 0, 1) eq "A") { $status = "Admitted" }
            if ($row[0] eq "R")               { $status = "Denied" }
            if (substr($row[0], 0, 1) eq "C") { $status = "Cancelled" }
        }
        else {
            $status = "Applied";
       }
    }
    else {
        $status = "Recruited";
    }

    $status || ($status = "Unknown");  # just in case


    return { "recr_status"  => $status };
}


sub sbgi_info {
    my($dbh, $sbgi) = @_;

    my ($stat_code, $county, $city);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_sbgi_info"} ) {
        $sth_qry_sbgi_info = $glb_prepared_sql{"sth_qry_sbgi_info"};
    }
    else {
        # rtrim(sobsbgi_cnty_code) needed because somehow the cnty_codes in
        # sobsbgi have a trailing space, but stvcnty_code doesn't.
        $sth_qry_sbgi_info = $dbh->prepare( q{
        select sobsbgi_stat_code,
               stvcnty_desc,
               sobsbgi_city
        from   sobsbgi,
               stvcnty
        where  sobsbgi_sbgi_code = ? and
               stvcnty_code (+)= rtrim(sobsbgi_cnty_code) } );

        $glb_prepared_sql{"sth_qry_sbgi_info"} = $sth_qry_sbgi_info;
    }
    
    $sth_qry_sbgi_info->execute($sbgi);
    ($stat_code, $county, $city) = $sth_qry_sbgi_info->fetchrow_array;

    return { "sbgi_state"  => $stat_code,
             "sbgi_county" => $county,
             "sbgi_city"   => $city };
}


sub coll_info {
    my($dbh, $pidm) = @_;
 
    my ($rh_tr_coll);

    $rh_tr_coll = last_tr_coll($dbh, $pidm);

    add2hash($rh_tr_coll, sbgi_info($dbh, $rh_tr_coll->{prior_coll} ) );

    return $rh_tr_coll;
}


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

return 1;

