package LIMS::Model::HMRN;

use Moose;
extends 'LIMS::Model::Base';
use namespace::clean -except => 'meta';

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

# ------------------------------------------------------------------------------
sub has_data {
    my ($self, $patient_id) = @_; # warn $patient_id;
    
	my $dbix = $self->lims_dbix;
    
    # minimum data set for hmrn is mdt or chronology:
    for ( qw/chronologies mdt_dates/ ) {
        my $tbl = 'hmrn.patient_' . $_;        
        return 1 if $dbix->query( "SELECT 1 FROM $tbl WHERE patient_id = ?",
            $patient_id )->list;
    }
    return 0;
}

# ------------------------------------------------------------------------------
sub get_all_hmrn_data {
    my ($self, $patient_id) = @_; # warn $patient_id;
    
	my $dbix = $self->lims_dbix;
    
    # switch db:
    # $dbix->dbh->do('use hmrn'); # needs reversing or get fatal error downstream
    
    my $hmrn_data = {};
    
    { # chronologies:
        my $sql = q!select * from hmrn.patient_chronologies where patient_id = ?!;
        my $dates = $dbix->query($sql, $patient_id)->hash; # warn Dumper $dates;
        
        my $cols = $self->_get_cols('patient_chronologies'); # warn Dumper $cols;
        
        # convert MySQL dates to dt objects:
        my %data = map {
            $_ => DateTime::Format::MySQL->parse_date($dates->{$_})
        } grep $dates->{$_}, @$cols; # warn Dumper \%data;
        
        # provide an age calculation callback:
        $data{calculate_age} = sub {
            LIMS::Local::Utils::calculate_age(@_);
        };
        
        $hmrn_data->{chronology} = \%data; 
    }
    { # add mdt data to chronologies:
        my $sql = q!select id, date from hmrn.patient_mdt_dates where 
            patient_id = ? order by date!;
        my $dates = $dbix->query($sql, $patient_id);
        while ( my $vals = $dates->hash ) {
            my $dt = DateTime::Format::MySQL->parse_date($vals->{date});
            my $data = { id => $vals->{id}, date => $dt };
            push @{ $hmrn_data->{chronology}->{mdt_dates} }, $data;
        }
    }
	{ # antecendent event data:
		my $sql = q!select event_id from hmrn.patient_antecedent where patient_id = ?!;
		my $event_id = $dbix->query($sql, $patient_id)->list;
		$hmrn_data->{antecedent}{event_id} = $event_id;
	}
	{	# get previous therapies:
		my $sql = q!select radiotherapy, chemotherapy from
			hmrn.patient_prior_therapies where patient_id = ?!;
		my $tx = $dbix->query($sql, $patient_id)->hash; # warn Dumper $tx;
		$hmrn_data->{antecedent}{prior_tx} = $tx; # part of antecedent/prior tx set
	}
	{ # treatment details:
		my $sql  = $self->sql_lib->retr('hmrn_patient_treatment_data');
		my $tx = $dbix->query($sql, $patient_id);
		while ( my $vals = $tx->hash ) { # warn Dumper $vals;
			map { # dates to datetime:
				$vals->{$_} = DateTime::Format::MySQL->parse_date($vals->{$_})
			} grep $vals->{$_}, qw(start_date end_date); # warn Dumper $vals;

			push @{ $hmrn_data->{treatments} }, $vals; # add to treaments array
		}
	}
    { # get select option maps:
		my $select_option_data = $self->_get_select_option_data();
		$hmrn_data->{maps} = $select_option_data;
	}
	
	return $hmrn_data;
}

#-------------------------------------------------------------------------------
sub get_new_diagnoses {
	my $self = shift;
	my $args = shift;
	
    # get HMRN parent organisation ids:
    my $o = LIMS::DB::LocalNetworkLocation::Manager->get_local_network_locations;
    my @parent_organisation_ids = map { $_->parent_id } @$o;	
	
	# get referral_type.id for practices (saves multi_many_ok flag in query):
	my $ref_type = LIMS::DB::ReferralType->new(description => 'practice')->load;

	my @query = (
		'request_history.action' => 'authorised',
		or => [ # any network hospital or GP practice:
			'parent_organisations.id' => \@parent_organisation_ids,
			'parent_organisations.referral_type_id' => $ref_type->id, # GP's
		],		
		or => [ # ICDO3 or MGUS diagnoses:
			'request_report.diagnosis.icdo3' => { like => '%3' },
			'request_report.diagnosis.icdo3' => '9765/1', # MGUS
		],
	);
	
	{ # calculate requested duration (previous_week, days, date_range, etc):
		my $constraints = $self->_get_hmrn_new_diagnoses_constraints($args);
		push @query, @$constraints;
	}
	
	my @tables = qw( patients diagnoses parent_organisations request_history
		referrers );	
	my $relationships = $self->get_relationships(\@tables);

	my @params = (
		query => \@query,
		require_objects => $relationships,
	);	
	
	my $cases = LIMS::DB::Request::Manager->get_requests(@params);
	
	return $cases;
}

# ------------------------------------------------------------------------------
sub get_patient_demographics {
	my ($self, $patient_id) = @_;
	
	my $data = LIMS::DB::PatientDemographic->new(patient_id => $patient_id)
		->load( with => [ 'referrer', 'practice' ], speculative => 1 );
	
	return $data;
}

# ------------------------------------------------------------------------------
sub is_in_outreach {
	my ($self, $patient_id) = @_;
	
	my $dbix = $self->lims_dbix;
	
	my $sql = 'select 1 from outreach.dispatch_details where patient_id = ?';
	return $dbix->query( $sql, $patient_id )->list;	
}

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

	my %maps = ();
	
	{ # locations:
		my $locations = $dbix->query(q!select location,id from hmrn.locations!)->map;
		$maps{location} = $locations;
	}
	{ # antecedent events:
		my $antecedent
			= $dbix->query(q!select event,id from hmrn.antecedent_events!)->map;
		$maps{antecedent} = $antecedent;
	}
	{ # treatment types:
		my $tx_types
			= $dbix->query(q!select description,id from hmrn.treatment_types!)->map;
		$maps{tx_type} = $tx_types;
	}
	{ # treatment details:
		my $tx_details
			= $dbix->query(q!select * from hmrn.treatment_details order by description!)->hashes;
		$maps{tx_detail} = $tx_details; # array(ref) of hashes
		# get unique type_ids from treatment_details:
		my %type_ids = map { $_->{type_id} => 1 } @$tx_details;
		$maps{tx_type_ids} = [ keys %type_ids ]; # warn Dumper \%type_ids;
	}
	{ # treatment reponses:
		my $meta = $self->_get_meta('patient_treatment')->{response}->{type};
		my ($enum) = $meta =~ /enum\((.*)\)/; # warn $enum;
		my @opts = sort grep { $_ =~ s/\'//g } split ',', $enum; # warn Dumper \@opts;
		$maps{response} = \@opts;
	}
	
    return \%maps;
}

sub _get_cols {
	my ($self, $table) = @_;
	
	my $dbh = $self->lims_dbix;
	
	my $meta = $self->_get_meta($table); # warn Dumper $meta;
	
	my @cols = keys %$meta; # warn Dumper \@cols;
	return \@cols;
}

sub _get_meta {
	my ($self, $table) = @_;
	
	my $dbh = $self->lims_dbix;
	
	my $t = $dbh->query("show columns from hmrn.$table")->hashes; # warn Dumper $t;
	
	my %meta = map {
		$_->{field} => $_,
	} @$t; # warn Dumper \%meta;
	
	return \%meta;
}

1;