package LIMS::Controller::HMRN; use Moose; BEGIN { extends 'LIMS::Base'; } with ( 'LIMS::Controller::Roles::FormData', ); __PACKAGE__->meta->make_immutable(inline_constructor => 0); use Data::Dumper; __PACKAGE__->authz->authz_runmodes( ':all' => 'hmrn_admin' ); # ------------------------------------------------------------------------------ sub default : StartRunmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $errs = shift; # $self->stash( errs => $errs ); return $self->tt_process($errs); } # ------------------------------------------------------------------------------ sub new_diagnoses : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $dfv = $self->check_rm( 'default', $self->validate('hmrn_new_diagnoses') ) || return $self->dfv_error_page; my $params = $dfv->valid; my $cases = $self->model('HMRN')->get_new_diagnoses($params); # warn Dumper $cases; # split $cases into 2 categories: with & without known previous ICDO3 diagnosis: my @known_previous = my @new_diagnoses = (); CASE: for my $case (@$cases) { # warn Dumper $case->as_tree; my $previous_diagnoses # arrayref of diagnoses/icdo3 events for this patient id = $self->model('HMRN')->get_previous_diagnoses($case); # if previous icdo3 diagnoses, add case to @known_previous list with # array(ref) of previous diagnosis names: if (@$previous_diagnoses) { # warn Dumper $previous_diagnoses; # get map of unique previous diagnoses: my %unique = map +($_->{diagnosis} => $_->{icdo3}), @$previous_diagnoses; push @known_previous, { current => $case, # current record previous => \%unique, # unique previous diagnoses }; } else { # case doesn't have any previous diagnoses for this patient id push @new_diagnoses, $case; } } { # sort new_diagnoses by location then name: my @data = sort by_location_name @new_diagnoses; # warn Dumper \@data; $self->tt_params( cases => \@data ); } # provide an age calculation callback: $self->tt_params( calculate_age => sub { LIMS::Local::Utils::calculate_age(@_); }); my $format = $self->query->param('format'); # templates, worklist or export # templates: if ($format eq 'Templates' && @new_diagnoses) { # get specimens map: my @request_ids = map { $_->id } @new_diagnoses; # warn Dumper \@request_ids; my $specimen_map = $self->specimen_map(\@request_ids); $self->tt_params( specimen_map => $specimen_map ); # warn Dumper $specimen_map; return $self->tt_process('hmrn/data_collection.tt'); } # export: elsif ($format eq 'Export') { return $self->tt_process('hmrn/export.tt'); } # worklist, or no new diagnoses (gets 'no new diags' msg): elsif ($format eq 'WorkList' || ! @new_diagnoses) { # format date for template display: my $from = DateTime->today->subtract( days => $params->{duration} || 7 ); $self->tt_params( date_from => $from ); $self->tt_params( known_previous => \@known_previous ); return $self->tt_process; # use method default template } } # ------------------------------------------------------------------------------ sub params_config : Runmode { my $self = shift; my $categories = $self->model('HMRN')->get_categories; $self->tt_params( categories => $categories ); my $category = $self->query->param('category'); # if param_id submitted, update: if ( my @ids = $self->query->param('param_id') ) { # warn Dumper \@ids; my %args = ( category => $category, param_ids => \@ids, ); my $rtn = $self->model('HMRN')->update_category_parameter(\%args); if ($rtn) { return $self->error($rtn) } else { $self->flash(info => $self->messages('action')->{edit_success}) } } # get active params for category: if ($category) { my $params = $self->model('HMRN')->get_active_params_for_category($category); $self->tt_params( params => $params ); } return $self->tt_process; } # ------------------------------------------------------------------------------ sub by_location_name { # sort for new diagnosis list my $patient_a = $a->patient_case->patient; my $patient_b = $b->patient_case->patient; my $location_a = $a->patient_case->referral_source->display_name; my $location_b = $b->patient_case->referral_source->display_name; return $location_a cmp $location_b || $patient_a->last_name cmp $patient_b->last_name || $patient_a->first_name cmp $patient_b->first_name } 1;