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;