• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::HMRN::Data;

use Moose::Role;
requires 'patient_id';

use Data::Dumper;

# ------------------------------------------------------------------------------
# all diagnoses with ICDO3 designation for this patient (NB includes /1, /3, /6):
sub all_icdo3_diagnoses { 
    my $self = shift;
    
    my $patient_id = $self->patient_id;
    
	my @tables = qw( patients diagnoses );	
	my $relationships = $self->get_relationships(\@tables);
	
	my %args = (
		query => [
            patient_id => $patient_id,
            'request_report.diagnosis.icdo3' => { ne => undef }, # icdo3 col not null
        ],
		require_objects => $relationships,        
	);
	
	my $data = LIMS::DB::Request::Manager->get_requests(%args);
	return $data;
}

# ------------------------------------------------------------------------------
sub chronologies {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my $dbix = $self->lims_dbix;

    my $sql = q!select * from hmrn.patient_chronologies where patient_id = ?!;
    my $dates = $dbix->query($sql, $patient_id)->hash; # warn Dumper $dates;

	my $meta = $self->get_meta('hmrn.patient_chronologies'); # warn Dumper $meta;
	my @date_cols = grep {
        $meta->{$_}->{type} eq 'date'
    } keys %$meta; # warn Dumper \@date_cols;

    # convert MySQL dates to dt objects:
	$self->inflate_mysql_dates_to_datetime($dates, \@date_cols);

    $data->{chronology} = $dates; 
}

# ------------------------------------------------------------------------------
# add mdt data to chronologies:
sub mdt_dates {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my $dbix = $self->lims_dbix;

    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 ) {	# inflate 'date' val to DT object:
    	$self->inflate_mysql_dates_to_datetime($vals, ['date']);
        push @{ $data->{chronology}->{mdt_dates} }, $vals;
    }
}

# ------------------------------------------------------------------------------
sub antecedent_events {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my $dbix = $self->lims_dbix;

    { # antecedent_events:
        my $sql = q!select event_id from hmrn.patient_antecedent where patient_id = ?!;
        my $event_id = $dbix->query($sql, $patient_id)->list;
        $data->{antecedent}{event_id} = $event_id;
	}
	{	# previous radio- & chemo-therapies:
		my $sql = q!select therapy from hmrn.patient_prior_therapies where patient_id = ?!;
		my $tx = $dbix->query($sql, $patient_id)->flat; # warn Dumper $tx;
		my %data = map { $_ => 1 } @$tx; # warn Dumper \%data;
		$data->{antecedent}{prior_tx} = \%data; # part of antecedent/prior tx set
	}
}

# ------------------------------------------------------------------------------
sub treatment {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my $dbix = $self->lims_dbix;

	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; # dates to datetime:
		$self->inflate_mysql_dates_to_datetime($vals, [ qw(start_date end_date) ]);
		push @{ $data->{treatments} }, $vals; # add to treaments array
	}
}

# ------------------------------------------------------------------------------
sub data_params {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my $dbix = $self->lims_dbix;

	my $sql = $self->sql_lib->retr('hmrn_all_patient_params');
	my $query = $dbix->query($sql, $patient_id);
	while ( my $vals = $query->hash ) {
		my $param_name = $vals->{param_name};
		my $category   = $vals->{category};

		$data->{params}{$category}{$param_name} = $vals->{result};
	}
}

# ------------------------------------------------------------------------------
# which dataset(s) do we have - skip 'promiscuous' params & autoincrement category counter:
sub dataset_type {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my $dbix = $self->lims_dbix;

    my $sql = $self->sql_lib->retr('hmrn_non_unique_params');
    my @non_unique_params = $dbix->query($sql)->flat;

    my $param_data = $data->{params};

    CATEGORY: # for each category (precursor, myeloid, etc):
	while ( my($category, $ref) = each %$param_data ) {
		PARAM: # for each data param (albumin, Hb, etc):
		while ( my ($param, $result) = each %$ref ) {
			# skip any params shared by >1 category:
			next PARAM if grep $param eq $_, @non_unique_params;
			# increment category_has_data count for category:
			$data->{category_has_data}{$category}++;
		}            
    } # warn Dumper \%data_type;
}

# ------------------------------------------------------------------------------
sub staging_data {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my $dbix = $self->lims_dbix;

	my $sql = $self->sql_lib->retr('hmrn_patient_staging');
	my $list = $dbix->query($sql, $patient_id)->flat;
	$data->{params}{staging}{$_}++ for @$list;

    { # add 'staging other' text data:
        my $sql = 'select detail from hmrn.patient_staging_other where
            patient_id = ?';
        my $list = $dbix->query($sql, $patient_id)->flat;
        $data->{params}{staging}{$_}++ for @$list;       
    }
	{ # other (free-text) sites:
		my $sql = q!select details from hmrn.patient_sites_other where
			patient_id = ?!;			
		if ( $dbix->query($sql, $patient_id)->into(my $other) ) {
			$data->{params}{staging}{details} = $other;
		}
	}
}

# ------------------------------------------------------------------------------
sub comments {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my $dbix = $self->lims_dbix;
    
	my $sql = 'select * from hmrn.patient_comments where patient_id = ?';
	my $comment = $dbix->query($sql, $patient_id)->hash;
	$self->inflate_mysql_timestamp_to_datetime($comment, ['timestamp']);
	$data->{params}{comment} = $comment;
}

# ------------------------------------------------------------------------------
# calculated indices (IPI, FLIPI, HIPI, etc):
sub calculated_indices {
    my $self = shift;
    my $data = shift;

    my $patient_id = $self->patient_id;

	my %args = (
		patient_id  => $patient_id,
		params_data => $data->{params},
	); # warn Dumper $data->{params};
    
    # all calculations handled by Model::HMRN::PrognosticIndicator:
    my $indices = $self->prognostic_indicators(\%args);

	$data->{params}{indices} = $indices; # warn Dumper $indices;		
}

1;