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;