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

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

use base 'LIMS::Base';
use Data::Dumper;
$Data::Dumper::Terse = 1;

use IO::Socket;

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

has labels => (
	is  => 'ro',
	isa => 'ArrayRef[HashRef]',
	default => sub { [] },
	lazy => 1,
	traits => ['Array'],
	handles  => {
        add_to_labels => 'push',
        count_labels  => 'count',
    },
);

has formats => (
    is      => 'ro',
    isa     => 'HashRef',
    builder => '_build_formats',
    lazy    => 1,
    traits  => ['Hash'],
    handles => {
        get_format    => 'get',
        format_exists => 'exists'
      },
);

sub _build_formats {
    return {
        #default format
        label => { fields => [qw/labno name label/], no_of_labels => 1 },

        cell_selection_worklist => {
            fields       => [qw/labno lastname sampletype labtest/],
            no_of_labels => 5
        }
    };
}

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


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

	# get label_type from query param, or return to start (in case user cleared menu):
	my $label_type = $self->query->param('label_type')
	|| return $self->redirect( $self->query->url . '/worklist' );

	# 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 (H&E and H&E/Giemsa):

    my @lab_test_ids = map {
        $self->get_lab_test_for_unique_test_name($_)->id;
    } qw( haematoxylin_eosin h_and_e_giemsa ); # warn Dumper \@lab_test;

    # have to die as default() caller doesn't handle err rtn:
	@lab_test_ids == 2 || die 'expected test_names either not found, or not unique';

	{ # get requests where test status is not complete:
        my %args = ( # don't supply status_option_id, forces model to load id <> 2
			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 immunohistology_panels : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
    return $self->forward('_ihc_tests'); # don't restrict on status option
}

# ------------------------------------------------------------------------------
sub dako_link : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
    return $self->forward('_ihc_tests', { status_option => 'new' });
}

# ------------------------------------------------------------------------------
sub do_ulisa : 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=dako_link'
		);
	}

	my $yaml = $self->get_yaml_file('print_labels')
		|| return $self->error('no config file found'); # warn Dumper $yaml;
	my $config = $yaml->{dako_link};

	# get immunohistology panel lab-tests:
	my $panels = $self->_get_immunohistology_panel_lab_tests(); # warn Dumper $panels;

	# some tests don't require labels:
	my $skip_tests = $config->{skip_tests}; # warn Dumper $skip_tests;

	# 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
		); # warn Dumper \%d;

		# get list of tests/panels for this request:
		my $investigations = $request_lab_test_map->{$id}; # warn Dumper $investigations;
		# for each test/panel, calculate how many labels of each type required:

		TEST:
		for my $ref (@$investigations) { # warn Dumper $ref; # lab_test href
            my $test_name = $ref->{test_name};
			next TEST if grep $test_name eq $_, @$skip_tests; # skip unwanted tests

            if ( $ref->{test_type} eq 'test' ) {
                push @{ $d{lab_test} }, $ref;
            } # if test_type = panel, get list of individual lab-tests (AoH):
            elsif ( my $panel_lab_test = $panels->{$test_name} ) {
                push @{ $d{lab_test} }, $_ for @$panel_lab_test;
            } # not test, and can't find panel:
            else { die "no lab-tests found for $test_name panel" }
		} # warn Dumper \%d;
        # add 1 negative label (ficticious lab_test_id = 000): # discontinued 01/2018
        # push @{ $d{lab_test} }, { test_id => '000', test_name => 'NEG' };

        my $rtn = $self->send_xml(\%d); # C::R::ULISA
        # return error if method rtn value:
        return $self->error($rtn) if $rtn;
	}

	# set flash message:
	$self->flash( info => $self->messages('worklist')->{dako_link_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 dna_quantification : Runmode {
    return shift->_get_quantification_data('dna_quantification');
}

# ------------------------------------------------------------------------------
sub rna_quantification : Runmode {
    return shift->_get_quantification_data('rna_quantification');
}

# ------------------------------------------------------------------------------
sub _get_quantification_data {
	my ($self, $test_name) = @_; $self->_debug_path($self->get_current_runmode);

    my $lab_test_id = $self->get_lab_test_for_unique_test_name($test_name)->id;

	# get requests where test status is not complete:
    my %args = ( # don't supply status_option_id, forces model to load id <> 2
		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 print_lab_section_labels : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

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

    my $specimen_map = $self->specimen_map(\@request_ids); # warn Dumper $specimen_map;

	for my $id (@request_ids) {
		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
		);

		my $specimens = $specimen_map->{$id}->{sample_code}; # arrayref
		for my $sample_code (@$specimens) {
            my %h = ( data => \%d, label => $sample_code );
			my $label = $self->_format_label_data(\%h);
			$self->add_to_labels($label);
		}
	}
    # do print_labels function:
    my $rtn = $self->_do_print_labels(); # only returns error condition
    if ($rtn) {
        $self->flash( error => $rtn );
    }
    else {
        my $msg = $self->messages('worklist')->{print_labels_ok};
        $self->flash( info => $msg );

        # store request_ids in session:
        $self->session->param( lab_section_labels => \@request_ids );
    }
	my $addr = $self->query->param('query_string'); # warn $addr;
	return $self->redirect( $addr );
}

# ------------------------------------------------------------------------------
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')
		|| return $self->error('no config file found'); # warn Dumper $yaml;
	my $config = $yaml->{immunohistology_panels};

	# get immunohistology panel lab-tests:
	my $panels = $self->_get_immunohistology_panel_lab_tests(); # warn Dumper $panels;

	# some tests don't require labels:
	my $skip_tests = $config->{skip_tests};

	# 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}; # warn Dumper $investigations;

		my $blank_label = do {
            my %h = ( data => \%d, label => undef ); # don't need a title
            $self->_format_label_data(\%h);
        };

		# for each test/panel, calculate how many labels of each type required:
		TEST:
		for my $ref (@$investigations) {
            my $field_label = $ref->{field_label};
            my $test_name   = $ref->{test_name};
			next TEST if grep $test_name eq $_, @$skip_tests; # skip unwanted tests

            if ( $ref->{test_type} eq 'test' ) {
                my %h = ( data => \%d, label => $field_label ); # warn $field_label;
				my $label = $self->_format_label_data(\%h);
				$self->add_to_labels($label);
                if ( my $n = $config->{test_blank_labels} ) { # add blanks:
                    $self->add_to_labels($blank_label) for (1 .. $n);
                }
            }
            # if test_name is in panel_lab_test (ie it's a panel), add 1 label
			# for each label_list entry:
            elsif ( my $panel_lab_test = $panels->{$test_name} ) {
                for my $t (@$panel_lab_test) { # warn Dumper $t; # lab-test href
                    my %h = ( data => \%d, label => $t->{field_label} );
					my $data = $self->_format_label_data(\%h);
					$self->add_to_labels($data);
				}
                { # add 1 negative:
                    my %h = ( data => \%d, label => 'NEG' );
                    my $neg = $self->_format_label_data(\%h);
                    $self->add_to_labels($neg);
                }
                if ( my $n = $config->{panel_blank_labels} ) { # add blank labels:
                    $self->add_to_labels($blank_label) for (1 .. $n);
                }
			}
            else { die "no lab-tests found for $test_name panel" }
		}
	}

    # do print_labels function:
    my $rtn = $self->_do_print_labels(); # only returns error condition
    if ($rtn) {
        $self->flash( error => $rtn );
    }
    else {
	    my $msg = $self->messages('worklist')->{print_labels_ok};
        $self->flash( info => $msg );
    	# 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;
	my $name_format = $yaml->{histology_staining}->{name_format}; # override default format

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

        # common fields for _format_label_data (label name added inside loop):
        my %label_data = ( data => \%d, name_format => $name_format );

		# 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 & name_format to _format_label_data():
				for my $lbl (@$label_list) { # warn Dumper $lbl;
                    $label_data{label} = $lbl; # update label name
                    my $data = $self->_format_label_data(\%label_data);
					$self->add_to_labels($data);
				}
			}
		}
	}

    if ( not scalar @{ $self->labels } )
    {    # give up if there are no labels to print
        $self->flash(
            warning => $self->messages('worklist')->{print_labels_none} );
    }
    else {
        # do print_labels function:
        my $rtn = $self->_do_print_labels();

        if ($rtn) {
            $self->flash( error => $rtn );
        }
        else {
            my $msg = $self->messages('worklist')->{print_labels_ok};
            $self->flash( info => $msg );
            # 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_xna_extraction_labels : Runmode {
    my $self = shift;

    my $vars = $self->query->Vars(); # warn Dumper $vars;

    # retrieve data from session (param = xna_extraction_request_specimen):
    my $data = $self->session->param('xna_extraction_request_specimen');
        # warn Dumper $data;

    my %request_specimens; # create HoA of requests & specimens
	my @all_request_ids; # to hold req_id * in same order as $data *

    for (@$data) {
        my ($request_id, $specimen) = split '~';
		push @all_request_ids, $request_id;
        push @{ $request_specimens{$request_id} }, $specimen;
    } # warn Dumper \%request_specimens;

    # extract (unique) request_id's:
    my $request_ids = LIMS::Local::Utils::get_unique_elements(\@all_request_ids);

	for my $id (@$request_ids) { # warn Dumper $id;
		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
		);

		my $specimens = $request_specimens{$id}; # array(ref) of sample codes
		for my $sample_code (@$specimens) {
            # add xna extraction type to specimen code for label description:
            my $description = sprintf '%s [%s]',
                $sample_code, uc $vars->{extraction_type};
            my %h = ( data => \%d, label => $description );
			my $label = $self->_format_label_data(\%h);
			$self->add_to_labels($label);
		}
	}
    # do print_labels function:
    my $rtn = $self->_do_print_labels(); # only returns error condition
    if ($rtn) {
        $self->flash( error => $rtn );
    }
    else {
        my $msg = $self->messages('worklist')->{print_labels_ok};
		$self->flash( info => $msg );
    }
    my $arg_str = sprintf 'extraction_type=%s;function_name=%s;lab_section=%s;'
        . 'print_labels=1', lc $vars->{extraction_type}, $vars->{function_name},
        $vars->{lab_section}; # warn $arg_str;

	my $addr = join '?', '/local_worklist/xna_extraction_worksheet', $arg_str; # warn $addr;
    return $self->redirect( $self->query->url . $addr );
}

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

	my @data = $self->query->param('label_id'); # warn Dumper \@data;
    my $return_addr = '/local_worklist/plasma_storage_labels'; # in case of error
    my $messages    =  $self->messages('worklist');
    my @request_ids;
    for (@data) {
        my ($req_id, $specimen, $count) = split '~'; # ? don't need specimen
        unless ($req_id) { # one or more rows submitted with no #labels option
            $self->flash( error => $messages->{no_plasma_label_data} );
            return $self->redirect( $self->query->url . $return_addr );
        }
        next unless $count; # in case it's 0
        push @request_ids, $req_id;
		my $o = $self->model('Request')->get_patient_and_request_data($req_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
		);
        { # these labels require trial number in place of patient name:
            # get trial id for request:
            my $trial_id =
                $self->model('ClinicalTrial')->get_request_trial($req_id); # warn $trial_id;
            if ( $trial_id ) { # get trial number for patient:
                my $patient_id = $o->patient_case->patient_id;
                my $trial_number = $self->model('ClinicalTrial')
                    ->get_trial_number($patient_id, $trial_id);
                if ( $trial_number ) { # replace patient last_name:
                    $d{patient}->{last_name} = $trial_number;
                }
            }
        }
    	my $label = do {
            my %h = ( data => \%d, label => 'Plasma' );
            $self->_format_label_data(\%h);
        };
		$self->add_to_labels($label) for 1 .. $count;
	}
    unless ( $self->count_labels ) {
        $self->flash( error => $messages->{no_labels_selected} );
        return $self->redirect( $self->query->url . $return_addr );
    }
    # do print_labels function:
    my $rtn = $self->_do_print_labels(); # only returns error condition
    if ($rtn) {
        $self->flash( error => $rtn );
    }
    else {
        $self->flash( info => $messages->{print_labels_ok} );
    }
    my $arg_str = 'function_name=trial_plasma_storage';
	my $addr = join '?', '/local_worklist', $arg_str; # warn $addr;
    return $self->redirect( $self->query->url . $addr );
}

# ------------------------------------------------------------------------------
sub print_xna_quantification_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=' .
                $self->query->param('label_type')
		);
	}

	# get specimen_map for request_ids:
	my $specimen_map = $self->specimen_map(\@request_ids); # warn Dumper $specimen_map;

	for my $id (@request_ids) {
		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
		);

		my $specimens = $specimen_map->{$id}->{sample_code}; # array(ref) of sample codes
		for my $sample_code (@$specimens) {
            my %h = ( data => \%d, label => $sample_code );
			my $label = $self->_format_label_data(\%h);
			$self->add_to_labels($label);
		}
	}

    # 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_cell_selection_labels {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
    # 1st arg is caller (C::Local::Worklist) so we can set flash() on it for tt:
    my $calling_object = shift; # LIMS::Controller::Local::Worklist
	my $label_data     = shift;

    my %specimen_map;
    foreach my $pair ( @{ $label_data->{request_specimen} } ) { # warn Dumper $pair;
        my ($request_id, $specimen) = split '~', $pair; # eg 331105~PB
        push @{ $specimen_map{$request_id} } , $specimen;
    }

    foreach my $entry ( @{ $label_data->{requests} } ) { # RequestLabTestStatus object
        my $request  = $entry->request;
        my $patient  = $request->patient_case->patient;
        my $lab_test = $entry->lab_test;
        foreach my $specimen ( @{ $specimen_map{$request->id} } ) { # warn Dumper $specimen;
            my %d = (
                request  => $request->as_tree(max_depth => 0), # only want base object data
                patient  => $patient->as_tree, # don't need dt object
                lab_test => $lab_test->as_tree(max_depth => 0), # don't need dt object
            );
			my $label = $self->_format_cell_selection_label_data(\%d, $specimen);
			$self->add_to_labels($label);
        }
    }

    my %msg; # flash message for tt:
    if ( $self->count_labels ) { # we have some requests selected for printing
        # _do_print_labels returns undef on success, or error:
        if ( my $rtn = $self->_do_print_labels('cell_selection_worklist') ) {
            $msg{error} = $rtn;
        }
        else {
            $msg{info} = $self->messages('worklist')->{print_labels_ok};
        }
    }
    else { # no requests selected:
        $msg{warning} = $self->messages('worklist')->{no_selection};
    }
    # set flash message in caller (Controller::Local::Worklist) object:
    $calling_object->flash(%msg);
    return 0; # caller doesn't expect a return value
}

# ------------------------------------------------------------------------------
# shared by dako_link() & immunohistology_panels() to retrieve IHC tests:
sub _ihc_tests : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    my $args = shift; # optional href, if need to restrict by status opt

	# get list of lab_tests for immunohistochemistry section:
	my $lab_tests = do {
        my %args = ( section_name => 'Immunohistochemistry' );
        $self->model('LabTest')->get_section_lab_tests(\%args);
    }; # warn Dumper $lab_tests;

	# some tests don't require labels:
	my $yaml = $self->get_yaml_file('print_labels'); # warn Dumper $yaml;
	my $skip_tests = $yaml->{immunohistology_panels}->{skip_tests};

    my @lab_test_ids = ();
    for my $t (@$lab_tests) {
        next if grep $t->test_name eq $_, @$skip_tests; # only skips tests, not panels
        push @lab_test_ids, $t->id;
    } # warn Dumper \@lab_test_ids;

	{ # get requests where test status is not complete:
		my %args = (
			lab_test_id      => \@lab_test_ids,
			fetch_only       => [ 'request' ], # don't need all cols from model
		);
        # if we need to restrict to particular status option:
        if ( my $status_option = $args->{status_option} ) {
            my $option_id = do {
                my $map = $self->lab_test_status_options_map('description');
                $map->{$status_option}->{id};
            };
            $args{status_option_id} = $option_id;
        }

		my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);

        # get_outstanding_investigations() returns one row per test, need unique requests:
        my (@requests, %seen);
        for my $r (@$data) {
            my $id = $r->request->id;
            next if $seen{$id}++;
            push @requests, $r->request;
        } # warn Dumper \@requests;
		return \@requests;
	}
}

# ------------------------------------------------------------------------------
sub _do_print_labels {
    my $self = shift; $self->_debug_path();
    # default label is 3 fields (labno, name, label), or provide alternative:
    my $label_type = shift || 'label';
    return 'invalid label format' unless $self->format_exists($label_type);
    my $label_format = $self->get_format($label_type); # warn Dumper $label_format;

	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 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; # warn Dumper $first_label;

    # check label has all fields for this format:
    if ( grep { ! exists $first_label->{$_} } @{ $label_format->{fields} } ) {
        return "label doesn't have all fields necessary for this format";
    }

    my %first_label_data =
      map { $_ => $first_label->{$_} } @{ $label_format->{fields} };

    $first_label_data{no_of_labels} =  $label_format->{no_of_labels};

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

	# send 1st label to printer:
	print $socket ${$label_body}; # deref

    # (R)eplace field params for rest of labels:
    for my $next_label (@$labels) { # warn Dumper $next_label;
		for my $field( @{ $label_format->{fields} } ) { # eg R LABEL;Giemsa R LABNO;H1/10 etc
			print $socket sprintf "R %s;%s\n", uc $field, $next_label->{$field};
		}
		print $socket "A $label_format->{no_of_labels}\n"; # print 1 label each
    }

    close $socket;

	return 0; # as caller expects only errors returned
}

# ------------------------------------------------------------------------------
sub _format_label_data {
    my ($self, $ref) = @_; $self->_debug_path();

    my $name_format = $ref->{name_format};    # if initial required on label (optional)
    my $label       = $ref->{label} || '';    # warn $label; # can be blank for controls
    my $data        = $ref->{data};           # warn Dumper $data; # hashref

	# need lab_no, patient name & label name:
    my $name = ucfirst $data->{patient}->{last_name};    # truncate if too long
    if (defined $name_format and $name_format eq 'lastname_firstinitial') {
        ( my $initial = $data->{patient}->{first_name} ) =~ s/^(\w).*/ \U$1/;
        $name .= $initial;
    }
	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 _format_cell_selection_label_data {
	my $self  = shift; $self->_debug_path();
	my $data  = shift; # warn Dumper $data; # hashref
	my $label = shift || ''; # warn $label; # can be blank for controls

	# need lab_no, patient name & label name:
	my $lastname  = ucfirst $data->{patient}->{last_name}; # truncate if too long
	my $labno = sprintf 'H%s/%s',
		$data->{request}{request_number}, $data->{request}{year} - 2000;
    my $test_name = $data->{lab_test}{field_label};

    my %label_data = (
        lastname => $lastname,
        labno    => $labno,
        labtest    => $test_name,
        sampletype => $label
    );

	return \%label_data;
}
# ------------------------------------------------------------------------------
sub _get_request_test_name_map {
	my ($self, $request_ids) = @_; $self->_debug_path();

	my %args = (
		section_name => 'Immunohistochemistry',
		request_id   => $request_ids,
        description  => { ne => 'complete' },
	);

	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 $lab_test_data = $data->lab_test->as_tree(max_depth => 0);
        push @{ $map{$request_id} }, $lab_test_data;
	} # warn Dumper \%map;
	return \%map;
}

# ------------------------------------------------------------------------------
sub _get_immunohistology_panel_lab_tests {
    my $self = shift; $self->_debug_path();

    my $o = $self->model('LabTest')->get_panel_lab_tests('immunohistochemistry');

    # need HoA:
    my %panels = ();
    for (@$o) {
		next unless $_->lab_test->is_active eq 'yes';
        my $panel_name = $_->panel_test->test_name;
        push @{ $panels{$panel_name} }, $_->lab_test->as_tree;
    } # warn Dumper \%panels;
    return \%panels;
}

1;