package LIMS::Model::Outreach;

use Moose;
extends 'LIMS::Model::Base';
with (
    'LIMS::Model::Roles::Query', # get_sql_with_constraint(), sql_lib()
	'LIMS::Model::Roles::Outreach',
	'LIMS::Model::Roles::RequestUpdate', # do_history_log
);
use namespace::clean -except => 'meta';

has actions => (
    is         => 'ro',
    isa        => 'ArrayRef[Str]',
    default    => sub { [] },
    lazy    => 1,
	traits  => ['Array'],
	handles => {
		add_to_actions => 'push',
		reset_actions  => 'clear',
		all_actions    => 'elements',
	},
);
__PACKAGE__->meta->make_immutable;

use DateTime::Format::MySQL;
use LIMS::Local::Utils;
use Data::Dumper;
use DateTime;

#-------------------------------------------------------------------------------
sub get_all_data {
    my ($self, $request_id) = @_; # warn $request_id;
    
    my $dbix = $self->lims_dbix;
    
    my $request = LIMS::DB::Request->new(id => $request_id)
        ->load(with => 'patient_case');
    my $patient_id = $request->patient_case->patient_id; # warn Dumper $patient_id;

    my %data = ();    

    { # first get list of all departments, lab_tests, defaults & ranges:
        my $sql = $self->sql_lib->retr('outreach_lab_params');
        my $query = $dbix->query($sql);
        
        # get list of cols from defaults_and_ranges table:
        my $meta = $self->dbix_get_meta('outreach.defaults_and_ranges'); # warn Dumper $meta;
        my @cols = grep {
            $meta->{$_}->{key} ne 'PRI' # skip primary key
        } keys %$meta; # warn Dumper \@cols;        

        while ( my $vars = $query->hash ) {
            my $param = $vars->{param_name};
            my $dept  = $vars->{description};
            
            my %params = (
                field_label => $vars->{field_label},
                param_name  => $vars->{param_name},
                field_type  => $vars->{field_type},
                result      => undef, # initialise placeholder
            );
            
            $data{$dept}{$param} = \%params;
            
            # add any (optional) default & ranges cols:
            map {
                $data{$dept}{$param}{$_} = $vars->{$_};
            } grep $vars->{$_}, @cols;
        }        
    }
	{ # requested lab tests:
		my $sql = $self->sql_lib->retr('outreach_requested_lab_tests');
		my @lab_tests = $dbix->query($sql, $request_id)->list;
		$data{requested_lab_tests} = \@lab_tests;		
	}
    { # add lab_test results:
        my $sql = $self->sql_lib->retr('outreach_lab_results');
        my $query = $dbix->query($sql, $request_id);
        
        # get epoch value of current request for data summary:
        # my $epoch = $request->created_at->epoch; # using chart instead now
        
        while ( my $vals = $query->hash ) { 
            my $result = $vals->{result};
            my $param  = $vals->{param_name};
            my $dept   = $vals->{description};
            
            # for individual sections (haem, immunol, etc):
            $data{$dept}{$param}{result} = $result;
            # for data summary - using chart instead now:
            # $data{datasets}{$epoch}{$param}{result} = $result;
        }
        { # calculate total & abnormal B cells:
            my %h = (
                wbc => $data{haematology}{wbc}{result},
                total_b_cells => $data{flow_cytometry}{total_b_cells}{result},
                neoplastic_b_cells => $data{flow_cytometry}{neoplastic_b_cells}{result},
            );
            my $calculated = $self->calculate_flow_params(\%h);
            map { $data{calculated}{$_}{result} = $calculated->{$_} }
                keys %$calculated;
        }
    }
    { # add patient demographics data:
        my $sql = $self->sql_lib->retr('outreach_patient_demographics');
        my $demographics = $dbix->query($sql, $patient_id)->hash;
        $self->inflate_mysql_dates_to_datetime($demographics, ['dod']);
        $data{demographics} = $demographics;        
    }
    { # questionnaire:
		my $ref = { request_id => $request_id };
		{ # eq5d:
			my $tbl = 'outreach.questionnaire_eq5d';
			my $meta = $self->dbix_get_meta($tbl); # get list of cols (not PRIMARY KEY):
			my @cols = grep { $_ ne 'request_id' } keys %$meta; # warn Dumper \@cols;
			my $eq5d = $dbix->select($tbl, \@cols, $ref)->hash;
	        $data{questionnaire}{eq5d} = $eq5d;
		}
		{ # symptoms:
			my $tbl = 'outreach.questionnaire_symptoms';	       
			my $meta = $self->dbix_get_meta($tbl); # get list of cols (not PRIMARY KEY):
			my @cols = grep { $_ ne 'request_id' } keys %$meta; # warn Dumper \@cols;
			my $symptoms = $dbix->select($tbl, \@cols, $ref)->hash;
	        $data{questionnaire}{symptoms} = $symptoms;
		}
		{ # pain:
			my $tbl = 'outreach.questionnaire_pain';
			my $ary = $dbix->select($tbl, 'pain_option_id', $ref)->flat;
	        $data{questionnaire}{pain}{$_}++ for @$ary;
		}
		{ # adenopathy:
			my $tbl = 'outreach.questionnaire_adenopathy';
			my $ary = $dbix->select($tbl, 'nodal_option_id', $ref)->flat;
	        $data{questionnaire}{adenopathy}{$_}++ for @$ary;
		}
		{ # service assessment:
			my $tbl = 'outreach.questionnaire_service';
			my $service = $dbix->select($tbl, 'opinion', $ref)->hash;
	        $data{questionnaire}{service} = $service;
		}
    }
    { # follow-up data:
        my $follow_up = $self->get_followup_data($request_id);
        $data{followup} = $follow_up;        
    }
    { # patient notes:
        my @args = ( patient_id => $patient_id );
        my $data = LIMS::DB::PatientNote->new(@args)->load(speculative => 1);
        $data{demographics}{patient_notes} = $data;
    }
    # get GP's for practice:
    if ( my $practice_id = $data{demographics}{practice_id} ) {
        my $GPs = $self->get_practitioners_for_practice($practice_id);
        $data{demographics}{practitioners} = $GPs;
    }
    { # get unknown practitioner id:
        my $o = LIMS::DB::ReferralType->new(description => 'practitioner')
            ->load(with => 'unknown_referrer');
        $data{demographics}{unknown_gp_id} = $o->unknown_referrer->id;
    }
    { # non-participating practices:
        my $sql = 'select practice_id, 1 from outreach.non_participant_practice';
        my $ids = $dbix->query($sql)->map;
        $data{demographics}{non_participant_practices} = $ids;        
    }
    { # get menu options:
        my $opts = $self->get_menu_options; # warn Dumper $opts;
        $data{menu_options} = $opts; 
    } # warn Dumper \%data;
    
    return \%data;
}

# ------------------------------------------------------------------------------
# calculate absolute number of total & neoplastic B-cells; shared with C::Chart::outreach
sub calculate_flow_params {
    my $self = shift;
    my $data = shift; # warn Dumper $data;
    
    my %calculated = ();
    
    # require wbc AND total_b_cells AND neoplastic_b_cells:
    my @required = qw(wbc total_b_cells neoplastic_b_cells);
    unless ( grep { ! defined $data->{$_} } @required ) {
    	my $total_b_cell_count = $data->{wbc} * $data->{total_b_cells} / 100;
        $calculated{total_b_cells} = $total_b_cell_count;
        
        my $neoplastic_b_cell_count
            = $total_b_cell_count * $data->{neoplastic_b_cells} / 100;
        $calculated{neoplastic_b_cells} = $neoplastic_b_cell_count;
    } # warn Dumper \%calculated;
    
    return \%calculated;
}

#-------------------------------------------------------------------------------
sub get_menu_options { # get menu options - shared with C::Outreach::dfv_err()
    my $self = shift;    
    
    my $dbix = $self->lims_dbix;

	# get pain opts, nodal opts, follow-up opts:
    my $opts = $self->questionnaire_options;
	
    { # add data from menu_options table:
		my $sql = $self->sql_lib->retr('outreach_menu_options');
		my $query = $dbix->query($sql);
		
		while ( my $vars = $query->array ) {
			my ($field_name, $detail) = @$vars;
			push @{ $opts->{$field_name} }, $detail;
		} # warn Dumper $opts;
	}
    return $opts;
}

#-------------------------------------------------------------------------------
sub get_chart_results {
    my ($self, $patient_id, $field) = @_; # scalar, scalar || arrayref

    # $fields either scalar, or arrayref; need to get additional fields for
    # calculation of value if $fields either total_b_cells or neoplastic_b_cells:
    return $self->calculated_chart_results($patient_id, $field)
        if (! ref $field) && grep $field eq $_, qw(total_b_cells neoplastic_b_cells);
    
    my $dbix = $self->lims_dbix; 

    my $sql = $self->sql_lib->retr('outreach_request_results'); # warn Dumper $sql;
 
    my @bind = ref $field eq 'ARRAY' ? @$field : $field; # warn Dumper \@bind;
    my $data = $dbix->query( $sql, $patient_id, @bind )->hashes; # warn Dumper $data;
    return $data;
}

#-------------------------------------------------------------------------------
sub calculated_chart_results { # for total_b_cells or neoplastic_b_cells:
    my ($self, $patient_id, $field) = @_;    

    my $dbix = $self->lims_dbix; 

    my @fields = ( 'wbc', 'total_b_cells', 'neoplastic_b_cells' );

    my $sql = $self->sql_lib->retr('outreach_request_results');
    my $data = $dbix->query( $sql, $patient_id, @fields )->hashes; # warn Dumper $data;
    
    # create interim hash where keys = epoch seconds, vals = hashref of results:
    my %h = my %labels = (); # %labels for @calculated array
    for (@$data) { # warn Dumper $_;
        my $result = $_->{result};
        my $param  = $_->{param_name};
        my $date   = $_->{created_at};
        
        $labels{$param} = $_->{field_label};
        
        my $epoch = LIMS::Local::Utils::to_datetime_using_parsedate($date)->epoch;
        $h{$epoch}{$param} = $result; # convert to seconds to allow sort on hash
    } # warn Dumper \%h;
    
    my @calculated = (); # array of data in same format as original @$data
    
    # calculate total_b_cells & neoplastic_b_cells vals for each time-point:
    for my $key ( sort keys %h ) { # $key = epoch seconds of requests.created_at
        my $data_set = $h{$key}; # warn Dumper $set;
        my $vals = $self->calculate_flow_params($data_set); # warn Dumper $vals;
        
        # convert epoch back to date string for perlchartdir::chartTime(@date): 
        my $formatter = DateTime::Format::Strptime->new( pattern => '%F %T' );
        my $date = DateTime->from_epoch( epoch => $key, formatter => $formatter );

        my $result = $vals->{$field}; # warn Dumper $result;
        
        # recreate original @$data entries:
        my %data = (
            field_label => $labels{$field},
            created_at  => $date, # ( join ' ', $dt->ymd, $dt->hms ),
            param_name  => $field,
            result      => $result,
        ); # warn Dumper \%data;
        push @calculated, \%data;
    } # warn Dumper \@calculated;
    
    return \@calculated;
}

#-------------------------------------------------------------------------------
sub get_lab_param {
    my ($self, $param) = @_;
    
    my $o = LIMS::DB::Outreach::LabParam->new(param_name => $param)->load;
    return $o;
}

#-------------------------------------------------------------------------------
sub update_patient_questionnaire {
    my ($self, $args) = @_; # warn Dumper $args;
    
    my $request_id = $args->{request_id};
    
	# tables with 1-to-1 relationship with request.id:
    my @horizontal = qw(
        outreach_questionnaire_symptoms
        outreach_questionnaire_service
        outreach_questionnaire_eq5d
    );
	# tables with 1-to-many relationship with request.id:
	my @vertical = qw(
		outreach_questionnaire_adenopathy
		outreach_questionnaire_pain
	);
	my @all = (@horizontal,@vertical); # combined for %class_for_tbl
	
    # create hash of corresponding classes for above tables (*in same order*):
    my %class_for_tbl; @class_for_tbl{@all} = qw(
        QuestionnaireSymptoms
		QuestionnaireService
		QuestionnaireEQ5D 
        QuestionnaireAdenopathy
        QuestionnairePain
    );
    
    # get existing (1-2-1) questionnaire data for this request:
    my $data = LIMS::DB::Request->new(id => $request_id)
		->load( with => \@horizontal ); # warn Dumper $data;

    # create hashref of $data object to avoid 2nd db query when testing for accessors:
    my $h = $data->as_tree; # warn Dumper $h;
    
# use 162560 & 168625;
    my $has_array_diff = sub { LIMS::Local::Utils::get_array_diff(@_) };
    
    my $update = sub {
		# for 1-to-1 tables, if accessor exists, update it, otherwise create new:
		for my $tbl (@horizontal) { # eg outreach_questionnaire_eq5d
			if ( $h->{$tbl} ) { # exists so update it:
				my $o = $data->$tbl; # get object
				my @cols = $o->meta->column_names;
				COL: for my $col(@cols) { # warn Dumper $_;
					no warnings 'uninitialized'; # ie optional cols
					next COL if $o->$col eq $args->{$col}; # skip unchanged
					$o->$col($args->{$col}); # warn Dumper $o->as_tree;

					my $action = sprintf 'updated outreach %s from %s to %s',
						$col, $h->{$tbl}->{$col} || 'NULL', $args->{$col} || 'NULL';
					$self->add_to_actions($action);
				}
				$o->save(changes_only => 1);
			}
			else { # doesn't exist so insert new:
				my $class = 'LIMS::DB::Outreach::'.$class_for_tbl{$tbl}; # eg QuestionnairePain
				# get cols from meta data:
				my @cols = $class->new->meta->column_names; # warn Dumper \@cols;
				my %data = map +($_ => $args->{$_}),
					grep { defined $args->{$_} } # skip unless col has a value
						grep { $_ ne 'request_id' } @cols; # warn Dumper \%data;
				
				if (%data) { # if table data, add request_id & save:
					$data{request_id} = $args->{request_id};
					$data->$tbl(%data)->save;

					$tbl =~ s/_/ /g; # for history log:
                    # TODO: can't distinguish between individual tables & complete questionnaire
					$self->add_to_actions("added new $tbl dataset");
				} # else { warn "$tbl has no data" }
			} # warn Dumper $data->as_tree;
		}
		
		TBL: # 1-to-many (vertical) tables:
        for my $tbl (@vertical) { # eg outreach_questionnaire_pain
			my $class = 'LIMS::DB::Outreach::'.$class_for_tbl{$tbl}; # eg QuestionnairePain
			# get table col names from meta data:
			my @cols = $class->new->meta->column_names; # warn Dumper \@cols;
            # get existing data object:
			my $mgr = $class . '::Manager';
			my $o = $mgr->get_objects( query => [ request_id => $request_id ] );
			
            # get single non-request_id col name (only 1 for vertical tables):
            my ($col_name) = grep $_ ne 'request_id', @cols; # warn $col_name;

            # get existing data for this col:
            my @vals = map $_->$col_name, @$o; # warn Dumper \@vals;

			# ensure form data is arrayref (even if empty - for get_array_diff()):
			my $data = ref $args->{$col_name} eq 'ARRAY'
				? $args->{$col_name} # already arrayref
                : defined $args->{$col_name} # make scalar into arrayref, or create empty []
                    ? [ $args->{$col_name} ] : []; # warn Dumper $data;

            # check for changes or skip table:
            &$has_array_diff($data, \@vals) || next TBL; # warn Dumper $diff;
            
			# delete any existing rows:
			$_->delete for @$o; # warn Dumper $o;
			# add any new rows:
			$class->new( request_id => $request_id, $col_name => $_ )->save
                for @$data;
            # log change:
            $tbl =~ s/_/ /g; # for history log:
            $self->add_to_actions("updated $tbl dataset");
		}		

		$self->do_history_log({ _request_id => $request_id }); # just needs _request_id attr
	};
	
	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
    
	my $ok = $db->do_transaction($update);
    
	# don't need return value unless error:
    return $ok ? 0 : 'update_patient_questionnaire() error - ' . $db->error;    
}

#-------------------------------------------------------------------------------
sub update_followup {
    my ($self, $args) = @_; # warn Dumper $args;
    
    my $option_id  = $args->{followup_option_id}; # required
    my $request_id = $args->{_request_id};        # required
    my $return_due = $args->{return_due};         # optional
    my $pack_due   = $args->{pack_due};           # optional
    
    # get follow-up options table data:
    my $options_map = $self->followup_options_map; # warn Dumper $options_map;
    
    # get existing data for this request:
    my @tbls = qw( outreach_request_followup outreach_request_pack_dispatch );
    my $data = LIMS::DB::Request->new(id => $request_id)
        ->load( with => \@tbls ); # warn Dumper $data->as_tree;

    # outreach_request_pack_dispatch will only exist for a duration followup (eg
    # 1 month, 6 month, etc) - calling method on $data will force db lookup every time, so:
    my $has_pack_dispatch = $data->as_tree->{outreach_request_pack_dispatch}; #warn Dumper $has_pack_dispatch;
    
    # set null date to 1/1/1999: 
    my $null_date = LIMS::Local::Utils::to_datetime_using_datecalc('1/1/1999');
    
    # 1) where follow-up option has changed:
    if ( $option_id != $data->outreach_request_followup->followup_option_id ) {

        # get value of new duration (will be undef if not a duration choice):
        my $number_of_months = $self->get_followup_option_duration($option_id);
        # where new follow-up option is a duration (including '0'):
        if ( defined $number_of_months ) { # warn Dumper $number_of_months;
            # calculate new pack dispatch due date:
            my %args = (
                int  => $number_of_months,
                date => $data->created_at, # datetime object required
            );
            my $new_pack_dispatch_date
                = $self->calculate_pack_dispatch_date(\%args);

            # if existing entry in request_pack_dispatch table:
            if ( $has_pack_dispatch ) {
                my $o = $data->outreach_request_pack_dispatch;

                # update pack dispatch due date only if no pack sent:
                if (! $o->pack_sent ) {
                    $o->pack_due($new_pack_dispatch_date);
                }
                # if pack sent, adjust pack return date
                else {
                    # clone pack_sent_date so val not changed:
                    my $d = $new_pack_dispatch_date->clone; 
                    my $return_date = $self->calculate_pack_return_date($d);
                    $o->return_due($return_date);
                }
            }
            else { # else add a new request_pack_dispatch row:
                $data->outreach_request_pack_dispatch(
                    request_id => $request_id,
                    pack_due   => $new_pack_dispatch_date,
                )->save;
            }
        }
        # new follow-up not a duration - check for existing pack dispatch:
        # if pack not sent, set pack dispatch due date null
        # if pack sent, set return due date to null
        elsif ( $has_pack_dispatch ) {
            my $pack_dispatch = $data->outreach_request_pack_dispatch;
            
            # if we get here, previous follow-up decision must have been a timeline
            if ($pack_dispatch->return_due) { # pack must have been sent
                $pack_dispatch->return_due($null_date);
            }
            else { # pack not sent so due date must be future:
                $pack_dispatch->pack_due($null_date);
            }
        }
        
        { # log follow-up option change:
            my $original_option_id
                = $data->outreach_request_followup->followup_option_id;
            my $msg = sprintf 'changed outreach follow-up option from %s to %s',
                $options_map->{$original_option_id}->{label},
                $options_map->{$option_id}->{label};                
            $self->add_to_actions($msg);
        }
        
        # register the follow-up option change (AFTER changing pack_due date):
        $data->outreach_request_followup->followup_option_id($option_id);
    }
    
    # 2) elsif pack dispatch due date submitted (and follow-up option NOT changed):
    elsif ($pack_due) { # only allowed to do this if not already past pack_due date
        my $old_date = $data->outreach_request_pack_dispatch->pack_due;
        my $new_date = LIMS::Local::Utils::to_datetime_using_datecalc($pack_due);

        if ( $new_date->delta_days($old_date)->delta_days ) { # if date changed:
            $data->outreach_request_pack_dispatch->pack_due($new_date);
            # and log date change
            my $msg = sprintf 'changed pack due date from %s to %s',
                $old_date->dmy, $new_date->dmy;
            $self->add_to_actions($msg);
        }
    }
    
    # 3) elsif return_due date submitted (and follow-up option NOT changed):
    elsif ($return_due) {
        my $old_date = $data->outreach_request_pack_dispatch->return_due;
        my $new_date = LIMS::Local::Utils::to_datetime_using_datecalc($return_due);

        if ( $new_date->delta_days($old_date)->delta_days ) { # date changed:
            $data->outreach_request_pack_dispatch->return_due($new_date);
            # and log date change
            my $msg = sprintf 'changed pack return date from %s to %s',
                $old_date->dmy, $new_date->ymd;
            $self->add_to_actions($msg);
        }
    }
    
	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
    
    my $update = sub {
        $data->outreach_request_followup->save(changes_only => 1);
        if ($has_pack_dispatch) { # won't exist for a previously non-pack-dispatch entry
            $data->outreach_request_pack_dispatch->save(changes_only => 1);
        }
        
        $self->do_history_log($args); # just needs _request_id attr
    };
    
	my $ok = $db->do_transaction($update);
    
	# don't need return value unless error:
    return $ok ? 0 : 'update_followup() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_lab_params {
    my ($self, $data) = @_; # warn Dumper $data;
    
    my $request_id = $data->{_request_id};
    my $department = $data->{department}; # eg immunology
    
    my $dbix = $self->lims_dbix;

    # get lab_param => id map:
    my $sql = $self->sql_lib->retr('outreach_params_for_department');
    my $param_map = $dbix->query( $sql, $department )->map; # warn Dumper $param_map;
    
    my @cols = keys %$param_map; # warn Dumper \@cols;
    
	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $update = sub {
        PARAM: for my $col (@cols) {
            my $val = $data->{$col};
            
            my $param_id = $param_map->{$col}
                or die "$col doesn't exist in lab_params table";

            my @PK = (request_id => $request_id, param_id => $param_id);
            my $o = LIMS::DB::Outreach::RequestResult->new(@PK); # warn Dumper $o;
            if ( $o->load_speculative ) { # warn Dumper [$val, $o->result];
                if ( defined $val && defined $o->result ) { # log update if param changed:
                    next PARAM if $val eq $o->result; # skip unchanged
                    $self->add_to_actions("updated outreach $col from " . $o->result);
                }
                elsif ($val) { # new param
                    $self->add_to_actions("new outreach $col result");
                }
                elsif ($o->result) { # delete param
                    $self->add_to_actions("removed outreach $col result");
                    $o->delete;
                    next PARAM; # skip $o->result() & $o->save later in loop
                }
            }
            else { # log new dataset:                
                $department =~ s/_/ /g; # underscores => spaces
                my $action = sprintf 'input new outreach %s dataset', $department;

                $self->add_to_actions($action) # only need it once
                    unless grep $_ eq $action, $self->all_actions;
            }
            if ( defined $val ) { # in case allowing null cols in any table
                $o->result($val);
                $o->save(changes_only => 1);
            }
        }
        $self->do_history_log($data); # just needs _request_id attr
    };

	my $ok = $db->do_transaction($update);
    
	# don't need return value unless error:
    return $ok ? 0 : 'update_lab_params() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_dispatch_detail {
    my ($self, $args) = @_;
    
    my $patient_id  = $args->{patient_id};
    my $dispatch_to = $args->{dispatch_to};
    
	my $user_id = $self->user_profile->{id};

	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $update = sub {
        my $o = LIMS::DB::Outreach::PatientDispatchDetail
            ->new(patient_id => $patient_id);
        # do patient demographic history if dispatch_to changed:
        if ( $o->load_speculative && $o->dispatch_to ne $args->{dispatch_to} ) {
			my $action = sprintf q!updated 'dispatch_to' from '%s'!, $o->dispatch_to;
			my %data = (
				patient_id => $patient_id,
				user_id    => $user_id,
				action 	   => $action,
			);
            LIMS::DB::PatientDemographicHistory->new(%data)->save;
        }
        $o->dispatch_to($dispatch_to);
        $o->save(changes_only => 1); # doesn't do changes_only
    };
    
	my $ok = $db->do_transaction($update);
	
	# don't need return value unless error:
    return $ok ? 0 : 'update_dispatch_detail() error - ' . $db->error;    
}

#-------------------------------------------------------------------------------
sub get_overdue_packs {
    my $self = shift;
    my $args = shift; # optional flag to include notification events
    
    my $dbix = $self->lims_dbix;
    
    # get most recent registration date for all outreach patients:
    my $most_recent = do {
        my $sql = $self->sql_lib->retr('outreach_most_recent');
        $dbix->query($sql, 'community monitoring', 'outreach')->map; # hashref map
    };
    
    my $dfm = DateTime::Format::MySQL->new();
    
    # get all requests where return_due date < today:    
    my $requests = do {
        my $sql = $self->sql_lib->retr('outreach_overdue_packs');
        $dbix->query($sql); # AoH
    };
    
    # if outreach notification request:
    if ($args->{notifications}) { # create overdue_notification map:
        my $o = $self->get_overdue_pack_notifications(); # M::R::Outreach
        my %map = map +($_->request_id => $_), @$o;
        $self->set_notifications(%map) if %map; # warn Dumper $self->overdue_notification;
    }
    
    my @request_ids = ();    
    
    REQ: # get request_ids where return_date < today and no follow-up yet:
    while ( my $ref = $requests->hash ) { # request_id, nhs_number, pack_sent
        my $nhs_number = $ref->{nhs_number};
        my $request_id = $ref->{request_id};
        
        # skip if follow-up sample received *after* pack_sent date:
        if ( my $entry = $most_recent->{$nhs_number} ) {
            my $most_recent_date = $dfm->parse_date($entry);
            my $pack_sent_date   = $dfm->parse_date($ref->{pack_sent});

            # result of compare: -1 if $dt1 < $dt2, 0 if $dt1 == $dt2, 1 if $dt1 > $dt2
            my $val = DateTime->compare( $pack_sent_date, $most_recent_date );            
                # warn Dumper ['sent:'.$ref->{pack_sent},'back:'.$entry,'cmp:'.$val];
            next REQ if $val < 0; # ie $most_recent_date AFTER $pack_sent_date
            
            # if outreach notification request, skip if final notification sent,
            # or less overdue than next event date:
            if ( $self->has_notification_event($request_id) ) {
                next REQ if $self->skip_notification($ref);
            }
        }
        # no follow-up received for this request_id:
        push @request_ids, $request_id;
    }
    
    # get details of all requests where no follow-up sample received:
    my $data = $self->_get_overdue_packs_data(\@request_ids);
    return $data;
}

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

    my $sql = $self->sql_lib->retr('outreach_packs_due_details');
    my $query = $dbix->query($sql);
    
    my @packs;
    
	my $trim = sub { LIMS::Local::Utils::trim(@_) };
	
    while ( my $row = $query->hash ) {
        $self->inflate_mysql_dates_to_datetime($row, ['dob']);
        # re-arrange GP name:
        $row->{practitioner} = join ' ', reverse split ' ', $row->{practitioner};
		# extract post_code from practice address:
		my $post_code = ( split ',', $row->{practice_address} )[-1]; # last item
		$row->{practice_post_code} = &$trim($post_code); # warn Dumper [$post_code, &$trim($post_code)];

        # decision-tree for loading correct questionnaire & pathology request form:
        $self->_do_questionnaire_decision_tree($row); # updates $row hashref

        push @packs, $row;
    }
    
    return \@packs;
}

#-------------------------------------------------------------------------------
sub _do_questionnaire_decision_tree {
    my ($self, $vals) = @_; # warn Dumper $vals;
    
	my (%pathology, $questionnaire);
	
    my $electrophoresis = $vals->{electrophoresis};
    my $neoplastic_b    = $vals->{neoplastic_b_cells};
    
	# CML:
	if ( $vals->{icdo3} && $vals->{icdo3} =~ m!9875/3! ) {
		$questionnaire = 'cml';
		$pathology{biochem}{$_}++ for qw(u_and_e lft mg); # doesn't need immunology
	}
    # IgM paraprotein:
	elsif ( defined $electrophoresis && $electrophoresis =~ /^IgM/ ) {
		$questionnaire = 'blpd';
		$pathology{immunology}{$_}++ for qw(igs sep ppq);
	}
    # MGUS:
	elsif ( $vals->{diagnosis} =~ 'MGUS|gammopathy' ) { # can't use icdo3 - includes amyloidosis
		$pathology{immunology}{$_}++ for qw(igs sep ppq);
		
        # neoplastic-B value of zero gets MGUS questionnaire, otherwise combined:
		$questionnaire = ( defined $neoplastic_b && ! $neoplastic_b ) 
            ? 'mgus' # ie neoplastic-B result zero but not null
            : 'combined'; # warn Dumper [$ref->{neoplastic_b_cells}, $questionnaire];
	}
    # not IgM paraprotein and non-MGUS:
	else {
        # no electrophoresis:
		if ( ! defined $electrophoresis ) {
			$questionnaire = 'combined';
            $pathology{immunology}{$_}++ for qw(igs sep);
		}
        # known electrophoresis result but no paraprotein:
		elsif ( $electrophoresis =~ /^No/ ) {
			$questionnaire = 'blpd';
			$pathology{immunology}{$_}++ for qw(igs);
		}
        # any (non-IgM) paraprotein:
		else {
			$questionnaire = 'combined';
			$pathology{immunology}{$_}++ for qw(igs sep ppq);
		}
	}
	# biochem tests defined in CML block, otherwise:
	$pathology{biochem} ||= { map +($_ => 1), qw(albumin calcium creatinine) };

	$vals->{pathology} = \%pathology;
	$vals->{questionnaire}  = $questionnaire;
}

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

    my $sql = $self->sql_lib->retr('outreach_packs_due_summary');
    my $query = $dbix->query($sql);
    
    my @packs;
    
    while ( my $row = $query->hash ) {
        $self->inflate_mysql_dates_to_datetime($row, ['pack_due']);
        $self->inflate_mysql_timestamp_to_datetime($row, ['created_at']);
        push @packs, $row;
    }
    
    return \@packs;
}

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

    my $sql = $self->sql_lib->retr('outreach_pack_labels');
    
    my $data = $dbix->query($sql)->hashes;
    return $data;
}

#-------------------------------------------------------------------------------
sub report_labels {
    my ($self, $patient_ids) = @_; # arrayref of request_ids
    
    my $dbix = $self->lims_dbix;    

    my $sql = $self->sql_lib->retr('outreach_report_labels');
    
    my $data = $dbix->query($sql, @$patient_ids)->hashes;
    return $data;
}

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

    my $sql = $self->sql_lib->retr('outreach_practices');
    
    my $practices = $dbix->query($sql)->hashes;
    return $practices;
}

#-------------------------------------------------------------------------------
sub get_practice_blood_tube {
    my ($self, $practice_id) = @_;
    
    my $data
        = LIMS::DB::ReferralSource->new(id => $practice_id )
        ->load(with => 'outreach_practice_blood_tube');
    return $data;
}

#-------------------------------------------------------------------------------
sub practice_blood_tube_overrides {
	my $self = shift;
	
	my @args = (
		require_objects => 'practice',
		sort_by => 'TRIM(RIGHT(display_name, 8))', # ie post code, but ascii-numerical
	);
	my $data = LIMS::DB::Outreach::PracticeBloodTube::Manager
		->get_practice_blood_tubes(@args);
	return $data;
}

#-------------------------------------------------------------------------------
sub update_practice_blood_tube {
    my ($self, $args) = @_;
    
    my $practice_id = $args->{practice_id};
    my $tube_type   = $args->{tube_type}; # optional
    
    my $o = LIMS::DB::Outreach::PracticeBloodTube->new(practice_id => $practice_id);
    
    # if row exists, only valid action is to delete:
    if ( $o->load(speculative => 1) ) {
        $o->delete;
    }
    elsif ($tube_type) { # insert new entry:
        $o->tube_type($tube_type);
        $o->save;
    }        

    return 0;  # or could return error, but will already propagate 
}

#-------------------------------------------------------------------------------
sub update_alternate_address {
    my $self = shift;
    my $data = shift; # warn Dumper $data;
    
    my $patient_id = $data->{patient_id};
    my $post_code  = $data->{post_code};
    my $address    = $data->{address};
    
    my $o = LIMS::DB::Outreach::PatientAlternateAddress
        ->new(patient_id => $patient_id);
        
    if ( $o->load_speculative ) { # edit
        $o->address($address);
        $o->post_code($post_code);        
        $o->save(changes_only => 1);        
    }
    else { # new
        $o->address($address);
        $o->post_code($post_code);
        $o->save;
    }

    return 0;  # or could return error, but will already propagate 
}

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

    my $sql = $self->sql_lib->retr('outreach_packs_due_summary');
    # change pack_due <= CURRENT_DATE() to > CURRENT_DATE():
    $sql =~ s/<= (CURRENT_DATE)/> $1/; # warn $sql;    
    
    my @packs;
    
    my $today = LIMS::Local::Utils::time_now();

    my $query = $dbix->query($sql);
    while ( my $row = $query->hash ) {
        $self->inflate_mysql_dates_to_datetime($row, ['pack_due']);
        $self->inflate_mysql_timestamp_to_datetime($row, ['created_at']);
        { # calculate delta_days (from current_date to pack_dispatch):
            my $delta = $today->delta_days($row->{pack_due})->delta_days;
            $row->{delta_days} = $delta;
        }
        push @packs, $row;
    }
    
    return \@packs;
}

#-------------------------------------------------------------------------------
sub do_pack_dispatch {
    my ($self, $request_ids) = @_; # arrayref

	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
    
    my $today = LIMS::Local::Utils::time_now();
    
    my $return_due_date = $self->calculate_pack_return_date($today)->ymd;
    
    my $update = sub {
        for my $id(@$request_ids) {
            my $o = LIMS::DB::Outreach::RequestPackDispatch
                ->new(request_id => $id)->load;
            $o->pack_sent($today->ymd);
            $o->return_due($return_due_date);
            $o->save(changes_only => 1);

			{ # request history:
				$self->add_to_actions('dispatched CMP pack');
				$self->do_history_log({ _request_id => $id }); # just needs _request_id attr
				$self->reset_actions; #  prevent build up of actions in loop
			}
        }
    };

	my $ok = $db->do_transaction($update);
    
	# don't need return value unless error:
    return $ok ? 0 : 'do_pack_dispatch() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub do_letter_dispatch {
	my $self = shift;
	my $args = shift; # warn Dumper $args;
	
	my $request_ids = $args->{request_ids};
	my $notification_event = $args->{notification}; # 30, 60 or 90 days
	
	my $notification = LIMS::DB::Outreach::NotificationEvent
		->new(days => $notification_event)->load; # warn Dumper $notification->as_tree;

	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tx = sub {
		for my $id (@$request_ids) {
			my $o = LIMS::DB::Outreach::RequestNotification->new(request_id => $id);
			$o->event_id($notification->id); # warn Dumper $o->as_tree;
			$o->insert_or_update_on_duplicate_key; # MySQL-specific syntax - updates if primary key exists
			
			{ # request history:
				my $action = sprintf "dispatched %s day outreach notification",
					$notification_event;
				$self->add_to_actions($action);
				$self->do_history_log({ _request_id => $id }); # just needs _request_id attr
				$self->reset_actions; #  prevent build up of actions in loop
			}
		}
	};
	
	my $ok = $db->do_transaction($tx);
    
	# don't need return value unless error:
    return $ok ? 0 : 'do_letter_dispatch() error - ' . $db->error;
}	

#-------------------------------------------------------------------------------
sub get_authorised_cases_data {
    my $self = shift;
    my $date = shift; # warn Dumper $date; # hashref of date_from & date_to DateTimes
    
    my $dbix = $self->lims_dbix; 

    my $sql = $self->sql_lib->retr('outreach_authorised_between_dates');
    
    my @date_fields = qw(created_at authorised); # for inflation to DateTimes
    
    my $date_from = $date->{begin}->ymd;
    # make date_to extend to end of day - effectively 00:00:00 on following day:
    my $date_to = $date->{end}->clone->add(days => 1)->ymd; # clone, or affects tmpl
    
    my $query = $dbix->query( $sql, $date_from, $date_to ); # warn Dumper $query;   
    
    my @data;    
    while ( my $row = $query->hash ) {
        $self->inflate_mysql_timestamp_to_datetime($row, \@date_fields);
        push @data, $row; 
    }
    
    return \@data;    
}

#-------------------------------------------------------------------------------
# method shared by get_all_data & C::Outreach::edit_followup:
sub get_followup_data {
    my ($self, $request_id) = @_;
    
    my $dbix = $self->lims_dbix;

    my $sql = $self->sql_lib->retr('outreach_followup_data');
    my $data = $dbix->query($sql, $request_id)->hash;

	my $meta = $self->dbix_get_meta('outreach.request_pack_dispatch'); # warn Dumper $meta;
	my @date_fields = grep { $meta->{$_}->{type} eq 'date' } keys %$meta; # warn Dumper \@date_cols;

    $self->inflate_mysql_dates_to_datetime($data, \@date_fields);
    
    return $data;
}

#-------------------------------------------------------------------------------
sub get_diagnosis_ids {
    my $self = shift;
    
    my $dbix = $self->lims_dbix;
    
    my $ids = $dbix->query('select diagnosis_id from outreach.diagnoses')->flat;
    return $ids;    
}

#-------------------------------------------------------------------------------
sub do_history {
	my ($self, $patient_id) = @_;
	
	my @actions = $self->all_actions;
	
	my $dbix = $self->lims_dbix;

	my $user_id = $self->user_profile->{id};
	
	for my $action(@actions) {
		my %data = (
			patient_id => $patient_id,
			user_id    => $user_id,
			action 	   => $action,
		); # warn Dumper \%data;
		$dbix->insert('some_table', \%data); # request_history
	}	
}

#-------------------------------------------------------------------------------
sub get_practitioners_for_practice { # from M::Referrer::get_referrers_by_source_id
    my ($self, $source_id) = @_;
    
    my @args = (
        query => [ 'referral_sources.id' => $source_id ],
        require_objects => [
            'referrer',
            'parent_organisation.referral_source'
        ],
    );

    # use ReferrerDepartment - easier to retrieve data from object:
    my $referrers = LIMS::DB::ReferrerDepartment::Manager
        ->get_referrer_department(@args);

    my @data = map { # warn Dumper $_->as_tree;
        [ $_->referrer->id, $_->referrer->name ];
    } sort { $a->referrer->name cmp $b->referrer->name } @$referrers;
    
    return \@data;
}

#-------------------------------------------------------------------------------
# get details of all requests where no follow-up sample received:
sub _get_overdue_packs_data {
    my ($self, $request_ids) = @_;
    
    my @tables = qw(
        diagnoses patient_practices patient_gps outreach_pack_dispatches
		referral_sources
    );    
    my $relationships = $self->get_relationships(\@tables); # warn Dumper $relationships;

    my @args = (
        query => [ id => $request_ids ],
        require_objects => $relationships,
        sort_by => 'outreach_request_pack_dispatch.return_due',
    );
    my $o = LIMS::DB::Request::Manager->get_requests(@args);
    
    my $today = LIMS::Local::Utils::time_now();
    my @requests;
    
    # calculate delta_days (from return_due to current_date):
    for (@$o) {
        my $data = $_->as_tree(deflate => 0); # preserve DateTime
        { 
            my $return_due = $_->outreach_request_pack_dispatch->return_due;
            my $delta = $return_due->delta_days($today)->delta_days;
            $data->{delta_days} = $delta;
        }
        push @requests, $data;
    }

    return \@requests;
}

1;