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 { $a->name cmp $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;