#!/usr/bin/env perl
=begin
to use hl7d:
config in /usr/local/hl7/hl7d.conf
plugins /usr/local/hl7/plugins
start hl7d: cd /usr/local/hl7d; sudo perl -T hl7d.pl --nodetach --debug
run <$0> (uses HILIS), or: t/report_status.t, then perl <$0> 2 (uses lims_test)
see bhods_hl7.pl for use of $Net::HL7::NULL var
=cut
use Getopt::Std;
getopts('d:t'); # days (not used in query yet), testing
our($opt_d,$opt_t); # warn $opt_d; exit;
use strict;
use warnings;
use lib '/home/raj/apps/HILIS4/lib';
use FindBin qw($Bin); # warn $Bin; exit;
use LIMS::Local::ScriptHelpers;
use LIMS::Local::Stuff;
use LIMS::Local::Utils;
use LIMS::Local::HL7;
use Data::Dumper;
use Data::Printer alias => 'p';
use Net::HL7::Connection;
# ==============================================================================
my $JUST_TESTING = $opt_t || 0; # overrides cfg hl7d settings with localhost:12002
my $use_hl7_null = 0; # use $Net::HL7::NULL (double-quotation marks), or undef for null character
my @request_id = $ARGV[0] || 101111; # anon hiv
# push @request_id, 188067; # Flow & Molecular results, with new-line in comment causing problem
# ==============================================================================
open my $hl7_log, '>', $Bin . '/hl7_log.txt' or die $!;
open my $hl7_ice, '>', $Bin . '/hl7_ice.txt' or die $!;
my $cfg_file = "$Bin/crons/lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings; exit;
# copy lth_ice_server data to $settings for use in LIMS::Local::HL7:
$settings->{hl7d_addr} = $settings->{lth_ice_server}->{remote_addr};
$settings->{hl7d_port} = $settings->{lth_ice_server}->{remote_port};
# set null character - $Net::HL7::NULL (double-quotation marks), or undef:
$settings->{use_hl7_null} = $use_hl7_null;
if ($JUST_TESTING) {
$settings->{hl7d_addr} = 'localhost';
$settings->{hl7d_port} = 12002;
} # p $settings; exit;
my $tools = LIMS::Local::ScriptHelpers->new();
my $now = LIMS::Local::Utils::time_now();
# get tools from LIMS::Local::ScriptHelpers:
my $sql_lib = $tools->sql_lib(); # warn Dumper $sql_lib->elements;
my $config = $tools->config();
my $dbix = $tools->dbix();
# increase max length of group_concat; permitted range (32-bit system) 4 .. 4294967295
$dbix->dbh->do('SET group_concat_max_len = 3072');
#$dbix->dbh->do('use lims_test') if $request_id < 5;
# redo_summary(); ONLY DO THIS IF USING TEST DB !!!!
# get sql statments:
my $sql = _get_sql();
my $result = $dbix->query($sql, @request_id); # warn Dumper \@request_id;
# args for LIMS::Local::HL7->new():
my $hl7_socket = _build_hl7_socket(); # open connection to hl7 server once only
my %hl7_args = (
sending_application => 'HILIS',
receiving_facility => 'Ensemble',
sending_facility => 'HMDS',
receiving_system => 'Ensemble',
hl7_socket => $hl7_socket,
settings => $settings,
); # p %hl7_args; exit;
my $i = 0; # auto-incrementing message id
while ( my $vars = $result->hash ) { # p $vars; next;
my $hl7 = LIMS::Local::HL7->new(\%hl7_args); # pass socket & settings args
# build HL7 message:
$hl7->build_msh_segment(++$i); # message id counter
$hl7->build_pid_segment($vars);
$hl7->build_obr_segment($vars);
# add report (comment, diagnosis, etc) to HL7 message:
_build_report($hl7, $vars);
# message should now be complete, send it
my $response = $hl7->send_message(); # warn $response;
# dump msg, vars & response to log (and stdout if test mode):
_dump_msg($vars, $hl7->msg, $response);
}
$hl7_socket->close();
# ------------------------------------------------------------------------------
sub _build_report {
my ($hl7, $vars) = @_;
# create text string from samples code(s):
$vars->{specimen_type} = $hl7->specimen_summary($vars->{sample_code});
my @report = (
[ 'Specimen type', $vars->{specimen_type} ],
[ 'Specimen quality', $vars->{specimen_quality} ],
[ 'Gross description', $vars->{gross_description} ],
[ 'Results summary', $vars->{result_summaries} ],
[ 'Clinical details', $vars->{clinical_details} ],
[ 'Morphology/comment', $vars->{comment} ],
[ 'Diagnosis', $vars->{diagnosis} ],
[ 'ICDO3', $vars->{icdo3} ],
);
my $i = 0; # incremental OBX counter
$hl7->build_obx_segment(@$_, ++$i) for @report; # field, value, counter
}
# ------------------------------------------------------------------------------
sub _build_hl7_socket {
# open HL7 connection via socket
my ($addr, $port) = @{$settings}{ qw(hl7d_addr hl7d_port) };
my $socket = new Net::HL7::Connection($addr, $port)
or die "Could not connect to HL7d $addr on port $port: $!";
return $socket;
}
# ------------------------------------------------------------------------------
sub dump_msg { # write to interface logs
my ($vars, $msg, $response) = @_;
# output to stdout:
p $msg->toString(1) if $JUST_TESTING; # Net::HL7::Request object
# my $dow = $now->day_name; # warn $dow;
my $request_number = _get_request_number($vars);
printf $hl7_log "%s: %s\n\n", $request_number, $response;
print $hl7_log $msg->toString(1)."\n";
print $hl7_log Dumper $msg;
printf $hl7_ice "H%s %s\n", $request_number, '=' x 100;
while ( my @pair = map { $_ ||= 'NULL' } each %$vars ) {
printf $hl7_ice "%s: %s\n", @pair;
}
}
# ------------------------------------------------------------------------------
sub redo_summary {
my $line = LIMS::Local::Stuff::silly_werder(10,20); # warn length $line;
# add some chars for escaping:
$line .= ' and & and ^ and \ and | and ~ end.';
$dbix->update('request_result_summaries',
{ results_summary => $line }, { request_id => 2 });
}
# ------------------------------------------------------------------------------
sub _get_request_number {
my $vars = shift;
return join '/', $vars->{request_number}, $vars->{year} - 2000;
}
# ------------------------------------------------------------------------------
sub _get_sql {
return q!
SELECT
p.last_name,
p.first_name,
p.middle_name,
p.dob,
p.nhs_number,
p.gender,
pc.unit_number,
src.display_name as 'location',
src.organisation_code,
rf.name as 'referrer_name',
rf.national_code as 'referrer_code',
req.id as 'request_id',
req.request_number,
req.year,
req.created_at,
req.updated_at,
rr.status,
rr.comment,
rr.clinical_details,
rr.specimen_quality,
rr.gross_description,
GROUP_CONCAT(DISTINCT(s.`sample_code`)) as 'sample_code',
GROUP_CONCAT(DISTINCT(s.`description`) separator '/') as 'sample_description',
d.name as 'diagnosis',
d.icdo3,
GROUP_CONCAT( DISTINCT ls.section_name, ': ', rrs.results_summary SEPARATOR "\n" )
as 'result_summaries',
MAX(CASE WHEN h.action = 'reported' THEN u.username END) as 'report_by',
MAX(CASE WHEN h.action = 'reported' THEN date(h.time) END) as 'report_date',
MAX(CASE WHEN h.action = 'authorised' THEN u.username END) as 'auth_by',
MAX(CASE WHEN h.action = 'authorised' THEN date(h.time) END) as 'auth_date'
FROM
requests req
JOIN ( patient_case pc JOIN patients p on pc.patient_id = p.id )
on req.patient_case_id = pc.id
JOIN referral_sources src on pc.referral_source_id = src.id
JOIN ( referrer_department rd JOIN referrers rf on rd.referrer_id = rf.id )
on req.referrer_department_id = rd.id
JOIN ( request_history h JOIN users u on h.user_id = u.id )
on h.request_id = req.id
JOIN ( request_report_view rr JOIN diagnoses d on rr.diagnosis_id = d.id )
on rr.request_id = req.id
JOIN ( request_specimen rs JOIN specimens s on rs.`specimen_id` = s.id )
on rs.`request_id` = req.id
LEFT JOIN ( request_result_summaries rrs join lab_sections ls
on rrs.`lab_section_id` = ls.id ) on rrs.`request_id` = req.id
WHERE req.id in (??)
GROUP BY req.id
!;
}
