#! /usr/bin/perl # Copyright 2001-2020 Leslie Richardson # This file is part of Open Admin for Schools. %lex = ( 'Nominal Roll' => 'Nominal Roll', 'Staff' => 'Staff', 'Main' => 'Main', 'Eoy' => 'Eoy', 'Continue' => 'Continue', 'Error' => 'Error', 'Continue' => 'Continue', 'Grade' => 'Grade', 'Homeroom' => 'Homeroom', 'Name' => 'Name', 'Area Code' => 'Area Code', 'Phone Number' => 'Phone Number', 'Download' => 'Download', 'Version' => 'Version', 'Missing' => 'Missing', 'Found' => 'Found', 'Student' => 'Student', 'School' => 'School', 'Students' => 'Students', 'Field' => 'Field', 'Transport' => 'Transport', 'Errors' => 'Errors', 'Warnings' => 'Warnings', 'Warning' => 'Warning', 'Contact' => 'Contact', 'Area' => 'Area', 'Userid' => 'Userid', 'Current' => 'Current', 'Previous' => 'Previous', 'Occupation' => 'Occupation', ); my $self = 'nomroll.pl'; my $version = '2020-09-15'; my $referencedatadate = '2020-06-26'; # Watch for 7 embedded in schema location my $schemalocation = "aandc.gc.ca/Schema/Forms/NRSC_R_462572/8.8/NRSC_R_462572.xsd"; my $dcinumber = '462572'; my $dciversion = '8.8'; my $xmllang = 'en'; my $instns = "http://www.w3.org/2001/XMLSchema-instance"; my $schemans = "http://www.w3.org/2001/XMLSchema"; my $xml = "http://www.w3.org/XML/1998/namespace"; my %provs = qw(SK 1 AB 1 BC 1 MB 1 ON 1 QC 1 NS 1 YT 1 NL 1 NB 1 PE 1 NU 1 NT 1); my @errors; # global error tracker. my @warnings; # global warnings; doesn't stop XML creation. my %currstuds; # Current Nominal Roll students my %prevstuds; # Previous Year NR students. my %staff; use DBI; use CGI; use XML::Writer; use XML::Writer::String; use XML::LibXML; use IO::File; use Number::Format qw(:subs); eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } # This file contains default including SchoolProgram eval require "./inac.conf"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; my $q = new CGI; print $q->header( -charset, $charset ); my %arr = $q->Vars; # Current Date my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $iddst) = localtime(time); $year = $year + 1900; $mon++; $wday++; if (length( $mon) == 1 ){ $mon = '0'. $mon; }; if (length( $mday) == 1 ){ $mday = '0'. $mday; }; my $currdate = "$year-$mon-$mday"; # Print Page Header my $title = qq{$lex{'Nominal Roll'}}; print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} ]}; print qq{

$title

\n}; print qq{

$lex{Version}: $version

\n}; # Load Nominal Roll Info (certifier, contact) from config system. my $ref = getNominalRollData( $dbh ); my %nd = %$ref; =head if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; mkNominalRoll(); } =cut mkNominalRoll(); #---------------- sub mkNominalRoll { #---------------- # Create Writer Instance # my $output = new XML::Writer::String; my $filename = "nominalroll$$.xml"; my $output = new IO::File(">$filename"); my $datamode = 1; my $wr = new XML::Writer(OUTPUT => $output, DATA_MODE => $datamode, DATA_INDENT => '4', PREFIX_MAP => { $xml => 'xml' }, ENCODING => 'utf-8', NAMESPACES => 1 ); # Set XML Header $wr->xmlDecl("utf-8"); $wr->forceNSDecl( $instns ); $wr->forceNSDecl( $schemans ); $wr->addPrefix( $instns, 'xsi'); $wr->addPrefix( $schemans, 'xsd'); # 'xsi' => "http://www.w3.org/2001/XMLSchema-instance", # 'noNamespaceSchemaLocation' => $schemalocation, $wr->startTag('DCI', DCINumber => $dcinumber, DCIVersion => $dciversion, [ $instns => 'noNamespaceSchemaLocation'] => $schemalocation ); # Data Element $wr->startTag('Data', 'DCINumber' => $dcinumber, 'DCIVersion' => $dciversion ); print qq{

Writing Applicant Information

\n}; $wr->startTag('Applicant'); # if ( length( $nd{'recipientnumber'} ) > 3 ) { # print qq{

Error: Recipient Number $nd{'recipientnumber'} is too long

\n}; # print qq{\n}; # exit; # } $wr->dataElement('RecipientNumber', $nd{'recipientnumber'} ); $wr->dataElement('Region', $nd{'region'} ); $wr->endTag('Applicant'); my $sy = $schoolyear; $sy =~ s/-|\s+//g; # strip dashes and spaces. $wr->dataElement('Year', $sy ); # strip hyphen # Vendor Info $wr->startTag('Vendor'); $wr->dataElement('Name','Les Richardson' ); $wr->dataElement('Product','Open Administration for Schools'); $wr->dataElement('Version', "$g_OpenadminVersion ($version)" ); $wr->dataElement('Date', $currdate ); $wr->dataElement('ReferenceDataDate', $referencedatadate ); $wr->endTag('Vendor'); $wr->startTag('PrimaryContact'); if ( $nd{email} ) { $wr->dataElement('Email', $nd{email} ); } $wr->startTag('PhoneNumber'); my $phone = formatPhone( $nd{'contact_phone'}, $lex{Contact} ); if ( not $phone ) { my $error = "$lex{'Nominal Roll'}:contact_phone:Format Error:$nd{'contact_phone'}:Should be 10 digits"; push @errors, $error; } $wr->dataElement('Number', $phone ); if ( $nd{'contact_phone_ext'} ) { $wr->dataElement('Extension', $nd{'contact_phone_ext'} ); } $wr->endTag('PhoneNumber'); if ( $nd{'contact_fax'} ) { my $fax = formatPhone( $nd{'contact_fax'}, $lex{Contact} ); $wr->startTag('FaxNumber'); $wr->dataElement('Number', $fax ); $wr->endTag('FaxNumber'); } $wr->startTag('Addresses'); $wr->startTag('Mailing'); $wr->dataElement('Street', $nd{'contact_address'} ); $wr->dataElement('City', $nd{'contact_city'} ); $wr->dataElement('ProvinceState', $nd{'contact_province'} ); $wr->dataElement('Country', 'CA'); $wr->dataElement('PostalCode', $nd{'contact_postalcode'} ); $wr->endTag('Mailing'); $wr->dataElement('StreetSameAsMailing', 'true'); $wr->endTag('Addresses'); $wr->dataElement('FamilyName', $nd{'contact_lastname'} ); $wr->dataElement('GivenName', $nd{'contact_firstname'} ); $wr->dataElement('Title', $nd{'contact_title'} ); $wr->endTag('PrimaryContact'); $wr->dataElement('HasSecondary', 'false'); #$wr->dataElement('SecondaryContact'); # we're not doing this... $wr->startTag('Certifier'); $wr->dataElement('FamilyName', $nd{'certifier_lastname'} ); $wr->dataElement('GivenName', $nd{'certifier_firstname'} ); $wr->dataElement('Title', $nd{'certifier_title'} ); $wr->endTag('Certifier'); $wr->dataElement('CertificationDate', $currdate ); $wr->startTag('Identification'); $wr->startTag('DeliveryOrganization', 'isRecipient' => 'true'); $wr->dataElement('Id', $nd{recipient_id} ); # New Values Here. $wr->startTag('PhoneNumber'); my $phone = formatPhone( $nd{'recipient_phone'}, $lex{Contact} ); if ( not $phone ) { my $error = "$lex{'Nominal Roll'} recipient_phone ". "format error: $nd{'recipient_phone'} Should be 10 digits"; push @errors, $error; } $wr->dataElement('Number', $phone ); if ( $nd{'recipient_phone_ext'} ) { $wr->dataElement('Extension', $nd{'recipient_phone_ext'} ); } $wr->endTag('PhoneNumber'); if ( $nd{'recipient_fax'} ) { my $fax = formatPhone( $nd{'recipient_fax'}, $lex{Contact} ); $wr->startTag('FaxNumber'); $wr->dataElement('Number', $fax ); $wr->endTag('FaxNumber'); } $wr->startTag('Addresses'); $wr->startTag('Mailing'); $wr->dataElement('Street', $nd{'recipient_street'} ); $wr->dataElement('City', $nd{'recipient_city'} ); $wr->dataElement('ProvinceState', $nd{'recipient_province'} ); $wr->dataElement('Country', 'CA'); $wr->dataElement('PostalCode', $nd{'recipient_postalcode'} ); $wr->endTag('Mailing'); $wr->endTag('Addresses'); # End of New Values. $wr->dataElement('Type', $nd{recipient_type} ); $wr->dataElement('Name', $nd{recipient_name} ); $wr->endTag('DeliveryOrganization'); $wr->endTag('Identification'); # previous value with xml:lang attribute # $wr->dataElement('Name', $deliveryorg_name, [ $xml => 'lang'], 'en' ); # Reporting Orgs: not needed unless doing subreports. # $wr->startTag('ReportingDeliveryOrganizations'); # $wr->startTag('DeliveryOrganization'); # $wr->dataElement('Id', $deliveryorg_id ); # $wr->dataElement('Type', $deliveryorg_type ); # $wr->dataElement('Name', $deliveryorg_name ); # $wr->endTag('DeliveryOrganization'); # $wr->endTag('ReportingDeliveryOrganizations'); $wr->dataElement('ReportingPeriod', 'Annual' ); # Reported Orgs $wr->startTag('ReportedDeliveryOrganizations'); $wr->startTag('DeliveryOrganization'); $wr->dataElement('Id', $nd{deliveryorg_id} ); $wr->dataElement('Type', $nd{deliveryorg_type} ); $wr->dataElement('Name', $nd{deliveryorg_name} ); # $wr->dataElement('Name', $deliveryorg_name, [ $xml => 'lang'], 'en' ); # Get Students my @students; # my $sth = $dbh->prepare("select si.studnum from student_inac si # left outer join studentall sa on si.studnum = sa.studnum # order by sa.grade, sa.lastname, sa.firstname"); print qq{

Writing Student Information

\n}; my $sth = $dbh->prepare("select studnum from student_inac"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } $wr->startTag('Clients'); while ( my $studnum = $sth->fetchrow ) { my $ref = getStudentValues( $dbh, $studnum ); if ( $ref ) { # not skipped since PK. mkStudent( $wr, $ref ); push @students, $studnum; } } $wr->endTag('Clients'); # Display Current and Previous NR Students my $sth = $dbh->prepare("select defaultvalue from meta where fieldid = 'serviceprovision'"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $default = $sth->fetchrow; my %srview = split(/\s+/, $default); # foreach my $key ( sort keys %srview ) { # print qq{K:$key V:$srview{$key}
\n}; # } # Current Students # print qq{

$lex{Current} $lex{'Nominal Roll'} $lex{Students}

\n}; my $first = 1; my $ccount = 1; my %grades; $sth = $dbh->prepare("select grade from studentall where studnum = ? and grade != '' and grade != ''"); foreach my $key ( sort keys %currstuds ) { my ($lastname, $firstname, $studnum ) = split(':', $key); my $val = $currstuds{$key}; $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $gr = $sth->fetchrow; $grades{$gr}++; if ( $first ) { print qq{\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{}; my $sp = $srview{$val}; $sp =~ s/\_/ /g; # replace underscores with spaces print qq{\n}; $ccount++; } print qq{
}; print qq{$lex{Current} $lex{'Nominal Roll'} $lex{Students}
NameGradeService Provision
$ccount. $lastname, $firstname ($studnum)$gr$sp
\n}; # Previous Students my $first = 1; my $pcount = 1; foreach my $key ( sort keys %prevstuds ) { my ($lastname, $firstname, $studnum ) = split(':', $key); my $val = $srview{ "$prevstuds{$key}" }; $val =~ s/\_/ /g; # replace underscores with spaces if ( $first ) { print qq{\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{}; print qq{\n}; $pcount++; } print qq{
}; print qq{$lex{Previous} $lex{'Nominal Roll'} $lex{Students}
NameService Provision
$pcount. $lastname, $firstname ($studnum)$val
\n}; # Print Students by Grade. print qq{\n}; print qq{\n}; print qq{\n}; my $totalstudent; foreach my $grade ( sort {$a <=> $b} keys %grades ) { $totalstudent += $grades{$grade}; print qq{\n}; } print qq{\n}; print qq{
Sept 30
GradeCount
$grade$grades{$grade}
Total$totalstudent

\n}; print qq{

Writing School Information

\n}; my $schoolref = getSchoolData( $dbh ); mkSchool( $wr, $schoolref ); # Print Staff List $sth = $dbh->prepare("select field_value from staff_multi where userid = ? and field_name = 'position'"); my $first = 1; my $scount = 1; foreach my $key ( sort keys %staff ) { my ($lastname, $firstname, $userid ) = split(/:/, $key); $sth->execute( $userid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my @pos; while ( my $pos = $sth->fetchrow ) { push @pos, $pos; } my $position = join('/', @pos); if ( $first ) { print qq{\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{}; print qq{\n}; $scount++; } print qq{
}; print qq{$lex{Staff} Set nrskip field to remove
NamePosition
$scount. $lastname, $firstname ($userid)$position
\n}; $wr->endTag('DeliveryOrganization'); $wr->endTag('ReportedDeliveryOrganizations'); # Supporting Docs $wr->emptyTag('SupportingDocuments'); $wr->endTag('Data'); $wr->endTag('DCI'); $wr->end(); $output->close; # Check for Any Warnings. if ( @warnings ) { # display warnings print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; foreach my $val ( @warnings ) { my @warn = split(':', $val); print qq{}; foreach my $v ( @warn ) { print qq{}; } print qq{\n}; } print qq{
}; print qq{$lex{Warnings} $lex{Found}
$lex{Area}$lex{Field}$lex{Userid}$lex{Name}
$v
\n}; } if ( $arr{skiperr} ) { system("mv $filename $downloaddir"); print qq{

[ }; print qq{$lex{'Download'} $lex{'Nominal Roll'} ]

\n}; } # Check for any errors if ( @errors ) { # display errors! print qq{

$lex{Errors} $lex{Found}

\n}; print qq{\n}; print qq{}; print qq{\n}; foreach my $val ( @errors ) { my @err = split(':', $val); print qq{}; foreach my $v ( @err ) { print qq{}; } print qq{\n}; } print qq{
$lex{Area}$lex{Field}$lex{Userid}$lex{Name}
$v

\n}; unlink $filename; } else { # everything is ok # Move and Display Link system("mv $filename $downloaddir"); print qq{

[ }; print qq{$lex{'Download'} $lex{'Nominal Roll'} ]

\n}; } print qq{

[ $lex{Main} ]

\n}; print qq{\n}; } #---------------- sub showStartPage { #---------------- # Setup the form and start of table. print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{'First Name'}\n}; print qq{}; print qq{
$lex{'Last Name'}\n}; print qq{}; print qq{
$lex{Title}\n}; print qq{}; print qq{
$lex{Date}\n}; print qq{}; print qq{
}; print qq{}; print qq{
\n}; print qq{\n}; exit; } #--------------------- sub getNominalRollData { # nominal roll contact, certifier #--------------------- my ( $dbh ) = @_; my %nrskip = qw(contact_email 1 contact_phone_ext 1 recipient_fax 1 recipient_phone_ext 1); # removed tuition agreement skipping # Load Existing Configuration Data. my $sth = $dbh->prepare("select dataname, datavalue from conf_system where filename = ?"); $sth->execute('first_nation'); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my %val; while ( my ($dn,$dv) = $sth->fetchrow ) { # Note: This will work ONLY with scalar values! my ($name, $val) = split(/=/, $dv); $val =~ s/^\s*'|;//g; $val =~ s/'\s*$//g; # if ( $val ) { # we want to trap errors below $val{$dn} = $val; #} } #print qq{VAL", %val, "
\n"; # Recipient Number Check. if ( ($val{recipientnumber} =~ m/-/ ) or ( length( $val{recipientnumber} ) > 9 )) { my $error = "$lex{'Nominal Roll'}:$val{recipientnumber}: :Recipient Number"; push @errors, $error; } # Province Check # %provs set at top. if ( not $provs{ "$val{'contact_province'}" } ) { my $error = "$lex{'Nominal Roll'}:contact_province $val{'contact_province'}: : "; push @errors, $error; } foreach my $key ( sort keys %val ) { # print qq{K:$key V:$val{$key}
\n}; if ( not $val{$key} or $val{$key} eq '' ) { # blank or undefined, zero allowed # if ( $key =~ m/2/ ) { next; } # skip all contact 2 issues. if ( $nrskip{$key} ) { next; } # skip any values in this hash my $error = "$lex{'Nominal Roll'}:$key: : "; push @errors, $error; } } return \%val; } # end of getNominalRollData #------------------- sub getStudentValues { # populate a student hash for values #------------------- my ( $dbh, $studnum ) = @_; my $sth = $dbh->prepare("select lastname, firstname, sex, treaty, birthdate, studnum, ethnic, grade, prov1 from studentall where studnum = ?"); $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; my %rec = %$ref; if ( $rec{grade} > 13 ) { # flag error my $error = "$lex{Student}:$lex{Grade} $rec{grade}:$rec{studnum}:$rec{firstname} $rec{lastname}"; push @errors, $error; } my $tempgrade; if ( $rec{grade} =~ /\D/ ) { # nondigit if ( $rec{grade} eq 'P3' ) { return; } # return without any record info, skip this student. if ( $rec{grade} eq 'K5' or $rec{grade} eq 'K' ) { $tempgrade = 'K'; } if ( $rec{grade} eq 'K3' or $rec{grade} eq 'K4' or $rec{grade} eq 'PK' ) { $tempgrade = 'JK'; } else { # grade error my $error = "$lex{Student}:$lex{Grade} Unknown $rec{grade}:$studnum:$rec{firstname} $rec{lastname}"; } } else { $tempgrade = $rec{grade}; } if ( not $school_attendance_factor{$tempgrade} ) { # print qq{TEMP Grade:$tempgrade:
\n}; # print qq{ATENDANCE FACTOR:}; # foreach my $key ( sort keys %school_attendance_factor ) { # print qq{K:$key V:$school_attendance_factor{$key}
\n}; # } my $error = "$lex{Student}:$lex{Grade} $lex{Missing} Attendance Factor - $rec{grade} ($tempgrade):$studnum:$rec{firstname} $rec{lastname}"; push @errors, $error; } # Treaty Number Check if ( ($rec{treaty} =~ m/\D/ ) or ( length( $rec{treaty}) != 10 and $rec{treaty} ) or ( $rec{treaty} =~ m/\s+/ ) ) { my $error = "$lex{Student}:$rec{treaty} (IRS Number):$studnum:$rec{firstname} $rec{lastname}"; push @errors, $error; } # Birthdate Check if ( ($rec{birthdate} eq '0000-00-00' )) { my $error = "$lex{Student}:Birthdate $rec{birthdate}:$studnum:$rec{firstname} $rec{lastname}"; push @errors, $error; } # foreach my $key ( sort keys %rec ) { print qq{K:$key V:$rec{$key}
\n}; } foreach my $key ( sort keys %rec ) { if ( not defined $rec{$key} or $rec{$key} eq '' ) { # blank or undefined, zero allowed if ( $key eq 'treaty' ) { my $error = "$lex{Student}:$key (IRS Number):$studnum:$rec{firstname} $rec{lastname}"; push @warnings, $error; next; } # Area:Field:Userid:Name my $error = "$lex{Student}:$key:$studnum:$rec{firstname} $rec{lastname}"; push @errors, $error; } } return $ref; } #---------------- sub getSchoolData { # load scalar data #---------------- my ( $dbh ) = @_; my $filename = 'admin'; my $sectionname = 'schooladdress'; # Load Existing Configuration Data. my $sth = $dbh->prepare("select dataname, datavalue from conf_system where filename = ? and sectionname = ?"); $sth->execute( $filename, $sectionname ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my %val; while ( my ($dn,$dv) = $sth->fetchrow ) { # Note: This will work ONLY with scalar values! my ($name, $val) = split(/=/, $dv); $val =~ s/^\s*'|;//g; $val =~ s/'\s*$//g; if ( $val ) { $val{$dn} = $val; } } # Get the values from configuration system my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); foreach my $val ( qw( f_DirectorFirstname f_DirectorLastname )) { $sth->execute( $val ); my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } } $val{'director_lastname'} = $f_DirectorLastname; # now from configuration system $val{'director_firstname'} = $f_DirectorFirstname; print qq{
Education Director
First Name: $val{'director_firstname'}
\n}; print qq{Last Name: $val{'director_lastname'}
\n}; # Get the Principals Name my $sth = $dbh->prepare("select lastname, firstname from staff s, staff_multi sm where s.userid = sm.userid and sm.field_name = 'position' and sm.field_value = 'Principal'"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname ) = $sth->fetchrow; $val{'principal_lastname'} = $lastname; $val{'principal_firstname'} = $firstname; # Load Inac File, later oanomroll.conf # eval require "inac.conf"; # if ( $@ ) { # print $lex{Error}. ": $@
\n"; # die $lex{Error}. ": $@\n"; # } $val{'delivery_methods'} = $delivery_methods; $val{'programs_offered'} = $programs_offered; # Province Check # %provs set at top. if ( not $provs{ "$val{'schoolprov'}" } ) { my $error = "$lex{School}:schoolprov $val{schoolprov}: : "; push @errors, $error; } # Missing Check. foreach my $key ( sort keys %val ) { if ( not defined $val{$key} or $val{$key} eq '' ) { # blank or undefined, zero allowed if ( $nrskip{$key} ) { next; } # skip any values in this hash my $error = "$lex{School}:$key: : "; push @errors, $error; } } # foreach my $key ( sort keys %val ) { # print qq{K:$key V:$val{$key}
\n}; # } return \%val } #------------ sub getGrades { # populate a grade array #------------ my ( $dbh ) = @_; my $sth = $dbh->prepare("select distinct grade from student where grade is not NULL and grade != ''"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my %grades = (); while ( my $grade = $sth->fetchrow ) { if ( $grade eq 'P3' ) { next; } if ( $grade eq 'PK' or $grade eq 'K4' ) { $grade = 'JK'; } if ( $grade eq 'K5' or $grade =~ /EC/ ) { $grade = 'K'; } $grades{$grade} = 1; } my @grades = keys %grades; return \@grades; } #----------- sub mkSchool { # write School element #----------- my ( $wr, $schoolref ) = @_; my %sch = %$schoolref; $wr->forceNSDecl( $schemans ); $wr->addPrefix( $schemans, 'i'); $wr->startTag('ESSchoolInformation'); $wr->startTag('AdminData'); $wr->dataElement('Email', $sch{'schoolemail'} ); $wr->startTag('PhoneNumber'); my $schoolphone = formatPhone( $sch{'schoolphone'}, $lex{School} ); if ( not $schoolphone ) { my $error = "$lex{School}:Phone Number format error:$sch{'schoolphone'}: "; push @errors, $error; } $wr->dataElement('Number', $schoolphone ); # Not nillable, just leave out. # $wr->emptyTag('Extension', [$schemans, 'nil'], 'true'); $wr->endTag('PhoneNumber'); $wr->startTag('FaxNumber'); my $schoolfax = formatPhone( $sch{'schoolfax'}, $lex{School} ); $wr->dataElement('Number', $schoolfax ); $wr->endTag('FaxNumber'); $wr->startTag('Addresses'); $wr->startTag('Mailing'); $wr->dataElement('Street', $sch{'schooladdr1'} ); $wr->dataElement('City', $sch{'schoolcity'} ); $wr->dataElement('ProvinceState', $sch{'schoolprov'}); $wr->dataElement('Country', 'CA'); $wr->dataElement('PostalCode', $sch{'schoolpcode'} ); $wr->endTag('Mailing'); $wr->dataElement('StreetSameAsMailing', 'true'); $wr->endTag('Addresses'); # Education Director $wr->startTag('EducationDirector'); $wr->dataElement('FamilyName', $sch{'director_lastname'} ); $wr->dataElement('GivenName', $sch{'director_firstname'} ); $wr->endTag('EducationDirector'); # Principal Info $wr->startTag('Principal'); $wr->dataElement('FamilyName', $sch{'principal_lastname'} ); $wr->dataElement('GivenName', $sch{'principal_firstname'} ); $wr->endTag('Principal'); # Provincial Certification $wr->dataElement('ProvincialCertification', 'true'); # Program Delivery Methods my @methods = split(/,/, $sch{'delivery_methods'} ); $wr->startTag('ProgramDeliveryMethods'); foreach my $dmethod ( @methods ) { $wr->startTag('DeliveryMethod'); $wr->dataElement('Active', 'true'); $wr->dataElement('Method', $dmethod); $wr->endTag('DeliveryMethod'); } $wr->endTag('ProgramDeliveryMethods'); # Programs Offered my @programs = split(',', $sch{'programs_offered'} ); $wr->startTag('ProgramsOffered'); foreach my $program ( @programs ) { $wr->startTag('SchoolProgram'); $wr->dataElement('Active', 'true'); $wr->dataElement('Program', $program ); $wr->endTag('SchoolProgram'); } $wr->endTag('ProgramsOffered'); # Grades Offered my $graderef = getGrades( $dbh ); my @grades = @$graderef; $wr->startTag('GradesOffered'); foreach my $grade ( sort {$a <=> $b} @grades ) { $wr->startTag('JurisdictionGrade'); # my $inacgrade = $grade; # if ( $inacgrade =~ m/\d/ and length($inacgrade) == 1 ) { # $inacgrade = '0'. $inacgrade; # prepend a zero # } $wr->dataElement('Jurisdiction', $sch{'schoolprov'} ); $wr->dataElement('Grade', $grade ); $wr->dataElement('AttendanceFactor', $school_attendance_factor{"$grade"} ); # above set in inac.conf $wr->dataElement('Active', 'true' ); $wr->endTag('JurisdictionGrade'); } $wr->endTag('GradesOffered'); # Get Staff Userid, and create staff. my $sth = $dbh->prepare("select userid, nrskip from staff order by lastname, firstname"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($userid,$nrskip) = $sth->fetchrow ) { if ($nrskip) { next; } mkStaff( $wr, $userid ); } $wr->dataElement('CulturalEducationCentreServiced', 'true'); # Reload this since not passed in function; needed below my $ref = getNominalRollData( $dbh ); my %nd = %$ref; # New elements 2019-2020 - Count of cultural and language/land ed. if ( not $nd{'count_culture'} ) { my $error = qq{Configuration:count_culture:Missing count_culture value. Please update configuration: }; push @errors, $error; } else { $wr->dataElement('CulturalCurriculumStudentCount', $nd{'count_culture'}); } if ( not $nd{'count_language'} ) { my $error = qq{Configuration: count_language: Missing count_language value. Please update configuration: }; push @errors, $error; } else { $wr->dataElement('FNLanguageStudentCount', $nd{'count_language'}); } # Removed July/2019 for upgrade from 8.3 to 8.5 =head # Get days open eval require "../../lib/libattend.pl"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } # print qq{Start:$schoolstart End:$schoolend\n}; my %sd = mkSchoolDays( $schoolstart, $schoolend, $dbh ); my $totaldays; foreach my $key ( keys %sd ) { $totaldays += $sd{$key}; } $totaldays = round($totaldays, 0); $wr->dataElement('InstructionDays', $totaldays ); # Get PD Days (ie. Inservice ) my $sth = $dbh->prepare("select * from dates where type = 'Inservice'"); $sth->execute; my $pdtotal; while ( my $ref = $sth->fetchrow_hashref ) { $pdtotal += $ref->{dayfraction}; } $pdtotal = round($pdtotal, 0); $wr->dataElement('ProfessionalDevelopmentDays', $pdtotal ); =cut $wr->endTag('AdminData'); if ( $nd{tuitionagreement} ) { $wr->dataElement('TuitionAgreement2', $nd{tuitionagreement} ); } $wr->endTag('ESSchoolInformation'); return; } #---------- sub mkStaff { #---------- my ($wr, $userid) = @_; my %staffskip = qw( alt_city 1 alt_country 1 alt_email 1 alt_pcode 1 alt_phone 1 alt_prov 1 alt_street 1 certification2 1 certification3 1 certification4 1 certification5 1 certification6 1 certification7 1 certification8 1 doatt 1 driver_class 1 driver_license 1 emergency_contact_name 1 emergency_contact_phone 1 ldap_gidnumber 1 ldap_uid 1 ldap_uidnumber 1 middlename 1 passport 1 salaryallowanceamount 1 salaryallowancetype 1 tdate 1 vehicle_plate 1 vehicle_reg 1 citizenship 1 emailwork 1 website 1 home_phone 1 street 1 city 1 prov 1 pcode 1 salaryallowancetype 1 salaryallowanceamount 1 birthdate 1 specialtycertificatetype 1 specialtycertificateobtained 1 areaofstudy 1 certification1 1 cell_phone 1 indianstatus 1 teachingcertificatestatus 1 teachingcertificatejurisdiction 1 nrskip 1 provincialclassification 1 sal 1 emailpersonal 1 extrafield1 1 extrafield2 1 extrafield3 1 ); # Get Staff Member Info $sth = $dbh->prepare("select * from staff where userid = ?"); $sth->execute( $userid ); if ( $DBI::errstr ) { print qq{$DBI::errstr}; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; my %s = %$ref; foreach my $key ( sort keys %s ) { if ( not $s{$key} or $s{$key} eq '' ) { # blank or undefined, zero allowed if ( $staffskip{$key} ) { next; } my $error = "$lex{Staff}:$key:$s{userid}:$s{firstname} $s{lastname}"; push @errors, $error; } } # Check Teaching Certificate if ( $s{'certification1'} ) { # if we have a certificate, check if ( not $s{'teachingcertificatejurisdiction'} ) { my $error = "$lex{Staff}:teachingcertificatejurisdiction:$lex{Missing} teachingcertificatejurisdiction :$s{firstname} $s{lastname}"; push @errors, $error; } if ( not $s{'teachingcertificatestatus'} ) { my $error = "$lex{Staff}:teachingcertificatestatus:$lex{Missing} teachingcertificatestatus :$s{firstname} $s{lastname}"; push @errors, $error; } } if ( not $s{'certification1'} ) { # if no certificate, check code value if ( $s{'teachingcertificatestatus'} != 9999 and $s{'teachingcertificatestatus'} != 1228 ) { # 9999 'Not Certified' / 1228 'In Progress' my $error = "$lex{Staff}:teachingcertificatestatus:Certificate Status should be 'Not Certified'(9999)". " or 'In Progress'(1228):$s{firstname} $s{lastname}"; push @errors, $error; } } # Check Province value if ( not $provs{"$s{prov}"} ) { # if no certificate, check code value my $error = "$lex{Staff}:Province must be 2 digit: :$s{firstname} $s{lastname}"; push @errors, $error; } # Global hash for printing staff. $staff{"$s{lastname}:$s{firstname}:$s{userid}"} = $s{userid}; $wr->startTag('Staff'); # Teaching Certificate $wr->startTag('TeachingCertificate'); if ( $s{certification1} ) { $wr->dataElement('ID', $s{'certification1'}); $wr->dataElement('CertificateStatus', $s{'teachingcertificatestatus'}); $wr->dataElement('Jurisdiction', $s{'teachingcertificatejurisdiction'} ); # Province } else { # no certificate number, only display status $wr->dataElement('CertificateStatus', $s{'teachingcertificatestatus'}); } $wr->endTag('TeachingCertificate'); $wr->startTag('StaffMember'); #if ( $s{email} ) { # $wr->dataElement('Email', $s{email} ); #} #$wr->dataElement('Id', $s{userid}); # Phone Number #my $phone = formatPhone( $s{'home_phone'}, $userid ); #if ( $phone ) { # $wr->startTag('PhoneNumber'); # $wr->dataElement('Number', $phone ); # $wr->endTag('PhoneNumber'); #} # Address #if ( $s{street} and $s{city} and $s{prov} and $s{pcode} ) { # $wr->startTag('Addresses'); # $wr->startTag('Mailing'); # # $wr->dataElement('Line1'); # $wr->dataElement('Street', $s{street}); # $wr->dataElement('City', $s{city}); # $wr->dataElement('ProvinceState', $s{prov}); # $wr->dataElement('Country', 'CA'); # $wr->dataElement('PostalCode', $s{pcode}); # $wr->endTag('Mailing'); # $wr->endTag('Addresses'); # } $wr->dataElement('FamilyName', $s{lastname}); $wr->dataElement('GivenName', $s{firstname}); # $wr->dataElement('Title', $s{sal}); # $wr->dataElement('Alias'); # $wr->dataElement('DateOfBirth', $s{birthdate}); # $wr->dataElement('Initial'); $wr->dataElement('Ancestry', $s{ancestry}); if ( $s{indianstatus} ) { $wr->dataElement('IndianStatus', $s{indianstatus}); } $wr->dataElement('Gender', $s{gender}); $wr->endTag('StaffMember'); $wr->dataElement('FullTimeEquivalent', $s{fulltimeequivalent}); # Parse Occupation Structure into %occ if ( $s{'occupations'} ) { eval $s{'occupations'}; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } } my $showGradesFlag; # if we have a special .01 occupation type foreach my $key ( sort keys %occ ) { if ( $occ{$key}{type} =~ m/\.01$/ ) { $showGradesFlag = $occ{$key}{type}; # set flag with occ code. } if ( $occ{$key}{'percent'} and $occ{$key}{'type'} ) { # do this occupation value $wr->startTag('Occupations'); $occ{$key}{'percent'} =~ s/\%//; # filter percent. $wr->dataElement('Percentage', $occ{$key}{'percent'} ); $wr->dataElement('OccupationType', $occ{$key}{'type'}); $wr->endTag('Occupations'); } else { # if we have an occupation type and percent my $error = "$lex{Occupation}:Percent-$occ{$key}{'percent'}, Type-$occ{$key}{'type'}". ":$s{userid}:$s{firstname} $s{lastname}"; push @errors, $error; } } # end Occupation Loop if ( $showGradesFlag ) { # get the grades; my $sth = $dbh->prepare("select field_value from staff_multi where userid = ? and field_name = 'grade'"); $sth->execute( $userid ); if ( $DBI::errstr ) { print qq{$DBI::errstr}; die $DBI::errstr; } my $first = 1; while ( my $grade = $sth->fetchrow ) { $first = 0; if ( $grade eq 'PK' or $grade eq 'P3' ) { $grade = 'JK'; } if ( $grade eq 'K5' ) { $grade = 'K'; } $wr->startTag('JurisdictionGrade'); $wr->dataElement('Jurisdiction', 'SK'); $wr->dataElement('Grade', $grade ); $wr->dataElement('AttendanceFactor', $school_attendance_factor{$grade} ); $wr->endTag('JurisdictionGrade'); } if ( $first ) { # we have an error with grades missing for this occumpation type. my $error = "$lex{Occupation}: Type $showGradesFlag Requires Grades Taught". ":$s{userid}:$s{firstname} $s{lastname}"; push @errors, $error; } } # end of showGradesFlag (with occ code). $wr->endTag('Staff'); } #------------ sub mkStudent { #------------ my ( $wr, $studref ) = @_; my %sr = %$studref; # student record values my $studnum = $sr{studnum}; my %studskip = qw( nrskip 1 hcse 1 transportation_other 1 transportation_daily 1 accommodation 1 residence_reserve 1 programcompletedprevyear 1 ); # Load Nominal Roll Data $sth = $dbh->prepare("select * from student_inac where studnum = ?"); $sth->execute( $studnum ); if ( $DBI::errstr ) { print qq{$DBI::errstr}; die $DBI::errstr; } my $nref = $sth->fetchrow_hashref; my %nr = %$nref; # Test: foreach my $key ( sort keys %nr ) { print qq{K:$key V:$nr{$key}
\n}; } # Check for missing values. if ( $nr{serviceprovision} eq '41' or $nr{serviceprovision} eq '42' ) { # 41-schoolprogram,42-upgrade # only check for missing values in current students. foreach my $key ( sort keys %nr ) { if ( not defined $nr{$key} or $nr{$key} eq '' ) { # blank or undefined, zero allowed my $error = "$lex{Student}:$key:$studnum:$sr{firstname} $sr{lastname}"; if ( $studskip{$key} ) { next; } # skip values that may be blank push @errors, $error; } } } # push name into hash to display students if ( $nr{'serviceprovision'} eq '41' or $nr{'serviceprovision'} eq '42' ) { $currstuds{"$sr{lastname}:$sr{firstname}:$studnum"} = $nr{serviceprovision}; } else { $prevstuds{"$sr{lastname}:$sr{firstname}:$studnum"} = $nr{serviceprovision}; } # Four Sections in Client: Identification, ServiceProvision, Objectives, and Enrollment $wr->startTag('Client'); # Identification Element $wr->startTag('Identification'); $wr->startTag('Student'); if ( $sr{treaty} ) { # only output if has a value. $wr->dataElement('IRSNumber', $sr{treaty}); # Indian Registry System (treaty) number. } $wr->dataElement('FamilyName', $sr{lastname}); $wr->dataElement('GivenName', $sr{firstname} ); # $wr->dataElement('Alias', $sr{alias}); $wr->dataElement('DateOfBirth', $sr{birthdate} ); # Ancestry Mapping my $ancestry; if ( $sr{ethnic} eq 'Status Native' or $sr{ethnic} eq 'Non-status Native' or $sr{treaty} ) { $ancestry = '0998.01'; } elsif ( $sr{ethnic} eq 'Metis' ) { $ancestry = '0998.03'; } else { $ancestry = '9999'; } $wr->dataElement('Ancestry',$ancestry ); $wr->dataElement('Gender', $sr{sex}); $wr->endTag('Student'); $wr->endTag('Identification'); # Service Provision - NEW # Temporary if ( not $nr{'serviceprovision'} ) { $nr{'serviceprovision'} = '41'; # Fully Completed, Elem/Sec Program. } $wr->startTag('ServiceProvision'); if ( $nr{'serviceprovision'} eq '41' or $nr{'serviceprovision'} eq '42' ) { # program $wr->dataElement('CompletedAsPlanned', '02'); } else { # no program $wr->dataElement('CompletedAsPlanned', '03'); } $wr->dataElement('ReasonNotFullyProvided', $nr{'serviceprovision'}); $wr->endTag('ServiceProvision'); # Objectives: Transport and Accommodation if ( $nr{'serviceprovision'} eq '02' ) { # no accom/transport if not current my $first = 1; # Accommodation if ( $nr{'accommodation'} and $nr{'accommodation'} != 1680 ) { # we have an accommodation value if ( $first ) { $wr->startTag('Objectives'); $first = 0; } $wr->startTag('Objective'); $wr->dataElement('ObjectiveId', 'ACCOMM'); $wr->startTag('SubmissionActivities'); $wr->startTag('SubmissionActivity'); $wr->dataElement('ActivityId', $nr{'accommodation'}); $wr->emptyTag('ExpenseSet'); $wr->endTag('SubmissionActivity'); $wr->endTag('SubmissionActivities'); $wr->emptyTag('ExpenseSet'); $wr->endTag('Objective'); } # Transportation # strip values if is 09. if ( $nr{'transportation_daily'} eq '09' ) { $nr{'transportation_daily'} = undef; } if ( $nr{'transportation_other'} eq '09' ) { $nr{'transportation_other'} = undef; } if ( $nr{'transportation_daily'} or $nr{'transportation_other'} ) { if ( $first ) { $wr->startTag('Objectives'); $first = 0; } $wr->startTag('Objective'); $wr->dataElement('ObjectiveId','TRANS'); $wr->startTag('SubmissionActivities'); } # Transport - Daily (306 is daily code, 01 is bus, 02 is public, 03 other means, 309 is no transport) if ( $nr{'transportation_daily'} ) { my $code = '306'; $wr->startTag('SubmissionActivity'); $wr->dataElement('ActivityId', $code); $wr->startTag('SubActivities'); $wr->startTag('SubActivity'); $wr->dataElement('Code', $nr{'transportation_daily'}); $wr->endTag('SubActivity'); $wr->endTag('SubActivities'); $wr->emptyTag('ExpenseSet'); $wr->endTag('SubmissionActivity'); } # Transport - Other if ( $nr{'transportation_other'} ) { $wr->startTag('SubmissionActivity'); # Activity Codes; 306 Daily, 307 Noon, 308 Seasonal/Weekend # SubActivity Codes: 01 School Bus, 02 Public Transit, 03 Other, # 04 Special (HCSE), 05 Lunch, 06 Weekend, 07 Seasonal, 08 Special (HCSE) my $actid; # 307/05 (Noon Lunch) 5,11 Seasonal:308-06,7,8,10 if ( $nr{'transportation_other'} eq '05' or $nr{'transportation_other'} eq '11' ) { $actid = '307'; } else { $actid = '308'; } $wr->dataElement('ActivityId', $actid ); $wr->startTag('SubActivities'); $wr->startTag('SubActivity'); $wr->dataElement('Code', $nr{'transportation_other'} ); $wr->endTag('SubActivity'); $wr->endTag('SubActivities'); $wr->emptyTag('ExpenseSet'); $wr->endTag('SubmissionActivity'); } if ( $nr{'transportation_daily'} or $nr{'transportation_other'} ) { $wr->endTag('SubmissionActivities'); $wr->emptyTag('ExpenseSet'); $wr->endTag('Objective'); } if ( not $first ) { $wr->endTag('Objectives'); } } # end of if serviceprovision eq '02' # Enrolment Element $wr->startTag('Enrolment'); $wr->startTag('NominalRoll'); $wr->startTag('StudentEnrolment'); # High Cost - blank or false is same # if ( not $nr{highcost} ) { $nr{highcost} = 'false'; } # $wr->dataElement('HCSE', $nr{highcost} ); # High Cost, true or false $wr->dataElement('BandOfResidence', $nr{'residence_band'}); $wr->dataElement('LanguageOfInstruction', $nr{'language_instruction'} ); # $wr->dataElement('ExtentOfFirstNationLanguageInstruction',$nr{'language_extent'} ); # $wr->dataElement('HomeLanguage', $nr{'language_home'} ); $wr->dataElement('Residence', $nr{'residence'} ); $wr->dataElement('ReserveOfResidence', $nr{'residence_reserve'} ); $wr->dataElement('ElementarySecondaryProgram', $nr{'schoolprogram'} ); $wr->dataElement('FullTimeEquivalent', $nr{'fte'} ); # Grade # Rewrite grade to match AANDC values. my $grade = $sr{grade}; if ( $sr{grade} eq 'PK' or $sr{grade} eq 'K4' ) { $grade = 'JK'; } if ( $sr{grade} eq 'K5' ) { $grade = 'K'; } $wr->startTag('JurisdictionGrade'); $wr->dataElement('Jurisdiction', 'SK' ); $sr{grade} =~ s/^0//; # strip leading zero $wr->dataElement('Grade', $grade ); $wr->dataElement('AttendanceFactor', $school_attendance_factor{$grade} ); $wr->endTag('JurisdictionGrade'); $wr->dataElement('ProgramDeliveryMethod', $nr{'programdelivery'}); my $progcompleted = 'false'; # programcompletedprevyear. if ( $nr{programcompletedprevyear} ) { $progcompleted = 'true'; } $wr->dataElement('ProgramCompletedPreviousYear', $progcompleted); $wr->endTag('StudentEnrolment'); $wr->endTag('NominalRoll'); $wr->endTag('Enrolment'); $wr->endTag('Client'); return; } #-------------- sub formatPhone { # format phone numbers to correct format #-------------- my ($phone, $user) = @_; $phone =~ s/\D|\-|\s+//g; my $originalphone = $phone; $phone =~ s/\D//g; # strip non-digit characters. if ( length($phone) == 10 ) { # we have area code my ($acode, $first, $second) = unpack('A3A3A4', $phone); $phone = "($acode) ". $first. '-'. $second; } elsif ( length($phone) == 7 ) { # no area code print qq{$lex{Missing} $lex{'Area Code'} $originalphone :$user
\n}; my ($first, $second) = unpack('A3A4', $phone); $phone = $first. '-'. $second; return undef; } else { # some other length, just give up. $phone = $originalphone; print qq{$lex{Error}: $lex{'Phone Number'} $originalphone :$user
\n}; return undef; } return $phone; }