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 $constraint = $self->_get_search_constraints('created_at');
my $sql = qq!
SELECT count(*) as f, name
FROM request_report t1
join diagnoses t2 on (t1.diagnosis_id = t2.id)
WHERE icdo3 is not null
and $constraint
and status = 'new'
GROUP BY t2.id
ORDER BY f desc
LIMIT 20!; # warn $sql; # much faster if group by = t2.id not t1.diagnosis_id
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 $constraint = $self->_get_search_constraints('created_at');
my $sql = qq!
SELECT
COUNT(*) as f,
if ( status = 'default', 'follow-up', status )
FROM request_report
WHERE $constraint
GROUP BY status
ORDER BY f desc!; # warn $sql; # order by for control of color order
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 $constraint = $self->_get_search_constraints('created_at');
my $sql = qq!
SELECT count(*) as f,
dayname(created_at)
FROM requests
WHERE $constraint
GROUP BY dayname(created_at)
ORDER BY dayofweek(created_at)!; # warn $sql;
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 $constraint = $self->_get_search_constraints('created_at','all_data');
my $sql = qq!
SELECT count(*) as f,
concat(year, '_', date_format(created_at,'%b'))
FROM requests
WHERE $constraint
GROUP BY year,month(created_at)
ORDER BY year,month(created_at) !; # 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;
}
1;
