package LIMS::Model::Roles::Outreach; use Moose::Role; use Data::Dumper; has followup_options_map => ( is => 'ro', isa => 'HashRef', lazy_build => 1 ); has overdue_notification => ( is => 'ro', isa => 'HashRef[LIMS::DB::Outreach::RequestNotification]', default => sub { {} }, lazy => 1, traits => ['Hash'], handles => { set_notifications => 'set', get_notification_event => 'get', has_notification_event => 'exists', }, ); has notification_events => ( is => 'ro', isa => 'ArrayRef[Str]', lazy_build => 1, traits => ['Array'], handles => { all_events => 'elements', get_event => 'get', # final_event => 'pop', # can't do this in a loop !! }, ); use Lingua::EN::Words2Nums; #------------------------------------------------------------------------------- sub do_outreach_request_pack_dispatch { my ($self, $data) = @_; my $request_id = $data->{_request_id}; my $followup_option_id = $data->{followup_option_id}; { # request_followup table: my @args = ( followup_option_id => $followup_option_id, request_id => $request_id, ); LIMS::DB::Outreach::RequestFollowup->new(@args)->save; } my $number_of_months = $self->get_followup_option_duration($followup_option_id); if ( defined $number_of_months ) { my $request = LIMS::DB::Request->new(id => $request_id)->load; my %args = ( int => $number_of_months, date => $request->created_at, # requires datetime object ); my $pack_dispatch_date = $self->calculate_pack_dispatch_date(\%args); my %data = ( request_id => $request_id, pack_due => $pack_dispatch_date, ); LIMS::DB::Outreach::RequestPackDispatch->new(%data)->save; } } #------------------------------------------------------------------------------- sub get_followup_option_duration { my ($self, $option_id) = @_; my $options_map = $self->followup_options_map; my $followup_durations = $self->followup_durations_map; my $followup_option_name = $options_map->{$option_id}->{option}; # eg six_month my $int = $followup_durations->{$followup_option_name}; # eg 0, 3, 6, etc return $int; } #------------------------------------------------------------------------------- sub calculate_pack_dispatch_date { # returns datetime object my $self = shift; my $args = shift; my $date = $args->{date}; # datetime object my $int = $args->{int}; # number of months my $dispatch_due_date = $date->clone # registration date (clone to be safe) ->add(months => $int) # + no. of months ->subtract(days => 14); # - 14 days return $dispatch_due_date; } #------------------------------------------------------------------------------- sub calculate_pack_return_date { # returns datetime object my ($self, $ref_date) = @_; # datetime object # return date = pack dispatch date + 1 month: my $return_date = $ref_date->clone->add(months => 1); # clone otherwise updates orig!! return $return_date; } #------------------------------------------------------------------------------- sub followup_durations_map { my $self = shift; my $opts = $self->followup_options_map; # get list of 'option' col: my @follow_up_opts = map $opts->{$_}->{option}, keys %$opts; # warn Dumper \@follow_up_opts; my %map; for my $option (@follow_up_opts) { if ( $option =~ /(\w+)_month/ ) { my $num = words2nums($1); # warn Dumper $num; $map{$option} = $num if defined $num; # could be zero } } # warn Dumper \%map; return \%map; } #------------------------------------------------------------------------------- sub get_overdue_pack_notifications { my $self = shift; my $o = LIMS::DB::Outreach::RequestNotification::Manager ->get_request_notifications( require_objects => 'event' ); return $o; } #------------------------------------------------------------------------------- # skip notification if final notification already sent, or less overdue than next event date: sub skip_notification { my ($self, $data) = @_; my $today = LIMS::Local::Utils::time_now(); my $dfm = DateTime::Format::MySQL->new(); my $notification_event = $self->get_notification_event($data->{request_id}); my $pack_sent_date = $dfm->parse_date($data->{pack_sent}); my $event_id = $notification_event->event_id; my $prev_event = $notification_event->event->days; # most recent notification my $next_event = $self->get_event($event_id) || 0; # works due to array pos my $final_event = $self->get_event(-1); # last entry in events list my $delta_days = $pack_sent_date->delta_days($today)->delta_days; # warn Dumper [$delta_days, $prev_event, $next_event, $final_event]; return ( $prev_event == $final_event || $delta_days < $next_event ); } #------------------------------------------------------------------------------- # method shared by C::Outreach::edit_followup & M::Outreach (get_menu_options & update_followup) sub _build_followup_options_map { my $self = shift; my $dbix = $self->lims_dbix; my $sql = 'select `id`, `label`, `option` from outreach.followup_options'; my $options = $dbix->query($sql)->map_hashes('id'); return $options; } #------------------------------------------------------------------------------- sub _build_notification_events { my $self = shift; my $dbix = $self->lims_dbix; my $sql = 'select `days` from outreach.notification_events order by id'; my $o = $dbix->query($sql)->flat; # warn Dumper $o; return $o; } 1;