package History;

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

use Data::Dumper;
use Date::Calc qw(Decode_Date_EU);
use DateTime::Format::MySQL;

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

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

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

has $_ => ( is => 'ro', isa => 'Object', lazy_build => 1 )
	foreach qw(
		missing_screener_info
		missing_reporter_info
		missing_registration_info
	);

has actions_list => ( is => 'ro', isa => 'Str', lazy_build => 1 );
has err_code_other => ( is => 'ro', isa => 'Int', lazy_build => 1 );

has actions_map => ( is => 'ro', isa => 'HashRef[Str]',lazy_build => 1 );
has change_options_map => ( is => 'ro', isa => 'HashRef[Str]',lazy_build => 1 );
has error_code_map => ( is => 'ro', isa => 'HashRef[HashRef]',lazy_build => 1 );

has $_ => ( is => 'ro', isa => 'ArrayRef[Str]', lazy_build => 1, auto_deref => 1 )
	foreach qw( request_actions modified_request_fields lab_test_actions );

__PACKAGE__->meta->make_immutable;

my @tables = qw(
	patient_edits
	request_history
	request_error_code
	request_lab_test_history
);

$|++;

sub convert {
    my $self = shift; 

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

	my $fh = $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_history`! );

    my $sql = q!select ID,Date,Time,UserID,Action,HMDS from History!; # where ID > 20000!;

    my $history = $dbix3->query($sql);

    HISTORY:
    while ( my $vals = $history->hash ) { # warn Dumper $vals;
        $vals->{id} % 10000 || print $vals->{id}, "\n";

		# eg Ki67 -> selection, remove trailing 'on':
		$vals->{action} = $self->_do_action_field_substitutions($vals->{action});

        my $lab_no = $vals->{hmds}; # warn $lab_no;

        my ($hmds, $yr) = $lab_no =~ /H(\d+)\/(\d{2})/;

        # create lab_no -> request.id map if not already exists:
        $self->request->{$lab_no} ||=
            $dbix4->query( q!SELECT id FROM requests WHERE request_number = ? AND
                year = ?!, $hmds, 2000 + $yr )->list; # warn $self->request->{$lab_no};

        unless ($self->request->{$lab_no}) {
            print $fh "no request.id for lab_no $lab_no\n";
            next HISTORY;
        }

		# do this 1st so 'entered foo' list matches before lab_tests:
		if ( grep $vals->{action} =~ /^$_/, $self->request_actions ) { # match at beginning
			$self->_do_request_actions($vals);
		}
		# do this next so we remove 'recorded error codes' so can do other 'recorded foo':
		elsif ( $vals->{action} =~ /^recorded error code \w/ ) {
			$self->_do_error_code_actions($vals);
		}
		elsif ( grep $vals->{action} =~ /^$_/, $self->lab_test_actions ) { # match at beginning
			$self->_do_lab_test_actions($vals);
		}
		elsif ( $vals->{action} =~ /^(modified)/ ) {
			$self->_do_modification_actions($vals);
		}
		elsif ( $vals->{action} =~ /diagnosis of DLBCL or Burkitt lymphoma/ ) {
			$vals->{action} = 'dispatched DLBCL/Burkitt lymphoma email alert';
			$self->_do_request_actions($vals);
		}
		else {
			print $vals->{action}, "\n";
		}
	}
print "updating requests table - will cause requests.updated_at to shift to current_time\n";
#print DateTime->now(time_zone => 'local')->datetime, "\n";
	# change status to incomplete if outstanding tests or final_diag required:
	$self->_revert_status_on_outstanding_tests;
#print DateTime->now(time_zone => 'local')->datetime, "\n";
	$self->_revert_status_if_final_diagnosis_required;
#print DateTime->now(time_zone => 'local')->datetime, "\n";

	# patch for MyISAM tables - to replace sub-selects which kills performance:
	my $requests = $dbix4->query('select id, request_number, year from requests')->hashes;
	
	# get missing registration, screener, reporter info:
	$self->_do_missing_registration_info($requests);
	$self->_do_missing_screener_info($requests);
	$self->_do_missing_reporter_info($requests);
print DateTime->now(time_zone => 'local')->datetime, "\n";
	
	warn 'dumping temp table into request_history';
=begin # process failed at this point 18/8/2011 so combined into single statement:
	# transfer data from temp to request_history in date/time order:
    my $data = $dbix4->query( q!select request_id, action, user_id, time
        from `temp` order by `time`,`request_id`,`id`! ); # don't want id

    while ( my $vals = $data->hash ) { # warn $vals->{request_id};
        $dbix4->insert('request_history', $vals);
    }
=cut
    $dbh4->do( q!
        INSERT INTO `request_history` (`request_id`, `action`, `user_id`, `time`)
        SELECT `request_id`, `action`, `user_id`, `time`
        FROM `temp` order by `time`, `request_id`, `id`!
    );
    
    $dbh4->do( q!DROP TABLE `temp`! );
#=cut
print DateTime->now(time_zone => 'local')->datetime, "\n";
	
	# update requests table 'created_at' col with registration date/time:
	$self->_do_request_created_at;
	
	# update request_report table 'created_at' col with report date/time:
	$self->_do_report_created_at;
	
    $self->convert_to_InnoDB($_) for @tables;
    
    print $fh Dumper $self->no_username;
}

# change status to incomplete if outstanding tests (before timestamp updated):
sub _revert_status_on_outstanding_tests {
    my $self = shift;

    my $dbh = $self->db->{dbh4};
    
	my $sql = q!
		update requests r set r.status_option_id = 4 where r.id in (
			select s.request_id from request_lab_test_status s
			where s.status_option_id <> 2 
		) and r.status_option_id = 5!;

	$dbh->do($sql);	
}

# use hilis3 final_diagnosis.pl cron queries to find requests which need final diagnosis:
sub _revert_status_if_final_diagnosis_required {
	my $self = shift;
	
	my $dbix3 = $self->db->{dbix3};
	my $dbix4 = $self->db->{dbix4};
	
	my $sql = q!
		SELECT `HMDS`, DATE_FORMAT(`Date`, '%Y') as 'year', `InitialDiag`, `Specimen`
		FROM `Report`
			LEFT JOIN `Main` on `DBID` = `Rpt_ID`
			LEFT JOIN `MolGen` on `Mol_ID` = `DBID`
		WHERE YEAR(`Date`) >= 2010
			AND `AuthorisedBy` IS NOT NULL
			AND `FinalDiag`	IS NULL
			AND (`GenResult` IS NOT NULL OR	`FishResult` IS NOT NULL OR `MolResult` IS NOT NULL)
			AND `InitialDiag` NOT IN ('Molecular miscellaneous', 'Chimerism sample',
				'PNH', 'Rheumatoid arthritis')!;

	my @excluded_if_peripheral_blood = (
		'CML follow-up (post-BMT)', 'CML imatinib PB follow-up',
		'CML interferon follow-up', 'CML STI follow-up' );
	
    my $data = $dbix3->query($sql);

	ROW:
    while ( my $vals = $data->hash ) { # warn $vals->{request_id};
		# skip 'escapees' from HILIS3:
		next ROW if grep $vals->{hmds} == $_, (2646, 2656, 5217);
		
		my $specimen = $vals->{specimen};
		my $screen   = $vals->{initialdiag};
		
		next ROW if ( grep $screen eq $_, @excluded_if_peripheral_blood )
			&& $specimen eq 'PB'; # skip CML follow-up PB's
		
		# get lab_tests:
		my $sql = q!
			select t3.test_name, t4.description
			from requests t1
				join request_lab_test_status t2 on t2.request_id = t1.id
				join lab_tests t3 on t2.lab_test_id = t3.id
				join lab_test_status_options t4 on t2.status_option_id = t4.id
			where t1.request_number = ? and	t1.year = ?!;
		my $lt = $dbix4->query( $sql, @{$vals}{ qw(hmds year) } )->hashes;
		# warn Dumper $tests; next;
		
		my @status = map $_->{description}, @$lt;
		my @tests  = map $_->{test_name},   @$lt;
		
		# next if any incomplete tests:
		next ROW if grep $_ ne 'complete', @status;
		
		if ( $screen eq 'CMPD pres & follow-up' && $specimen eq 'PB' ) {
			# check to see if JAK2 is only lab_test:			
			next ROW if (join '', @tests) eq 'jak2';
		}
		# warn Dumper [ @{$vals}{qw(hmds initialdiag specimen)}, @tests ];

		# update status if already set to complete:
		$dbix4->update( 'requests', { status_option_id => 4 },
			{
				request_number 	=> $vals->{hmds},
				year 		   	=> $vals->{year},
				status_option_id => 5
			}
		); 
	}
}

# update requests table 'created_at' col with registration date/time:
sub _do_request_created_at {
	my $self = shift;
	
	my $dbix = $self->db->{dbix4};
	my $dbh =  $self->db->{dbh4};
	
	my $sql = q!select request_id, time from request_history where action = 'registered'!;
	
	my $request_time_map = $dbix->query( $sql )->map;
	
	# to avoid updated_at col updating to now():
	$dbh->do( q!ALTER TABLE `requests` CHANGE COLUMN `updated_at`
		`updated_at` timestamp;! );

	map { # warn $_ unless $_ % 1000;
		my $created_at = $request_time_map->{$_};									 
		$dbix->update('requests', { created_at => $created_at }, { id => $_ } );
	} sort keys %$request_time_map;	

	$dbh->do( q!ALTER TABLE `requests` CHANGE COLUMN `updated_at` `updated_at`
		timestamp NOT NULL DEFAULT '0000-00-00 00:00:00' ON UPDATE CURRENT_TIMESTAMP! );
}

# update request_report table 'created_at' col with report date/time:
sub _do_report_created_at {
	my $self = shift;
	
	my $dbix = $self->db->{dbix4};
	my $dbh =  $self->db->{dbh4};
	
	my $sql = q!select request_id, time from request_history where action = 'reported'!;

	my $report_time_map = $dbix->query( $sql )->map;

	# to avoid updated_at col updating to now():
	$dbh->do( q!ALTER TABLE `request_report` CHANGE COLUMN `updated_at`
		`updated_at` timestamp;! );

	map { # warn $_ unless $_ % 1000;
		my $created_at = $report_time_map->{$_};									 
		$dbix->update('request_report', { created_at => $created_at }, { request_id => $_ } );
	} sort keys %$report_time_map;	

	$dbh->do( q!ALTER TABLE `request_report` CHANGE COLUMN `updated_at` `updated_at` 
		timestamp NOT NULL DEFAULT '0000-00-00 00:00:00' ON UPDATE CURRENT_TIMESTAMP! );	
}

sub _do_lab_test_actions {
	my $self = shift;
	my $vals = shift;

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

	# get common fields: user_id, request_id & time:
	my $data = $self->_get_history_table_data($vals);
	$data->{action} = $vals->{action};

	$dbh->insert('request_lab_test_history', $data);
}

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

	my $data = $self->_get_history_table_data($vals);
	
	my $error_code_map = $self->error_code_map;

	my ($error_code) = $vals->{action} =~ /error code (\w)/;

	{ # request_history
		my %data = %$data;
		$data{action} = 'recorded error code ' . $error_code;
		$dbh->insert('temp', \%data);
	
		if ($vals->{action} =~ /pre-IR1/) {
			$data{action} = 'completed LIC';
			$dbh->insert('temp', \%data);			
		}
	}
	
	my $error_code_id = $error_code_map->{$error_code}->{id}
	|| die "Cannot find error code id for $error_code";

	my $error_code_is_unique = $error_code_map->{$error_code}->{unique}
	|| die "Cannot find error code 'is_unique' for $error_code";

	{ # request_error_code:
		$data->{error_code_id} = $error_code_id;
	
		if ($error_code_is_unique eq 'yes') {
			my $sql = q!select 1 from request_error_code
				where request_id = ? and error_code_id = ?!;
			return if
				$dbh->query( $sql, @{$data}{ qw(request_id error_code_id) } )->list;
		}
		# ok, request_error_code doesn't exist or code not unique:
		$dbh->insert('request_error_code', $data);
	}
	
	return $error_code_id;
}

# can be modifications to request, patient or lab_test fields:
sub _do_modification_actions {
	my $self = shift;
	my $vals = shift;

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

    return if $vals->{action} eq 'modified' || $vals->{action} eq 'modified PID';
    
    $vals->{action} =~ s/\((.*)\)/\[$1\]/g; # early HILIS3 used () instead of []
    $vals->{action} =~ s/(modified \w+)\:/$1/;
    $vals->{action} =~ s/&#187;/->/;
    $vals->{action} =~ s/modified Number/modified PatNo/;
    
	my $fh = $self->log_file;
	# print $fh $vals->{action}, "\n";

	my $error_code_id;
	# get error_code data:
	if ( $vals->{action} =~ /error code \w/ ) {
		# record error_code:
		$error_code_id = $self->_do_error_code_actions($vals);
		# strip error code (it's already logged in request_history file):
		$vals->{action} =~ s/\s::\serror code \w//; # warn $vals->{action};
	}

	# in case Action doesn't have error code (early HILIS3):
	my $err_code_other = $self->err_code_other;
	$error_code_id ||= $err_code_other;
	
	# get common fields: user_id, request_id & time:
	my $data = $self->_get_history_table_data($vals);
	$data->{action} = $vals->{action};

	my $request_fields = join '|', $self->modified_request_fields; # using auto_deref here

    # patient fields:
	if ( $vals->{action} =~ /Name|DoB|NHSNo|Sex/ ) { # warn Dumper $vals->{action};
        $vals->{action} =~ s/\[(NULL)\]/$1/g; # square brackets causing regex problems

		my %mods = $vals->{action} =~ /(\w+) \[(.*?) ->/g; # warn Dumper \%mods;
			
		# only interested in PID fields - but also need to capture BlockRef & PatNo:
		if (grep $_ =~ 'Name|DoB|NHSNo', keys %mods) { # warn Dumper \%mods;
			# get PID.P_ID from .. & get HILIS4 patient.id 
			my $request_id = $data->{request_id};	
			
			if ( my $name = $mods{Name}) {
				my ($lname, $fname) = split ', ', $name;
				$mods{LName} = $lname;
				$mods{FName} = $fname if $fname; # if Name => 'foo' have to assume LName
			}
			# get existing patient for this request:
			my $patient = do {
				my $sql = q!select p.* from requests r join patient_case 
					pc on r.patient_case_id = pc.id join patients p on pc.patient_id = p.id 
					where r.id = ?!;			
				$dbh->query($sql, $request_id)->hash; 
			}; # warn Dumper $patient;
			
			my $merged_data; # update $patient or $patient_edit with %mods data:
			# if patient already modified in patient_edits table - get most recent entry:
			my $sql = 'select * from patient_edits where patient_id = ? order by id desc limit 1';		
			if ( my $entry = $dbh->query($sql, $patient->{id})->hash ) {
				$merged_data = $self->_merge($entry,\%mods);
			}
			else {
				$merged_data = $self->_merge($patient,\%mods);
			} # warn Dumper $merged_data;
			
			my %edit = map {
				$_ => $merged_data->{$_};
			} qw(last_name first_name middle_name dob gender nhs_number); # warn Dumper \%edit;
			
			$edit{error_code_id} = $error_code_id;
			$edit{patient_id} 	 = $patient->{id};
			$edit{user_id} 		 = $data->{user_id};
			$edit{time} 		 = $data->{time};
		
			$dbh->insert('patient_edits', \%edit);
        }
        # look for any request fields which have been captured:
        while ( my ($field, $value) = each %mods ) {
            next unless grep $field eq $_, qw(PatNo BlockRef Number Clinician);
            my ($change) = $vals->{action} =~ /$field.*$value -> (.*?)\]/;
            # recreate action:
            $field =~ s/Number/PatNo/; # early HILIS3
            
            # warn $vals->{hmds} if grep { ! $_ } ($field, $value, $change); # get uninitialized val        
            $change ||= '??'; # H10992/06 Action truncated at 255 chars
            
            my $action = sprintf 'modified %s [%s -> %s]', $field, $value, $change;
            my %history = (
                request_id  => $data->{request_id},
                user_id     => $data->{user_id},
                time        => $data->{time},
                action      => $action,
            ); # warn Dumper \%history;
            $dbh->insert('temp', \%history);
        } 
	}
	# request fields:
	elsif ( $vals->{action} =~ /$request_fields/ ) {
		$dbh->insert('temp', $data);
	}
	# assume lab_test fields:
	else {
		$dbh->insert('request_lab_test_history', $data);
	}
}

sub _merge {
	my ($self, $patient, $changes) = @_;

	if ( my $last_name = $changes->{LName} ) {
		$patient->{last_name} = $last_name;
	}
	if ( my $first_name = $changes->{FName} ) {
		$patient->{first_name} = $first_name;
	}
	if ( my $nhs_number = $changes->{NHSNo} ) {
		$patient->{nhs_number} = $nhs_number;
	}
	if ( my $dob = $changes->{DoB} ) {
		if ($dob =~ /NULL/) {
			$patient->{dob} = undef;
			$dob = undef;
		}		
		elsif ($dob =~ /(\d{2})[-\.](\d{2})[-\.](\d{4})/) {
			$dob = join '-', $3, $2, $1;
		}
		elsif ($dob =~ /\d{2}[-\.]\w{3}[-\.]\d{4}/) {
			$dob = sprintf '%s-%02d-%02d', Decode_Date_EU($dob); # require 4-2-2 for D::F::M
		}
		elsif ($dob =~ /\d{2}[-\.]\w{3}[-\.]\d{4}/) {
			$dob = sprintf '%s-%02d-%02d', Decode_Date_EU($dob); # require 4-2-2 for D::F::M
		}
		
		if ($dob) {
			eval { # check date is valid:
				my $dt = DateTime::Format::MySQL->parse_date($dob); # require 4-2-2
				if ($dt) {
					$patient->{dob} = $dob;
				}
			};
		}
	}
	
	no warnings 'uninitialized';
	map $patient->{$_} = lc $patient->{$_}, qw(last_name first_name middle_name);
	
	return $patient;	
}

sub _do_request_actions {
	my $self = shift;
	my $vals = shift;

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

	# get common fields: user_id, request_id & time:
	my $data = $self->_get_history_table_data($vals);

	my $actions_list = $self->actions_list;
	my $actions_map  = $self->actions_map;
    my $options_map  = $self->change_options_map;

    # screened / reported / authorised:
    my (@actions) = $vals->{action} =~ /$actions_list/g;

	# if action in actions_list (eg screened, reported & authorised):
	if (@actions) {
		foreach my $action(@actions) {
			# substitute 'action' if in %actions_map:
			$data->{action} = $actions_map->{$action} || $action;

			$dbh->insert('temp', $data);
		}
	}
	# else just insert action:
	else {
		$vals->{action} =~ s/pre-IR1/LIC/;
		$vals->{action} =~ s/\Ae-mailed\Z//; # empty e-mailed lines
		$vals->{action} =~ s/\A(e-mailed)/$1 diagnosis status alert to/; 
		
		$data->{action} = $vals->{action} || return; # skip empty lines
		$dbh->insert('temp', $data);
	}
	# update request_lab_test_status if status not complete:	
	if ($vals->{action} eq 'screened') { # should only be singlicate if outstanding tests
		my $sql = q!select 1 from request_lab_test_status where request_id = ?
			and status_option_id <> 2!;
		if ( $dbh->query($sql, $data->{request_id})->list ) {
			my $request_id = $data->{request_id};
			my $user_id    = $data->{user_id};
			$dbh->update(
				'request_lab_test_status',
				{ user_id    => $user_id },
				{ request_id => $request_id, status_option_id => { '!=', 2 } },
			);
		}
	}
	# update request_diagnosis_history table:		
	if ($vals->{action} eq 'entered ReviseDiag and FinalDiag') { # only 5 of these
		foreach ( qw/error update/ ) {
            my $option_id = $options_map->{$_};
            
			$dbh->update('request_diagnosis_history',
				{ time => $data->{time} }, # set
				{ # where:
					request_id => $data->{request_id},
					user_id    => $data->{user_id},
					option_id  => $option_id,
				}
			);
		}
	}	
	elsif ($vals->{action} =~ /(Revise|Final)Diag/) {
		my $reason = $1 eq 'Revise' ? 'error' : 'update';
        my $option_id = $options_map->{$reason};
        
		$dbh->update('request_diagnosis_history',
			{ time => $data->{time} }, # set
			{ # where:
				request_id => $data->{request_id},
				user_id    => $data->{user_id},
				option_id  => $option_id,
			} 
		);
	}
}

sub _get_history_table_data {
	my $self = shift;
	my $vals = shift; # warn Dumper $vals;

    my $username = lc $vals->{userid}; # warn $username if $lab_no eq 'H1608/02';

    # get user.id from History.UserID:
    my $user_id = $self->_get_user_id($username); # warn $user_id if $lab_no eq 'H1608/02';

	my $lab_no = $vals->{hmds}; # warn $lab_no;

    # get request.id from %request map:
    my $request_id = $self->request->{$lab_no};

    my %data = (
        user_id    => $user_id,
        request_id => $request_id,
        time       => join ' ', $vals->{date}, $vals->{time},
    );

	return \%data;
}

# look for missing registration info:
sub _do_missing_registration_info {
	my $self = shift;
	my $requests = shift;
	
	# sub-select on temp is table killer on MyISAM version:
	#my $missing_registration_info = $self->missing_registration_info;

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

#    while ( my $vals = $missing_registration_info->hash ) {#warn $vals->{id};
	my %ids = $dbix4->query( q!select request_id, 1 from temp where action = 'registered'! )->map;
	RECORD:	for  my $vals ( @$requests ) {
		next RECORD if $ids{ $vals->{id} }; # replacement for sub-select in $missing_registration_info
        my $date = $dbix3->query( q!select Date from Main where HMDS = ?
            and year(Date) = ?!, $vals->{request_number}, $vals->{year})->list;

        my %data = (
            action     => 'registered',
            request_id => $vals->{id},
            user_id    => $self->username_userid_map->{unknown},
            time       => join ' ', $date, '00:00:00',
        );

        $dbix4->insert('temp', \%data);
    }
}

# look for missing screener info:
sub _do_missing_screener_info {
	my $self = shift;
	my $requests = shift;
	# sub-select on temp is table killer on MyISAM version:
	# my $missing_screener_info = $self->missing_screener_info;

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

#    while ( my $vals = $missing_screener_info->hash ) {
	my %ids = $dbix4->query( q!select request_id, 1 from temp where action = 'screened'! )->map;
	RECORD:	for  my $vals ( @$requests ) {
		next if $ids{ $vals->{id} }; # replacement for sub-select in $missing_screener_info

        my ($user,$date) = $dbix3->query( q!select Screener, ScreenDate from
            Main,Report where HMDS = ? and year(Date) = ? and DBID = Rpt_ID!,
            $vals->{request_number}, $vals->{year})->list;

		# $user = signature - need user.id from $self->_get_user_id(), which needs UserID:
		$user || next RECORD; # presume not screened;

        my $username = $self->_get_username($user)
		|| die "No username for $vals->{request_number}/$vals->{year}";

        if ( my $user_id = $self->_get_user_id($username) ) {
            my %data = (
                action     => 'screened',
                request_id => $vals->{id},
                user_id    => $user_id,
                time       => join ' ', $date, '00:00:00',
            );
            $dbix4->insert('temp', \%data);
        }
    }
}

# look for missing reporter info:
sub _do_missing_reporter_info {
	my $self = shift;
	my $requests = shift;

	#my $missing_reporter_info = $self->missing_reporter_info;

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

#    while ( my $vals = $missing_reporter_info->hash ) {
	my %ids = $dbix4->query( q!select request_id, 1 from temp where action = 'reported'! )->map;
	RECORD:	for  my $vals ( @$requests ) {
		next if $ids{ $vals->{id} }; # replacement for sub-select in $missing_reporter_info
		
        my ($user,$date) = $dbix3->query( q!select ReportBy, ReportDate from
            Main,Report where HMDS = ? and year(Date) = ? and DBID = Rpt_ID!,
            $vals->{request_number}, $vals->{year})->list;

		# $user = signature - need user.id from $self->_get_user_id(), which needs UserID:
		$user || next RECORD; # presume not screened;

        my $username = $self->_get_username($user)
		|| die "No username for $vals->{request_number}/$vals->{year}";

        if ( my $user_id = $self->_get_user_id($username) ) {
            my %data = (
                action     => 'reported',
                request_id => $vals->{id},
                user_id    => $user_id,
                time       => join ' ', $date, '00:00:00',
            );
            $dbix4->insert('temp', \%data);
        }
    }
}

sub _build_error_code_map {
	my $self = shift;

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

	# needs to be uppercase:
	my $sql = q!select `id`, upper(`code`) as 'code', `is_unique` from error_codes!;
    my $codes = $dbh->query($sql);

	my %map;
	
    while ( my $vals = $codes->hash ) { # warn Dumper $vals;
		my $code = $vals->{code};
		my %data = (
			id     => $vals->{id},
			unique => $vals->{is_unique},
		);
		$map{$code} = \%data;
	}	
	return \%map;

	# add discontinued codes:
}

sub _build_actions_map {
	my $self = shift;

    my %map = (
        added => 'registered',
        'deleted record' => 'deleted',
		'unlocked record' => 'unlocked',
    );
	return \%map;
}

sub _build_change_options_map {
	my $self = shift;

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

	my $sql = q!select `option_name`, `id` from diagnosis_change_options!;
    my $map = $dbh->query($sql)->map;
    return $map;
}

sub _build_missing_registration_info {
	my $self = shift;

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

	return $dbh->query( q!select id, request_number, year from requests where
		id not in ( select request_id from temp where action = 'registered' )! );
}

sub _build_missing_screener_info {
	my $self = shift;

	my $dbh = $self->db->{dbix4};
	return $dbh->query( q!select id, request_number, year from requests where
		id not in ( select request_id from temp where action = 'screened' )! );
}

sub _build_missing_reporter_info {
	my $self = shift;

	my $dbh = $self->db->{dbix4};
	return $dbh->query( q!select id, request_number, year from requests where
		id not in ( select request_id from temp where action = 'reported' )! );
}

sub _build_actions_list {
	my $self = shift;

    my $actions_list = join '|', qw(registered added screened reported
        authorised deleted unlocked);

	return $actions_list;
}

sub _build_err_code_other {
	my $self = shift;
	
	my $dbh = $self->db->{dbix4};
	
	my $id = $dbh->query('select id from error_codes where description = ?',
		'other error(s)' )->list;

	return $id;
}

sub _build_modified_request_fields {
	my $self = shift;

	my @fields = qw(
		NewDiagnosis
		TrialNo
		Urgent
		SpecQuality
		Private
		Store
		Study
		Research
		ReviseDiag
		Specimen
		Source
		BlockRef
		ClinDetails
		Clinician
		Comment
		Consent
		DoI
		FinalDiag
		GrossDesc
		Hospital
		InitDiag
        PatNo
	);

	return \@fields;
}

sub _build_request_actions {
	my $self = shift;

	my @request_actions = (
		'added',
		'screened',
		'reported',
		'authorised',
		'registered',
		'unlocked', # always 'unlocked record' in table
		'reported and authorised',
		'screened, reported and authorised',
		'deleted', # always 'deleted%' in table
		'emailed', # always 'emailed report' or 'emailed report%' in table
		'e-mailed', # always 'emailed report' or 'emailed report%' in table
		'recorded telephone',
		'completed pre-IR1',
		'dispatched', # report, CMP pack, sample alert, etc
	);

	push @request_actions, map { 'entered ' . $_ }
		qw( Comment ClinDetails FinalDiag GrossDesc ReviseDiag );

	return \@request_actions;
}

sub _build_lab_test_actions {
	my $self = shift;

	my @lab_test_actions = (
		'updated',
		'checked',
		're-checked',
		'requested',
		'input',
		'recorded', # will match all not matched in 'recorded error code' & @_build_request_actions::request_actions
		'signed out',
		'H & E', # always 'H & E signed out',
		'returned blocks',
		'referred blocks',
		'block updated',
		'removed FISH',
		'analysed flow data',
		'entered', # will match all which didn't match in @_build_request_actions::request_actions
	);

	return \@lab_test_actions;
}

sub _do_action_field_substitutions {
	my $self   = shift;
	my $action = shift;
	
	$action =~ s/Ki67/selection/;
	
    # remove trailing 'on' & 'records:':
    $action =~ s/\s(on|records\:)\Z//;
	
	return $action;
}

1;