• Files
• Commits
• Log
• Graph
• Stats

use strict;
use warnings;

=begin
to use: 
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 hl7.pl (uses HILIS), or: t/report_status.t, then perl hl7.pl 2 (uses lims_test)
=cut

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;

# ==============================================================================
my $hl7d_addr = '127.0.0.1'; # '163.160.104.248' # TIE
my $hl7d_port = 12002; # 7210;

my $request_id = $ARGV[0] || 101111; # anon hiv
# ==============================================================================

open my $hl7_log, '>', $Bin . '/hl7_log.txt' or die $!;
open my $hl7_ice, '>', $Bin . '/hl7_ice.txt' or die $!;

my $tools = LIMS::Local::ScriptHelpers->new();

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;

# 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();

$dbix->dbh->do('use lims_test') if $request_id == 2;
# increase max length of group_concat; permitted range (32-bit system) 4 .. 4294967295
$dbix->dbh->do('SET group_concat_max_len = 3072'); 

redo_summary();

# get sql statments:
my $sql = _get_sql();
my $result = $dbix->query($sql, $request_id); # warn $request_id;

while ( my $vars = $result->hash ) { # warn Dumper $vars; next;
    my $hl7 = LIMS::Local::HL7->new(settings => $settings);

	# build message:
	$hl7->build_msh_segment();	
	$hl7->build_pid_segment($vars);	
	$hl7->build_nte_segment($vars);
#	$hl7->build_pv1_segment($vars);	# not using
#	$hl7->build_orc_segment($vars);	# not using
	$hl7->build_obr_segment($vars);	
#	$hl7->build_obx_segment($vars);	# using _build_report_segment()
	
	# add report (comment, diagnosis, etc) to hl7 message:
	_build_report($hl7, $vars);

	# message should now be complete, send it
    my $response = $hl7->send_message($vars); # warn $response;

    my $msg = $hl7->msg(); # Net::HL7::Request object; warn $msg->toString(1)
	dump_msg($vars, $msg, $response);
}

sub _build_report {
	my ($hl7, $vars) = @_;
	
}

# ------------------------------------------------------------------------------
sub dump_msg { #  write to interface logs
	my ($vars, $msg, $response) = @_;
    
#	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 ($field, $value) = each %$vars ) {
		printf $hl7_ice "%s: %s\n", $field, $value || 'NULL';
	}
}

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 mail_admin {
	my $msg = shift; # warn $msg;
	$tools->mail_admin({ script => $0, msg => $msg });
	exit;
}

# ------------------------------------------------------------------------------
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,
    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.comment,
	group_concat(distinct sp.description) as 'specimen',
    d.name as 'diagnosis',
	d.icdo3,
	group_concat( distinct ls.section_name,':',rrs.results_summary,'|') as '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 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
	
WHERE 
	/*  rs.organisation_code like '%'
	and h.action = 'authorised'
	and date(h.time) = DATE_SUB(CURRENT_DATE(), INTERVAL ? DAY) */
	req.id = ?
	group by req.id
!;
}