• Files
• Commits
• Log
• Graph
• Stats

package PreScreen;

use Moose;
    with qw(
        Role::RebuildTables
    );
use namespace::clean -except => 'meta';

has db  => (is => 'ro', isa => 'HashRef', required => 1);
has sql => (is => 'ro', isa => 'HashRef', required => 1);

__PACKAGE__->meta->make_immutable;

use Data::Dumper;

my @tables = qw(
    pre_registration
    pre_registration_lab_test
    pre_registration_specimen    
);

$|++;

sub convert {
    my $self = shift; # warn Dumper $self;

    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};

    # my $log_file = $self->log_file;

    $self->rebuild_tables(\@tables);

    my $sql = q!select 1 from requests r join request_initial_screen ris on
        ris.request_id = r.id where r.request_number = ? and r.year = ?!;
    
    my @tests = qw(b_lymphoid t_lymphoid plasma_cell stem_cell outreach rituximab);
    
    # get lab_test_map:
    my $lab_test_map = $dbix4->query( q!select t.field_label,t.id from lab_tests t
        join lab_sections s on t.lab_section_id = s.id where s.section_name =
        'Flow cytometry' and t.test_name in (??)!, @tests)->map; # warn Dumper $lab_test_map; exit;
    
    my %lab_test_abbr = (
        pcs => 'Plasma cell',
        bls => 'B lymph',
        scs => 'Stem cell',
        tls => 'T lymph',
        rit => 'Rituximab',
        out => 'Outreach',
    );
    
    # get all PreScreen recs:    
    my $records = $dbix3->query( 'select * from PreScreen where surname is not null');
    
    my %labnos;
    
    RECORD:
    while ( my $vals = $records->hash ) { # warn Dumper $vals; next;
        my $labno = $vals->{labno} || next RECORD; # warn $labno; next;
        my $specimen = $vals->{specimen} || next RECORD;
        
        # get pre_registration id if exists, or create new:
        my $id = $labnos{$labno};
        
        if (! $id ) {
            my ($yr, $req_no) = split '_', $labno; # warn 2000 + $yr; warn int $req_no; next;
            
            my $is_screened = $dbix4->query($sql, int $req_no, 2000 + $yr)->list; # warn $is_screened; next;
            
            my %data = (
                labno       => $labno,
                surname     => $vals->{surname},
                is_screened => $is_screened  ? 'yes' : 'no',
                time        => $vals->{datetime},
            );
            $dbix4->insert('pre_registration', \%data);
            
            $id = $dbix4->last_insert_id( undef, undef, qw/pre_registration id/ )
            || die 'no last_insert_id';
            
            $labnos{$labno} = $id;
        }
        
        my $reg_specimen_id;
        
        { # pre_registration_specimen data:
            my %data = (
                pre_reg_id  => $id,
                specimen_code => $specimen,
            );
            $dbix4->insert('pre_registration_specimen', \%data);
            
            $reg_specimen_id = $dbix4->last_insert_id(
                undef, undef, qw/pre_registration_specimen id/ )
                || die 'no last_insert_id';
        }
        
        { # pre_registration_lab_test:
            while( my($abbr, $test_name) = each %lab_test_abbr ) {
                next unless $vals->{$abbr}; # either 'x' or null
                # add to pre_registration_lab_test table:
                my $lab_test_id = $lab_test_map->{$test_name};
                    # warn Dumper [$abbr, $vals->{$abbr}, $lab_test_id];
                
                my %data = (
                    reg_specimen_id => $reg_specimen_id,
                    lab_test_id     => $lab_test_id,
                );
                $dbix4->insert('pre_registration_lab_test', \%data);
            }
        }        
    }
    $self->convert_to_InnoDB($_) for @tables;
}

1;