• Files
• Commits
• Log
• Graph
• Stats

package LabTest;

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

use Data::Dumper;
use DateTime::Format::MySQL;

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

has log_file => ( is => 'ro', required => 1 );

has $_ => (is => 'ro', isa => 'HashRef', lazy_build => 1)
	foreach qw(
		status_map
		user_id_map
		hilis4_users
		field_label_map
		lab_section_map
		status_option_map
		hilis3_lab_test_map
		hilis4_lab_test_map
		lab_test_lab_section_map
	);

has request => ( is => 'ro', isa => 'HashRef', default => sub { {} } );

__PACKAGE__->meta->make_immutable;

my @tables = qw(
	request_lab_test_status
	request_lab_test_results
    request_result_summaries
	request_lab_section_notes
);

$|++;

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);
    $self->rebuild_tables_asMyISAM($_) for @tables;
    
    $dbh4->do( q!DROP TABLE IF EXISTS `temp`! );
    $dbh4->do( q!CREATE TABLE `temp` LIKE `request_lab_test_results`! );

    my $sql =
        q!select m.DBID, m.HMDS, date_format(m.Date, '%Y') as 'Year',
            cp.*, fp.*, fs.*, hp.*, mg.*, mg.TimeStamp as 'MolTime',
            fp.TimeStamp as 'FlowTime', hp.TimeStamp as 'HistTime',
            fs.TimeStamp as 'ScreenTime', cp.TimeStamp as 'CytoTime'
        from Main m left join CytoPanel cp on Cyto_ID = DBID
            left join FlowPanel fp on Flow_ID = DBID
            left join FlowScreen fs on FS_ID = DBID
            left join HistoPanel hp on Hist_ID = DBID
            left join MolGen mg on Mol_ID = DBID!;

    my $lab_tests = $dbix3->query($sql);
	# data maps:
	my $status_map = $self->status_map;
	my $user_id_map = $self->user_id_map; 
    my $lab_section_map = $self->lab_section_map; 
	my $field_label_map = $self->field_label_map;
	my $status_option_map = $self->status_option_map;
    my $hilis3_lab_test_map = $self->hilis3_lab_test_map;
    my $hilis4_lab_test_map = $self->hilis4_lab_test_map;
	my $lab_test_lab_section_map = $self->lab_test_lab_section_map;
	
	my %unknown_users;
	
	# unknown / unwanted entries in cols:
	my @crap = ( '.','-','_', '=' );
	
    TEST:
    while ( my $vals = $lab_tests->hash ) {
        my $dbid = $vals->{DBID};
            # $dbid % 1000 || print $dbid, "\n";

        # create lab_no -> request.id map if not already exists:
        my $request_id = $self->request->{$dbid} ||=
            $dbix4->query( q!SELECT id FROM requests WHERE request_number = ? AND
                year = ?!, $vals->{HMDS}, $vals->{Year} )->list;

		FIELD:
        foreach my $field ( keys %$vals ) { # warn $field;
            next FIELD unless defined $vals->{$field} && $vals->{$field} ne '';
			next FIELD if grep $field eq $_, qw(DBID HMDS Year TimeStamp);
            next FIELD if $field =~ /_id|req(rec|out)|cig|tpll/i; # cIgu & TPLL discontinued
			next FIELD if $field =~ /hother|checked/i; # discontinued Checked & HOther1,2,3
			next FIELD if $field =~ /time\Z/i; 
            next FIELD if grep $vals->{$field} eq $_, @crap; # deselected tests & other crap

			# section_details to request_lab_section_notes:
            if ( $field =~ /(Flow|Hist)Details/ ) {
                my $time = $vals->{$1 . 'Time'}; # warn $time;

                my %data = (
                    request_id      => $request_id,
                    lab_section_id  => $lab_section_map->{$1},
                    details         => $vals->{$field},
                    time            => $time,
                );
                $dbix4->insert('request_lab_section_notes', \%data);
            }

			# if it's a result - put it in request_result_summaries table:
			elsif ( $field =~  /(Flow|Hist|Mol|Fish|Gen)Result/ ) {
                my $time = $1 eq 'Flow' ? $vals->{'FlowTime'}
                    : $1 eq 'Hist' ? $vals->{'HistTime'}
                        : $vals->{'MolTime'}; # warn $time;

                my %data = (
                    request_id      => $request_id,
                    lab_section_id  => $lab_section_map->{$1},
                    results_summary => $vals->{$field},
                    time            => $time,
                );
                $dbix4->insert('request_result_summaries', \%data);
			}
			# active request:
			elsif ( length $vals->{$field} == 1 ) {
				my $val    = $vals->{$field};
				my $status = $status_map->{$val};
				
				my $status_option_id = $status_option_map->{$status};
				
				unless ($status_option_id) {
					my $msg = qq!unrecognised status for $field = $val !
					. qq!for $vals->{DBID}\n!;
					print $log_file, $msg;
					next FIELD;
				}
				
				my $lab_test_id = $hilis3_lab_test_map->{$field}
				|| die "no lab_test_id for $field"; # warn $lab_test_id;
				my $time = $self->_get_table_timestamp($field, $vals);
				
				# unknown user (or could use screened_by):
				my $user_id = $self->_get_user_id('unknown');
				
				my %data = (
					request_id       => $request_id,
					lab_test_id      => $lab_test_id,
					status_option_id => $status_option_id,
					user_id          => $user_id,
					time 	         => $time,
				);				
				$dbix4->insert('request_lab_test_status', \%data);
			}
			# signed-out:
			elsif ( length $vals->{$field} == 2 ) {
				my $inits = $self->_get_inits($vals->{$field});
				
				my $user_id = $user_id_map->{uc $inits};
				
				if ($field eq 'Genetics' && ! $user_id) {
					$user_id = $user_id_map->{HD};
				}
				
				if (grep $inits eq $_, qw/KR KH/) {
					$user_id = $self->_get_user_id('henshaw');
				}
				elsif ($inits eq 'GB') {
					$user_id = $self->_get_user_id('laycock-brown');
				}
				
				unless ($user_id) {
					$unknown_users{$field}{$inits}++;
					#my $msg = qq!unrecognised inits for $field = $inits !
					#. qq!for $vals->{DBID}\n!;
					#print $log_file, $msg;
					# next FIELD;
					$user_id = $self->_get_user_id('unknown');
				}
				
				my $lab_test_id = $hilis3_lab_test_map->{$field};
				my $time = $self->_get_table_timestamp($field, $vals);
				
                my %data = (
                    request_id  	 => $request_id,
                    lab_test_id 	 => $lab_test_id,
					status_option_id => 2,
                    user_id     	 => $user_id,
                    time        	 => $time,
                );
                $dbix4->insert('request_lab_test_status', \%data);				
			}			
			# H&E:
			elsif ( $field eq 'HandE' ) {
				my @fields = split ',', $vals->{$field};
				
				my $lab_test_id = $hilis3_lab_test_map->{$field}
				|| die "no lab_test_id for $field"; # warn $lab_test_id;
				my $time = $self->_get_table_timestamp($field, $vals);
				
				my ($user_id, $quality);
				my $quality_int = 0;
				
				FIELD:
				foreach(@fields) {
					next if $_ =~ m!/!; # date
					if ( $_ =~ /\A([A-Za-z]{2})\Z/i ) {
						my $inits = $self->_get_inits($1);
						$user_id = $user_id_map->{uc $inits};
							# print $inits, "\n" unless $user_id;
					}
					elsif ($_ =~ /\A([1-9])\Z/) {
						$quality_int = $1;
					}
				}	
				$user_id ||= $self->_get_user_id('unknown');					
					
				my %data = (
					request_id  	 => $request_id,
					lab_test_id 	 => $lab_test_id,
					status_option_id => 2,
					user_id     	 => $user_id,
					time        	 => $time,
				);
				$dbix4->insert('request_lab_test_status', \%data);					

				if ($quality_int > 1) { # 1 used for other reason
					if ($quality_int >= 7) {
						$quality = 'good';
					}
					elsif ($quality_int < 6) {
						$quality = 'poor';
					}
					else {
						$quality = 'adequate';
					}
					my %data = (
						request_id  => $request_id,
						lab_test_id => $lab_test_id,
						result 		=> $quality,
						time        => $time,						
					);
					$dbix4->insert('temp', \%data);						
				}				
			}
			# CutUp:
			elsif ( $field eq 'CutUp' ) {
				my @fields = split ',', $vals->{$field};
				
				my $lab_test_id = $hilis3_lab_test_map->{$field}
				|| die "no lab_test_id for $field"; # warn $lab_test_id;
				my $time = $self->_get_table_timestamp($field, $vals);
				
				# reset:
				my $user_id = my $paraffin = my $storage = my $pieces_and_blocks = '';

				FIELD:
				foreach(@fields) {
					next if $_ =~ m!\d+/\d+!; # date					
					
					# inits in their own field:
					if ( $_ =~ m!\A([A-Za-z]{2})(/[A-Za-z]{2,3}?)\Z!i ) {
						my $inits = $self->_get_inits($1);
						# just get user_id & loop next:
						$user_id = $user_id_map->{uc $inits};
							# print $inits, "\n" unless $user_id;
						next FIELD;
					}
					# 'frozen' in its own field:
					if (my ($frozen) = $_ =~ /\AF(\d)/i) {
						my $local_lab_test_id = $hilis4_lab_test_map->{'Frozen tissue'};
						my %data = (
							request_id  => $request_id,
							lab_test_id => $local_lab_test_id,
							result 		=> $frozen,
							time        => $time,						
						);
						$dbix4->insert('temp', \%data);	# warn 'here';					
						next FIELD;
					}
					# paraffin (shared with storage):
					if ( ($paraffin) = $_ =~ /P(\d)/i) {
						$pieces_and_blocks .= $paraffin;
					}
					# storage (shared with paraffin):
					if ( ($storage) = $_ =~ /(AE|RP)/i) {
						$pieces_and_blocks .= $storage;
					}
					# resin (maybe shared with storage) - just register status change:
#					if ( $_ =~ /R(\d)/i && $user_id ) { # only if have user_id
#						my %data = (
#							request_id => $request_id,
#							user_id    => $user_id,
#							action     => 'set Cut Up status to final cut-up',
#							time       => $time,							
#						);
						# no point doing this - table rebuilt in History conversion:
#						$dbix4->insert('request_lab_test_history', \%data);	# warn 'here'
#					}					
				}
				
				$user_id ||= $self->_get_user_id('unknown');					

				my %data = (
					request_id  	 => $request_id,
					lab_test_id 	 => $lab_test_id,
					status_option_id => 2,
					user_id     	 => $user_id,
					time        	 => $time,
				);
				$dbix4->insert('request_lab_test_status', \%data);					
				
				if ($pieces_and_blocks) {
					my $local_lab_test_id = $hilis4_lab_test_map->{'Pieces & blocks'};
					my %data = (
						request_id  => $request_id,
						lab_test_id => $local_lab_test_id,
						result 		=> $pieces_and_blocks,
						time        => $time,						
					);
					$dbix4->insert('temp', \%data);	# warn 'here'						
				}

				# default is 1 resin unless specified otherwise:
#				unless ($paraffin || $resin) { 
#					my $lab_test_id = $hilis4_lab_test_map->{'Resin blocks'};
#					my %data = (
#						request_id  => $request_id,
#						lab_test_id => $lab_test_id,
#						result 		=> 1, 
#						time        => $time,						
#					); 
#					$dbix4->insert('temp', \%data);	# warn 'here';						
#				}
			}			
			# else die, or will lose data:
			else {
				my $val = $vals->{$field};
                die "$field ($val) is orphaned";
            }
        }
    }
#=cut
	# get results & move temp table to request_lab_test_results:
	$self->do_lab_test_results();
	
	$self->do_histology_sample_type_tests();
	
    $self->convert_to_InnoDB($_) for @tables;
    
    $dbix3->lc_columns = 1; # reset to default
	
	# print 'Unknown users for tests:';
	# print Dumper \%unknown_users;
}

sub do_lab_test_results {
	my $self = shift;
	
    my $dbix4 = $self->db->{dbix4};
    my $dbix3 = $self->db->{dbix3};
    my $dbh4 = $self->db->{dbh4};

    $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`! );
}

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 = 'Immunohistochemistry'
        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/;
#            $test_name =~ s/EBV/EBV ISH/; # reverted name to EBV; EBV-ISH moved to FISH
            $test_name =~ s/Co57/CD57/; # combine - Co57 is misprint for CD57
            $test_name =~ s/BCL-2/E17/;
            
            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'!;
        
    # create lab test => test id map:
    my $lab_test_map = {}; # $dbix4->query($sql)->map;
    # need to convert new HUGO names to HILIS3 equivalents first:
    for ( $dbix4->query($sql)->arrays ) {
        my ($field_name, $lab_test_id) = @$_;
        
        $field_name =~ s/(alpha)\-/$1/;
        $field_name =~ s/(MYC)/c-$1/;
        $field_name =~ s/CCND1/BCL-1/;
        $field_name =~ s/(BCL|PAX)(\d)/$1\-$2/; # do AFTER above
        $field_name =~ s/IGH/IgH/;
        $field_name =~ s/IGK/IgKappa/;
        $field_name =~ s/IGL/IgLambda/;
        $field_name =~ s/TP53/p53/;                
        
        $lab_test_map->{$field_name} = $lab_test_id;
    } # warn Dumper $lab_test_map;

    # 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 );
        }
    }
}

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

	my $hilis3_lab_test_map = $self->hilis3_lab_test_map;

	{ # from H&E worklist:
		my $sql = q!SELECT `DBID`,`HMDS`, YEAR(`Date`) as 'Year' FROM `Main` LEFT
			JOIN `HistoPanel` on `Hist_ID` = `DBID` WHERE `HandE` IS NULL AND
			`Specimen` REGEXP '[DGLRX][BL|F|SL|U]|T[B.|S.]|BMAT'!;
			
		my $lab_test_id = $hilis3_lab_test_map->{HandE};

		my $query = $dbix3->query($sql);
		while ( my $vals = $query->hash ) { # print Dumper $row; next;
			my $dbid = $vals->{DBID}; # warn Dumper $vals;

			# create lab_no -> request.id map if not already exists:
			my $request_id = $self->request->{$dbid} ||=
				$dbix4->query( q!SELECT id FROM requests WHERE request_number = ?
					AND year = ?!, $vals->{HMDS}, $vals->{Year} )->list;

			my $hmds = sprintf 'H%s/%02d', $vals->{HMDS}, $vals->{Year} - 2000;
			my $sql = q!select UserID, Date, Time from History where HMDS = ?
                and Action = 'registered'!;
			my $history = $dbix3->query($sql, $hmds)->hash; # warn Dumper $history;

			my $username = lc $history->{UserID};
			my $user_id = $self->hilis4_users->{$username}
                || warn "no user_id for $username [$hmds]"; # Date & Time will fail
                
			my $time = join ' ', $history->{Date}, $history->{Time};
            $time ||= DateTime::Format::MySQL->format_datetime(DateTime->now);
			
			my %data = (
				request_id  	 => $request_id,
				lab_test_id 	 => $lab_test_id,
				status_option_id => 1,
				user_id     	 => $user_id || 24, # unknown user
				time        	 => $time,				
			);
			$dbix4->insert('request_lab_test_status', \%data);	
		}
	}	
	{ # from CutUp worklist
		my $sql = q!SELECT `DBID`,`HMDS`, YEAR(`Date`) as 'Year' FROM `Main` LEFT
			JOIN `HistoPanel` on `Hist_ID` = `DBID` LEFT JOIN `Report` on
			Rpt_ID = DBID WHERE `CutUp` IS NULL AND `ReportBy` IS NULL AND
			`Specimen` REGEXP '[DFGLRX]U|[DGLRX]F|BMAT|TBP'!;
		
		my $lab_test_id = $hilis3_lab_test_map->{CutUp};

		my $query = $dbix3->query($sql);
		while ( my $vals = $query->hash ) { # print Dumper $row; next;
			my $dbid = $vals->{DBID};

			# create lab_no -> request.id map if not already exists:
			my $request_id = $self->request->{$dbid} ||=
				$dbix4->query( q!SELECT id FROM requests WHERE request_number = ?
					AND year = ?!, $vals->{HMDS}, $vals->{Year} )->list;
				
			my $hmds = sprintf 'H%s/%02d', $vals->{HMDS}, $vals->{Year} - 2000;
			my $sql = q!select UserID, Date, Time from History where HMDS = ?
                and Action = 'registered'!;
			my $history = $dbix3->query($sql, $hmds)->hash;
			
			my $username = lc $history->{UserID};
			my $user_id = $self->hilis4_users->{$username}
                || warn "no user_id for $username [$hmds]"; # Date & Time will fail
                
			my $time = join ' ', $history->{Date}, $history->{Time};
            $time ||= DateTime::Format::MySQL->format_datetime(DateTime->now);
			
			my %data = (
				request_id  	 => $request_id,
				lab_test_id 	 => $lab_test_id,
				status_option_id => 1,
				user_id     	 => $user_id || 24, # unknown user
				time        	 => $time,				
			);
			$dbix4->insert('request_lab_test_status', \%data);	
		}
	}
}

sub _get_table_timestamp {
    my ($self, $field, $vals) = @_;

    my $lab_test_lab_section_map
        = $self->lab_test_lab_section_map;

    my $time;

    if( $lab_test_lab_section_map->{$field} eq 'Cytochemistry' ) {
        $time = $vals->{CytoTime};
    }
    elsif( $lab_test_lab_section_map->{$field} eq 'Flow cytometry' ) {
        $time = $vals->{FlowTime};
    }
    elsif( $lab_test_lab_section_map->{$field} eq 'Flow screen' ) {
        $time = $vals->{ScreenTime};
    }
    elsif( $lab_test_lab_section_map->{$field} =~ /\AHistology/ ) { # H&E/CutUp
        $time = $vals->{HistTime};
    }
    elsif( $lab_test_lab_section_map->{$field} eq 'Immunohistochemistry' ) { 
        $time = $vals->{HistTime};
    }
    elsif( $lab_test_lab_section_map->{$field} eq 'Molecular' ) {
        $time = $vals->{MolTime};
    }
    elsif (grep $field eq $_, qw/FISH Genetics/) {
        $time = $vals->{MolTime};
    }
    elsif (grep $field eq $_, qw/PML Ki67/) { # Ki67 now 'selection'
        $time = $vals->{FlowTime};
    }
    else {
        warn "Cannot set a timestamp for field $field"
    }

    return $time;
}

sub _build_hilis3_lab_test_map {
    my $self = shift;

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

    my $map
        = $dbh->query( q!select `TestName`, `id` from `_lab_test_map`! )->map;

    return $map;
}

sub _build_hilis4_lab_test_map {
    my $self = shift;

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

    my $map = $dbh->query( q!select `field_label`, `id` from `lab_tests`! )->map;

    return $map;
}

sub _build_user_id_map {
	my $self = shift;
	
	my $dbh3 = $self->db->{dbix3};
	my $dbh4 = $self->db->{dbix4};
	
	my $h4_users = $self->hilis4_users;
	my $h3_users = $dbh3->query( q!select `Initials`, `UserID` from `Users`
		where `Initials` is not null! )->map;
	
	# change RD:
	# $h3_users->{RD} = 'DE TUTE';
	
	my %map = map {
		my $userid = $h3_users->{$_}; # warn $userid;		
		$_ => $h4_users->{lc $userid}; # warn $h4_users->{lc $userid};
	} keys %$h3_users;
	
	return \%map;
}

sub _build_hilis4_users {
	my $self = shift;
	
	my $dbh4 = $self->db->{dbix4};
	
	my $users = $dbh4->query( q!select `username`, `id` from `users`! )->map;
	
	return $users;	
}

sub _build_field_label_map {
	my $self = shift;
	
    my $dbh = $self->db->{dbix4};

    my $map
        = $dbh->query( q!select `id`, `field_label` from `lab_tests`! )->map;

    return $map;	
}

sub _build_status_map {
	my $self = shift;
	
	my %map = (
		'x' => 'new',
		'p' => 'new',
		'+' => 'stabilised', 
		'/' => 'microtomy',
		'c' => 'checked',
		'r' => 'primary report',
		's' => 'setup',
	);
	
	return \%map;
}

sub _build_status_option_map {
	my $self = shift;
	
	my $dbh = $self->db->{dbix4};
	
	my $map = $dbh->query( 'select description, id from lab_test_status_options')->map;
	
	return $map;
}

sub _build_lab_test_lab_section_map {
    my $self = shift;

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

    my $sql = q!select `TestName`, `section_name` from `_lab_test_map` ltm
        join `lab_tests` lt on ltm.id = lt.id join `lab_sections` ls on
		lt.lab_section_id = ls.id!;

    my $map = $dbh->query( $sql )->map;

    return $map;
}

sub _build_lab_section_map {
    my $self = shift;

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

    my $lab_sections
        = $dbh->query( q!select `section_name`, `id` from `lab_sections`! )->map;

	# add these:
	$lab_sections->{Flow} = $lab_sections->{'Flow cytometry'};
	$lab_sections->{Hist} = $lab_sections->{'Immunohistochemistry'};
	$lab_sections->{Fish} = $lab_sections->{'FISH'};
	$lab_sections->{Mol}  = $lab_sections->{'Molecular'};
	$lab_sections->{Gen}  = $lab_sections->{'Cytogenetics'};

    return $lab_sections;
}

sub _get_user_id {
	my ($self, $username) = @_;
	
	my $user_map = $self->hilis4_users;
	
	return $user_map->{$username};
}

sub _get_inits {
	my $self  = shift;
	my $inits = shift;	
	
	{ # corrections:
		$inits = 'PE' if grep $inits eq $_, qw(+_ +P 00 +p);
		$inits = 'AR' if grep $inits eq $_, qw(\r AF CM);
		$inits = 'SO' if grep $inits eq $_, qw(S0); # zero
		$inits = 'AK' if $inits eq 'AD';
		$inits = 'FB' if $inits eq 'XB';
		$inits = 'IF' if $inits eq 'IM'; # H&E/CutUp
		# $inits = ? if $inits eq 'LD';	# H&E/CutUp	
	}
	
	# AN & NA = unknown & not applicable, so converted to 'unknown user'
	
	return $inits;
}

1;