• Files
• Commits
• Log
• Graph
• Stats

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;