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;