• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::Roles::Outreach;

use Moose::Role;
use Data::Dumper;

has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 )
	for qw(pain_options_map nodal_options_map followup_options_map);

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 );
}

#-------------------------------------------------------------------------------
sub questionnaire_options {
	my $self = shift;
	
	my %h = (
		followup_options => $self->followup_options_map,
		nodal_options    => $self->nodal_options_map,
		pain_options     => $self->pain_options_map,
	);
	return \%h;
}

#-------------------------------------------------------------------------------
# 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_pain_options_map {
    my $self = shift;
    
    my $dbix = $self->lims_dbix;

	my $sql = q!select id, `option` from outreach.pain_options!;
    my $map = $dbix->query($sql)->map;
    return $map;
}

#-------------------------------------------------------------------------------
sub _build_nodal_options_map {
    my $self = shift;
    
    my $dbix = $self->lims_dbix;

	my $sql = q!select id, `option` from outreach.nodal_options!;
    my $map = $dbix->query($sql)->map;
    return $map;
}

#-------------------------------------------------------------------------------
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;