• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Local::Labels;

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

use base 'LIMS::Base';

use IO::Socket;

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

use MooseX::AttributeHelpers;

has labels => (
	is  => 'ro',
	isa => 'ArrayRef[HashRef]',
	default => sub { [] },
	lazy => 1,
	metaclass => 'Collection::Array',
	provides  => {
        push  => 'add_to_labels',
    }, 
);

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

use Data::Dumper;

# ------------------------------------------------------------------------------
sub default : StartRunmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	# get label_type from query param, or complain:
	my $label_type = $self->query->param('label_type')
	|| return $self->error( 'no label_type provided at '
	   . $self->get_current_runmode );
	
	# check method exists or return error:
	unless ( UNIVERSAL::can($self, $label_type) ) {
		return $self->error( qq!no method  "$label_type" found at !
		. $self->get_current_runmode );
	}
	
	# forward to required method to generate data for template:
	my $data = $self->forward($label_type);
    $self->tt_params( labels => $data );
	
	return $self->render_view('worklist/local/labels/'.$label_type.'.tt', {});
}

# ------------------------------------------------------------------------------
sub histology_staining : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	# get lab_test details:
	my $lab_test = $self->get_lab_test_for_unique_test_name('haematoxylin_eosin')
	|| 	# have to die as default() caller doesn't handle err rtn: 
	die 'test_name = "haematoxylin_eosin" either not found, or is not unique';
	
	{ # get requests where test status is not complete:
		my %args = (
			status_option_id => 1, # if we need to restrict to status = 'new'
			lab_test_id      => $lab_test->id,
			fetch_only       => [ 'request' ], # don't need all cols from model 
		);
		
		my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);	
		return $data;
	}
}

# ------------------------------------------------------------------------------
sub immunohistology_panels : 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; # warn Dumper \@lab_test_ids;
	
	{ # get requests where test status is not complete:
		my %args = (
#			status_option_id => 1, # if we need to restrict to status = 'new'
			lab_test_id      => \@lab_test_ids,
			fetch_only       => [ 'request' ], # don't need all cols from model 
		);
	
		my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);
		return $data;
	}
}

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

	my @request_ids = $self->query->param('request_id'); # warn Dumper \@request_ids;

	# if ! @request_ids, don't return via rm or may get loop if arrived via timeout:
	unless (@request_ids) {
		return $self->redirect(
			$self->query->url . '/local_labels?label_type=immunohistology_panels'
		);
	}

	my $yaml = $self->get_yaml_file('print_labels'); # warn Dumper $yaml;

	# get panel defs from immunohistology_panels section of yaml config:
	my $panels = $yaml->{immunohistology_panels}->{panels}; # warn Dumper $panels;
	
	# some tests don't require labels:
	my $skip_tests = $yaml->{immunohistology_panels}->{skip_tests};

    # how many blank labels required:
    my $blank_labels = $yaml->{immunohistology_panels}->{blank_labels};
    
	# get map of request_id => test_name(s):
	my $request_lab_test_map = $self->_get_request_test_name_map(\@request_ids);

	# just need request, investigation_name(s) & patient data on request_ids:
	for my $id (@request_ids) { # don't sort - need original submission order
		my $o = $self->model('Request')->get_patient_and_request_data($id);
            # $self->debug( [$o->request_number, $o->year] );
		my %d = (
			request => $o->as_tree(max_depth => 0), # only want base object data
			patient => $o->patient_case->patient->as_tree, # don't need dt object			
		);

		# get list of tests/panels for this request:
		my $investigations = $request_lab_test_map->{$id};

		# for each test/panel, calculate how many labels of each type required:
		TEST:
		for my $test (@$investigations) {
			next TEST if grep $test eq $_, @$skip_tests; # skip unwanted tests
			
			# if test_name is in the yaml cfg (ie it's a panel), add 1 label for
			# each label_list entry:
			if ( my $label_list = $panels->{$test} ) {
				for my $lbl (@$label_list) { # warn Dumper $lbl;
					my $data = $self->_format_label_data(\%d, $lbl);
					$self->add_to_labels($data);
				}                
                { # add blank labels:
                    my $blank = $self->_format_label_data(\%d); # omit label title
                    $self->add_to_labels($blank) for (1 .. $blank_labels);
                }        
                { # add 1 negative:
                    my $neg = $self->_format_label_data(\%d, 'NEG');
                    $self->add_to_labels($neg);
                }
			}
			else { # probably individual test:
				my $label = $self->_format_label_data(\%d, $test);
				$self->add_to_labels($label);
                { # add 1 blank:
                    my $blank = $self->_format_label_data(\%d); # omit label title
                    $self->add_to_labels($blank);
                }        
			}
		}
	} 

    # do print_labels function:
    my $rtn = $self->_do_print_labels();
	# return error if method rtn value:
    return $self->error($rtn) if $rtn;
	
	# set flash message:
	$self->flash( info => $self->messages('worklist')->{print_labels_ok} );
	
	{ # make hash of request_id's for template:
		my %done = map { $_ => 1 } @request_ids;
		$self->tt_params( done => \%done );
	}
	
    return $self->forward('default');
}

# ------------------------------------------------------------------------------
sub print_histology_staining_labels : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my @request_ids = $self->query->param('request_id'); # warn Dumper \@request_ids;	
	
	# if ! @request_ids, don't return via rm or may get loop if arrived via timeout:
	unless (@request_ids) {
		return $self->redirect(
			$self->query->url . '/local_labels?label_type=histology_staining'
		);
	}
	
	# get specimen_map for request_ids:
	my $specimen_map = $self->specimen_map(\@request_ids);
	
	my $yaml = $self->get_yaml_file('print_labels'); # warn Dumper $yaml;
	
	# get specimen_type defs from histology_staining section of yaml config:
	my $specimen_regex = $yaml->{histology_staining}->{specimen_types};
		# warn Dumper $specimen_regex;

	# just need request, specimen & patient data on request_ids:
	for my $id (sort @request_ids) {
		my $o = $self->model('Request')->get_patient_and_request_data($id);

		my %d = (
			request => $o->as_tree(max_depth => 0), # only want base object data
			patient => $o->patient_case->patient->as_tree, # don't need dt object			
		);

		my $specimen = $specimen_map->{$id}->{sample_code};
		
		# for each request_specimen, calculate how many labels of each type required:
		while ( my ($sample_code_regex, $label_list) = each %$specimen_regex ) {
			SPECIMEN:
			for my $sample_code (@$specimen) { # warn $sample_code;
				next SPECIMEN unless $sample_code =~ /$sample_code_regex/;
				# send request/patient data & label name to _format_label_data():
				for my $lbl (@$label_list) { # warn Dumper $lbl;
					my $data = $self->_format_label_data(\%d, $lbl);
					$self->add_to_labels($data);
				}
			}	
		}
	}
	
    # do print_labels function:
    my $rtn = $self->_do_print_labels();
	# return error if method rtn value:
    return $self->error($rtn) if $rtn;
	
	# set flash message:
	$self->flash( info => $self->messages('worklist')->{print_labels_ok} );
	
	{ # make hash of request_id's for template:
		my %done = map { $_ => 1 } @request_ids;
		$self->tt_params( done => \%done );
	}
	
    return $self->forward('default');
}

# ------------------------------------------------------------------------------
sub _do_print_labels {
    my $self = shift; $self->_debug_path();
	
	my $labels = $self->labels; # warn Dumper $labels;

	my $peer_addr =
        $ENV{LOCALHOST_SOCKET} # print to a localhost socket for testing
            ? 'localhost'
            : $self->cfg('settings')->{label_printer_addr};
        
	$peer_addr || return 'no setting for label printer address found in config file';
	
    my $socket = new IO::Socket::INET(
        PeerAddr => $peer_addr,
        PeerPort => 9100,
        Proto 	 => 'tcp',
		Timeout  => 10,
    ) || return 'could not create socket: ' . $!;
    
    # need to shift 1st item from @data to format 1st label: 
    my $first_label = shift @$labels;

    my %first_label_data = (
		labno => $first_label->{labno},
		name  => $first_label->{name},
		label => $first_label->{label},
	);
	
	# process label.tt template:
	my $label_body = do {
		$self->tt_process('worklist/local/labels/label.tt', \%first_label_data);
	};

	# send 1st label to printer:
	print $socket ${$label_body}; # deref
	
    # (R)eplace 'labno', 'name' & 'label' params for rest of labels:
    for my $next_label (@$labels) { # warn Dumper $next_label;
		for my $field( qw/labno name label/ ) { # eg R LABEL;Giemsa R LABNO;H1/10 etc
			print $socket sprintf "R %s;%s\n", uc $field, $next_label->{$field};
		}
		print $socket "A 1\n"; # print 1 label each
    }

    close $socket;
	
	return 0; # as caller expects only errors returned
}

# ------------------------------------------------------------------------------
sub _format_label_data {
	my $self  = shift; $self->_debug_path();
	my $data  = shift; # hashref
	my $label = shift || ''; # warn $label; # can be blank for controls
	
	# need lab_no, patient name & label name:
	my $name  = ucfirst $data->{patient}->{last_name}; # truncate if too long
	my $labno = sprintf 'H%s/%s',
		$data->{request}{request_number}, $data->{request}{year} - 2000;
	
	my %data = (
		name  => $name,
		labno => $labno,
		label => $label,
	);
	
	return \%data;
}

# ------------------------------------------------------------------------------
sub _get_request_test_name_map {
	my ($self, $request_ids) = @_; $self->_debug_path();
	
	my %args = (
		section_name => 'Immunohistochemistry',
		request_id   => $request_ids,
	);
	
	my $o = $self->model('LabTest')->get_request_lab_tests_status_for_section(\%args);
	
	my %map;
	for my $data (@$o) {
		my $request_id = $data->request_id;
		my $test_name = $data->lab_test->test_name;
		
		push @{ $map{$request_id} }, $test_name;
	} # warn Dumper \%map;
	
	return \%map;
}

1;