#!/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 <days> [-p <port>]

use $Net::HL7::NULL (double-quotation marks), or default (undef) for null fields
* use of default (undef) generates following warning: "Use of uninitialized value
    $field in concatenation (.) or string at Net/HL7/Segment.pm line 187"
  reason: my $field = $self->{FIELDS}->[$index];
  $self->{FIELDS} = [
    [0]  "OBX",
    ...
    [9]  undef,
    [10] undef,
    [11] "F"
so index value of 9 or 10 will trigger warning - suppressed using Net::HL7::NULL
    [9]  ""
    [10] ""
=cut

use Getopt::Std;
getopts('d:p:tq'); # port, days, testing, output sql query
our($opt_d,$opt_p,$opt_q,$opt_t); # warn $opt_d; 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 SQL::Abstract::More;
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 $use_hl7_null = 0; # use $Net::HL7::NULL (double-quotation marks) for null fields

my $duration = $opt_d // 1; # days ago (allow 0)
my $port     = $opt_p || 3306; # eg 3307 via localhost tunnel - for testing

my @locations = (
    'RD130', # RUH
    'RVJ01', # Southmead
    'RVJ20', # Frenchay
);
# ==============================================================================

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

$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;
my $ref_date = $now->clone->subtract(days => $duration)->ymd;

# copy bristol_ice_server data to $settings for use in LIMS::Local::HL7:
$settings->{hl7d_addr} = $settings->{bristol_ice_server}->{remote_addr};
$settings->{hl7d_port} = $settings->{bristol_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) { # overrides addr:port with localhost:12002
    $settings->{hl7d_addr} = 'localhost';
    $settings->{hl7d_port} = 12002;
} # p $settings; exit;

my $dbix = do {
    my %h = (
        dbname => 'bristol',
        port   => $port,
    );
    Local::DB->dbix(\%h);
};

# 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 @requests = $dbix->query($sql, @bind)->hashes; # p @requests;
exit unless @requests;

# 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

for my $vars ( @requests ) { # 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 (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 $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;

    # 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 _get_request_number {
	my $vars = shift;
	return join '/', $vars->{request_number}, $vars->{year} - 2000;
}

sub _get_query_params { # bristol don't authorise so using report_date as auth_date
    my @cols = (
        qw/
            p.last_name
            p.first_name
            p.middle_name
            p.dob
            p.nhs_number
            p.gender
            pc.unit_number
            rs.display_name|location
            rs.organisation_code
            ref.name|referrer_name
            ref.national_code|referrer_code
            r.id|request_id
            r.request_number
            r.year
            r.created_at
            r.updated_at
            rr.status
            rr.specimen_quality
            group_concat(distinct(s.description))|specimen
            group_concat(distinct(s.sample_code))|sample_code
            d.name|diagnosis
            d.icdo3
            rsv.username|report_by
            rsv.time|auth_date
        /,
        "group_concat(distinct(ls.section_name), ':', rrs.results_summary, '|')"
        . "|result_summaries",
    );

    my @rels = (
        'requests|r'                    => q{r.patient_case_id=pc.id}			,
        'patient_case|pc'               => q{pc.patient_id=p.id}     			,
        'patients|p'       	            => q{pc.referral_source_id=rs.id}       ,
        'referral_sources|rs'           => q{r.referrer_department_id=rd.id}    ,
        'referrer_department|rd'        => q{rd.referrer_id=ref.id}             ,
        'referrers|ref'                 => q{rh.request_id=r.id}                ,
        'request_history|rh'            => q{rr.request_id=r.id}                ,
        'request_report_view|rr'        => q{rr.diagnosis_id=d.id}              ,
        'diagnoses|d'                   => q{rrs.request_id=r.id}               ,
        'request_result_summaries|rrs'  => q{rrs.lab_section_id=ls.id}          ,
        'lab_sections|ls'               => q{rs2.request_id=r.id}               ,
        'request_specimen|rs2'          => q{rs2.specimen_id=s.id}              ,
        'specimens|s'                   =>
                       q{rsv.request_id=r.id,rsv.action='reported'}             ,
        'request_status_view|rsv'       => q{=>rdh.request_id=r.id}             ,
        'request_diagnosis_history|rdh'
    );
    # reported, request_report updated, request_diagnosis_history updated, or
    # patient table updated:
    my %where = (
        'rs.organisation_code' => { -in => \@locations },
        'rh.action'            => 'reported',
        -or => [
            'DATE(rh.time)'       => $ref_date,
            'DATE(rdh.time)'      => $ref_date,
            'DATE(rr.updated_at)' => $ref_date,
            -and => {
                'DATE(p.updated_at)' => $ref_date,
                'DATE(rh.time)'      => { '<' => $ref_date },
            },
        ],
    );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
        -group_by => 'r.id',
        -order_by => 'r.id',
    ); # p @args;
    my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
        # $dbix->dump_query($sql, @bind); exit;
    return ($sql, @bind);
}

=BEGIN
# ------------------------------------------------------------------------------
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
        ( /* 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)
            )
            AND rs.organisation_code IN (??)
        )
	GROUP BY req.id!;
}
=cut
