• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Screen;

use Moose;

# if using 'extends', need to run at compile time to load attribute handlers
# from parent class otherwise StartRunmode, Runmode, etc fails - hack around AutoRunmode
BEGIN { extends 'LIMS::Base'; }
with (
	'LIMS::Controller::Roles::DataMap',
	'LIMS::Controller::Roles::RecordHandler',
);

# in .t: Not inlining a constructor for LIMS::Controller::Screen since it is
# not inheriting the default Moose::Object constructor - or if want to use the
# constructor from the non moose parent class:
__PACKAGE__->meta->make_immutable(inline_constructor => 0);

use Data::Dumper;

# ------------------------------------------------------------------------------
# default() should never be called direct - redirect to start page:
sub default : StartRunmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    return $self->redirect( $self->query->url );
}

# ------------------------------------------------------------------------------
sub load : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    my $errs = shift;

	return $self->forbidden() unless $self->user_can('screen');

    my $id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

    # check if request already been screened:
    if ( my $initial_screen = $self->model('Screen')->get_initial_screen($id) ) {
		my $request_history_map = $self->request_history_map($id);

        $self->tt_params(
			initial_screen  => $initial_screen,
			request_history => $request_history_map,
		);
        return $self->tt_process('screen/already_screened.tt');
    }

    $self->js_validation_profile('initial_screen');

    # load initial_screen data into tt_params:
    $self->_load_initial_screen_data($id);

    return $self->render_view('screen/load_data.tt', $errs);
}

# ------------------------------------------------------------------------------
sub do_initial_screen : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

	# attempt to re-screen request (eg back button re-submit) is an error:
    if ( my $initial_screen = $self->model('Screen')->get_initial_screen($id) ) {
		my $request_history_map = $self->request_history_map($id);

	    $self->tt_params(
            initial_screen  => $initial_screen,
            request_history => $request_history_map,
        );

        return $self->tt_process('screen/already_screened.tt');
    }

	my $dfv = $self->check_rm('load', $self->validate('initial_screen') )
	|| return $self->dfv_error_page;

    my $data = $dfv->valid;
    $data->{_request_id} = $id; # $self->debug($data);

	# get (optional) config file for auto_reportable requests:
	if ( my $cfg = $self->get_yaml_file('auto_reportable') ) {
		$data->{auto_reportable_config} = $cfg;
	}
    # get (optional) config file for additional_options:
	if ( my $cfg = $self->get_yaml_file('additional_options') ) {
		$data->{additional_options_config} = $cfg;
	}

    my $rtn = $self->model('Screen')->do_initial_screen($data);

    if (! $rtn->{success}) {
        return $rtn->{error};
    }
    else {
        $self->_process_screen_outcome($rtn); # sets flash msg
        $self->redirect( $self->query->url . '/search/=/' . $id );
    }
}

# ------------------------------------------------------------------------------
sub edit : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('screen');

	# attempt to load record before it's been screened is an error:
	my $initial_screen = $self->model('Screen')->get_initial_screen($id)
	|| return $self->error('cannot edit initial screen before record has been screened');

    my $request = $self->model('Request')->get_single_request($id);

    $self->tt_params(
        initial_screen => $initial_screen,
        request        => $request,
    );

    # load screens & screen_categories data into tt:
    $self->_load_screen_data();

	return $self->tt_process();
}

# ------------------------------------------------------------------------------
sub update : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $request_id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('screen');

	my $dfv = $self->check_rm('load', { required => 'screen_id' }  )
	|| return $self->dfv_error_page;

    my $data = $dfv->valid; # $self->debug($data);
    $data->{request_id} = $request_id;

	# now allowed to change screening term after report, but need to skip new tests:
	$data->{_skip_new_tests} = $self->query->param('_skip_new_tests');

    my $rtn = $self->model('Screen')->update_screen($data);

    if (! $rtn->{success}) {
        return $rtn->{error};
    }
    else {
        $self->_process_screen_outcome($rtn); # sets flash msg
        $self->redirect( $self->query->url . '/search/=/' . $request_id );
    }
}

# ------------------------------------------------------------------------------
# ajax function called from screening select menu:
sub screen_terms : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $screens = [];

    if ( my $category_id = $self->query->param('category_id') ) { # warn $category_id;
    	$screens = $self->model('Screen')->get_screens_for_category($category_id);
    }

    return $self->tt_process({ screens => $screens });
}

# ------------------------------------------------------------------------------
sub _load_initial_screen_data {
    my $self = shift; $self->_debug_path();
    my $id   = shift;

    # get hashref of request data & specimen map:
    my $request_data = $self->get_single_request_data($id); # $self->debug($request_data);
    # deref into list of pairs for tt_params:
    $self->tt_params($_ => $request_data->{$_}) for keys %$request_data;

    # load screens & screen_categories data into tt:
    $self->_load_screen_data();

	if ( $self->cfg('settings')->{have_request_audit} ) { # request audit data:
		my $audit_data = $self->model('RequestAudit')
            ->get_audit_options({sort_by => 'description'});
		$self->tt_params( request_audit => $audit_data );

		my $categories = $self->model('RequestAudit')
            ->get_audit_categories({sort_by => 'id'});
		$self->tt_params( audit_categories => $categories );
	}
	if ( $self->cfg('settings')->{have_haematology_data} ) { # FBC data
        my $request = $request_data->{data};
		my $haem_data = $self->model('Result')->get_haematology_data($request);
		$self->tt_params( haem_data => $haem_data );
	}
}

# ------------------------------------------------------------------------------
# load list of screens & screen_categories, sorted by category name:
sub _load_screen_data { # shared by _load_initial_screen_data() & edit()
    my $self = shift; $self->_debug_path();

    my $screens = $self->model('Screen')
        ->get_all_screens({ sort_by => 'description' });
    $self->tt_params( screens => $screens ); # warn Dumper $_->as_tree for @$screens;

    my %h; # for uniqueness
    my @unique = map $_->category, # only grep active ones:
        grep { $_->category->is_active eq 'yes' }
            grep { ! $h{$_->category->id}++ } @$screens;
        # warn Dumper $_->as_tree for @unique;
    my @categories = sort { lc $a->name cmp lc $b->name } @unique;
         # warn Dumper $_->as_tree for @categories;
    $self->tt_params( screen_categories => \@categories );
}

# ------------------------------------------------------------------------------
# generates flash message with outcome of do_initial_screen or update_screen():
sub _process_screen_outcome {
    my ($self, $data) = @_;

    my $outcome_data = $data->{outcome};

    my (@requested, @skipped);

    for (@{ $outcome_data->{requested} }) { # warn Dumper $_->as_tree;
        push @requested, [ $_->field_label, $_->lab_section->section_name ];
    }
    for (@{ $outcome_data->{skipped} }) { # warn Dumper $_->as_tree;
        push @skipped, [ $_->field_label, $_->lab_section->section_name ];
    }

    {
        my $data = {
            requested => \@requested,
            skipped   => \@skipped,
        }; # warn Dumper $data;


        my $html = $self->tt_process('screen/outcome.tt', $data);
        $self->flash( info => ${$html} );
    }

    return 1; # not expecting return value
}

1;