package LIMS::Model::HMRN::PrognosticIndicator;

use Moose::Role;
use Data::Dumper;

# all previous & current diagnostic categories on this patient:
has diagnostic_categories_map => (is => 'ro', isa => 'HashRef', lazy_build => 1);
# number of nodal & extranodal sites - set in prognostic_indicators():
has involved_sites => (is => 'rw', isa => 'HashRef', default => sub { {} });
# supplied by calling model class & set in prognostic_indicators()
has params_data => (is => 'rw', isa => 'HashRef', default => sub { {} });

has patient_age => (is => 'rw', isa => 'Int'); # calculated in prognostic_indicators()
has patient_id  => (is => 'rw', isa => 'Int'); # set in prognostic_indicators()
has ann_arbor   => (is => 'rw', isa => 'Str'); # calculated in ann_arbor()

sub prognostic_indicators {
    my $self = shift;
    my $args = shift;
    
    my $dbix = $self->lims_dbix;

	# set some internal params for calculations:
	my $data = $args->{params_data}; # warn Dumper $data;
	$self->params_data($data);
	
	my $patient_id = $args->{patient_id}; # warn Dumper $patient_id;	
	$self->patient_id($patient_id);	

    # set some internal params for calculations:
	{ # number of extranodal sites + nodal sites from above & below diaphragm:
        my %involved_sites = ( # initialise all 3 regions:
			upper_nodal => 0,
			lower_nodal => 0,
			extranodal  => 0,                              
        );
        
        my $anatomical_sites
            = $dbix->query('select description,location from anatomical_sites')->map;

        while ( my ($description, $location) = each %$anatomical_sites ) {
            $involved_sites{$location}++ if $data->{extramedullary}->{$description};
        } 
        $self->involved_sites(\%involved_sites); # warn Dumper \%involved_sites;
	}
	{ # need to calculate age again, as patient object not handed to model:
		my $sql = $self->sql_lib->retr('hmrn_calculate_patient_age');
		my $dates = $dbix->query($sql, $patient_id)->hash; # warn Dumper $dates;
		$self->inflate_mysql_dates_to_datetime($dates, [ qw(dob diagnosed) ]);
        
		my $age = LIMS::Local::Utils::calculate_age(@{$dates}{qw(dob diagnosed)});
        $self->patient_age($age); # warn "AGE: $age";
	} 
    
    my %indices = ();
    
    # do this 1st as some other calculated indices depend on it:
    if ( my $ann_arbor = $self->_calculate_ann_arbor ) {
        $indices{ann_arbor} = $ann_arbor;
    }
    if ( my $binet = $self->_calculate_binet ) {
        $indices{binet} = $binet;
    }
    if ( my $flipi = $self->_calculate_flipi ) {
        $indices{flipi} = $flipi;
    }
    if ( my $hipi = $self->_calculate_hipi ) {
        $indices{hipi} = $hipi;
    }
    if ( my $ipi = $self->_calculate_ipi ) {
        $indices{ipi} = $ipi;
    }
    
    return \%indices;
}

# calculate Ann-Arbor if HL, FL, DLBCL, EMZL or T-cell (ie not CLL, SMZL, MCL or HCL):
sub _calculate_ann_arbor {
    my $self = shift;
    
    my $data = $self->params_data;    
    
    # all previous & current diagnostic categories:
    my $categories_map = $self->diagnostic_categories_map; # warn Dumper $categories_map;
    
    my @AA_categories = qw( Hodgkin FL DLBCL MZL T-lymphoproliferative );
	
	my $ct  = $data->{lymphoid}->{ct} || 'N'; # avoid uninitialized error

    # Ann Arbor calc needs to be one of above, plus had a CT scan:
    return unless ( grep $categories_map->{$_}, @AA_categories )
        && $ct eq 'Y';

    my $sites = $data->{extramedullary}; # list of nodal & extranodal sites involved
    my $i = $self->involved_sites; # numerical representation of site distribution
    
    my $AA;
    
	# marrow involvement, extensive disease or > 1 extranodal site:
	if ( $sites->{marrow} || $sites->{extensive} || $i->{extranodal} > 1 ) {
	 	$AA = 'IV'; # number of nodal sites not relevant
	}
	# both upper & lower diaphragm involved:
	elsif ( $i->{upper_nodal} && $i->{lower_nodal} ) { $AA = 'III' }
	# either upper or lower diaphragm involved with > 1 group:
	elsif ( $i->{upper_nodal} > 1 || $i->{lower_nodal} > 1 ) { 
		$AA = sprintf 'II[%s]', $i->{upper_nodal} || $i->{lower_nodal};
	}
	# one group only, or no nodal involvement:
	elsif ( $i->{upper_nodal} + $i->{lower_nodal} <= 1 ) { $AA = 'I' }
	else { $AA = '[Unclassifiable - check data]' }  # presumably cocked-up the algorithm!!  
	
	$AA .= 'S' if ($sites->{spleen}); 
	$AA .= 'X' if ($sites->{bulky});
	# ? needs modifying to contiguous/proximal to nodal site:
	$AA .= 'E' if ($i->{extranodal} && $AA !~ /^IV/); # any extranodal & not already IV
	$AA .= 'B' if grep $data->{lymphoid}->{$_} eq 'Y', qw(sweats wt_loss fever);
    
	# some other calculated indices depend on this value:
    $self->ann_arbor($AA); # warn Dumper $AA;
	return $AA;
}

# calculate IPI if DLBCL or MCL + Ann-Arbor + age: 
sub _calculate_ipi {
    my $self = shift;
    
    # all previous & current diagnostic categories:
    my $categories_map = $self->diagnostic_categories_map;
    
    return unless grep $categories_map->{$_}, qw(DLBCL MCL); 
    
    my $data = $self->params_data;
    my $age  = $self->patient_age;
    my $AA   = $self->ann_arbor;
    
    my $i = $self->involved_sites; # numerical representation of site distribution
    
	my $ecog = $data->{lymphoid}->{ecog};
	my $ldh  = $data->{lymphoid}->{ldh};

	my $ipi;

    if ( $ldh && (defined $ecog) && $age &&	$AA ) { 
		my $score = 0 # add 1 for each (range 0 to 4):
			+ ( $AA =~ /^(III|IV)/ )
			+ ( $ecog > 1 )
			+ ( $ldh eq 'raised' )
			+ ( $age > 60 && $i->{extranodal} > 1 ); # only relevant > 60yr

		# works for both IPI & age-adjusted IPI, if age > 60 score cannot be 0,
		# so don't need to consider age 
		my @risk = qw/low low-intermediate high-intermediate high high/; 
		
		$ipi = sprintf "%s [%s]", $risk[$score], $score; # warn Dumper $ipi;
	}
	return $ipi;
}

# calculate HIPI if HL: 
sub _calculate_hipi {
    my $self = shift;
    
    # all previous & current diagnostic categories:
    my $categories_map = $self->diagnostic_categories_map;
    
    return unless $categories_map->{Hodgkin};
    
    my $dbix = $self->lims_dbix;

    my $sql = 'select gender FROM patients WHERE id = ?';
	my $gender = $dbix->query($sql, $self->patient_id)->list;

    my $data = $self->params_data;
    my $age  = $self->patient_age;
    my $AA   = $self->ann_arbor;
    
	my $lymph_data = $data->{lymphoid};

	my $albumin = $lymph_data->{albumin};
	my $lymphs  = $lymph_data->{lymphs};
	my $wbc = $lymph_data->{wbc};
	my $hb  = $lymph_data->{hb};

	my $hipi;

	if ( $age && $AA && $gender # plus all 4 params defined:
			&& !grep { !defined $lymph_data->{$_} } qw/hb albumin wbc lymphs/ ) {
		my $score = 0 # add 1 for each:
			+ ( $gender eq 'M')
			+ ( $age >= 45 )
			+ ( $AA =~ /^IV/ )
			+ ( $wbc > 15 )
			+ ( $hb < 10.5 )
			+ ( $lymphs < 0.6 )
			+ ( $albumin < 40 ); # = 4g/dL 

		my $risk = $score <= 2 ? 'low-risk' : 'mod/high risk';
		$hipi = sprintf "%s [%s]", $risk, $score; # CHECK THIS!!
	}
    return $hipi;
}

# calculate FLIPI if FL or diffuse FL: 
sub _calculate_flipi {
    my $self = shift;    
    
    # all previous & current diagnostic categories:
    my $categories_map = $self->diagnostic_categories_map;
    
    return unless $categories_map->{FL};
    
    my $data = $self->params_data;
    my $age  = $self->patient_age;
    my $AA   = $self->ann_arbor;

    my $i = $self->involved_sites; # numerical representation of site distribution

	my $ldh = $data->{lymphoid}->{ldh}; # warn Dumper $ldh;
	my $hb  = $data->{lymphoid}->{hb};  # warn Dumper $hb;
	my $ct  = $data->{lymphoid}->{ct} || 'N'; # avoid uninitialized error

	my $flipi;

	if ( $age && $AA && $hb && $ldh && $ct eq 'Y' ) {
		my @risk = qw(good good intermediate poor poor poor); # for scores 0 - 5 

		my $score = 0 # add 1 for each (range 0 to 5):
			+ ( $age > 60 )
			+ ( $hb < 12 )
			+ ( $ldh eq 'raised' )
			+ ( $AA =~ /^(III|IV)/ )
			+ ( $i->{upper_nodal} + $i->{lower_nodal} > 4 );

		$flipi = sprintf "%s [%s]", $risk[$score], $score; # warn Dumper $flipi;
	}
    return $flipi;
}

# BINET for CLL:
sub _calculate_binet {
    my $self = shift;
    
    # all previous & current diagnostic categories:
    my $categories_map = $self->diagnostic_categories_map;
    
    return unless $categories_map->{CLL};
    
    my $data = $self->params_data;

    my $sites = $data->{extramedullary}; # list of nodal & extranodal sites involved
    my $i = $self->involved_sites; # numerical representation of site distribution

	my $binet;

	my $plts = $data->{lymphoid}->{plts};
	my $hb   = $data->{lymphoid}->{hb};

	if ( $hb && $plts ) {
		if ($hb < 10 || $plts < 100) { $binet = 'C' }
		else { # 1 for each of neck, axillae, groin, spleen and liver (assumes CLL does not get CT scan)
			no warnings 'uninitialized'; # adding undef vals causes error
			my $sites = 0 # add numeric data:
				+ $i->{upper_nodal}
				+ $i->{lower_nodal}
				+ $sites->{liver};

			$binet = $sites >= 3 ? 'B' : 'A';
		}
	} 
    return $binet;
}

# get all previous & current diagnostic categories on this patient:
sub _build_diagnostic_categories_map {
    my $self = shift; # warn $self->patient_id;
    
    my $dbix = $self->lims_dbix;
    
	my $sql = $self->sql_lib->retr('hmrn_diagnostic_categories_map');
	my $map = $dbix->query($sql, $self->patient_id)->map;
    return $map;    
}

1;