RSS Git Download  Clone
Raw Blame History
package LIMS::Model::Audit;

use Moose;
with (
    'LIMS::Model::Roles::DBIxSimple', # get_sql_with_constraint()
   	'LIMS::Model::Roles::QueryFormatter', # get_relationships()
);
extends 'LIMS::Model::Base';
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable;

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

#-------------------------------------------------------------------------------
sub turnaround_times {
    my $self = shift;
    my $vars = shift || {}; # will be empty on 1st call
    
    $self->params($vars);
    
	my $dbix = $self->lims_dbix;

    my $request_ids = do {
        my @attr = ('turnaround_times_id', 'time');
        my $sql = $self->get_sql_with_constraint(@attr);
        $dbix->query($sql)->flat;
    }; # warn Dumper $request_ids;
    
    my @pnh = ( 'PNH', 'PNH (PB)' );
    my @outreach = ( 'Community monitoring', 'Outreach' );
    my @molecular = ( qw/CMPD Chimerism Molec/, 'CML follow-up',
        'Follow-up CML (PB)' );

    my %data = (); # controller needs array for sorting, but easier to create hashref for 'count'
    if (@$request_ids) {
        my $entry = $self->_get_sql_lib_entry_for_selection($vars->{selection});
        my $sql = $self->sql_lib->retr($entry); # warn $sql;
        my $query = $dbix->query( $sql, @$request_ids ); # warn Dumper $query;
        
        # for calculation of delta workings days:
        my $delta_days = sub { LIMS::Local::Utils::delta_business_days(@_) };
        
        while ( my $vars = $query->hash ) {
            my $specimen = $vars->{sample_code}; # warn $specimen;
            my $screened = $vars->{description};
            
            # need to split PB's according to request:
            if ($specimen eq 'PB') {
                $specimen = 'PB [HIV]' if $screened =~ /^HIV/;
                $specimen = 'PB [PNH]' if grep $screened eq $_, @pnh;
                $specimen = 'PB [CMP]' if grep $screened eq $_, @outreach;                   
                $specimen = 'PB [Mol]' if grep $screened =~ /^$_/, @molecular;
            } # warn $screened if $specimen eq 'PB [Mol]';

            $data{$specimen}{count}++; # increment specimen count
            
            # get registered, reported & authorised dates; using DATE_FORMAT in sql
            # MUCH faster than dt conversion afterwards:
            my ($registered, $reported, $authorised)
                = @{$vars}{ qw(registered reported authorised) };
    
            # calculate registered => reported & registered => auth'ed durations:
            my $delta = &$delta_days($registered, $reported);
            $data{$specimen}{delta_report} += $delta;
            
            if ($authorised) { # if using authorisation stage
                my $delta = &$delta_days($registered, $authorised);
                $data{$specimen}{delta_authorise} += $delta;
            }
        } # warn Dumper \%data;
    }
    
    my $title = $self->constraint_title; # set in Role _set_search_constraints()

    return (\%data, $title); # return array format
}

#-------------------------------------------------------------------------------
sub nhs_number_supplied {
    my $self = shift;
    my $vars = shift || {}; # will be empty on 1st call
    
    $self->params($vars);
    
	my $dbix = $self->lims_dbix;
    my $dbh  = $self->lims_db->dbh; # warn Dumper $dbh;
    
    # exempted NHS number:
    if ( my $yaml = $self->get_yaml_file('nhs_number_exempt') ) { # warn Dumper $yaml;
        my $clinical_trials = $yaml->{clinical_trial};
        my $presentation    = $yaml->{presentation};
        
        my $screens = join ',', map $dbh->quote($_), @$presentation;
        my $trials  = join ',', map $dbh->quote($_), @$clinical_trials;
        
        $self->add_constraint( qq!s.description NOT IN ($screens)! );
        $self->add_constraint( qq!ct.trial_name NOT IN ($trials)!  );
    }
    
    my @attr = ('nhs_number_compliance', 'r.created_at');
    my $sql = $self->get_sql_with_constraint(@attr); # warn $sql;

    my $data  = $dbix->query( $sql )->hashes; # warn Dumper $data;
    my $title = $self->constraint_title; # set in Role _get_search_constraints()

    return ($data, $title); # return array format
}

#-------------------------------------------------------------------------------
sub teaching_cases {
    my $self = shift;
    my $days = shift; # default is 365
	
  	my $dbix = $self->lims_dbix;
    my $sql  = $self->sql_lib->retr('teaching_cases');
    
    my $data = $dbix->query($sql, $days)->hashes; # warn Dumper $data;
    return $data;
}

#-------------------------------------------------------------------------------
sub user_workload {
    my ($self, $args) = @_; # warn Dumper $args;
    
    my $action = $args->{action}; 
    my $days   = $args->{duration};
    my $date   = LIMS::Local::Utils::today->subtract(days => $days);
    
	my @tables = qw( sample_code request_history_user );	
	my $relationships = $self->get_relationships(\@tables);
 
    my @query = (
        action => $action,
        'request_history.time' => { ge => $date },        
    );
    
    my @args = (
        query => \@query,
        multi_many_ok => 1, # to silence warning
		require_objects => $relationships,
		sort_by => 'specimen.sample_code', # to prevent eg PB/BMAT & BMAT/PB
    );
    
    my $data = LIMS::DB::Request::Manager->get_requests(@args); # warn Dumper $data;
    return $data;
}

#-------------------------------------------------------------------------------
sub revised_diagnoses {
    my $self = shift;
    my $vars = shift || {}; # will be empty on 1st call (except sort_by)
    
    $self->params($vars);
    
	my $dbix = $self->lims_dbix;
    
    my $revisions;
    { # get revised diagnoses over duration:
        my @attrs = ('revised_diagnoses', 'dh.time', 'one_month'); # default to 1 month
        my $sql = $self->get_sql_with_constraint(@attrs); # warn $sql;    
        $revisions = $dbix->query($sql)->hashes; # warn Dumper $revisions;
    }
    
    my @request_ids = map $_->{id}, @$revisions; # before $revisions gets revised!!
    
    my %data = (
        request_ids => \@request_ids,
    );
    
    my $constraint = join ' AND ', $self->all_constraints; # set in Role::get_sql_with_constraint
    $constraint =~ s/\w+\.(\w+)/$1/; # remove alias - only have 1 table to search

    my $sql = qq!select count(*) from request_history where $constraint
        and action = 'reported'!; # warn $sql;
    
    { # get total reported over duration:
        my $total = $dbix->query($sql)->list;
        $data{total_reported} = $total;
    }
    # need to manipulate & extend $revisions data if either apply:
    if ( grep $vars->{sort_by} eq $_, qw(reporter reviser) ) {
        my $data = $self->_sort_revisions($revisions); # sort data
        $data{revisions} = $data;
        
        if ( my @usernames = keys %$data ) { # will be empty if no revisions
            my $users = LIMS::DB::User::Manager->get_users(
                query => [ username => \@usernames ]
            );
            { # add user_details to %data:
                my %user_details = map { $_->{username} => $_ } @$users;
                $data{user_details} = \%user_details;
            }
            # add user contstraint to $sql:
            $sql .= q! and user_id = ?!;
            { # need report count for each user:
                for (@$users) {
                    my $username = $_->username;
                    my $user_id  = $_->id;
                    
                    my $report_count = $dbix->query($sql, $user_id)->list;
                    $data{user_report_counts}{$username} = $report_count;
                }                
            }
        }        
    }
    else {
        $data{revisions} = $revisions;
    }
    
    my $title = $self->constraint_title; # set in Role _get_search_constraints()

    return (\%data, $title); # return array format
}

# ------------------------------------------------------------------------------
sub _sort_revisions {
    my $self = shift;
    my $data = shift; # warn Dumper $data;
    
    my $functionary = $self->params->{sort_by}; # reporter / reviser

    my %sorted;
    
    for my $event (@$data) { # warn Dumper $event;
        my $user = $event->{$functionary}; # ie reporter / reviser
        push @{ $sorted{$user} }, $event; # warn Dumper $user;
    }
    
    return \%sorted;    
}

#-------------------------------------------------------------------------------
sub _get_sql_lib_entry_for_selection { # remove this if not selecting by specimen, location, etc
    my ($self, $selection) = @_;
    
    my %t = (
        specimen => 'turnaround_times_specimen',
    );

    my $lib_entry_name = $t{$selection};
    
    # have to modify lib_entry_name if authorisation stage not in use:
    if (! $self->does_authorisation) {
        $lib_entry_name .= '_no_authorisation';
    }
    return $lib_entry_name;
}

1;