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

use Moose;
extends 'LIMS::Model::Base';
with 'LIMS::Model::Roles::Query';
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;
	$args{sort_by} = $h->{sort_by} if $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 - much quicker
    # than combined query (inefficient table joins):
    if ( my $cfg = $h->{skip_reports} ) {
		my $map = $self->_print_run_excluded(\@query, $cfg); # warn Dumper $map;
		# remove excluded entries from @request_ids;
        @request_ids = grep { ! $map->{$_} } @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 (can't do this in
        # sql query as it's separated into 2 for efficiency):
		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, $query, $config) = @_; # warn Dumper [$query, $config];
	
	my @ary = ();
	
    if ( my $org_codes = $config->{organisation} ) {
        push @ary, 'parent_code' => $org_codes;
    }
    if ( my $hospitals = $config->{hospital} ) {
        push @ary, '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 @ary, [ \$sql, $site, $code ];
		}
	}    
    push @$query, ( or => [ @ary ] );
    
    my @tables = qw(parent_organisations referrer_departments request_report
        status_options);
    my $relationships = $self->get_relationships(\@tables); # warn Dumper $relationships;
    
	my @args = (
		select => [ 'id' ], # only need id's
		query  => $query,
		require_objects => $relationships,
	); # warn Dumper \@args;
	
	my $requests = LIMS::DB::Request::Manager->get_requests(@args);
	
	my %map = map { $_->id => 1 } @$requests; # warn Dumper \%map;	
	return \%map;	
}

1;