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 ®_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 |
\®_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 |
|