• Files
• Commits
• Log
• Graph
• Stats

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_patient_demographics {
	my ($self, $patient_id) = @_;
	
	my $data = LIMS::DB::PatientDemographic->new(patient_id => $patient_id)
		->load( with => [ 'referrer', 'practice' ] );
	
	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
	}
	{ # 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 $t = $dbh->query("show columns from hmrn.$table")->arrays;
	# warn Dumper $t; 
	my @cols = grep { $_ ne 'patient_id' } map $_->[0], @$t;
	# 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;