#!/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 usage: perl $0 [-tq] -d =cut use Getopt::Std; getopts('d:tq'); # days, testing our($opt_d,$opt_q,$opt_t); # warn $opt_q; exit; use strict; use warnings; use FindBin qw($Bin); # warn $Bin; use lib ( '/home/raj/perl-lib', "$Bin/../lib", ); use LIMS::Local::Utils; use LIMS::Local::HL7; use Data::Printer alias => 'p'; use Net::HL7::Connection; use Data::Dumper; use Local::DB; # ============================================================================== my $JUST_TESTING = $opt_t; # overrides addr:port with localhost:12002 $ENV{SQL_TRACE} = $opt_q; # warn $ENV{SQL_TRACE}; switch on query trace my $duration = $opt_d || 1; # days ago my $hl7d_addr = '10.180.109.184'; # opt_t overrides to localhost my $hl7d_port = 19200; # opt_t overrides to 12002 # ============================================================================== open my $hl7_log, '>', $Bin . '/../logs/hl7_log.txt' or die $!; open my $hl7_ice, '>', $Bin . '/../logs/hl7_ice.txt' or die $!; if ($JUST_TESTING) { $hl7d_addr = 'localhost'; $hl7d_port = 12002; } $Local::QueryLogger::NO_QUERY_LOGS = 1; # don't need queries in logs dir my $now = LIMS::Local::Utils::time_now(); my $cfg_file = "$Bin/crons/lib/settings.cfg"; my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings; exit; # add HL7d to settings - TODO: hard-code to cfg_file $settings->{hl7d_addr} = $hl7d_addr; $settings->{hl7d_port} = $hl7d_port; my $dbix = Local::DB->dbix({ dbname => 'bristol' }); # increase max length of group_concat; permitted range (32-bit system) 4 .. 4294967295 $dbix->dbh->do('SET group_concat_max_len = 3072'); # get sql statments: my ($sql, @bind) = _get_query_params(); my $result = $dbix->query($sql, @bind); # p $result; # 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-ICE', receiving_facility => 'ICE00', sending_facility => 'BHODS', receiving_system => 'ICE', 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_nte_segment($vars); $hl7->build_pv1_segment($vars); $hl7->build_orc_segment($vars); $hl7->build_obr_segment($vars); # $hl7->build_obx_segment($vars); # handled by _build_report() # $hl7->build_report_segment($vars); # handled by _build_report() # add report (comment, diagnosis, etc) to HL7 message: _build_report($hl7, $vars); # message should now be complete, send it my $response = $hl7->send_message(); # p $response; # dump msg, vars & response to log: my $msg = $hl7->msg(); warn $msg->toString(1); # Net::HL7::Request object _dump_msg($vars, $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 $n = 0; # incremental OBX counter $hl7->build_obx_segment(@$_, ++$n) 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) = @_; # warn Dumper $msg; # 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 _get_request_number { my $vars = shift; return join '/', $vars->{request_number}, $vars->{year} - 2000; } # ------------------------------------------------------------------------------ sub _get_query_params { my $sql = _get_sql(); # library.sql [ice_report] entry # count number of placeholders in $sql: my $n = () = $sql =~ /\?/g; # p $n; # bind one $duration per placeholder: my @bind = map $duration, (1..$n); # p \@bind; return ($sql, @bind); } # ------------------------------------------------------------------------------ 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, rs.display_name as 'location', rs.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.specimen_quality, group_concat(distinct sp.description) as 'specimen', group_concat(distinct sp.sample_code) as 'sample_code', d.name as 'diagnosis', d.icdo3, rsv.username as 'report_by', rsv.time as 'auth_date', /* bristol don't authorise */ group_concat( distinct ls.section_name,':',rrs.results_summary,'|') as 'result_summaries' FROM requests req join patient_case pc on req.patient_case_id = pc.id join patients p on pc.patient_id = p.id join referral_sources rs on pc.referral_source_id = rs.id join referrer_department rd on req.referrer_department_id = rd.id join referrers rf on rd.referrer_id = rf.id join request_history h on h.request_id = req.id join request_report_view rr on rr.request_id = req.id join diagnoses d on rr.diagnosis_id = d.id join request_result_summaries rrs on rrs.`request_id` = req.id join lab_sections ls on rrs.`lab_section_id` = ls.id join request_specimen rsp on rsp.`request_id` = req.id join specimens sp on rsp.`specimen_id` = sp.id join request_status_view rsv on rsv.request_id = req.id and rsv.`action` = 'reported' left join `request_diagnosis_history` rdh on rdh.`request_id` = req.id WHERE rs.organisation_code like 'RVJ%' and ( /* reported, request_report updated, request_diagnosis_history updated, or patient table updated: */ ( h.`action` = 'reported' and DATE(h.`time`) = DATE_SUB(CURRENT_DATE(), INTERVAL ? DAY) ) or DATE(rr.`updated_at`) = DATE_SUB(CURRENT_DATE(), INTERVAL ? DAY) or DATE(rdh.`time`) = DATE_SUB(CURRENT_DATE(), INTERVAL ? DAY) or ( /* previously reported: */ DATE(h.`time`) < DATE_SUB(CURRENT_DATE(), INTERVAL ? DAY) and DATE(p.`updated_at`) = DATE_SUB(CURRENT_DATE(), INTERVAL ? DAY) ) ) GROUP BY req.id!; }