package LIMS::Controller::HMRN;

use Moose;
BEGIN { extends 'LIMS::Base'; }
with (
    'LIMS::Controller::Roles::Misc',
    'LIMS::Controller::Roles::FormData',
);
use namespace::clean -except => 'meta';

has newly_diagnosed => (
    is => 'ro',
    isa => 'ArrayRef[LIMS::DB::Request]',
    default => sub { [] },
	lazy => 1,
    traits => ['Array'],
	handles  => {
		add_to_new_diagnoses => 'push',
        has_new_diagnoses    => 'count',
		all_new_diagnoses    => 'elements',
    },
);

has known_previous => (
    is => 'ro',
    isa => 'ArrayRef[HashRef]',
    default => sub { [] },
	lazy => 1,
    traits => ['Array'],
	handles  => {
		add_to_known_previous => 'push',
        has_known_previous    => 'count',
		all_known_previous    => 'elements',
    },
);
__PACKAGE__->meta->make_immutable(inline_constructor => 0);

use Spreadsheet::WriteExcel::Simple;
use Data::Dumper;

#__PACKAGE__->authz->authz_runmodes( ':all' => 'hmrn_admin' ); # doesn't work if not logged in

# ------------------------------------------------------------------------------
sub default : StartRunmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    my $errs = shift; # $self->stash( errs => $errs );
    
    return $self->forbidden() unless $self->user_can('hmrn_admin');
    return $self->tt_process($errs);    
}

# ------------------------------------------------------------------------------
sub new_diagnoses : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);    

    return $self->forbidden() unless $self->user_can('hmrn_admin');

    my $dfv = $self->check_rm( 'default', $self->validate('hmrn_new_diagnoses') )
        || return $self->dfv_error_page;

    my $params = $dfv->valid; # warn Dumper $params;
    
    my $cases = $self->model('HMRN')->get_new_diagnoses($params); # warn Dumper $cases;

    # split $cases into 2 categories: those with & without a known previous
    # ICDO3 diagnosis:
    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_icdo3_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;            
            my %unique # get map of unique previous diagnoses:
                = map +($_->{diagnosis} => $_->{icdo3}), @$previous_diagnoses;
            
            my %data = (
                current  => $case, # current record
                previous => \%unique, # unique previous diagnoses                
            );
            $self->add_to_known_previous(\%data);
        }
        else { # case doesn't have any previous diagnoses for this patient id
            $self->add_to_new_diagnoses($case);
        }
    }

    { # sort new_diagnoses by location then name:
        my @data = sort by_location_and_name $self->all_new_diagnoses;
        $self->tt_params( cases => \@data ); # warn Dumper \@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 (requires new_diagnoses):
    if (lc $format eq 'templates' && $self->has_new_diagnoses) {
        # get specimens map:
        my @request_ids = map { $_->id } $self->all_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 (requires new_diagnoses and/or known_previous, ie @$cases):
    elsif (lc $format eq 'export' && @$cases) {
        my $filename = sprintf 'new_diagnoses_%s.xls', DateTime->today->ymd('_');
        $self->header_props(-type => 'application/excel', -attachment => $filename, -expires => 'now');
        my $data = $self->_export_data();
        return $data;        
    }        
    else { # format = worklist, or no new diagnoses (gets 'no new diags' msg):        :
        my $from = DateTime->today->subtract( days => $params->{duration} || 7 );
        $self->tt_params( date_from => $from ); # format date for template display        
        $self->tt_params( known_previous => $self->known_previous );
        
        { # get request counts for each patient in list:
            my %patient_ids = map +($_->patient_case->patient_id => 1),
                $self->all_new_diagnoses; # warn Dumper \%patient_ids;
            if ( my @pids = keys %patient_ids ) { # warn Dumper \@pids;
                my $map = $self->model('HMRN')->get_total_request_counts(\@pids);
                $self->tt_params( request_counts => $map );
            }
        }
        return $self->tt_process; # use method default template
    }
}

# ------------------------------------------------------------------------------
sub params_config : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    return $self->forbidden() unless $self->user_can('hmrn_admin');

    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 treatment_options : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    return $self->forbidden() unless $self->user_can('hmrn_admin');
    
    my $opts = $self->model('HMRN')->get_treatment_options;
    
    $self->tt_params( opts => $opts );
    
    # vars only exist if form submitted:
    my $vars = $self->query->Vars();
    return $self->tt_process() unless %$vars; # warn Dumper $vars;
    
    my $rtn = $self->model('HMRN')->update_tx_options($vars);
    return $rtn
        ? $self->error($rtn)
        : $self->redirect_after_edit_success('/hmrn/treatment_options');
}

# ------------------------------------------------------------------------------
sub find_practice : Runmode { return shift->tt_process } # just loads tmpl

# ------------------------------------------------------------------------------
sub by_location_and_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
}

# ------------------------------------------------------------------------------
sub _export_data {
    my $self = shift; $self->_debug_path();
    
    my @known_previous = $self->all_known_previous;
    my @new_diagnoses  = $self->all_new_diagnoses;
   
    my %h; # hash so we can recombine lists in request.id order
    
    # process new diagnoses:
    for my $d (@new_diagnoses) { # warn Dumper $d;
        my $row = $self->_format_row($d);
        $h{$d->id} = $row;
    }
    # process requests with known previous diagnoses:
    REQ: for my $d (@known_previous) { # warn Dumper $d->{current};
        my $previous = $d->{previous}; # HoH of diagnosis => icdo3
        my $data     = $d->{current}; # LIMS::DB::Request object
        
        my $row = $self->_format_row($data);

        my @diagnoses = ();
        while ( my ($diagnosis, $icdo3) = each %$previous ) {
            # skip this case entirely if any previous diagnosis has same ICDO3:
            next REQ if $icdo3 eq $data->request_report->diagnosis->icdo3;
            push @diagnoses, $diagnosis; # icdo3 different so add
        }
        # add list of previous diagnoses to $row:
        push @$row, join ', ', @diagnoses;
        $h{$data->id} = $row; # add row to hash
    } 

    my $xl = Spreadsheet::WriteExcel::Simple->new;
    
    my @headers = qw(requestID ref name dob patID referrer source authorised
        unit_no nhs_no diagnosis new previous);        
    $xl->write_bold_row(\@headers);

    # write out rows in request.id order:
    $xl->write_row($h{$_}) for sort keys %h;
    
    return $xl->data; # or $xl->save("filename.xls");  
}

# ------------------------------------------------------------------------------
sub _format_row {
    my ($self, $d) = @_; $self->_debug_path();
    
    my $name = join ', ',
        uc $d->patient_case->patient->last_name,
        ucfirst $d->patient_case->patient->first_name;

    my $lab_number = join '/', $d->request_number, $d->year - 2000;

    my $auth_date = ref $d->request_history # for duplicate actions
        ? $d->request_history->[0]->time->dmy('.') # arrayref
        : $d->request_history->time->dmy('.');

    my $status = $d->request_report->status eq 'new'
        ? 'Y'
        : $d->request_report->status eq 'relapse'
            ? 'R'
            : 'N';

    my @data = (
        $d->id,
        $lab_number,
        $name,
        $d->patient_case->patient->dob->dmy('.'),
        $d->patient_case->patient_id,
        $d->referrer_department->referrer->name,
        $d->patient_case->referral_source->display_name,
        $auth_date,
        $d->patient_case->unit_number,
        $d->patient_case->patient->nhs_number,
        $d->request_report->diagnosis->name,
        $status,
    ); # warn Dumper \@data;

    return \@data;
}

1;