/[vdw]/trunk/WOU_Student.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/WOU_Student.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Sun Feb 6 05:28:38 2005 UTC (19 years, 3 months ago) by dpavlin
File size: 66169 byte(s)
initial import into svn

1 dpavlin 1 package WOU_Student;
2    
3     # Routines for Banner SIS Student
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/14/2002
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_students &student &term_graduates &graduate_needs_fixed
20     &enrolled &schedule &grades &astd &term_gpa &all_gpa
21     &class &advisor &all_term_hrs &stu_schedule &new_fr
22     &new_tr &new_fr_tr &term_students_id &new_fr_id &new_tr_id
23     &new_fr_tr_id &new_fr_sched &new_tr_sched &new_fr_tr_sched
24     &academic_level &term_registered &withdrawn &reg_sched
25     &term_reg_sched &sport &scarf_cohort_excl &adv_credit
26     &first_term &grade &class_by_pidm &enrolled_yn &student2
27     &curr_gpa &in_FR_cohort &last_term &term_athletes &term_hrs
28     &term_registered_scarf &fr_cohort &first_term_no_level
29     &first_student);
30     %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
31     @EXPORT_OK = qw( );
32    
33     ( grep /gen\$com/i, @INC ) || unshift @INC, "gen\$com";
34     }
35     use vars @EXPORT_OK;
36     use subs qw(term_students student term_graduates graduate_needs_fixed enrolled
37     schedule grades astd term_gpa all_gpa class advisor all_term_hrs
38     stu_schedule new_fr new_tr new_fr_tr term_students_id new_fr_id
39     new_tr_id new_fr_tr_id new_fr_sched new_tr_sched new_fr_tr_sched
40     academic_level term_registered withdrawn reg_sched term_reg_sched
41     sport scarf_cohort_excl adv_credit first_term grade class_by_pidm
42     enrolled_yn student2 curr_gpa in_FR_cohort last_term term_athletes
43     term_hrs term_registered_scarf fr_cohort first_term_no_level
44     first_student);
45    
46     use DBI;
47     use WOU_SIS_Util;
48     use WOU_Util;
49     use WOU_Person;
50    
51     # ============================================================================
52     # Package-Level Stuff
53     # ============================================================================
54    
55     my %glb_prepared_sql; # Hash that holds $sth's for prepared sql;
56     # helps performance. Entries are of the form:
57     # ( "sth_qry_all_gpa" => $sth_qry_all_gpa, ... )
58    
59     my ($sth_qry_graduate, $sth_qry_student, $sth_qry_enrolled, $sth_qry_sched,
60     $sth_qry_grades, $sth_qry_term_gpa, $sth_qry_shrttrm, $sth_qry_all_gpa,
61     $sth_qry_class, $sth_qry_advisor, $sth_qry_all_term_hrs,
62     $sth_qry_academic_level, $sth_qry_withdrawn, $sth_qry_reg_sched,
63     $sth_qry_sport, $sth_qry_scarf_cohort_excl, $sth_qry_adv_credit,
64     $sth_qry_first_term, $sth_qry_grade, $sth_qry_curr_gpa,
65     $sth_qry_in_FR_cohort, $sth_qry_last_term, $sth_qry_term_athletes,
66     $sth_qry_term_hrs, $sth_qry_fr_cohort, $sth_qry_first_term_no_level);
67    
68    
69    
70    
71     # ============================================================================
72     # Routines
73     # ============================================================================
74     # ========================================================
75     # term_students - All students for given term and level.
76     # Level may use wildcards.
77     # ========================================================
78     sub term_students {
79     my ($dbh, $term, $level) = @_;
80    
81     my (@row, @students);
82    
83     # Make sure this query selects all fields in sql_qry_student
84     # (of student() ) so that it can provide all the info that
85     # student() provides. That way the calling program doesn't
86     # have to redo the DB lookup if it is using term_student() and
87     # also needs student() info on that student.
88     my $sql_qry_term_students = q{
89     select distinct sfrstcr_pidm,
90     sgbstdn_levl_code,
91     upper(nvl(spbpers_confid_ind, 'N') ),
92     upper(nvl(spbpers_dead_ind, 'N') ),
93     sgbstdn_majr_code_1,
94     sgbstdn_majr_code_minr_1,
95     sgbstdn_majr_code_conc_1,
96     sgbstdn_majr_code_conc_1_2,
97     sgbstdn_majr_code_conc_1_3,
98     a.stvmajr_desc,
99     b.stvmajr_desc,
100     c.stvmajr_desc,
101     d.stvmajr_desc,
102     e.stvmajr_desc,
103     sgbstdn_resd_code,
104     sgbstdn_site_code,
105     sgbstdn_admt_code,
106     sgbstdn_styp_code,
107     sgbstdn_orsn_code,
108     sgbstdn_rate_code,
109     sgbstdn_coll_code_1,
110     sgbstdn_term_code_admit,
111     stvresd_desc
112     from sfrstcr,
113     spbpers,
114     sgbstdn,
115     stvmajr a,
116     stvmajr b,
117     stvmajr c,
118     stvmajr d,
119     stvmajr e,
120     stvresd
121     where sfrstcr_term_code = ? AND
122     sfrstcr_rsts_code in (
123     select stvrsts_code
124     from stvrsts
125     where stvrsts_incl_sect_enrl = 'Y') AND
126     spbpers_pidm (+)= sfrstcr_pidm AND
127     sgbstdn_pidm = sfrstcr_pidm AND
128     sgbstdn_term_code_eff = (
129     select max(sgbstdn_term_code_eff)
130     from sgbstdn
131     where sgbstdn_pidm = sfrstcr_pidm and
132     sgbstdn_term_code_eff <= sfrstcr_term_code) AND
133     sgbstdn_levl_code like ? AND
134     a.stvmajr_code (+) = sgbstdn_majr_code_1 AND
135     b.stvmajr_code (+) = sgbstdn_majr_code_minr_1 AND
136     c.stvmajr_code (+) = sgbstdn_majr_code_conc_1 AND
137     d.stvmajr_code (+) = sgbstdn_majr_code_conc_1_2 AND
138     e.stvmajr_code (+) = sgbstdn_majr_code_conc_1_3 AND
139     stvresd_code (+)= sgbstdn_resd_code };
140    
141     my $sth_qry_term_students = $dbh->prepare($sql_qry_term_students);
142    
143     $sth_qry_term_students->execute($term, $level);
144    
145     while (@row = $sth_qry_term_students->fetchrow_array) {
146     push @students, { "pidm" => $row[0],
147     "term" => $term, # for obj_srvr
148     "level" => $row[1],
149     "confidential" => $row[2],
150     "dead" => $row[3],
151     "majr_code" => $row[4],
152     "minr_code" => $row[5],
153     "con1_code" => $row[6],
154     "con2_code" => $row[7],
155     "con3_code" => $row[8],
156     "major" => $row[9],
157     "minor" => $row[10],
158     "conc1" => $row[11],
159     "conc2" => $row[12],
160     "conc3" => $row[13],
161     "resident" => $row[14],
162     "deg_plan" => $row[15],
163     "admt_code" => $row[16],
164     "styp_code" => $row[17],
165     "orsn_code" => $row[18],
166     "rate_code" => $row[19],
167     "coll_code" => $row[20],
168     "admit_term" => $row[21],
169     "resident_desc" => $row[22] };
170     }
171     return \@students;
172     }
173    
174    
175     # =============================================================
176     # term_registered - All registrees (includes drops before 4th
177     # week) for given term and level. Level
178     # may use wildcards.
179     # =============================================================
180     sub term_registered {
181     my ($dbh, $term, $level) = @_;
182    
183     my (@row, @registered);
184    
185     # Make sure this query selects all fields in sql_qry_student
186     # (of student() ) so that it can provide all the info that
187     # student() provides. That way the calling program doesn't
188     # have to redo the DB lookup if it is using term_student() and
189     # also needs student() info on that student.
190     my $sql_qry_term_registered = q{
191     select distinct sfrstcr_pidm,
192     sgbstdn_levl_code,
193     upper(nvl(spbpers_confid_ind, 'N') ),
194     upper(nvl(spbpers_dead_ind, 'N') ),
195     sgbstdn_majr_code_1,
196     sgbstdn_majr_code_minr_1,
197     sgbstdn_majr_code_conc_1,
198     sgbstdn_majr_code_conc_1_2,
199     sgbstdn_majr_code_conc_1_3,
200     a.stvmajr_desc,
201     b.stvmajr_desc,
202     c.stvmajr_desc,
203     d.stvmajr_desc,
204     e.stvmajr_desc,
205     sgbstdn_resd_code,
206     sgbstdn_site_code,
207     sgbstdn_admt_code,
208     sgbstdn_styp_code,
209     sgbstdn_orsn_code,
210     sgbstdn_rate_code,
211     sgbstdn_coll_code_1,
212     sgbstdn_term_code_admit,
213     stvresd_desc,
214     sfrstcr_crn,
215     sfrstcr_rsts_code,
216     nvl(sfrstcr_credit_hr, 0),
217     sfrstcr_gmod_code,
218     sfrstcr_grde_code
219     from sfrstcr,
220     spbpers,
221     sgbstdn,
222     stvmajr a,
223     stvmajr b,
224     stvmajr c,
225     stvmajr d,
226     stvmajr e,
227     stvresd
228     where sfrstcr_term_code = ? AND
229     spbpers_pidm (+)= sfrstcr_pidm AND
230     sgbstdn_pidm = sfrstcr_pidm AND
231     sgbstdn_term_code_eff = (
232     select max(sgbstdn_term_code_eff)
233     from sgbstdn
234     where sgbstdn_pidm = sfrstcr_pidm and
235     sgbstdn_term_code_eff <= sfrstcr_term_code) AND
236     sgbstdn_levl_code like ? AND
237     a.stvmajr_code (+) = sgbstdn_majr_code_1 AND
238     b.stvmajr_code (+) = sgbstdn_majr_code_minr_1 AND
239     c.stvmajr_code (+) = sgbstdn_majr_code_conc_1 AND
240     d.stvmajr_code (+) = sgbstdn_majr_code_conc_1_2 AND
241     e.stvmajr_code (+) = sgbstdn_majr_code_conc_1_3 AND
242     stvresd_code (+)= sgbstdn_resd_code };
243    
244     my $sth_qry_term_registered = $dbh->prepare($sql_qry_term_registered);
245    
246     $sth_qry_term_registered->execute($term, $level);
247    
248     while (@row = $sth_qry_term_registered->fetchrow_array) {
249     push @registered, { "pidm" => $row[0],
250     "term" => $term, # for obj_srvr
251     "level" => $row[1],
252     "confidential" => $row[2],
253     "dead" => $row[3],
254     "majr_code" => $row[4],
255     "minr_code" => $row[5],
256     "con1_code" => $row[6],
257     "con2_code" => $row[7],
258     "con3_code" => $row[8],
259     "major" => $row[9],
260     "minor" => $row[10],
261     "conc1" => $row[11],
262     "conc2" => $row[12],
263     "conc3" => $row[13],
264     "resident" => $row[14],
265     "deg_plan" => $row[15],
266     "admt_code" => $row[16],
267     "styp_code" => $row[17],
268     "orsn_code" => $row[18],
269     "rate_code" => $row[19],
270     "coll_code" => $row[20],
271     "admit_term" => $row[21],
272     "resident_desc" => $row[22],
273     "crn" => $row[23],
274     "rsts_code" => $row[24],
275     "credit_hrs" => $row[25],
276     "grade_mode" => $row[26],
277     "grade" => $row[27] };
278     }
279     return \@registered;
280     }
281    
282    
283     sub term_registered_scarf {
284     my ($dbh, $term, $level) = @_;
285    
286     my (@row, @registered);
287    
288     # Make sure this query selects all fields in sql_qry_student
289     # (of student() ) so that it can provide all the info that
290     # student() provides. That way the calling program doesn't
291     # have to redo the DB lookup if it is using term_student() and
292     # also needs student() info on that student.
293     my $sql_qry_term_registered = q{
294     select distinct sfrstcr_pidm,
295     sgbstdn_levl_code,
296     upper(nvl(spbpers_confid_ind, 'N') ),
297     upper(nvl(spbpers_dead_ind, 'N') ),
298     sgbstdn_majr_code_1,
299     sgbstdn_majr_code_minr_1,
300     sgbstdn_majr_code_conc_1,
301     sgbstdn_majr_code_conc_1_2,
302     sgbstdn_majr_code_conc_1_3,
303     a.stvmajr_desc,
304     b.stvmajr_desc,
305     c.stvmajr_desc,
306     d.stvmajr_desc,
307     e.stvmajr_desc,
308     sgbstdn_resd_code,
309     sgbstdn_site_code,
310     sgbstdn_admt_code,
311     sgbstdn_styp_code,
312     sgbstdn_orsn_code,
313     sgbstdn_rate_code,
314     sgbstdn_coll_code_1,
315     sgbstdn_term_code_admit,
316     stvresd_desc,
317     sfrstcr_crn,
318     sfrstcr_rsts_code,
319     nvl(sfrstcr_credit_hr, 0),
320     sfrstcr_gmod_code,
321     sfrstcr_grde_code
322     from sfrstcr,
323     spbpers,
324     sgbstdn,
325     stvmajr a,
326     stvmajr b,
327     stvmajr c,
328     stvmajr d,
329     stvmajr e,
330     stvresd
331     where sfrstcr_term_code = ? AND
332     sfrstcr_rsts_code in (
333     select stvrsts_code
334     from stvrsts
335     where stvrsts_incl_sect_enrl = 'Y') AND
336     spbpers_pidm (+)= sfrstcr_pidm AND
337     sgbstdn_pidm = sfrstcr_pidm AND
338     sgbstdn_term_code_eff = (
339     select max(sgbstdn_term_code_eff)
340     from sgbstdn
341     where sgbstdn_pidm = sfrstcr_pidm and
342     sgbstdn_term_code_eff <= sfrstcr_term_code) AND
343     sgbstdn_levl_code like ? AND
344     a.stvmajr_code (+) = sgbstdn_majr_code_1 AND
345     b.stvmajr_code (+) = sgbstdn_majr_code_minr_1 AND
346     c.stvmajr_code (+) = sgbstdn_majr_code_conc_1 AND
347     d.stvmajr_code (+) = sgbstdn_majr_code_conc_1_2 AND
348     e.stvmajr_code (+) = sgbstdn_majr_code_conc_1_3 AND
349     stvresd_code (+)= sgbstdn_resd_code };
350    
351     my $sth_qry_term_registered = $dbh->prepare($sql_qry_term_registered);
352    
353     $sth_qry_term_registered->execute($term, $level);
354    
355     while (@row = $sth_qry_term_registered->fetchrow_array) {
356     push @registered, { "pidm" => $row[0],
357     "term" => $term, # for obj_srvr
358     "level" => $row[1],
359     "confidential" => $row[2],
360     "dead" => $row[3],
361     "majr_code" => $row[4],
362     "minr_code" => $row[5],
363     "con1_code" => $row[6],
364     "con2_code" => $row[7],
365     "con3_code" => $row[8],
366     "major" => $row[9],
367     "minor" => $row[10],
368     "conc1" => $row[11],
369     "conc2" => $row[12],
370     "conc3" => $row[13],
371     "resident" => $row[14],
372     "deg_plan" => $row[15],
373     "admt_code" => $row[16],
374     "styp_code" => $row[17],
375     "orsn_code" => $row[18],
376     "rate_code" => $row[19],
377     "coll_code" => $row[20],
378     "admit_term" => $row[21],
379     "resident_desc" => $row[22],
380     "crn" => $row[23],
381     "rsts_code" => $row[24],
382     "credit_hrs" => $row[25],
383     "grade_mode" => $row[26],
384     "grade" => $row[27] };
385     }
386     return \@registered;
387     }
388    
389    
390     sub student {
391     my ($dbh, $pidm, $term) = @_;
392    
393     my (@row);
394    
395     # for performance we will only prepare repeated sql once
396     if (exists $glb_prepared_sql{"sth_qry_student"} ) {
397     $sth_qry_student = $glb_prepared_sql{"sth_qry_student"};
398     }
399     else {
400     # add fields to below as needed
401     $sth_qry_student = $dbh->prepare( q{
402     select distinct sgbstdn_pidm,
403     sgbstdn_levl_code,
404     upper(nvl(spbpers_confid_ind, 'N') ),
405     upper(nvl(spbpers_dead_ind, 'N') ),
406     sgbstdn_majr_code_1,
407     sgbstdn_majr_code_minr_1,
408     sgbstdn_majr_code_conc_1,
409     sgbstdn_majr_code_conc_1_2,
410     sgbstdn_majr_code_conc_1_3,
411     b.stvmajr_desc,
412     c.stvmajr_desc,
413     d.stvmajr_desc,
414     e.stvmajr_desc,
415     f.stvmajr_desc,
416     sgbstdn_resd_code,
417     sgbstdn_site_code,
418     sgbstdn_admt_code,
419     sgbstdn_styp_code,
420     sgbstdn_orsn_code,
421     sgbstdn_rate_code,
422     sgbstdn_coll_code_1,
423     sgbstdn_term_code_admit,
424     stvresd_desc
425     from sgbstdn a,
426     spbpers,
427     stvmajr b,
428     stvmajr c,
429     stvmajr d,
430     stvmajr e,
431     stvmajr f,
432     stvresd
433     where sgbstdn_pidm = ? AND
434     sgbstdn_term_code_eff = (
435     select max(sgbstdn_term_code_eff)
436     from sgbstdn g
437     where g.sgbstdn_pidm = a.sgbstdn_pidm and
438     g.sgbstdn_term_code_eff <= ?) AND
439     spbpers_pidm (+)= sgbstdn_pidm AND
440     b.stvmajr_code (+) = sgbstdn_majr_code_1 AND
441     c.stvmajr_code (+) = sgbstdn_majr_code_minr_1 AND
442     d.stvmajr_code (+) = sgbstdn_majr_code_conc_1 AND
443     e.stvmajr_code (+) = sgbstdn_majr_code_conc_1_2 AND
444     f.stvmajr_code (+) = sgbstdn_majr_code_conc_1_3 AND
445     stvresd_code (+)= sgbstdn_resd_code } );
446    
447     $glb_prepared_sql{"sth_qry_student"} = $sth_qry_student;
448     }
449    
450     $sth_qry_student->execute($pidm, $term);
451    
452     @row = $sth_qry_student->fetchrow_array;
453    
454     if (@row) {
455     # add fields to below as needed
456     # return anonymous hash
457     return { "pidm" => $row[0],
458     "level" => $row[1],
459     "confidential" => $row[2],
460     "dead" => $row[3],
461     "majr_code" => $row[4],
462     "minr_code" => $row[5],
463     "con1_code" => $row[6],
464     "con2_code" => $row[7],
465     "con3_code" => $row[8],
466     "major" => $row[9],
467     "minor" => $row[10],
468     "conc1" => $row[11],
469     "conc2" => $row[12],
470     "conc3" => $row[13],
471     "resident" => $row[14],
472     "deg_plan" => $row[15],
473     "admt_code" => $row[16],
474     "styp_code" => $row[17],
475     "orsn_code" => $row[18],
476     "rate_code" => $row[19],
477     "coll_code" => $row[20],
478     "admit_term" => $row[21],
479     "resident_desc" => $row[22] };
480     }
481    
482     # fall-through means no student record
483     return;
484     }
485    
486    
487     # student2() returns a ref to an empty hash if no record found
488     sub student2 {
489     my ($dbh, $pidm, $term) = @_;
490    
491     my $rh_stu = student($dbh, $pidm, $term);
492    
493     if ( defined($rh_stu) ) {
494     return $rh_stu;
495     }
496     else {
497     return { };
498     }
499     }
500    
501    
502     # first_student() returns a students first student record
503     sub first_student {
504     my ($dbh, $pidm) = @_;
505    
506     my $rh_first_term = first_term_no_level($dbh, $pidm);
507    
508     my $rh_stu = student($dbh, $pidm, $rh_first_term->{first_term} );
509    
510     if ( defined($rh_stu) ) {
511     return $rh_stu;
512     }
513     else {
514     return { };
515     }
516     }
517    
518     # =========================================================
519     # term_students plus id() fields - helps performance on
520     # table subs that do one-to-many joins of term_students.
521     # This way is is run before one-to-many join (so not run
522     # redundantly).
523     # =========================================================
524     sub term_students_id {
525     my ($dbh, $term, $level) = @_;
526    
527     my ($ra_students, $rh_stu);
528    
529     $ra_students = term_students($dbh, $term, $level);
530    
531     foreach $rh_stu ( @{ $ra_students } ) {
532    
533     add2hash($rh_stu, id($dbh, $rh_stu->{pidm}) );
534     }
535    
536     return $ra_students;
537     }
538    
539    
540     # =========================================================
541     # stu_schedule - All students and their class schedule for
542     # given term and level. Level may use wildcards.
543     # =========================================================
544     sub stu_schedule {
545     my ($dbh, $term, $level) = @_;
546    
547     return join_table_subs( \&term_students_id,
548     [ $dbh, $term, $level ],
549     \&schedule,
550     [ $dbh, "\$pidm", $term ] );
551     }
552    
553    
554     # ========================================================================
555     # term_reg_sched - All "registrees" and the courses they registered for,
556     # even if they dropped them. Level may use wildcards.
557     # ========================================================================
558     sub term_reg_sched {
559     my ($dbh, $term, $level) = @_;
560    
561     return join_table_subs( \&term_registered,
562     [ $dbh, $term, $level ],
563     \&reg_sched,
564     [ $dbh, "\$pidm", $term, "\$crn" ] );
565     }
566    
567    
568     # =========================================================
569     # term_graduates - All graduates for given term and level.
570     # Level may use wildcards.
571     # =========================================================
572     sub term_graduates {
573     my ($dbh, $term, $level) = @_;
574    
575     my (@row, @graduates);
576    
577     # Make sure this query selects all fields in sth_qry_graduate
578     # (of graduate() ) so that it can provide all the info that
579     # graduate() provides. That way the calling program doesn't
580     # have to redo the DB lookup if it is using term_graduate() and
581     # also needs graduate() info on that graduate.
582     my $sth_qry_term_graduates = $dbh->prepare( q{
583     select shrdgmr_pidm,
584     shrdgmr_levl_code,
585     upper(nvl(spbpers_confid_ind, 'N') ),
586     upper(nvl(spbpers_dead_ind, 'N') ),
587     stvacyr_desc,
588     to_char(shrdgmr_grad_date, 'mm/dd/yyyy'),
589     shrdgmr_degc_code,
590     stvdegc_desc,
591     stvcoll_desc,
592     stvdept_desc,
593     shrdgmr_majr_code_1,
594     shrdgmr_majr_code_conc_1,
595     m1.stvmajr_desc,
596     stvhonr_desc,
597     stvethn_desc,
598     spbpers_ethn_code,
599     m1c1.stvmajr_desc,
600     m1c2.stvmajr_desc,
601     m1c3.stvmajr_desc,
602     m2.stvmajr_desc,
603     m2c1.stvmajr_desc,
604     m2c2.stvmajr_desc,
605     m2c3.stvmajr_desc,
606     mi1.stvmajr_desc,
607     mi2.stvmajr_desc
608     from shrdgmr a,
609     spbpers,
610     stvacyr,
611     stvdegc,
612     stvcoll,
613     stvdept,
614     shrdgih,
615     stvhonr,
616     stvethn,
617     stvmajr m1,
618     stvmajr m1c1,
619     stvmajr m1c2,
620     stvmajr m1c3,
621     stvmajr m2,
622     stvmajr m2c1,
623     stvmajr m2c2,
624     stvmajr m2c3,
625     stvmajr mi1,
626     stvmajr mi2
627     where shrdgmr_term_code_grad = ? AND
628     shrdgmr_levl_code like ? AND
629     shrdgmr_degs_code in
630     (select stvdegs_code
631     from saturn.stvdegs
632     where stvdegs_award_status_ind = 'A') AND
633     /* *** jhjh don't want below
634     shrdgmr_seq_no = (
635     select max(shrdgmr_seq_no)
636     from shrdgmr b
637     where b.shrdgmr_pidm = a.shrdgmr_pidm and
638     b.shrdgmr_term_code_grad = a.shrdgmr_term_code_grad and
639     b.shrdgmr_degs_code in (
640     select stvdegs_code
641     from saturn.stvdegs
642     where stvdegs_award_status_ind = 'A') ) AND *** */
643     spbpers_pidm (+) = shrdgmr_pidm AND
644     stvacyr_code (+) = shrdgmr_acyr_code AND
645     stvdegc_code (+) = shrdgmr_degc_code AND
646     stvcoll_code (+) = shrdgmr_coll_code_1 AND
647     stvdept_code (+) = shrdgmr_dept_code AND
648     m1.stvmajr_code (+) = shrdgmr_majr_code_1 AND
649     m1c1.stvmajr_code (+)= shrdgmr_majr_code_conc_1 AND
650     m1c2.stvmajr_code (+)= shrdgmr_majr_code_conc_1_2 AND
651     m1c3.stvmajr_code (+)= shrdgmr_majr_code_conc_1_3 AND
652     m2.stvmajr_code (+)= shrdgmr_majr_code_1_2 AND
653     m2c1.stvmajr_code (+)= shrdgmr_majr_code_conc_121 AND
654     m2c2.stvmajr_code (+)= shrdgmr_majr_code_conc_122 AND
655     m2c3.stvmajr_code (+)= shrdgmr_majr_code_conc_123 AND
656     mi1.stvmajr_code (+)= shrdgmr_majr_code_minr_1 AND
657     mi2.stvmajr_code (+)= shrdgmr_majr_code_minr_1_2 AND
658     shrdgih_pidm (+) = shrdgmr_pidm AND
659     shrdgih_dgmr_seq_no (+) = shrdgmr_seq_no AND
660     stvhonr_code (+) = shrdgih_honr_code AND
661     stvethn_code (+)= spbpers_ethn_code} );
662    
663     $sth_qry_term_graduates->execute($term, $level);
664    
665     while (@row = $sth_qry_term_graduates->fetchrow_array) {
666     push @graduates, { "pidm" => $row[0],
667     "term" => $term,
668     "level" => $row[1],
669     "confidential" => $row[2],
670     "dead" => $row[3],
671     "grad_year" => $row[4],
672     "grad_date" => $row[5],
673     "degr_code" => $row[6],
674     "degree" => $row[7],
675     "college" => $row[8],
676     "dept" => $row[9],
677     "majr_code" => $row[10],
678     "conc1" => $row[11],
679     "major" => $row[12],
680     "honors" => $row[13],
681     "ethnicity" => $row[14],
682     "ethn_code" => $row[15],
683     "conc1_1" => $row[16],
684     "conc1_2" => $row[17],
685     "conc1_3" => $row[18],
686     "major2" => $row[19],
687     "conc2_1" => $row[20],
688     "conc2_2" => $row[21],
689     "conc2_3" => $row[22],
690     "minor" => $row[23],
691     "minor2" => $row[24] };
692     }
693    
694     return \@graduates;
695     }
696    
697    
698     # fix below to return array of hash refs, then fix dev:graduate_gpa.pl
699     # to use graduate() correctly
700     # jhjh sub graduate {
701     sub graduate_needs_fixed {
702     my ($dbh, $pidm, $term) = @_;
703    
704     my (@row);
705    
706     # for performance we will only prepare repeated sql once
707     if (exists $glb_prepared_sql{"sth_qry_graduate"} ) {
708     $sth_qry_graduate = $glb_prepared_sql{"sth_qry_graduate"};
709     }
710     else {
711     # add fields to below as needed
712     $sth_qry_graduate = $dbh->prepare( q{
713     select shrdgmr_levl_code,
714     upper(nvl(spbpers_confid_ind, 'N') ),
715     upper(nvl(spbpers_dead_ind, 'N') ),
716     stvacyr_desc,
717     shrdgmr_grad_date,
718     shrdgmr_degc_code,
719     stvdegc_desc,
720     stvcoll_desc,
721     stvdept_desc,
722     shrdgmr_majr_code_1,
723     shrdgmr_majr_code_conc_1,
724     stvmajr_desc,
725     stvhonr_desc,
726     stvethn_desc,
727     spbpers_ethn_code
728     from shrdgmr a,
729     spbpers,
730     stvacyr,
731     stvdegc,
732     stvcoll,
733     stvdept,
734     stvmajr,
735     shrdgih,
736     stvhonr,
737     stvethn
738     where shrdgmr_pidm = ? AND
739     shrdgmr_degs_code in
740     (select stvdegs_code
741     from saturn.stvdegs
742     where stvdegs_award_status_ind = 'A') AND
743     shrdgmr_term_code_grad = (
744     select max(shrdgmr_term_code_grad)
745     from shrdgmr b
746     where b.shrdgmr_pidm = a.shrdgmr_pidm and
747     b.shrdgmr_term_code_grad <= ? and
748     b.shrdgmr_degs_code in
749     (select stvdegs_code
750     from saturn.stvdegs
751     where stvdegs_award_status_ind = 'A') ) AND
752     /* *** jhjh - don't want below
753     shrdgmr_seq_no = (
754     select max(shrdgmr_seq_no)
755     from shrdgmr c
756     where c.shrdgmr_pidm = a.shrdgmr_pidm and
757     c.shrdgmr_term_code_grad = a.shrdgmr_term_code_grad
758     and
759     c.shrdgmr_degs_code in
760     (select stvdegs_code
761     from saturn.stvdegs
762     where stvdegs_award_status_ind = 'A') ) AND *** */
763     spbpers_pidm (+) = shrdgmr_pidm AND
764     stvacyr_code (+) = shrdgmr_acyr_code AND
765     stvdegc_code (+) = shrdgmr_degc_code AND
766     stvcoll_code (+) = shrdgmr_coll_code_1 AND
767     stvdept_code (+) = shrdgmr_dept_code AND
768     stvmajr_code (+) = shrdgmr_majr_code_1 AND
769     shrdgih_pidm (+) = shrdgmr_pidm AND
770     shrdgih_dgmr_seq_no (+) = shrdgmr_seq_no AND
771     stvhonr_code (+) = shrdgih_honr_code AND
772     stvethn_code (+) = spbpers_ethn_code} );
773    
774     $glb_prepared_sql{"sth_qry_graduate"} = $sth_qry_graduate;
775     }
776    
777     $sth_qry_graduate->execute($pidm, $term);
778    
779     @row = $sth_qry_graduate->fetchrow_array;
780    
781     if (@row) {
782     # add fields to below as needed
783     # return anonymous hash
784     return { "level" => $row[0],
785     "confidential" => $row[1],
786     "dead" => $row[2],
787     "grad_year" => $row[3],
788     "grad_date" => $row[4],
789     "degr_code" => $row[5],
790     "degree" => $row[6],
791     "college" => $row[7],
792     "dept" => $row[8],
793     "majr_code" => $row[9],
794     "conc1" => $row[10],
795     "major" => $row[11],
796     "honors" => $row[12],
797     "ethnicity" => $row[13],
798     "ethn_code" => $row[14] };
799     }
800    
801     # fall-through means no graduate record
802     return;
803     }
804    
805    
806     sub enrolled {
807     my ($dbh, $pidm, $term) = @_;
808    
809     my (@row);
810    
811     # for performance we will only prepare repeated sql once
812     if (exists $glb_prepared_sql{"sth_qry_enrolled"} ) {
813     $sth_qry_enrolled = $glb_prepared_sql{"sth_qry_enrolled"};
814     }
815     else {
816     # add fields as needed
817     $sth_qry_enrolled = $dbh->prepare( q{
818     select 'Y'
819     from dual
820     where exists (
821     select 1
822     from sfrstcr
823     where sfrstcr_pidm = ? and
824     sfrstcr_term_code = ? and
825     sfrstcr_rsts_code in (
826     select stvrsts_code
827     from stvrsts
828     where stvrsts_incl_sect_enrl = 'Y') ) } );
829    
830     $glb_prepared_sql{"sth_qry_enrolled"} = $sth_qry_enrolled;
831     }
832    
833     $sth_qry_enrolled->execute($pidm, $term);
834    
835     @row = $sth_qry_enrolled->fetchrow_array;
836    
837     if (@row) { return 1 } # enrolled
838    
839     # fall-through means not enrolled
840     return 0;
841     }
842    
843    
844     sub enrolled_yn {
845     my ($dbh, $pidm, $term) = @_;
846    
847     return { "enrolled" => enrolled($dbh, $pidm, $term) ? 'Y' : 'N' };
848     }
849    
850    
851     sub withdrawn {
852     my ($dbh, $pidm, $term) = @_;
853    
854     my (@row);
855    
856     # for performance we will only prepare repeated sql once
857     if (exists $glb_prepared_sql{"sth_qry_withdrawn"} ) {
858     $sth_qry_withdrawn = $glb_prepared_sql{"sth_qry_withdrawn"};
859     }
860     else {
861     # add fields as needed
862     $sth_qry_withdrawn = $dbh->prepare( q{
863     select 'Y'
864     from dual
865     where exists (
866     select 1
867     from sfrstcr
868     where sfrstcr_pidm = ? and
869     sfrstcr_term_code = ? and
870     sfrstcr_rsts_code != 'WL' and
871     substr(sfrstcr_rsts_code, 1, 1) in ('W', 'X') ) } );
872    
873     $glb_prepared_sql{"sth_qry_withdrawn"} = $sth_qry_withdrawn;
874     }
875    
876     $sth_qry_withdrawn->execute($pidm, $term);
877    
878     @row = $sth_qry_withdrawn->fetchrow_array;
879    
880     if (@row) { return 1 } # withdrawn
881    
882     # fall-through means not withdrawn
883     return 0;
884     }
885    
886    
887     sub schedule {
888     my ($dbh, $pidm, $term) = @_;
889    
890     my ($crn, $levl, $subj, $crse, $cred_hr, $add_date, $ptrm, @sched);
891    
892     my (@row);
893    
894     # for performance we will only prepare repeated sql once
895     if (exists $glb_prepared_sql{"sth_qry_sched"} ) {
896     $sth_qry_sched = $glb_prepared_sql{"sth_qry_sched"};
897     }
898     else {
899     # add fields to below as needed
900     $sth_qry_sched = $dbh->prepare( q{
901     select sfrstcr_crn,
902     sfrstcr_levl_code,
903     ssbsect_subj_code,
904     ssbsect_crse_numb,
905     nvl(sfrstcr_credit_hr, 0),
906     to_char(sfrstcr_add_date, 'mm/dd/yyyy'),
907     sfrstcr_ptrm_code
908     from sfrstcr,
909     ssbsect
910     where sfrstcr_pidm = ? and
911     sfrstcr_term_code = ? and
912     sfrstcr_rsts_code in (
913     select stvrsts_code
914     from stvrsts
915     where stvrsts_incl_sect_enrl = 'Y') and
916     ssbsect_crn = sfrstcr_crn and
917     ssbsect_term_code = sfrstcr_term_code } );
918    
919     $glb_prepared_sql{"sth_qry_sched"} = $sth_qry_sched;
920     }
921    
922     $sth_qry_sched->execute($pidm, $term);
923    
924     while ( @row = $sth_qry_sched->fetchrow_array ) {
925     ($crn,
926     $levl,
927     $subj,
928     $crse,
929     $cred_hr,
930     $add_date,
931     $ptrm) = @row;
932    
933     push @sched, { "term" => $term, # for obj_srvr
934     "crn" => $crn,
935     "level" => $levl,
936     "subject" => $subj,
937     "course" => $crse,
938     "credit_hrs" => $cred_hr,
939     "add_date" => $add_date,
940     "ptrm" => $ptrm };
941     }
942     return \@sched;
943     }
944    
945    
946     # like sub schedule, but includes all sfrstcr records, even drops before 4th week
947     sub reg_sched {
948     my ($dbh, $pidm, $term, $crn) = @_;
949    
950     my ($levl, $subj, $crse, $cred_hr, $gmod, $grade, $rsts_code, $add_date,
951     $ptrm, @sched);
952    
953     my (@row);
954    
955     # for performance we will only prepare repeated sql once
956     if (exists $glb_prepared_sql{"sth_qry_reg_sched"} ) {
957     $sth_qry_reg_sched = $glb_prepared_sql{"sth_reg_qry_sched"};
958     }
959     else {
960     # add fields to below as needed
961     $sth_qry_reg_sched = $dbh->prepare( q{
962     select sfrstcr_levl_code,
963     ssbsect_subj_code,
964     ssbsect_crse_numb,
965     nvl(sfrstcr_credit_hr, 0),
966     sfrstcr_gmod_code,
967     sfrstcr_grde_code,
968     sfrstcr_rsts_code,
969     to_char(sfrstcr_add_date, 'mm/dd/yyyy'),
970     sfrstcr_ptrm_code
971     from sfrstcr,
972     ssbsect
973     where sfrstcr_pidm = ? and
974     sfrstcr_term_code = ? and
975     sfrstcr_crn = ? and
976     ssbsect_crn = sfrstcr_crn and
977     ssbsect_term_code = sfrstcr_term_code } );
978    
979     $glb_prepared_sql{"sth_qry_reg_sched"} = $sth_qry_reg_sched;
980     }
981    
982     $sth_qry_reg_sched->execute($pidm, $term, $crn);
983    
984     while ( @row = $sth_qry_reg_sched->fetchrow_array ) {
985     ($levl,
986     $subj,
987     $crse,
988     $cred_hr,
989     $gmod,
990     $grade,
991     $rsts_code,
992     $add_date,
993     $ptrm) = @row;
994    
995     push @sched, { "crn" => $crn,
996     "level" => $levl,
997     "subject" => $subj,
998     "course" => $crse,
999     "credit_hrs" => $cred_hr,
1000     "grade_mode" => $gmod,
1001     "grade" => $grade,
1002     "rsts_code" => $rsts_code,
1003     "add_date" => $add_date,
1004     "ptrm" => $ptrm };
1005     }
1006     return \@sched;
1007     }
1008    
1009    
1010     sub grades {
1011     my ($dbh, $pidm, $term) = @_;
1012    
1013     my ($crn, $rh_grade, %grades);
1014    
1015     # for performance we will only prepare repeated sql once
1016     if (exists $glb_prepared_sql{"sth_qry_grades"} ) {
1017     $sth_qry_grades = $glb_prepared_sql{"sth_qry_grades"};
1018     }
1019     else {
1020     # add fields to below as needed
1021     $sth_qry_grades = $dbh->prepare( q{
1022     select sfrstcr_crn
1023     from sfrstcr
1024     where sfrstcr_pidm = ? and
1025     sfrstcr_term_code = ? and
1026     sfrstcr_rsts_code in (
1027     select stvrsts_code
1028     from stvrsts
1029     where stvrsts_gradable_ind = 'Y') } );
1030    
1031     $glb_prepared_sql{"sth_qry_grades"} = $sth_qry_grades;
1032     }
1033    
1034     $sth_qry_grades->execute($pidm, $term);
1035    
1036     while ( ($crn) = $sth_qry_grades->fetchrow_array ) {
1037    
1038     $rh_grade = grade($dbh, $pidm, $term, $crn);
1039    
1040     if ($rh_grade->{subject} ) { $grades{$crn} = $rh_grade }
1041     }
1042    
1043     return \%grades;
1044     }
1045    
1046    
1047     sub grade {
1048     my ($dbh, $pidm, $term, $crn) = @_;
1049    
1050     my (@row, $subj, $crse, $grade, $credit_hrs, %grades);
1051    
1052     # for performance we will only prepare repeated sql once
1053     if (exists $glb_prepared_sql{"sth_qry_grade"} ) {
1054     $sth_qry_grade = $glb_prepared_sql{"sth_qry_grade"};
1055     }
1056     else {
1057     # add fields to below as needed
1058     $sth_qry_grade = $dbh->prepare( q{
1059     SELECT shrtckn_subj_code,
1060     shrtckn_crse_numb,
1061     SHRTCKG_GRDE_CODE_FINAL,
1062     SHRTCKG_CREDIT_HOURS
1063     FROM SHRTCKN, SHRTCKG
1064     WHERE SHRTCKN_PIDM = ? AND
1065     SHRTCKN_TERM_CODE = ? AND
1066     shrtckn_crn = ? AND
1067     SHRTCKG_PIDM = SHRTCKN_PIDM AND
1068     SHRTCKG_TERM_CODE = SHRTCKN_TERM_CODE AND
1069     SHRTCKG_TCKN_SEQ_NO = SHRTCKN_SEQ_NO AND
1070     SHRTCKG_SEQ_NO =
1071     (SELECT MAX(SHRTCKG_SEQ_NO) FROM SHRTCKG
1072     WHERE SHRTCKG_PIDM = SHRTCKN_PIDM and
1073     SHRTCKG_TERM_CODE = SHRTCKN_TERM_CODE and
1074     SHRTCKG_TCKN_SEQ_NO = SHRTCKN_SEQ_NO) } );
1075    
1076     $glb_prepared_sql{"sth_qry_grade"} = $sth_qry_grade;
1077     }
1078    
1079     $sth_qry_grade->execute($pidm, $term, $crn);
1080    
1081     if (@row = $sth_qry_grade->fetchrow_array ) {
1082    
1083     ($subj, $crse, $grade, $credit_hrs) = @row;
1084    
1085     return { "subject" => $subj,
1086     "course" => $crse,
1087     "grade" => $grade,
1088     "credit_hrs" => $credit_hrs };
1089     }
1090    
1091     else {
1092     return { "subject" => "",
1093     "course" => "",
1094     "grade" => "",
1095     "credit_hrs" => 0 };
1096     }
1097     }
1098    
1099    
1100     sub astd {
1101     my ($dbh, $pidm, $term) = @_;
1102    
1103     my ($astd, $astd_desc);
1104    
1105     if (exists $glb_prepared_sql{"sth_qry_shrttrm"} ) {
1106     $sth_qry_shrttrm = $glb_prepared_sql{"sth_qry_shrttrm"};
1107     }
1108     else {
1109     # add fields to below as needed
1110     $sth_qry_shrttrm = $dbh->prepare( q{
1111     select shrttrm_astd_code_end_of_term,
1112     stvastd_desc
1113     from shrttrm a,
1114     stvastd
1115     where shrttrm_pidm = ? AND
1116     shrttrm_term_code = (
1117     select max(shrttrm_term_code)
1118     from shrttrm b
1119     where b.shrttrm_pidm = a.shrttrm_pidm and
1120     b.shrttrm_term_code <= ?) AND
1121     stvastd_code = shrttrm_astd_code_end_of_term } );
1122    
1123     $glb_prepared_sql{"sth_qry_shrttrm"} = $sth_qry_shrttrm;
1124     }
1125    
1126     $sth_qry_shrttrm->execute($pidm, $term);
1127    
1128     ($astd, $astd_desc) = $sth_qry_shrttrm->fetchrow_array;
1129    
1130     return { "astd" => $astd,
1131     "astd_desc" => $astd_desc };
1132    
1133     }
1134    
1135    
1136     sub term_gpa {
1137     my ($dbh, $pidm, $term, $level) = @_;
1138    
1139     my (@row, $trans_key, %trans, %term_gpa, $got_data, $gpa_type,
1140     $trit_seq, $tram_seq, $gpa, $hrs_att, $hrs_earned, $hrs_gpa, $qual_pts );
1141    
1142     $level = ahist_level($level); # trans. to acad. hist. level
1143    
1144     # for performance we will only prepare repeated sql once
1145     if (exists $glb_prepared_sql{"sth_qry_term_gpa"} ) {
1146     $sth_qry_term_gpa = $glb_prepared_sql{"sth_qry_term_gpa"};
1147     }
1148     else {
1149     # add fields to below as needed
1150     $sth_qry_term_gpa = $dbh->prepare( q{
1151     select shrtgpa_gpa_type_ind,
1152     shrtgpa_trit_seq_no,
1153     shrtgpa_tram_seq_no,
1154     shrtgpa_hours_attempted,
1155     shrtgpa_hours_earned,
1156     shrtgpa_gpa_hours,
1157     shrtgpa_quality_points,
1158     shrtgpa_gpa
1159     from shrtgpa
1160     where shrtgpa_pidm = ? and
1161     shrtgpa_term_code = ? and
1162     shrtgpa_levl_code = ? } );
1163    
1164     $glb_prepared_sql{"sth_qry_term_gpa"} = $sth_qry_term_gpa;
1165     }
1166    
1167     $sth_qry_term_gpa->execute($pidm, $term, $level);
1168    
1169     $got_data = 0;
1170     while (@row = $sth_qry_term_gpa->fetchrow_array) {
1171     $got_data = 1;
1172     ($gpa_type,
1173     $trit_seq,
1174     $tram_seq,
1175     $hrs_att,
1176     $hrs_earned,
1177     $hrs_gpa,
1178     $qual_pts,
1179     $gpa) = @row;
1180    
1181     CASE_GPA_TYPE: {
1182     if ($gpa_type eq "T") {
1183     $trans_key = $trit_seq . "," . $tram_seq;
1184    
1185     $trans{$trans_key} = { "hrs_att" => $hrs_att,
1186     "hrs_earned" => $hrs_earned,
1187     "hrs_gpa" => $hrs_gpa,
1188     "qual_pts" => $qual_pts,
1189     "gpa" => $gpa };
1190     last CASE_GPA_TYPE;
1191     }
1192     if ($gpa_type eq "I") { # assume only one of these
1193     %term_gpa = ( "hrs_att" => $hrs_att,
1194     "hrs_earned" => $hrs_earned,
1195     "hrs_gpa" => $hrs_gpa,
1196     "qual_pts" => $qual_pts,
1197     "gpa" => $gpa );
1198     last CASE_GPA_TYPE;
1199     }
1200     } # CASE_GPA_TYPE
1201     }
1202    
1203     if ($got_data) {
1204    
1205     $term_gpa{"transfer"} = \%trans; # key holds ref to trans hash
1206    
1207     return \%term_gpa;
1208     }
1209    
1210     # fall-through means no data in term gpa
1211     return;
1212     }
1213    
1214    
1215     sub all_gpa {
1216     my ($dbh, $pidm, $level, $gpa_type) = @_;
1217    
1218     my (@row);
1219    
1220     if (!defined($gpa_type) ) { $gpa_type = "O" }
1221    
1222     $level = ahist_level($level); # trans. to acad. hist. level
1223    
1224     # for performance we will only prepare repeated sql once
1225     if (exists $glb_prepared_sql{"sth_qry_all_gpa"} ) {
1226     $sth_qry_all_gpa = $glb_prepared_sql{"sth_qry_all_gpa"};
1227     }
1228     else {
1229     # add fields to below as needed
1230     $sth_qry_all_gpa = $dbh->prepare( q{
1231     select shrlgpa_hours_attempted,
1232     shrlgpa_hours_earned,
1233     shrlgpa_gpa_hours,
1234     shrlgpa_quality_points,
1235     shrlgpa_gpa
1236     from shrlgpa
1237     where shrlgpa_pidm = ? and
1238     shrlgpa_levl_code = ? and
1239     shrlgpa_gpa_type_ind = ? } );
1240    
1241     $glb_prepared_sql{"sth_qry_all_gpa"} = $sth_qry_all_gpa;
1242     }
1243    
1244     $sth_qry_all_gpa->execute($pidm, $level, $gpa_type);
1245    
1246     @row = $sth_qry_all_gpa->fetchrow_array;
1247    
1248     if (@row) {
1249     # add fields to below as needed
1250     return { "hrs_att" => $row[0],
1251     "total_hrs" => $row[1],
1252     "gpa_hrs" => $row[2],
1253     "qual_pts" => $row[3],
1254     "gpa" => $row[4] }; # return ref to anonymous hash
1255     }
1256    
1257     # fall-through
1258     return { "hrs_att" => 0,
1259     "total_hrs" => 0,
1260     "gpa_hrs" => 0,
1261     "qual_pts" => 0,
1262     "gpa" => 0 };
1263     }
1264    
1265    
1266     sub curr_gpa {
1267     my ($dbh, $pidm, $term, $level, $gpa_type) = @_;
1268    
1269     my ($hrs_att, $hrs_earned, $hrs_gpa, $qual_pts);
1270    
1271     $level = ahist_level($level); # trans. to acad. hist. level
1272    
1273     # for performance we will only prepare repeated sql once
1274    
1275     if (exists $glb_prepared_sql{"sth_qry_curr_gpa"} ) {
1276     $sth_qry_curr_gpa = $glb_prepared_sql{"sth_qry_curr_gpa"};
1277     }
1278     else {
1279     # add fields to below as needed
1280     $sth_qry_curr_gpa = $dbh->prepare( q{
1281     select sum(shrtgpa_hours_attempted),
1282     sum(shrtgpa_hours_earned),
1283     sum(shrtgpa_gpa_hours),
1284     sum(shrtgpa_quality_points)
1285     from shrtgpa
1286     where shrtgpa_pidm = ? and
1287     shrtgpa_term_code <= ? and
1288     shrtgpa_levl_code = ? and
1289     shrtgpa_gpa_type_ind like ? } );
1290    
1291     $glb_prepared_sql{"sth_qry_curr_gpa"} = $sth_qry_curr_gpa;
1292     }
1293     $sth_qry_curr_gpa->execute($pidm, $term, $level, $gpa_type);
1294    
1295     if ( ($hrs_att, $hrs_earned, $hrs_gpa, $qual_pts) =
1296     $sth_qry_curr_gpa->fetchrow_array ) {
1297    
1298     return { "gpa_type" => $gpa_type,
1299     "hrs_att" => $hrs_att,
1300     "hrs_earned" => $hrs_earned,
1301     "hrs_gpa" => $hrs_gpa,
1302     "qual_pts" => $qual_pts };
1303    
1304     }
1305     else {
1306     return { "gpa_type" => $gpa_type,
1307     "hrs_att" => 0,
1308     "hrs_earned" => 0,
1309     "hrs_gpa" => 0,
1310     "qual_pts" => 0 };
1311     }
1312     }
1313    
1314    
1315     sub all_term_hrs {
1316     my ($dbh, $pidm, $level, $term) = @_;
1317    
1318     my ($tot_hrs);
1319    
1320     $level = ahist_level($level); # trans. to acad. hist. level
1321    
1322     # for performance we will only prepare repeated sql once
1323     if (exists $glb_prepared_sql{"sth_qry_term_gpa"} ) {
1324     $sth_qry_all_term_hrs = $glb_prepared_sql{"sth_qry_all_term_hrs"};
1325     }
1326     else {
1327     # add fields to below as needed
1328     $sth_qry_all_term_hrs= $dbh->prepare( q{
1329     select nvl(sum(shrtgpa_hours_earned), 0)
1330     from shrtgpa
1331     where shrtgpa_pidm = ? and
1332     shrtgpa_term_code < ? and
1333     shrtgpa_levl_code = ? } );
1334    
1335     $glb_prepared_sql{"sth_qry_all_term_hrs"} = $sth_qry_all_term_hrs;
1336     }
1337    
1338     $sth_qry_all_term_hrs->execute($pidm, $term, $level);
1339    
1340     $tot_hrs = $sth_qry_all_term_hrs->fetchrow_array;
1341    
1342     return $tot_hrs;
1343    
1344     }
1345    
1346    
1347     sub class_by_pidm {
1348     my ($dbh, $pidm, $level) = @_;
1349    
1350     my $rh_all_gpa = all_gpa($dbh, $pidm, $level);
1351    
1352     return { "pidm" => $pidm,
1353     "level" => $level,
1354     "class" => class($dbh, $level, $rh_all_gpa->{total_hrs} ) } ;
1355     }
1356    
1357    
1358     sub class {
1359     my ($dbh, $level, $tot_hrs) = @_;
1360    
1361     my (@row);
1362    
1363     # for performance we will only prepare repeated sql once
1364     if (exists $glb_prepared_sql{"sth_qry_class"} ) {
1365     $sth_qry_class = $glb_prepared_sql{"sth_qry_class"};
1366     }
1367     else {
1368     $sth_qry_class = $dbh->prepare( q{
1369     select saturn.class(?, ?)
1370     from dual } );
1371    
1372     $glb_prepared_sql{"sth_qry_class"} = $sth_qry_class;
1373     }
1374    
1375     $sth_qry_class->execute($level, $tot_hrs);
1376    
1377     @row = $sth_qry_class->fetchrow_array;
1378    
1379     return $row[0];
1380     }
1381    
1382    
1383     # academic_level(): returns class for UG, levl description for others. $tot_hrs
1384     # param is optional - if missing it will figure it out for you.
1385     sub academic_level {
1386     my ($dbh, $pidm, $level, $tot_hrs) = @_;
1387    
1388     my ($level_desc, $rh_all_gpa);
1389    
1390     my %class_desc = ( "FR" => "Freshman",
1391     "SO" => "Sophomore",
1392     "JR" => "Junior",
1393     "SR" => "Senior" );
1394    
1395     if ( $level eq "UG" ) {
1396     if ( !defined($tot_hrs) ) {
1397     $rh_all_gpa = all_gpa($dbh, $pidm, $level);
1398     $tot_hrs = $rh_all_gpa->{total_hrs};
1399     }
1400    
1401     return { "academic_level" => $class_desc{ class($dbh, $level, $tot_hrs) } };
1402     }
1403    
1404     # fall-through
1405    
1406     # for performance we will only prepare repeated sql once
1407     if (exists $glb_prepared_sql{"sth_qry_academic_level"} ) {
1408     $sth_qry_academic_level = $glb_prepared_sql{"sth_qry_academic_level"};
1409     }
1410     else {
1411     $sth_qry_academic_level = $dbh->prepare( q{
1412     select stvlevl_desc from stvlevl where stvlevl_code = ? } );
1413    
1414     $glb_prepared_sql{"sth_qry_academic_level"} = $sth_qry_academic_level;
1415     }
1416    
1417     $sth_qry_academic_level->execute($level);
1418    
1419     ($level_desc) = $sth_qry_academic_level->fetchrow_array;
1420    
1421     return { "academic_level" => $level_desc };
1422    
1423     }
1424    
1425    
1426     sub advisor {
1427     my ($dbh, $stu_pidm, $term) = @_;
1428    
1429     my (@row, $fname, $mi, $lname, $id);
1430    
1431     # for performance we will only prepare repeated sql once
1432     if (exists $glb_prepared_sql{"sth_qry_advisor"} ) {
1433     $sth_qry_advisor = $glb_prepared_sql{"sth_qry_advisor"};
1434     }
1435     else {
1436     # add fields to below as needed
1437     $sth_qry_advisor = $dbh->prepare( q{
1438     select spriden_first_name,
1439     spriden_mi,
1440     spriden_last_name,
1441     spriden_id
1442     from sgradvr,
1443     spriden
1444     where sgradvr_pidm = ? and
1445     sgradvr_term_code_eff <= ? and
1446     sgradvr_prim_ind = 'Y' and
1447     spriden_pidm = sgradvr_advr_pidm and
1448     spriden_change_ind is null
1449     order by sgradvr_term_code_eff desc,
1450     sgradvr_activity_date desc} );
1451    
1452     $glb_prepared_sql{"sth_qry_advisor"} = $sth_qry_advisor;
1453     }
1454    
1455     $sth_qry_advisor->execute($stu_pidm, $term);
1456    
1457     # just pull back first row
1458     if (@row = $sth_qry_advisor->fetchrow_array) {
1459    
1460     ($fname,
1461     $mi,
1462     $lname,
1463     $id) = @row;
1464    
1465     # add fields to below as needed
1466     return { "adv_fname" => $fname,
1467     "adv_mi" => $mi,
1468     "adv_lname" => $lname,
1469     "adv_id" => $id };
1470    
1471     }
1472    
1473     # fall-through means no advisor
1474     return { "adv_fname" => "",
1475     "adv_mi" => "",
1476     "adv_lname" => "",
1477     "adv_id" => "" };
1478     }
1479    
1480    
1481     sub sport {
1482     my ($dbh, $pidm, $term) = @_;
1483    
1484     my (@sport, $sport_code, $sport, $status, $elig, $athl_aid);
1485    
1486     # for performance we will only prepare repeated sql once
1487     if (exists $glb_prepared_sql{"sth_qry_sport"} ) {
1488     $sth_qry_sport = $glb_prepared_sql{"sth_qry_sport"};
1489     }
1490     else {
1491     # add fields to below as needed
1492     $sth_qry_sport = $dbh->prepare( q{
1493     select sgrsprt_actc_code,
1494     stvactc_desc,
1495     sgrsprt_spst_code,
1496     sgrsprt_elig_code,
1497     sgrsprt_athl_aid_ind
1498     from sgrsprt,
1499     stvactc
1500     where sgrsprt_pidm = ? and
1501     sgrsprt_term_code = ? and
1502     stvactc_code = sgrsprt_actc_code } );
1503    
1504     $glb_prepared_sql{"sth_qry_sport"} = $sth_qry_sport;
1505     }
1506    
1507     $sth_qry_sport->execute($pidm, $term);
1508    
1509     while ( ($sport_code, $sport, $status, $elig, $athl_aid) =
1510     $sth_qry_sport->fetchrow_array) {
1511    
1512     push @sport, { "pidm" => $pidm,
1513     "sport_code" => $sport_code,
1514     "sport" => $sport,
1515     "status" => $status,
1516     "elig" => $elig,
1517     "aid_ind" => $athl_aid };
1518     }
1519    
1520     return \@sport;
1521     }
1522    
1523     # ==========================================
1524     # new_fr - New Freshmen for the given term
1525     # ==========================================
1526     sub new_fr {
1527    
1528     my ($dbh, $term) = @_;
1529    
1530     my (@new_fr, $ra_students, $rh_stu);
1531    
1532     $ra_students = term_students($dbh, $term, "UG");
1533    
1534     foreach $rh_stu ( @{ $ra_students } ) {
1535     next unless $rh_stu->{admt_code} and
1536     $rh_stu->{admt_code} eq "FR" and
1537     $rh_stu->{admit_term} and
1538     $rh_stu->{admit_term} eq $term;
1539    
1540     push @new_fr, $rh_stu;
1541     }
1542    
1543     return \@new_fr;
1544     }
1545    
1546    
1547     # ===========================================
1548     # new_tr - New Transfers for the given term
1549     # ===========================================
1550     sub new_tr {
1551    
1552     my ($dbh, $term) = @_;
1553    
1554     my (@new_tr, $ra_students, $rh_stu);
1555    
1556     $ra_students = term_students($dbh, $term, "UG");
1557    
1558     foreach $rh_stu ( @{ $ra_students } ) {
1559     next unless $rh_stu->{admt_code} and
1560     ( $rh_stu->{admt_code} eq "FT" or
1561     $rh_stu->{admt_code} eq "TR" ) and
1562     $rh_stu->{admit_term} and
1563     $rh_stu->{admit_term} eq $term;
1564    
1565     push @new_tr, $rh_stu;
1566     }
1567    
1568     return \@new_tr;
1569     }
1570    
1571    
1572     # ===============================================================
1573     # new_fr_tr - New Freshmen and New Transfers for the given term
1574     # ===============================================================
1575     sub new_fr_tr {
1576    
1577     my ($dbh, $term) = @_;
1578    
1579     my (@new_fr_tr);
1580    
1581     push @new_fr_tr, @{ new_fr($dbh, $term) };
1582     push @new_fr_tr, @{ new_tr($dbh, $term) };
1583    
1584     return \@new_fr_tr;
1585     }
1586    
1587    
1588     # ==============================================================
1589     # new_fr_id - New Freshmen for the given term plus id() fields
1590     # ==============================================================
1591     sub new_fr_id {
1592    
1593     my ($dbh, $term) = @_;
1594    
1595     my (@new_fr, $ra_students, $rh_stu);
1596    
1597     $ra_students = term_students_id($dbh, $term, "UG");
1598    
1599     foreach $rh_stu ( @{ $ra_students } ) {
1600     next unless $rh_stu->{admt_code} and
1601     $rh_stu->{admt_code} eq "FR" and
1602     $rh_stu->{admit_term} and
1603     $rh_stu->{admit_term} eq $term;
1604    
1605     push @new_fr, $rh_stu;
1606     }
1607    
1608     return \@new_fr;
1609     }
1610    
1611    
1612     # ===============================================================
1613     # new_tr_id - New Transfers for the given term plus id() fields
1614     # ===============================================================
1615     sub new_tr_id {
1616    
1617     my ($dbh, $term) = @_;
1618    
1619     my (@new_tr, $ra_students, $rh_stu);
1620    
1621     $ra_students = term_students_id($dbh, $term, "UG");
1622    
1623     foreach $rh_stu ( @{ $ra_students } ) {
1624     next unless $rh_stu->{admt_code} and
1625     ( $rh_stu->{admt_code} eq "FT" or
1626     $rh_stu->{admt_code} eq "TR" ) and
1627     $rh_stu->{admit_term} and
1628     $rh_stu->{admit_term} eq $term;
1629    
1630     push @new_tr, $rh_stu;
1631     }
1632    
1633     return \@new_tr;
1634     }
1635    
1636    
1637     # ==================================================================================
1638     # new_fr_tr_id - New Freshmen and New Transfers for the given term plus id() fields
1639     # ==================================================================================
1640     sub new_fr_tr_id {
1641    
1642     my ($dbh, $term) = @_;
1643    
1644     my (@new_fr_tr);
1645    
1646     push @new_fr_tr, @{ new_fr_id($dbh, $term) };
1647     push @new_fr_tr, @{ new_tr_id($dbh, $term) };
1648    
1649     return \@new_fr_tr;
1650     }
1651    
1652    
1653     # =================================================================
1654     # new_fr_sched - All New Freshmen and their class schedule for
1655     # the given term.
1656     # =================================================================
1657     sub new_fr_sched {
1658     my ($dbh, $term) = @_;
1659    
1660     return join_table_subs( \&new_fr_id,
1661     [ $dbh, $term ],
1662     \&schedule,
1663     [ $dbh, "\$pidm", $term ] );
1664     }
1665    
1666    
1667     # ==================================================================
1668     # new_tr_sched - All New Transfers and their class schedule for
1669     # the given term.
1670     # ==================================================================
1671     sub new_tr_sched {
1672     my ($dbh, $term) = @_;
1673    
1674     return join_table_subs( \&new_tr_id,
1675     [ $dbh, $term ],
1676     \&schedule,
1677     [ $dbh, "\$pidm", $term ] );
1678     }
1679    
1680    
1681     # =====================================================================
1682     # new_fr_tr_sched - All New Freshmen and Transfers and their class
1683     # schedule for given term.
1684     # =====================================================================
1685     sub new_fr_tr_sched {
1686     my ($dbh, $term) = @_;
1687    
1688     return join_table_subs( \&new_fr_tr_id,
1689     [ $dbh, $term ],
1690     \&schedule,
1691     [ $dbh, "\$pidm", $term ] );
1692     }
1693    
1694     sub scarf_cohort_excl {
1695     my ($dbh, $pidm) = @_;
1696    
1697     my ($excl_reason, $last_term, $last_acad_yr);
1698    
1699     # for performance we will only prepare repeated sql once
1700     if (exists $glb_prepared_sql{"sth_qry_scarf_cohort_excl"} ) {
1701     $sth_qry_scarf_cohort_excl = $glb_prepared_sql{"sth_qry_scarf_cohort_excl"};
1702     }
1703     else {
1704     $sth_qry_scarf_cohort_excl = $dbh->prepare( q{
1705     select exclude_reason,
1706     last_term,
1707     last_acad_yr
1708     from scarf.cohort_exclude
1709     where pidm = ? } );
1710    
1711     $glb_prepared_sql{"sth_qry_scarf_cohort_excl"} = $sth_qry_scarf_cohort_excl;
1712     }
1713    
1714     $sth_qry_scarf_cohort_excl->execute($pidm);
1715    
1716     ($excl_reason, $last_term, $last_acad_yr) =
1717     $sth_qry_scarf_cohort_excl->fetchrow_array;
1718    
1719     if ( defined($excl_reason) ) {
1720    
1721     return { "pidm" => $pidm,
1722     "exclude_reason" => $excl_reason,
1723     "last_term" => $last_term,
1724     "last_acad_yr" => $last_acad_yr,
1725     "last_cal" => "Q" };
1726     }
1727    
1728     # fall-through
1729     return { };
1730     }
1731    
1732    
1733     sub adv_credit {
1734     my ($dbh, $pidm) = @_;
1735    
1736     my ($ac_source, $ac_hours, @adv_credit);
1737    
1738     # for performance we will only prepare repeated sql once
1739     if (exists $glb_prepared_sql{"sth_qry_adv_credit"} ) {
1740     $sth_qry_adv_credit = $glb_prepared_sql{"sth_qry_adv_credit"};
1741     }
1742     else {
1743     $sth_qry_adv_credit = $dbh->prepare( q{
1744     select shrtrit_sbgi_code,
1745     sum(shrtrce_credit_hours)
1746     from shrtrit,
1747     shrtrce
1748     where shrtrit_pidm = ? and
1749     shrtrit_sbgi_code in ('CBE', 'CLEP', 'AP') and
1750     shrtrce_pidm = shrtrit_pidm and
1751     shrtrce_trit_seq_no = shrtrit_seq_no
1752     group by shrtrit_sbgi_code } );
1753    
1754     $glb_prepared_sql{"sth_qry_adv_credit"} = $sth_qry_adv_credit;
1755     }
1756    
1757     $sth_qry_adv_credit->execute($pidm);
1758    
1759     while ( ($ac_source, $ac_hours) = $sth_qry_adv_credit->fetchrow_array ) {
1760    
1761     push @adv_credit, { "pidm" => $pidm,
1762     "ac_source" => $ac_source,
1763     "ac_hours" => $ac_hours };
1764     }
1765    
1766     return \@adv_credit;
1767     }
1768    
1769    
1770     # returns the first term that a student registered for a class at their $level
1771     # (even if they dropped it before the 4th week)
1772     sub first_term {
1773     my ($dbh, $pidm, $level) = @_;
1774    
1775     my ($term_code);
1776    
1777     # for performance we will only prepare repeated sql once
1778     if (exists $glb_prepared_sql{"sth_qry_first_term"} ) {
1779     $sth_qry_first_term = $glb_prepared_sql{"sth_qry_first_term"};
1780     }
1781     else {
1782     # add fields as needed
1783     $sth_qry_first_term = $dbh->prepare( q{
1784     select sfrstcr_term_code
1785     from sgbstdn a,
1786     sfrstcr
1787     where sgbstdn_pidm = ? AND
1788     sgbstdn_levl_code = ? AND
1789     sgbstdn_term_code_eff = (
1790     select min(sgbstdn_term_code_eff)
1791     from sgbstdn b
1792     where b.sgbstdn_pidm = a.sgbstdn_pidm and
1793     b.sgbstdn_levl_code = a.sgbstdn_levl_code) AND
1794     sfrstcr_pidm = sgbstdn_pidm AND
1795     sfrstcr_term_code >= sgbstdn_term_code_eff
1796     order by sfrstcr_term_code } );
1797    
1798     $glb_prepared_sql{"sth_qry_first_term"} = $sth_qry_first_term;
1799     }
1800    
1801     $sth_qry_first_term->execute($pidm, $level);
1802    
1803     # just pull back first row
1804     ($term_code) = $sth_qry_first_term->fetchrow_array;
1805    
1806     if ( defined($term_code) ) { return $term_code }
1807    
1808     # fall-through
1809     return "";
1810     }
1811    
1812    
1813     # returns the first term that a student registered for a class
1814     # (even if they dropped it before the 4th week)
1815     sub first_term_no_level {
1816     my ($dbh, $pidm) = @_;
1817    
1818     my ($term_code);
1819    
1820     # for performance we will only prepare repeated sql once
1821     if (exists $glb_prepared_sql{"sth_qry_first_term_no_level"} ) {
1822     $sth_qry_first_term_no_level =
1823     $glb_prepared_sql{"sth_qry_first_term_no_level"};
1824     }
1825     else {
1826     # add fields as needed
1827     $sth_qry_first_term_no_level = $dbh->prepare( q{
1828     select min(sfrstcr_term_code)
1829     from sfrstcr
1830     where sfrstcr_pidm = ? } );
1831    
1832     $glb_prepared_sql{"sth_qry_first_term_no_level"} =
1833     $sth_qry_first_term_no_level;
1834     }
1835    
1836     $sth_qry_first_term_no_level->execute($pidm);
1837    
1838     # just pull back first row
1839     ($term_code) = $sth_qry_first_term_no_level->fetchrow_array;
1840    
1841     if ( defined($term_code) ) { return { "pidm" => $pidm,
1842     "first_term" => $term_code } }
1843    
1844     # fall-through
1845     return { "pidm" => $pidm,
1846     "first_term" => "" };
1847     }
1848    
1849    
1850     sub in_FR_cohort {
1851     my ($dbh, $pidm, $term, $cohort_code) = @_;
1852    
1853     my $junk;
1854    
1855     # for performance we will only prepare repeated sql once
1856     if (exists $glb_prepared_sql{"sth_qry_in_FR_cohort"} ) {
1857     $sth_qry_in_FR_cohort = $glb_prepared_sql{"sth_qry_in_FR_cohort"};
1858     }
1859     else {
1860     $sth_qry_in_FR_cohort = $dbh->prepare( q{
1861     select 1
1862     from sgrchrt
1863     where sgrchrt_pidm = ? and
1864     sgrchrt_chrt_code = ? and
1865     sgrchrt_term_code_eff = ? } );
1866    
1867     $glb_prepared_sql{"sth_qry_in_FR_cohort"} = $sth_qry_in_FR_cohort;
1868     }
1869    
1870     $sth_qry_in_FR_cohort->execute($pidm, $cohort_code, $term);
1871    
1872     if ( ($junk) = $sth_qry_in_FR_cohort->fetchrow_array ) {
1873     return 1; # in FR cohort
1874     }
1875    
1876     # fall-through
1877     return 0; # not in FR cohort
1878     }
1879    
1880    
1881     sub last_term {
1882     my ($dbh, $pidm) = @_;
1883    
1884     my $last_term;
1885    
1886     # for performance we will only prepare repeated sql once
1887     if (exists $glb_prepared_sql{"sth_qry_last_term"} ) {
1888     $sth_qry_last_term = $glb_prepared_sql{"sth_qry_last_term"};
1889     }
1890     else {
1891     $sth_qry_last_term = $dbh->prepare( q{
1892     select max(sfrstcr_term_code)
1893     from sfrstcr
1894     where sfrstcr_pidm = ? and
1895     sfrstcr_rsts_code in (
1896     select stvrsts_code
1897     from stvrsts
1898     where stvrsts_incl_sect_enrl = 'Y') } );
1899    
1900     $glb_prepared_sql{"sth_qry_last_term"} = $sth_qry_last_term;
1901     }
1902    
1903     $sth_qry_last_term->execute($pidm);
1904    
1905     if ( ($last_term) = $sth_qry_last_term->fetchrow_array ) {
1906     return $last_term;
1907     }
1908    
1909     # fall-through
1910     return "";
1911     }
1912    
1913    
1914     sub term_athletes {
1915     my ($dbh, $term) = @_;
1916    
1917     my ($pidm, $sport, @term_athletes);
1918    
1919     # for performance we will only prepare repeated sql once
1920     if (exists $glb_prepared_sql{"sth_qry_term_athletes"} ) {
1921     $sth_qry_term_athletes = $glb_prepared_sql{"sth_qry_term_athletes"};
1922     }
1923     else {
1924     $sth_qry_term_athletes = $dbh->prepare( q{
1925     select sgrsprt_pidm,
1926     stvactc_desc
1927     from sgrsprt,
1928     stvactc
1929     where sgrsprt_term_code = ? and
1930     stvactc_code = sgrsprt_actc_code } );
1931    
1932     $glb_prepared_sql{"sth_qry_term_athletes"} = $sth_qry_term_athletes;
1933     }
1934    
1935     $sth_qry_term_athletes->execute($term);
1936    
1937     while ( ($pidm, $sport) = $sth_qry_term_athletes->fetchrow_array ) {
1938     push @term_athletes, { "pidm" => $pidm,
1939     "sport" => $sport };
1940     }
1941    
1942     return \@term_athletes;
1943     }
1944    
1945    
1946     sub term_hrs {
1947     my ($dbh, $pidm, $term) = @_;
1948    
1949     my ($term_hrs);
1950    
1951     # for performance we will only prepare repeated sql once
1952     if (exists $glb_prepared_sql{"sth_qry_term_hrs"} ) {
1953     $sth_qry_term_hrs = $glb_prepared_sql{"sth_qry_term_hrs"};
1954     }
1955     else {
1956     $sth_qry_term_hrs = $dbh->prepare( q{
1957     select sum(sfrstcr_credit_hr)
1958     from sfrstcr
1959     where sfrstcr_pidm = ? and
1960     sfrstcr_term_code = ? and
1961     sfrstcr_rsts_code in (
1962     select stvrsts_code
1963     from stvrsts
1964     where stvrsts_incl_sect_enrl = 'Y') } );
1965    
1966     $glb_prepared_sql{"sth_qry_term_hrs"} = $sth_qry_term_hrs;
1967     }
1968    
1969     $sth_qry_term_hrs->execute($pidm, $term);
1970    
1971     ($term_hrs) = $sth_qry_term_hrs->fetchrow_array;
1972    
1973     return { "pidm" => $pidm,
1974     "term_hrs" => $term_hrs };
1975    
1976     }
1977    
1978    
1979     sub fr_cohort {
1980     my ($dbh, $pidm) = @_;
1981    
1982     my ($chrt_code, $eff_term);
1983    
1984     # for performance we will only prepare repeated sql once
1985     if (exists $glb_prepared_sql{"sth_qry_fr_cohort"} ) {
1986     $sth_qry_fr_cohort = $glb_prepared_sql{"sth_qry_fr_cohort"};
1987     }
1988     else {
1989     $sth_qry_fr_cohort = $dbh->prepare( q{
1990     select sgrchrt_chrt_code,
1991     sgrchrt_term_code_eff
1992     from sgrchrt
1993     where sgrchrt_pidm = ? and
1994     sgrchrt_chrt_code like 'F%F' } );
1995    
1996     $glb_prepared_sql{"sth_qry_fr_cohort"} = $sth_qry_fr_cohort;
1997     }
1998    
1999     $sth_qry_fr_cohort->execute($pidm);
2000    
2001     ($chrt_code, $eff_term) = $sth_qry_fr_cohort->fetchrow_array;
2002    
2003     if ( defined($chrt_code) and
2004     substr($chrt_code, 1, 2) eq substr($eff_term, 2, 2) ) {
2005     # i.e. cohort F02F has eff_term of 200201, F03F of 200301, etc.
2006    
2007     return { "pidm" => $pidm,
2008     "fr_cohort" => $chrt_code };
2009     }
2010     else {
2011     return { "pidm" => $pidm,
2012     "fr_cohort" => "" };
2013     }
2014     }
2015    
2016    
2017     # ============================================================================
2018     # Subroutines
2019     # ============================================================================
2020    
2021     return 1;
2022    
2023    

  ViewVC Help
Powered by ViewVC 1.1.26