• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::Chart;

use Moose;
with (
    'LIMS::Model::Roles::Query', # get_sql_with_constraint(), sql_lib()
);
extends 'LIMS::Model::Base';
use namespace::clean -except => 'meta';
__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;	
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}

# ------------------------------------------------------------------------------
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;
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}

# ------------------------------------------------------------------------------
sub get_specimen_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('specimen_frequency', 'created_at');

	my $data = $dbix->query( $sql )->arrays;
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}

# ------------------------------------------------------------------------------
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;
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}

# ------------------------------------------------------------------------------
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);	
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}

# ------------------------------------------------------------------------------
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);
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}

# ------------------------------------------------------------------------------
sub reports_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('reports_by_day_of_week', 'created_at');

	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);
    
    my @data = (); # initialise new data array
    { # need to massage AoA data into new array of ([freqs for sample types], day-name, sample_type)
        my (%h, %sample_types);
        for my $row (@$data) { # arrayref of day-name, sample_type, frequency
            my ($day, $sample_type, $f) = @$row;
            # add { sample_type => freq } hashref to %data 'day-name' key:
            $h{$day}{$sample_type} = $f; 
            $sample_types{$sample_type}++; # increment unique 'sample_type' index
        } # warn Dumper \%h;
        
        # list of days in required order: 
        my @days = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
        my @sample_types = keys %sample_types; # warn Dumper \@sample_types;
        
        for my $d(@days) {
            my $ref = $h{$d}; # hashref of { sample_type => freq } for each day
            my @ary = @{$ref}{@sample_types}; # warn Dumper \@ary; # array of frequencies
            { # calculate total number from @ary frequencies:
                my $total = 0; $total += $_ || 0 for @ary; # 0 in case $_ undef
                push @ary, $total;
            }
            push @data, [ \@ary, $d ]; # add [freqs] & day-name
        } # warn Dumper \@data;
        
        # add sample_types, one per row of @data, so they are pulled into 'points'
        # by Roles::Chart::_get_chart_data():
        for my $i (0 .. @sample_types -1) { # warn $i;
           push @{ $data[$i] }, $sample_types[$i];
        } # warn Dumper \@data;
    }
    
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return (\@data, $title);
}

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

    $self->params($vars);

	my $dbix = $self->lims_dbix;
    
    # set optional 3rd arg to 'all_data' to override default constraint_type:
    my @args = qw(requests_by_month created_at all_data);    
    my $sql = $self->get_sql_with_constraint(@args);

	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}

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

    $self->params($vars);

	my $dbix = $self->lims_dbix;
    
    # set optional 3rd arg to 'all_data' to override default constraint_type:
    my @args = qw(diagnosis_errors created_at all_data);    
    my $sql = $self->get_sql_with_constraint(@args);

	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}

#-------------------------------------------------------------------------------
sub requests_by_year {
    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_year'); # warn $sql;

	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}
    
#-------------------------------------------------------------------------------
sub specimens_by_year {
    my $self = shift;
    my $vars = shift || {}; # optional form params

    $self->params($vars);

	my $dbix = $self->lims_dbix;
    
	my $sql = $self->sql_lib->retr('specimens_by_year'); # warn $sql;
	
	my $data = $dbix->query( $sql )->arrays; # $self->debug($data);	
    my $title = $self->constraint_title; # set in Role::DBIxSimple
    
    return ($data, $title);
}
    
#-------------------------------------------------------------------------------
sub get_param_monitoring_data {
	my ($self, $args) = @_; # hashref of patient_id, lab_section & test name

	my @query = (
        section_name => $args->{lab_section},
        patient_id   => $args->{patient_id},
		test_name    => $args->{test_name}, 
    );
    my @rels = qw(
		lab_section
		request.patient_case
		request.request_lab_tests_status.lab_test
	);

    my @args = (
        query => \@query,
        require_objects => \@rels,
        sort_by => 'request.id',
    );
    
    my $data = LIMS::DB::RequestResultSummary::Manager
        ->get_request_result_summaries(@args);
        
    my @results = map {
        {
            result => $_->results_summary,
            date   => $_->request->created_at->ymd,
        }
    } @$data; # warn Dumper \@results;
    
    return \@results;	
}

1;