• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Local::Worklist; # only ucfirst or need an entry in Dispatch

# provides methods for local worklists - requires entry in config/.local/worklists.yml

use base 'LIMS::Base';

use Moose;
with (
	'LIMS::Controller::Roles::Misc',
	'LIMS::Controller::Roles::History',
	'LIMS::Controller::Roles::DataMap',
	'LIMS::Controller::Roles::DataFile',
);

use Data::Dumper;

__PACKAGE__->meta->make_immutable(inline_constructor => 0);

# ------------------------------------------------------------------------------
sub default : StartRunmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	# get function_name from query param, or return to start (in case user cleared menu):
	my $function_name = $self->query->param('function_name')
	|| return $self->redirect( $self->query->url . '/worklist' );
	
	# check method exists or return error:
	unless ( UNIVERSAL::can($self, $function_name) ) {
		return $self->error( qq!no method  "$function_name" found at !
		. $self->get_current_runmode );
	}
	
	# process method - all tmpl data handled in method
	do{ $self->$function_name }; # don't need rtn value - returns 0 if no hits
    #    or return $self->error($function_name.'() did not return a true value');

	# use render_view to override default template name:
	my $tmpl = 'worklist/local/'.$function_name.'.tt';
	return $self->render_view($tmpl, {});
}

# ------------------------------------------------------------------------------
# collects outstanding data from flow_screen table, for fresh tissue samples only
# formats request number in '%02d_%05d' format
# 
sub pre_screen : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	# optional list of lab-tests
	my @param = $self->query->param('param'); # warn Dumper \@param;
	
	{ # get data for flow screen panels:
        # need to supply list of lab_test id's to model:
        my $lab_test_names = @param
			? \@param
			: $self->get_yaml_file('pre_screen_panel'); # warn Dumper $lab_test_names;

		# hash map for tt:
		my %included_lab_tests = map +($_ => 1), @$lab_test_names;
		$self->tt_params( included_lab_tests => \%included_lab_tests );

        my $lab_tests = do {
            my %args = (
                section_name => 'Flow cytometry',
                test_name    => $lab_test_names, # arrayref           
            );            
            $self->model('LabTest')->get_section_lab_tests(\%args);
        }; # warn Dumper $lab_tests;
		my @lab_test_ids = map { $_->id } @$lab_tests;        
        return 1 unless @lab_test_ids; # or will get error in downstream model
        
		# get outstanding flow screen investigations:
        my $args = { lab_test_id => \@lab_test_ids };
        my $flow_screen_data # arrayref:
			= $self->model('WorkList')->get_outstanding_investigations($args);

		# parse flow screen data for template (returns hashref or undef):
		if ( my $data = $self->_parse_flow_screen_data($flow_screen_data) ) {
			# get a list of unique request_ids
			my $unique_ids = $self->get_unique_ids($flow_screen_data);
			
			{ # get specimen_map for template:					
				my $map = $self->specimen_map($unique_ids);
				$self->tt_params( specimen_map => $map );		
			}
			{ # get section notes for flow cytometry section:
				# stash section object for request_section_notes_map():
				my $lab_section	= $self->model('LabSection')
					->get_lab_section_by_name('Flow cytometry');
				$self->stash( lab_section => $lab_section );
				my $map = $self->request_section_notes_map($unique_ids);
				$self->tt_params( request_section_notes_map => $map );
			}
			{ # haematology data:
				my @requests = keys %$data; # warn Dumper \@requests;
				my $o = $self->model('Result')->get_multiple_haem(\@requests);
				for ( @$o ) { # warn Dumper $_->as_tree;
					my $lab_number = $_->lab_number; # 	warn Dumper $data;
					$data->{$lab_number}{haematology} = $_->as_tree;
				}
			}
			$self->tt_params( flow_screen_data => $data );				
		}		
	}
	
	# get unregistered data from pre_registration tables:
	my $cases = $self->model('Local')->get_unregistered_requests;
	if (@$cases) {
		$self->tt_params( unregistered_cases => $cases );		
		
		my @prereg_specimen_ids;
		{ # get list of pre_registration_specimen.id's from $cases:
			for my $case (@$cases) { # warn Dumper $case->as_tree;
				my $pre_registration_specimen = $case->pre_registration_specimen;
				foreach my $reg_specimen (@$pre_registration_specimen) {
					push @prereg_specimen_ids, $reg_specimen->id;
				}
			} # warn Dumper \@prereg_specimen_ids;
		}
		
		# get map of lab_tests for unregistered requests (if any):
        if (@prereg_specimen_ids) {
            my $lab_tests_map = $self->model('Local')
                ->get_unregistered_request_lab_tests(\@prereg_specimen_ids);
            $self->tt_params( unregistered_request_lab_tests => $lab_tests_map );
            # warn Dumper $lab_tests_map;
        }
	}
    
	return 1;
}

# ------------------------------------------------------------------------------
sub haem_data : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    my @args = ('RequestHaematology', { query => [ status => 'default' ] } );
    my $data = $self->model('Base')->get_objects(@args);
    
	{ # haem data, converted from sysmex to real values:
		my @haem = map $_->as_tree(deflate => 0), @$data; # extract data as hashrefs
    
		# massage haem data - convert params from sysmex to real (far too slow in tt):
		$self->_parse_haem_data(\@haem); # also adds param_flags & param_fields for tt
		$self->tt_params( haem_data => \@haem );
	}
	{ # lab_number (nn_nnnnn) => request.id map:
		my @lab_numbers = map $_->lab_number, @$data; # warn Dumper \@lab_numbers;
		my $map = $self->model('Request')
			->get_request_id_from_lab_number(\@lab_numbers);
		$self->tt_params( requestId_map => $map );
	}
    return 1;
}

# ------------------------------------------------------------------------------
sub gross_description : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my $id = $self->param('id');
	
	if ($id) { # update request_gross_description table & redirect back to worklist:
		my $vars = $self->query->Vars; # warn Dumper $vars;
		$vars->{request_id} = $id; # warn Dumper $vars;
		
		my $rtn = $vars->{detail} # just return error if no data submitted:
			? $self->model('Local')->update_gross_description($vars) # rtn 0 OR $err
			: $self->messages('worklist')->{no_data_submitted};
		
		# any $rtn is an error, otherwise update success:
		my $msg = $rtn || $self->messages('action')->{edit_success};
		my $f = $rtn ? 'error' : 'info'; 
		$self->flash( $f => $msg );
		
		my $addr = 'local_worklist?function_name=gross_description';
		# this works as we arrived direct to rm, not via default() using function_name param:
		return $self->redirect( $self->query->url . '/' . $addr );
	}
	
	# get list of unreported cases which still require gross-description:
	my $requests = $self->model('Local')->get_outstanding_gross_description;
	$self->tt_params( requests => $requests );
	return 1;
}

# ------------------------------------------------------------------------------
sub histology_processing : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	# name of test for this worklist:
	my $test_name = 'cut_up';
	
	return $self->_format_lab_test_data($test_name);
}

# ------------------------------------------------------------------------------
sub histology_blocks : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my $data = $self->model('WorkList')->get_outstanding_histology_blocks;
	{ # create hash of year => $data:
		my %h;
		for (@$data) {
			my $yr = $_->request->year;
			push @{ $h{$yr} }, $_;
		};
		$self->tt_params( requests => \%h );
	}
	
	# get a list of unique request_ids, return if empty:
	my $request_ids = $self->get_unique_ids($data); # warn Dumper $request_ids;	
	return 0 unless @$request_ids;
	
	{ # get specimen_map for requests:
		my $specimen_map = $self->specimen_map($request_ids);
		$self->tt_params( specimen_map => $specimen_map );
	}
	{ # create map of request_id => block_ref for tmpl:
		my %block_refs = map { $_->request_id => $_->external_reference } @$data;
		$self->tt_params( block_refs_map => \%block_refs );
	}

	return 1;
}

# ------------------------------------------------------------------------------
sub histology_staining : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	# name of test for this worklist:
	my $test_name = 'haematoxylin_eosin';
	
	return $self->_format_lab_test_data($test_name);
}

# ------------------------------------------------------------------------------
sub immunohistochemistry : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	# get list of lab_tests for immunohistochemistry secion:
	my %args = (
		section_name => 'Immunohistochemistry',
	);
	
	my $lab_tests = $self->model('LabTest')->get_section_lab_tests(\%args);
	
	my @lab_test_ids = map { $_->id } @$lab_tests;
	my @field_labels = map { $_->field_label } @$lab_tests;
	
	# get requests where test status is not complete:
	my $data = $self->model('WorkList')
		->get_outstanding_investigations({ lab_test_id => \@lab_test_ids });
	$self->tt_params( requests => $data );

	# get a list of unique request_ids, return if empty:
	my $request_ids = $self->get_unique_ids($data); # warn Dumper $request_ids;	
	return 0 unless @$request_ids;
	
	{ # get specimen_map for requests:
		my $specimen_map = $self->specimen_map($request_ids);
		$self->tt_params( specimen_map => $specimen_map );
	}

	{ # get lab_test history for tests:
		my %args = (
			request_ids => $request_ids,
			field_label => \@field_labels, # history table uses field label
		);
		my $lab_test_status_map
			= $self->lab_test_status_for_field_label_map(\%args);
		$self->tt_params( lab_test_status_map => $lab_test_status_map );
	}	

	return 1;
}

# ------------------------------------------------------------------------------
sub fish_worksheets : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    # get lab_section object for FISH:
    my $lab_section =
        $self->model('LabSection')->get_lab_section_by_name('FISH');
    
    my $sort_order = $self->query->param('sort_by') || ''; # optional
    
    my %args = ( # includes possible args accepted by model method:
        lab_section_id => $lab_section->id,
        sort_by        => $sort_order,
        
        fetch_only => undef,
        lab_test_id => undef,
        lab_number_from => undef,
        status_option_id => undef,      
    );
    
    my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);
    $self->tt_params( data => $data );
    
    { # get some data maps for tmpl:
		my $unique_ids = $self->get_unique_ids($data); # arrayref of request_ids
		
		{ # specimens:
			my $map = $self->specimen_map($unique_ids);
			$self->tt_params( specimen_map => $map );		
		}
		{ # request_options:
			my $map = $self->request_options_map($unique_ids);
			$self->tt_params( request_options_map => $map );
		}
    }
    
    return 1;
}

# ------------------------------------------------------------------------------
sub outreach_pack_forms : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	my $data = $self->model('Outreach')->get_packs_due_details;
	$self->tt_params( packs => $data );
    
    { # callback for blood-tube-type:
        my $_self = $self; weaken $_self;
        $self->tt_params( tube_type => sub { $_self->get_blood_tube_type(@_) } );
    }
    
    return 1;
}

# ------------------------------------------------------------------------------
sub outreach_pack_labels : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	my $data = $self->model('Outreach')->pack_labels;
	$self->tt_params( addresses => $data );
    
    return 1;
}

# ------------------------------------------------------------------------------
# looks for outreach cases where no new sample received by return due date
sub outreach_outstanding : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	my $data = $self->model('Outreach')->get_overdue_packs; # warn Dumper $data;
	$self->tt_params( requests => $data );
    
    return 1;
}

# ------------------------------------------------------------------------------
sub outreach_notifications : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	my $data # use same model as outreach_outstanding() but include flag:
        = $self->model('Outreach')->get_overdue_packs({ notifications => 1 });
	$self->tt_params( requests => $data ); # warn Dumper $requests;
	
	# callback to extract GP surname (split $_[0] on space, return 1st element):
	my $referrer = sub { (split(' ', shift))[0] };
	$self->tt_params( get_referrer_surname => $referrer );
	
    return 1;
}

# ------------------------------------------------------------------------------
sub outreach_notification_dispatch : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);    
	return $self->outreach_notifications(); # uses same data & tt params (except callback)
}

# ------------------------------------------------------------------------------
sub outreach_report_labels : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    return 1; # requires date input - function handled by Outreach controller
}

# ------------------------------------------------------------------------------
sub outreach_pack_dispatch : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	my $data = $self->model('Outreach')->get_packs_due_summary;
	$self->tt_params( packs => $data );
    
    return 1;
}

# ------------------------------------------------------------------------------
sub outreach_packs_future : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	my $data = $self->model('Outreach')->get_packs_due_future;
	$self->tt_params( packs => $data );
    
    return 1;
}

# ------------------------------------------------------------------------------
sub _format_lab_test_data {
	my ($self, $test_name) = @_; $self->_debug_path();
	
	# get lab_test:
	my $lab_test = $self->get_lab_test_for_unique_test_name($test_name)
	|| 	# have to die as default() caller doesn't handle err rtn: 
	die "test_name = '$test_name' either not found, or is not unique";
	
	# get requests where test status is not complete:
	my $data = $self->model('WorkList')
		->get_outstanding_investigations({ lab_test_id => $lab_test->id });
	$self->tt_params( requests => $data );

	# get a list of unique request_ids, return if empty:
	my $request_ids = $self->get_unique_ids($data); # warn Dumper $request_ids;	
	return 0 unless @$request_ids;
	
	{ # get specimen_map for requests:
		my $specimen_map = $self->specimen_map($request_ids);
		$self->tt_params( specimen_map => $specimen_map );
	}
	
	{ # get lab_test history for test:
		my %args = (
			request_ids => $request_ids,
			field_label => $lab_test->field_label, # history table uses field label
		);
		my $lab_test_status_map
			= $self->lab_test_status_for_field_label_map(\%args);
		$self->tt_params( lab_test_status_map => $lab_test_status_map );
	}	

	{ # get test results:
		my %args = (
			request_id     => $request_ids,
			lab_section_id => $lab_test->lab_section_id,
		); 
		my $results_map # may return empty, so default is empty hashref:
			= $self->get_lab_test_results_for_lab_section(\%args) || {};
		$self->tt_params( results_map => $results_map ); # warn Dumper $results_map;
	}
	
	return 1;
}

# ------------------------------------------------------------------------------
# need labno, sample type, last_name, flow_details & array of lab-test data for
# flow screen section for each entry in $flow_data:
sub _parse_flow_screen_data {
    my ($self, $flow_screen_data) = @_; $self->_debug_path();
	
	my $data; # hashref to hold parsed flow screen data
	
	REQUEST: # foreach request in $flow_screen_data:
	for my $request( @$flow_screen_data ) {
		# create lab_number in '%02d_%05d' format:
		my $lab_number = sprintf '%02d_%05d',
			$request->request->year - 2000,
			$request->request->request_number;
		
		# get lab-test data:
		my %lab_test_data = (
			name   => $request->lab_test->test_name,
            user   => $request->user->as_tree,
			status => $request->status->description,
		);
		
		# if lab_tests attr exists from any previous loop, just add new lab-test data:
		if ( my $lab_test_data = $data->{$lab_number}->{lab_tests} ) {
			push @$lab_test_data, \%lab_test_data;
			next REQUEST;
		}
		# create arrayref structure for lab_test_data, for re-use in any future loop:
		$data->{$lab_number}->{lab_tests} = [ \%lab_test_data ];
		$data->{$lab_number}->{request_id} = $request->request->id;
		$data->{$lab_number}->{patient}
			= $request->request->patient_case->patient->as_tree;
	}
	
	return $data;
	# my @data = map { $_->as_tree(deflate => 0) } @$data; # preserve datetime
}

sub _parse_haem_data {
    my ($self, $data) = @_; # warn Dumper $data; # AoH
    
    my @fields = qw( wbc rbc hb plt hct mcv mch mchc lymph_percent lymph
        mixed_percent mixed neutr_percent neutr );
    
    my $flag = {}; # hashref of params with flags
    my $NULL = qr{[*0]000}; # *000 or 0000
    
    for my $d(@$data) {
        my $lab_number = $d->{lab_number};

        PARAM: for my $f(@fields) {
            my $flag_field = sprintf '%s_f', $f; # eg hb_f, wbc_f, mixed_f, etc
            # add row param to $flag if <param>_f > 0, or param value = *000 or 0000:
            $flag->{$lab_number}{$f}++ if $d->{$flag_field} || $d->{$f} =~ /^$NULL\Z/;
            next PARAM if $d->{$f} =~ /^$NULL\Z/; # don't calculate, just report param 

            # adjust sysmex params to 'real' values:
            if ( $f eq 'rbc' ) {
                $d->{rbc} = sprintf '%.2f', $d->{rbc} / 100; # rbc to 2dp eg 0277 => 2.77
            }
            elsif ( grep $f eq $_, qw/hb plt mchc/ ) {
                $d->{$f} = $d->{$f} / 1; # convert to int eg 0080 => 80, 0277 => 277
            }
            else { # convert to 1dp eg 0080 => 8.0, 0277 => 27.7
                $d->{$f} = sprintf '%.1f', $d->{$f} / 10;
            }
        }
    } # warn Dumper \%flag;

    $self->tt_params(
        param_fields => \@fields,
        param_flags  => $flag,
    );
}

1;