• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::Chart;

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

has params => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
has data   => ( is => 'rw', isa => 'HashRef', default => sub { {} } );

__PACKAGE__->meta->make_immutable;

use LIMS::Local::Utils;
use Data::Dumper;

# using 'warn' requires SELECT to be uppercase to avoid dumping to apache error.log

# ------------------------------------------------------------------------------
sub get_diagnosis_frequency {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);

=begin
    my %args = (
#        query => [ 'time' => { ge => DateTime->now->year } ], # doesn't work
        group_by => 'name',
        require_objects => 'diagnosis',
    );
$self->set_rose_debug(1);    
    my $data = LIMS::DB::RequestReport::Manager->get_request_report(%args);
$self->set_rose_debug(0); 
=cut
	
	my $dbix = $self->lims_dbix;
	
    # joining request_history is deadly slow
#    $db->dbh->do( q!drop table if exists `bar`! );
#    $db->dbh->do( q!create temporary table `bar` (id INT)! );
    
#    $db->dbh->do( q!insert into bar select request_id from request_history where
#        action = 'reported' and year(time) = ?!, undef, DateTime->now->year );
    
    my $sql = $self->_get_sql_with_constraint('diagnosis_frequency', 'created_at');
    
	my $data = $dbix->query( $sql )->arrays;	
    return $data;
}

# ------------------------------------------------------------------------------
sub get_new_diagnosis_frequency {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);
	
	my $dbix = $self->lims_dbix;
	
    my $sql
        = $self->_get_sql_with_constraint('new_diagnosis_frequency', 'created_at');

	my $data = $dbix->query( $sql )->arrays;
    return $data;
}

# ------------------------------------------------------------------------------
sub get_presentation_frequency {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);

	
	my $dbix = $self->lims_dbix;
	
    my $sql
        = $self->_get_sql_with_constraint('presentation_frequency', 'created_at');

	my $data = $dbix->query( $sql )->arrays;
    return $data;
}

# ------------------------------------------------------------------------------
sub get_diagnosis_status {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);
    
	my $dbix = $self->lims_dbix;
    
    my $sql = $self->_get_sql_with_constraint('diagnosis_status', 'created_at');

	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);	
    return $data;
}

# ------------------------------------------------------------------------------
sub requests_by_day_of_week {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);

	my $dbix = $self->lims_dbix;
    
    my $sql
        = $self->_get_sql_with_constraint('requests_by_day_of_week', 'created_at');

	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);
    return $data;
}

# ------------------------------------------------------------------------------
sub requests_by_month {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);

	my $dbix = $self->lims_dbix;
    
    # set constraint_type to override default:
    my @constraints = qw(created_at all_data);
    
    my $sql = $self->_get_sql_with_constraint('requests_by_month', @constraints);

	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);
    return $data;
}

#-------------------------------------------------------------------------------
sub requests_by_request {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);

	my $dbix = $self->lims_dbix;
    
	my $sql = $self->sql_lib->retr('requests_by_request'); # warn $sql;

	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);
    return $data;
}
    
#-------------------------------------------------------------------------------
sub requests_by_specimen {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);

	my $dbix = $self->lims_dbix;
    
	my $sql = $self->sql_lib->retr('requests_by_specimen'); # warn $sql;
	
	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);	
    return $data;
}
    
#-------------------------------------------------------------------------------
sub get_param_monitoring_data {
	my ($self, $args) = @_; # hashref of patient_id, lab_section & screen term

	my $dbix = $self->lims_dbix;
	my $sql  = $self->sql_lib->retr('lab_param_monitoring_data');
	
	my @params = (
		$args->{patient_id},
		$args->{lab_section},
		$args->{presentation},
	);
	
	# return array of hashrefs in ascending date order:
	my $data = $dbix->query( $sql, @params )->hashes; # warn Dumper $data;
	
    return $data;	
}

# ------------------------------------------------------------------------------
=begin
my $type = $vars->{constraint_type};
my $method = "_build_${type}_sql";
my $sql = $self->$method($vars);
and have sub _build_lastyear_sql { ... } and such

you'll always have a constraint_type and you can dispatch by that,
e.g. simply use it to call a method named "handle_${constraint_type}_query"

the nice thing about dispatching to different methods per constraint type means
you can do things like put them into reusable roles and such
=cut

sub _get_search_constraints {
    my $self = shift;
    my $time_column = shift;
    my $default_constraint_type = shift || ''; # optional - to override return

    my $vars = $self->params;
    
    my $constraint_type # undef on 1st call, unless default set in method 
        = $vars->{constraint_type} || $default_constraint_type || ''; 
    
    my $constraint;
    
    # for checkboxes it's safe to examine $constraint_type, for textboxes &
    # selects, need to test for defined query param as it's possible to submit an
    # empty field, where constraint_type is defined but equivalent param is undef
    if ( $constraint_type eq 'all_data' ) {
        $constraint = qq!year($time_column) IS NOT NULL!; # ie everything
    }
    elsif ( $constraint_type eq 'this_year' ) {
        my $this_year = DateTime->now->year;
        $constraint = qq!year($time_column) = $this_year!;
    }
    # textboxes & select fields:
    elsif ( my $days = $vars->{days} ) { # $constraint_type eq 'days'
        $constraint = qq!$time_column between date_sub(curdate(), interval $days
            day) and curdate()!;
    }
    elsif ( my $year = $vars->{year} ) { # $constraint_type eq 'year'
        $constraint = qq!year($time_column) = $year!;
    }
    # need both 'from' & 'to' dates:
    elsif ( $vars->{date_from} && $vars->{date_to} ) { # $constraint_type eq 'date_range'
        # NB: silently fails if date is invalid:
        my $start_date = LIMS::Local::Utils::date_to_mysql($vars->{date_from});
        my $end_date   = LIMS::Local::Utils::date_to_mysql($vars->{date_to});
        
        # need to ensure no date conversion error:
        if ($start_date && $end_date) {
            $constraint = qq!$time_column between '$start_date' and '$end_date'!;
        }
    }
    
    # set default as previous calendar year (no params or invalid date):
    $constraint ||= qq!$time_column between date_sub(curdate(), interval 1 year)
        and curdate()!;
   
    return $constraint;
}

# for retrieving sql from chart.sql lib, and substituting constraint placeholder:
sub _get_sql_with_constraint {
    my $self  = shift;
    my $entry = shift; # chart.sql entry
    my $time_column = shift;
    my $default_constraint_type = shift || ''; # optional - to override return
    
    my $constraint
        = $self->_get_search_constraints($time_column, $default_constraint_type);

	my $sql = $self->sql_lib->retr($entry);
    $sql =~ s/%CONSTRAINT%/$constraint/; # warn $sql;
    return $sql;
}

1;