package LIMS::Model::Roles::ScreenUpdate;
use Moose::Role;
with (
'LIMS::Model::Roles::LabTestUpdate',
);
use Data::Dumper;
#-------------------------------------------------------------------------------
sub do_auto_screen {
my $self = shift;
# get hashref or required data (keys = lab_tests, presentation & trial_name):
my $auto_screen_data = $self->_get_auto_screen_data(); # warn Dumper $auto_screen_data;
return 0 unless %$auto_screen_data; # warn Dumper $auto_screen_data;
my $data = $self->form_data; # warn Dumper $data;
my $request_id = $data->{_request_id};
my $user_id = $self->user_profile->{id};
my $screen_id = 0; # set below, used in do_lab_test_details() block
# first save presentation info:
if ( my $presentation = $auto_screen_data->{presentation} ) {
my $description = $presentation->{description};
my $category = $presentation->{category};
my @args = (
query => [
description => $description,
name => $category,
],
require_objects => 'category',
);
my $screen = LIMS::DB::Screen::Manager->get_screens(@args)->[0];
$screen_id = $screen->id; # used in do_lab_test_details() block
my %data = (
request_id => $request_id,
screen_id => $screen->id,
); # warn Dumper \%data;
LIMS::DB::RequestInitialScreen->new(%data)->save;
# update request status:
$self->update_request_status('screened', $request_id);
}
# if trial name required:
if ( my $trial_name = $auto_screen_data->{trial_name} ) {
my $trial_id
= LIMS::DB::ClinicalTrial->new( trial_name => $trial_name)->load->id;
my %data = (
request_id => $request_id,
trial_id => $trial_id,
);
LIMS::DB::RequestTrial->new(%data)->load_or_insert; # in case already set in form
}
# if lab tests generated:
if ( my $lab_tests = $auto_screen_data->{lab_tests} ) { # warn Dumper $lab_tests;
while ( my($lab_test_id, $test_name) = each %$lab_tests ) {
my %data = (
_request_id => $request_id,
lab_test_id => $lab_test_id,
);
$self->do_new_lab_test(\%data);
# lab test details:
$data{screen_id} = $screen_id; # required by do_lab_test_details()
$self->do_lab_test_details(\%data);
}
}
$self->add_to_actions('screened');
}
#-------------------------------------------------------------------------------
sub additional_options {
my ($self, $action) = @_; # warn Dumper $action;
my $data = $self->form_data; # warn Dumper $data;
my $cfg = $data->{additional_options_config}->{$action} || return 0;
# get 'screened_as' description:
my $presentation = LIMS::DB::Screen->new(id => $data->{screen_id})->load;
my $screened_as = $presentation->description; # warn $screened_as;
# cycle through options to see if screened_as term triggers option flag:
while ( my($option, $d) = each %$cfg ) { # warn Dumper [$option, $d];
# check option (eg DoI) exists and is active:
my $o = LIMS::DB::AdditionalOption->new(option_name => $option)
->load(speculative => 1); # warn Dumper $o->as_tree;
return 0 unless $o && $o->is_active eq 'yes';
# set option flag if screened_as term matches one of list:
if ( grep lc($screened_as) eq lc($_), @$d ) {
my %data = (
request_id => $data->{_request_id},
option_id => $o->id,
); # warn Dumper \%data;
LIMS::DB::RequestOption->new(%data)->load_or_insert;
}
}
}
#-------------------------------------------------------------------------------
sub _get_auto_screen_data {
my $self = shift;
my $form_data = $self->form_data; # warn Dumper $form_data;
my $cfg = $form_data->{auto_screen_config}; # warn Dumper $cfg;
my $request_id = $form_data->{_request_id};
# get full request data (request, patient_case & patient tables) as a flat
# data stucture, in case we need to find any mandatory field (eg nhs_number):
my $request_data = do {
my $r = LIMS::DB::Request->new(id => $request_id)
->load(with => 'patient_case.patient')->as_tree;
LIMS::Local::Utils::traverse_hash($r); # uses Data::Traverse to flatten $r
}; # warn Dumper $request_data;
my %data = ();
# method for determining if required specimen(s) exists in supplied specimens:
my $has_specimen = sub { LIMS::Local::Utils::is_array_subset(@_) };
RULE: while ( my ($rule, $d) = each %$cfg ) { # $rule just for info - not used
# check any mandatory request/patient fields (eg nhs_number):
if ( my $required_fields = $d->{required_fields} ) {
for my $field(@$required_fields) { # warn $field;
# try to find required value in submitted form data, or else in
# request/patient_case/patient data fields:
next RULE unless $form_data->{$field} || $request_data->{$field};
}
}
my $match_criteria = $d->{match_criteria}; # HoH
# $match_criteria has 1 or more hashref entries:
while ( my ($field, $value) = each %$match_criteria ) {
# a match on specimen takes priority - may also generate trial name:
if ( $field eq 'specimen_type' ) {
my $required_specimens = $value; # always arrayref
my @supplied = split /\,\s?|\s+/, $form_data->{specimen};
# warn Dumper [$required_specimens, \@supplied];
# check required specimen(s) exists in supplied specimens, or skip to next:
next RULE if ! &$has_specimen($required_specimens, \@supplied);
}
elsif ( $field eq 'trial_name' ) {
# get trial id from form, or skip rule:
my $trial_id = $form_data->{trial_id} || next RULE;
my $trial # get trials.trial_name for trial id:
= LIMS::DB::ClinicalTrial->new(id => $trial_id)->load;
# skip rule unless submitted trial is in config:
next RULE unless $value eq $trial->trial_name;
}
else {
next RULE; # no matches
}
}
# add config presentation & trial_name fields to %data (unless already set
# from previous cycle through RULES loop, so ensure rules not inconsistent):
map { $data{$_} ||= $d->{$_} } grep $d->{$_}, qw( presentation trial_name );
# add lab tests:
if ( my $lab_tests = $d->{lab_tests} ) { # warn Dumper $lab_tests;
$data{lab_tests}{$_} = $lab_tests->{$_} for keys %$lab_tests;
}
# add lab-test details:
if ( my $lab_test_details = $d->{lab_test_details} ) {
$data{lab_test_details} = $lab_test_details;
}
} # warn Dumper \%data;
return \%data;
}
1;
