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

use Moose;
extends 'LIMS::Model::Base';
with 'LIMS::Model::Roles::QueryFormatter';
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable;

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

#-------------------------------------------------------------------------------
sub get_print_run_size {
	my ($self, $h) = @_; # warn Dumper $h; # hashref of start & end datetimes + optional cfg
	
	# just forward to get_print_run_request_ids and return count:
	my $ids = $self->get_print_run_request_ids($h);
	my $i = scalar @$ids; # warn $i;
	return $i;	
}

#-------------------------------------------------------------------------------
sub get_print_run_request_ids {
	my ($self, $h) = @_; # warn Dumper $h; # hashref of start & end datetimes + optional cfg
	
    my ($start_date, $end_date) = @{$h}{ qw(start_date end_date) };
	
	# set status level required for printing reports:
	my $status = $self->does_authorisation() ? 'authorised'	: 'reported';

	my @query = (
		'request_report.updated_at' => { ge_le => [ $start_date, $end_date ] },
		'status_option.description' => [ $status, 'complete' ],
	);

    my @tables = qw(request_report status_options);
    push @tables, 'referrers' if $h->{sort_by}; # only needed for sorting
    my $relationships = $self->get_relationships(\@tables);
    
	my %args = (
		select  => [ 'id' ], # only need id's        
		query   => \@query, 
		require_objects => $relationships,
	); # warn Dumper \%args;
	
	if ($h->{sort_by}) { # need to clone $h as $h->{sort_by} undergoes table
		# alias substitution in RDBO (eg referrers.name => t5.name):
		$args{sort_by} = LIMS::Local::Utils::clone($h)->{sort_by};
	}
	
	my $requests = LIMS::DB::Request::Manager->get_requests(%args);
	my @request_ids = map { $_->id } @$requests; # warn scalar @request_ids;
	return [] if ! @request_ids; # can't supply empty arrayref to _print_run_restricted()
    
	# exclude skipped locations/departments if configured:
    if ( my $cfg = $h->{skip_reports} ) { # quicker than a combined query:
		my %args = (
			request_ids => \@request_ids,
			sort_by     => $h->{sort_by}, # still need to sort by referrer name
			config      => $cfg,
		);
		my $ids = $self->_print_run_excluded(\%args); # warn scalar @$ids;
		# remove excluded ids from @request_ids;
        my %h = map { $_ => 1 } @$ids; # warn Dumper \%h;
        @request_ids = grep { ! $h{$_} } @request_ids; # warn scalar @request_ids;
	} # warn scalar @request_ids;
    
    return \@request_ids unless defined $h->{offset}; # can be zero    
    
	{ # return subset of request_ids if offset & limit supplied:
		my $min   = $h->{offset}; # eg 0, 100, 200
		my $total = $h->{limit}; # 50
        
        my $max = $min + $total; # ie offset + limit
        if ( $max > scalar @request_ids ) { # adjust if $max > array size:
            $max = scalar @request_ids; 
        } # warn Dumper [$min, $max];
        $max -= 1; # adjust for array position eg 0 .. 49, 50 .. 99, etc
        
        my @subset = @request_ids[$min .. $max]; # warn scalar @subset;
        return \@subset; 
	}
}

#-------------------------------------------------------------------------------
# get print-run request.id's for any excluded locations:
sub _print_run_excluded {
	my $self = shift;
	my $args = shift;
	
	my $request_ids = $args->{request_ids};
	my $sort_by     = $args->{sort_by};
	my $config      = $args->{config};
	
	my @locations = ();
	
    if ( my $org_codes = $config->{organisation} ) {
        push @locations, 'parent_code' => $org_codes;
    }
    if ( my $hospitals = $config->{hospital} ) {
        push @locations, 'organisation_code' => $hospitals;
    }
	if ( my $departments = $config->{department} ) { # warn Dumper $departments;
		for (@$departments) {
			my ($site, $code) = split '/'; # warn Dumper [$site, $code];
			my $sql = # can't be done in QueryBuilder - patch needed
				sprintf q!(%s = ? AND hospital_department_code = ?)!,
					length $site > 3 # 4 or more chars will be organisation code:
						? 'organisation_code'
						: 'parent_code'; # warn Dumper $sql;
			push @locations, [ \$sql, $site, $code ];
		}
	}
    my @tables = qw(parent_organisations);
    push @tables, defined $sort_by
        ? 'referrers' : 'referrer_departments'; # referrers only required for sorting
    my $relationships = $self->get_relationships(\@tables); # warn Dumper $relationships;
    
	my @args = (
		select => [ 'id' ], # only need id's
		query  => [
            id => $request_ids,
            or => [ @locations ],
        ],
		require_objects => $relationships,
	); # warn Dumper \@args;
	push @args, ( sort_by => $sort_by ) if $sort_by; # warn Dumper \@args;
	
	my $requests = LIMS::DB::Request::Manager->get_requests(@args);
	
	my @request_ids = map { $_->id } @$requests; # warn Dumper \@request_ids;	
	return \@request_ids;	
}

1;