package TestResult; # combined with LabTest now use Moose; with 'Role::RebuildTables'; use namespace::clean -except => 'meta'; use Data::Dumper; has $_ => (is => 'ro', isa => 'HashRef', required => 1) foreach qw( db sql ); has log_file => ( is => 'ro', required => 1 ); __PACKAGE__->meta->make_immutable; $|++; my @tables = 'request_lab_test_results'; sub convert { my $self = shift; my $dbix3 = $self->db->{dbix3}; my $dbix4 = $self->db->{dbix4}; my $dbh4 = $self->db->{dbh4}; # retain case-sensitivity of cols (CHANGES $DB::dbix3 SO MUST REVERSE THIS AFTER): $dbix3->lc_columns = 0; my $log_file = $self->log_file; #=begin $self->rebuild_tables(\@tables); $dbh4->do( q!DROP TABLE IF EXISTS `temp`! ); $dbh4->do( q!CREATE TABLE `temp` LIKE `request_lab_test_results`! ); $self->do_histology_results; $self->do_fish_results; # transfer data from temp to request_lab_test_results in request_id order: my $data = $dbix4->query( q!select request_id, lab_test_id, result from `temp` order by `request_id`,`id`! ); # don't want id while ( my $vals = $data->hash ) { # warn $vals->{request_id}; $dbix4->insert('request_lab_test_results', $vals); } $dbh4->do( q!DROP TABLE `temp`! ); $dbix3->lc_columns = 1; # reset to default } sub do_histology_results { my $self = shift; my $dbix3 = $self->db->{dbix3}; my $dbix4 = $self->db->{dbix4}; my $histology_data = $dbix3->query('select * from Histology'); my $sql = q!select lt.field_label, lt.id from lab_tests lt join lab_sections ls on lt.lab_section_id = ls.id where section_name = 'Histology' and test_type = 'test'!; my $lab_test_map = $dbix4->query($sql)->map; # hash so duplicate entries removed: my %local_data; while ( my $row = $histology_data->hash ) { # print Dumper $row; next; my $hmds = $row->{HMDS}; my ($request_number,$yr) = $hmds =~ m!H(\d+)/(\d{2})!; # print Dumper ($request_number,$yr); next; # create lab_no -> request.id map if not already exists: my $request_id = $dbix4->query( q!SELECT id FROM requests WHERE request_number = ? AND year = ?!, $request_number, $yr + 2000 )->list; if (! $request_id) { print "no request_id for $hmds\n"; next; } FIELD: foreach my $field ( keys %$row ) { # warn $field; next FIELD unless $field =~ '_'; # all tests have underscore next FIELD unless defined $row->{$field} && $row->{$field} ne ''; my ($panel,$test_name) = split '_', $field; # warn $test_name; $test_name =~ s/bcl/BCL/; # to match lab_tests; $test_name =~ s/Pax(-?)5/PAX-5/; $test_name =~ s/PU-1/PU1/; my $result = $row->{$field}; # warn $result; my $lab_test_id = $lab_test_map->{$test_name} || print "no lab_test_id for $test_name\n"; $local_data{$request_id}{$lab_test_id} = $result; } } foreach my $request_id ( keys %local_data ) { # warn $request_id; # warn Dumper $local_data{$request_id}; next; while ( my ($test_id, $result) = each %{ $local_data{$request_id} } ) { # warn $test_id; warn $result; next; my %data = ( request_id => $request_id, lab_test_id => $test_id, result => $result, ); # warn Dumper \%data; $dbix4->insert( 'temp', \%data ); } } } sub do_fish_results { my $self = shift; my $dbix3 = $self->db->{dbix3}; my $dbix4 = $self->db->{dbix4}; my $fish_data = $dbix3->query('select * from FISH'); my $sql = q!select lt.field_label, lt.id from lab_tests lt join lab_sections ls on lt.lab_section_id = ls.id where section_name = 'FISH' and test_type = 'test'!; my $lab_test_map = $dbix4->query($sql)->map; # warn Dumper $lab_test_map; exit; # hash so duplicate entries removed: my %local_data; while ( my $row = $fish_data->hash ) { # print Dumper $row; next; my $hmds = $row->{HMDS}; my ($request_number,$yr) = $hmds =~ m!H(\d+)/(\d{2})!; # print Dumper ($request_number,$yr); next; # create lab_no -> request.id map if not already exists: my $request_id = $dbix4->query( q!SELECT id FROM requests WHERE request_number = ? AND year = ?!, $request_number, $yr + 2000 )->list; if (! $request_id) { print "no request_id for $hmds\n"; next; } FIELD: foreach my $field ( keys %$row ) { # warn $field; next FIELD if grep $field eq $_, qw(F_ID HMDS Diagnosis Time); next FIELD unless defined $row->{$field} && $row->{$field} ne ''; my $result = $row->{$field}; # warn $result; my $lab_test_id = $lab_test_map->{$field} || print "no lab_test_id for $field\n"; $local_data{$request_id}{$lab_test_id} = $result; } } foreach my $request_id ( keys %local_data ) { # warn $request_id; # warn Dumper $local_data{$request_id}; next; while ( my ($test_id, $result) = each %{ $local_data{$request_id} } ) { # warn $test_id; warn $result; next; my %data = ( request_id => $request_id, lab_test_id => $test_id, result => $result, ); # warn Dumper \%data; $dbix4->insert( 'temp', \%data ); } } } 1;