package Role::Report;

use Moose::Role;
=begin
requires qw(screen_map signature_userid_map username_userid_map
    substitute_screening_terms substitute_user);
=cut

has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 )
	foreach qw(
        status_map
        diagnosis_map
        renamed_diagnoses
        change_options_map
        specimen_quality_map
    );

use Data::Dumper;

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

    # if not yet screened, will not exist in Report table:
    $vals->{rpt_id} || return 0;

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

	{ # InitialDiag:
		my $initialdiag = $vals->{initialdiag};

		my $screen_id = $self->screen_map->{$initialdiag}
			|| $self->substitute_screening_terms->{$initialdiag}
				|| die "no screen id for $initialdiag ($vals->{dbid})";

		my %data = (
			request_id => $vals->{_request_id},
			screen_id  => $screen_id,
		);
		$dbh->insert('request_initial_screen', \%data);
	}

	# if reported, convert data for request_report table:
	if ( $vals->{reportby} ) {
        my $new_diagnosis = $vals->{newdiagnosis} || '';
        my $quality       = $vals->{specquality}  || '';

		my $status = $self->status_map->{$new_diagnosis} || 'default';
		my $specimen_quality = $self->specimen_quality_map->{$quality}
			|| 'adequate';

        my $diagnosis_map = $self->diagnosis_map;

        my $diagnosis = $self->_process_diagnosis_data($vals);

        my $diagnosis_id = $diagnosis_map->{$diagnosis}
        || die "Cannot find diagnosis_id for $diagnosis";

		my %data = (
            request_id       => $vals->{_request_id},
            comment          => $vals->{comment},
            clinical_details => $vals->{clindetails},
            specimen_quality => $specimen_quality,
            status           => $status,
            diagnosis_id     => $diagnosis_id,
			created_at       => '0000-00-00 00:00:00', # will be updated in History
            updated_at       => $vals->{reporttime},
        );
        $dbh->insert('request_report', \%data);
	}
	# gross description:
	if ( my $gross_description = $vals->{grossdesc} ) {
		my %data = (
			request_id => $vals->{_request_id},
            detail     => $gross_description,
		);
		unless ( grep $gross_description eq $_, ('-', 'N/A') ) {
			$dbh->insert('request_gross_description', \%data);
		}
	}
}

# updates request_diagnosis_history table with any ReviseDiag or Diagnosis
# returns FinalDiag, ReviseDiag or Diagnosis:
sub _process_diagnosis_data {
    my $self = shift;
    my $vals = shift;

    my $diagnosis;

    # first try FinalDiag, update request_diagnosis_history table:
    if ( $diagnosis = $vals->{finaldiag} ) {
		if ($vals->{revisediag}) {
			if ( $vals->{revisediag} ne $vals->{diagnosis} ) {
				# diagnosis-that-got-changed, who-changed-it, date, reason:
				my %data = (
					diagnosis  => $vals->{diagnosis},
					username   => $vals->{revisedby},
					datetime   => $vals->{revisedate},
					request_id => $vals->{_request_id},
					reason     => 'error',
				);
				$self->_do_diagnosis_history(\%data);
			}
			if ( $vals->{finaldiag} ne $vals->{revisediag} ) {
				# diagnosis-that-got-changed, who-changed-it, date, reason:
				my %data = (
					diagnosis  => $vals->{revisediag},
					username   => $vals->{finalby},
					datetime   => $vals->{finaldate},
					request_id => $vals->{_request_id},
					reason     => 'update',
				);
				$self->_do_diagnosis_history(\%data);
			}				
		}
		elsif ( $vals->{finaldiag} ne $vals->{diagnosis} ) {
			# diagnosis-that-got-changed, who-changed-it, date, reason:
			my %data = (
				diagnosis  => $vals->{diagnosis},
				username   => $vals->{finalby},
				datetime   => $vals->{finaldate},
				request_id => $vals->{_request_id},
				reason     => 'update',
			);
			$self->_do_diagnosis_history(\%data);
		}
    }	
    # next try ReviseDiag, update request_diagnosis_history table:
    elsif ( $diagnosis = $vals->{revisediag} ) {
		if ( $vals->{revisediag} ne $vals->{diagnosis} ) {
			# diagnosis-that-got-changed, who-changed-it, date, reason:
			my %data = (
				diagnosis  => $vals->{diagnosis},
				username   => $vals->{revisedby},
				datetime   => $vals->{revisedate},
				request_id => $vals->{_request_id},
				reason     => 'error',
			);
			$self->_do_diagnosis_history(\%data);
		}
    }
	# group of molecular samples from 2002/2003 with no diagnosis:
	elsif ( ! $vals->{diagnosis} ) {
		if ( $vals->{initialdiag} =~ /molecular|chimerism/i ) {
			$diagnosis = 'Not required';
		}
	}
    else {
        $diagnosis = $vals->{diagnosis};
    }

    return $diagnosis;
}

sub _do_diagnosis_history {
	my $self = shift;
	my $data = shift;
	
	my $dbh = $self->db->{dbix4};
	
    my $diagnosis  = $data->{diagnosis}; # original diagnosis
    my $signature  = $data->{username}; # who changed it
    my $reason     = $data->{reason}; # why
    my $date       = $data->{datetime} || '0000-00-00'; # early data didn't record date
	
    my $diagnosis_map = $self->diagnosis_map;
    my $options_map   = $self->change_options_map;
    
    my $user_id = $self->_get_user_id_from_sig($signature)
        || die "Cannot find users.id for $signature";

    my $diagnosis_id = $diagnosis_map->{$diagnosis}
        || die "Cannot find diagnosis_id for $diagnosis";

    my %data = (
        request_id   => $data->{request_id},
        diagnosis_id => $diagnosis_id,
		option_id    => $options_map->{$reason},
        user_id      => $user_id,
        time         => join ' ', $date, '00:00:00',
    );
    $dbh->insert('request_diagnosis_history', \%data);		
}

sub _build_status_map {
	my $self = shift;

    my %status_map = (
        Y => 'new', # new_diagnosis = yes
        R => 'relapse',
        N => 'default', # new_diagnosis = no
    );

	return \%status_map;
}

sub _build_specimen_quality_map {
	my $self = shift;

    my %specimen_quality_map = (
        Adequate => 'adequate',
        Average  => 'adequate',
        Good     => 'good',
        Poor     => 'poor',
    );
	return \%specimen_quality_map;
}

sub _build_renamed_diagnoses {
    my $self = shift;
    
    # add renamed terms:
    my @renamed_pairs = (
        'B-cell chronic lymphocytic leukaemia',
        'B-cell chronic lymphocytic leukaemia (B-cell CLL)',
        
        'B-CLL - minimal residual disease present',
        'B-cell CLL - minimal residual disease present',
        
        'Blastic variant of mantle cell lymphoma',
        'Mantle cell lymphoma - blastic variant',
        
        'Chronic myeloproliferative disorder with myelofibrosis',
        'Chronic myeloproliferative neoplasm with myelofibrosis',
        
        'CLL-associated EBV lymphoproliferative disorder',
        'B-cell CLL-associated EBV lymphoproliferative disorder',
        
        'CML - cytogenetic remission',
        'Chronic myeloid leukaemia - cytogenetic remission',
        
        'CML - major molecular response',
        'Chronic myeloid leukaemia - major molecular response',
        
        'CML - minor molecular response',
        'Chronic myeloid leukaemia - minor molecular response',
        
        'CML - satisfactory molecular response',
        'Chronic myeloid leukaemia - satisfactory molecular response',
        
        'CML - unsatisfactory molecular reponse', # originally mis-spelled
        'Chronic myeloid leukaemia - unsatisfactory molecular response',
        
        'Diffuse large B-cell lymphoma',
        'Diffuse large B-cell lymphoma (DLBCL)',
        
        'Extranodal MZL with rearrangement of MALT-1',
        'Extranodal marginal zone lymphoma with rearrangement of MALT-1',
        
        'Hodgkin lymphoma - HIV associated',
        'Classical Hodgkin lymphoma - HIV associated',
        
        'MDS treated <5% blasts',
        'Myelodysplastic syndrome treated <5% blasts',
        
        'Mixed phenotype acute leukaemia with MLL rearrangement',
        'Acute leukaemia - mixed phenotype with MLL rearrangement',
        
        'Monoclonal gammopathy of uncertain significance',
        'Monoclonal gammopathy of undetermined significance (MGUS)',
        
        'Myeloma - minimal residual disease present',
        'Plasma cell myeloma - minimal residual disease present',
        
        'Atypical CML',
        'Atypical chronic myeloid leukaemia',
    );

    my %h = @renamed_pairs;
    return \%h;    
}

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_diagnosis_map {
    my $self = shift;

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

    my $map = $dbh->query( 'select name, id from diagnoses' )->map;
    
    # add any diagnoses which have changed names:
    my $renamed_diagnoses = $self->renamed_diagnoses;
    
    while ( my ($old, $new) = each %$renamed_diagnoses ) {
        $map->{$old} = $map->{$new}; # maps old term to new term for conversion
    }
    
    return $map;
}

sub _get_event_time {
	my ($self, $function, $date_field, $lab_no) = @_;

	my $sql;

	if ($function eq 'screened') {
		$sql = q!select Date, Time from History where HMDS = ? and
			Action = 'screened'!;
	}
	else {
		$sql = sprintf q!select Date, Time from History where HMDS = ? and
			Action in ('%s', 'reported and authorised')!, $function;
	}

	if ( my @date_time = $self->db->{dbix3}->query( $sql, $lab_no )->list ) {
		return join ' ', @date_time; # use Date/Time from History if available
	}
	elsif ($date_field) {
		return join ' ', $date_field, '00:00:00'; # time unknown
	}
	else { # should never happen ?
        warn Dumper [ $function, $date_field, $sql, $lab_no ];
        return undef;
    }
}

=begin # ? not used, was RequestHistory  - function should be in Role::User:
sub __get_user_id {
	my ($self, $function, $vals) = @_; # function = screener, reportby, authorisedby

	my $signature = $vals->{$function} || return;

	my $username = lc $self->signature_userid_map->{$signature};

	my $user_id = $self->username_userid_map->{$username}
		|| $self->substitute_user->{$signature}
			|| warn "no user id for $signature ($vals->{dbid})"; # warn $user_id;
}
=cut

=begin # these are wrong !!
sub _do_history_for_revisediag {
    my $self = shift;
    my $vals = shift;

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

    my $diagnosis = $vals->{diagnosis}; # original diagnosis
    my $signature = $vals->{revisedby}; # who changed it
    my $date      = $vals->{revisedate} || '0000-00-00'; # early data didn't record date
	
    my $diagnosis_map = $self->diagnosis_map;

    my $user_id = $self->_get_user_id_from_sig($signature)
        || die "Cannot find users.id for $signature";

    my $diagnosis_id = $diagnosis_map->{$diagnosis}
        || die "Cannot find diagnosis_id for $diagnosis";

    my %data = (
        request_id   => $vals->{_request_id},
        diagnosis_id => $diagnosis_id,
        user_id      => $user_id,
		reason       => 'error',
        time         => join ' ', $date, '00:00:00',
    );
    $dbh->insert('request_diagnosis_history', \%data);	
}

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

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

    my $diagnosis = $vals->{diagnosis}; # original diagnosis
    my $signature = $vals->{finalby}; # who changed it
    my $date      = $vals->{finaldate} || '0000-00-00'; # early data didn't record date
	
    my $diagnosis_map = $self->diagnosis_map;

    my $user_id = $self->_get_user_id_from_sig($signature)
        || die "Cannot find users.id for $signature";

    my $diagnosis_id = $diagnosis_map->{$diagnosis}
        || die "Cannot find diagnosis_id for $diagnosis";

    my %data = (
        request_id   => $vals->{_request_id},
        diagnosis_id => $diagnosis_id,
        user_id      => $user_id,
		reason       => 'update',
        time         => join ' ', $date, '00:00:00',
    );
    $dbh->insert('request_diagnosis_history', \%data);	
}

sub _update_request_diagnosis_with_diagnosis { # Diagnosis:
    my $self = shift;
    my $vals = shift;

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

    my $diagnosis = $vals->{diagnosis};
    my $signature = $vals->{reportby};

    my $diagnosis_map = $self->diagnosis_map;

    my $user_id = $self->_get_user_id_from_sig($signature)
        || die "Cannot find users.id for $signature";

    my $diagnosis_id = $diagnosis_map->{$diagnosis}
        || die "Cannot find diagnosis_id for $diagnosis";

    my $date = $vals->{reportdate} || '0000-00-00'; # early data didn't record date

    my %data = (
        request_id   => $vals->{_request_id},
        diagnosis_id => $diagnosis_id,
        user_id      => $user_id,
        time         => join ' ', $date, '00:00:00',
    );
    $dbh->insert('request_diagnosis_history', \%data);
}

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

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

    my $diagnosis_map = $self->diagnosis_map;

    my $diagnosis = $vals->{revisediag};
    my $signature = $vals->{revisedby};

    my $user_id = $self->_get_user_id_from_sig($signature)
        || die "Cannot find users.id for $signature";

    my $diagnosis_id = $diagnosis_map->{$diagnosis}
        || die "Cannot find diagnosis_id for $diagnosis";

    my $date = $vals->{revisedate} || '0000-00-00'; # early data didn't record date

    my %data = (
        request_id   => $vals->{_request_id},
        diagnosis_id => $diagnosis_id,
        user_id      => $user_id,
        time         => join ' ', $date, '00:00:00',
    );
    $dbh->insert('request_diagnosis_history', \%data);
}
=cut

1;