#!/usr/bin/env perl

=begin
NBT WinPath HL7 messeges - looks for H+E lab-test status changes on previous
day, providing HL7 message not already sent

usage: perl $0 [-tlqr] -d <days> [-p <port>]
* --localhost|l = use localhost HL7d (requires hl7d running)
* --query|q = output query to stdout
* --test|t = use remote test server IP::port
* --response|r = output remote HL7 server response
* --reqId <nnn> --reqId <nnn>, etc = specific request id's

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

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] ""

$Net::HL7::NULL set to 'true' if running under test mode (hl7d complains about undef fields)
=cut

# $ENV{CENTRE} = 'bristol'; # not required - setting sysadmin_email manually

# set default command-line opts:
my $RESPONSE_OUTPUT = 0;    # --response|r - output HL7 server response
my $QUERY_OUTPUT    = 0;    # --query|q - output sql queries to console
my @REQUEST_ID      = ();   # --reqId <nnn> --reqId <nnn> etc
my $MYSQL_PORT      = 3306; # --port|p - eg 3307 via localhost tunnel for testing
my $LOCALHOST       = 0;    # --localhost|l - use localhost hl7d
my $DURATION        = 1;    # --days|d - duration in days
my $TESTING         = 0;    # --test|t - use remote test server IP::port

use Getopt::Long;
GetOptions (
    "localhost|l" => \$LOCALHOST,       # flag
    "response|r"  => \$RESPONSE_OUTPUT, # flag
    "days|d=i"    => \$DURATION,        # int
    "port|p=i"    => \$MYSQL_PORT,      # int
    "query|q"     => \$QUERY_OUTPUT,    # flag
    "test|t"      => \$TESTING,         # flag
    'reqId=i'     => \@REQUEST_ID,      # int
); # warn $DURATION; warn $LOCALHOST; exit;

die "cannot select both --localhost|l and --test|t (remote address) options\n"
    if $LOCALHOST && $TESTING;

use strict;
use warnings;

use lib '/home/raj/perl5/lib/perl5';
use Data::Printer alias => 'p';
use Net::HL7::Connection;
use SQL::Abstract::More;
use FindBin qw($Bin); # warn $Bin;
use Data::Dumper;

use lib '/home/raj/perl-lib';
use Local::DB;

use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;
use LIMS::Local::Config; # to override sysadmin
use LIMS::Local::Utils;
use LIMS::Local::HL7;

# ==============================================================================
$ENV{SQL_TRACE} = $QUERY_OUTPUT; # warn $ENV{SQL_TRACE}; switch on query trace

# does WinPath server expect empty strings or undef fields?
my $use_hl7_null = 0; # $Net::HL7::NULL (double-quotation marks), or undef

my @locations = (
    'RA301', # Weston General
    'RA701', # BRI
    'RA709', # Bristol Dental Hospital
    'RA710', # Bristol Haematology & Oncology Ctr
    'RA723', # Bristol Childrens Hospital
    'RA799', # Bristol Oncology Centre (ficticious code)
    'RBA11', # Taunton, Musgrove Park
    'RD130', # RUH, Bath
    'RVJ01', # Southmead
); # also including all GP practices from Aug/2018

# ==============================================================================
my $app_dir = $Bin . '/../../../'; # warn $app_dir;

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

my $cfg_file = $app_dir . '/script/crons/lib/settings.cfg';
my $settings = Config::Auto::parse($cfg_file); # p $settings;
my $ref_date = $now->clone->subtract(days => $DURATION)->ymd;


# set null character - $Net::HL7::NULL (double-quotation marks), or undef:
$settings->{use_hl7_null} = $use_hl7_null;

{ # override global sysadmin_email for this script - persists due to instance():
    my $app_config  = LIMS::Local::Config->instance; # p $app_config;
    $app_config->{settings}->{sysadmin_email}
        = $settings->{nbt_winpath_server}->{admin_email};
}

my ($hl7_log, $hl7_ice);
_open_logfiles(); # only executed if called with -l or -t command opts

# set HL7 server addr & port:
if ($TESTING) { # remote test server:
    $settings->{hl7d_addr} = $settings->{nbt_winpath_server}->{_test_addr};
    $settings->{hl7d_port} = $settings->{nbt_winpath_server}->{_test_port};
}
elsif ($LOCALHOST) { # localhost hl7d:
    $settings->{hl7d_addr} = 'localhost';
    $settings->{hl7d_port} = 12002;
    $settings->{use_hl7_null} ||= 1;
}
else { # remote live server:
    $settings->{hl7d_addr} = $settings->{nbt_winpath_server}->{remote_addr};
    $settings->{hl7d_port} = $settings->{nbt_winpath_server}->{remote_port};
} # p $settings; exit;

my $dbix = do {
    my %h = (
        dbname => 'bristol',
        port   => $MYSQL_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');

my $nbt_user_id
    = $dbix->select('users', 'id', { username => 'nbt-bhods' })->value;

# get sql statments:
my ($sql, @bind) = _get_query_params();

my @requests = $dbix->query($sql, @bind)->hashes; # p @requests; exit;
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',
    receiving_facility  => 'WinPath',
    sending_facility    => 'NBT-WINPATH',
    receiving_system    => 'WinPath',
    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

    # custom fields:
    $vars->{sample_code} =~ s/BMA,BMT/BMAT/; # substitution to single sample type
    $vars->{application_acknowledgement_type} = 'NE';
    $vars->{accept_acknowledgement_type}      = 'AL';
    $vars->{observation_datetime} = $vars->{specimen_date}; # OBR#7
    $vars->{requested_datetime}   = $vars->{created_at};    # OBR#6
    $vars->{assigning_authority}  = 'HILIS';
    $vars->{speciality_code}      = 'CP'; # Cellular Pathology
    $vars->{message_type}         = 'ORM^O01';
    $vars->{order_control}        = 'NW'; # NW = new order
    $vars->{mrn_id}               = 'NBT^MRN';
    # send data to hl7 object:
    $hl7->dataset($vars);
    $hl7->msg_count(++$i);

	# build HL7 message:
	$hl7->build_msh_segment;
	$hl7->build_pid_segment;
	# $hl7->build_nte_segment; # not required
    $hl7->build_pv1_segment;
    $hl7->build_orc_segment;
	$hl7->build_obr_segment;
	# $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;

    # do this AFTER sending message (otherwise it gets used in ORC#3)
    $vars->{lab_number} = $hl7->get_lab_number($vars);

    # 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 = (
        [ 'SPECTYPE^Specimen type',      $vars->{specimen_type}     ],
        [ 'CLINDETS^Clinical details',   $vars->{clinical_details}  ],
    );

	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/ };
	if ( my $socket = new Net::HL7::Connection($addr, $port) ) {
        return $socket;
    } # no socket:
    my $msg = "Could not connect to HL7d $addr:$port - $!";
    $tools->mail_admin({ script => 'NBT WinPath HL7', msg => $msg })
        unless $addr eq 'localhost'; # NBT sysadmin doesn't need to know!
    die $msg;
}

# ------------------------------------------------------------------------------
sub _open_logfiles { # if called as command using --localhost|l or --test|t opts:
    return unless $LOCALHOST || $TESTING;
    open $hl7_log, '>', $app_dir . '/logs/hl7_log.txt' or die $!;
    open $hl7_ice, '>', $app_dir . '/logs/hl7_ice.txt' or die $!;
}

# ------------------------------------------------------------------------------
sub _dump_msg { # write to interface logs
	my ($vars, $msg, $response) = @_; # warn Dumper $msg;
    # $vars - hashref of request data
    # $msg  - HL7 msg object
    # $response - hl7d return string

    # log to db or output to stdout & log files:
    if ( $LOCALHOST || $TESTING ) {
        p $msg->toString(1); # Net::HL7::Request object
        p $response;

        printf $hl7_log "%s: %s\n\n", $vars->{lab_number}, $response;
        printf $hl7_log "%s\n", $msg->toString(1);
        # print  $hl7_log Dumper $msg;
        printf $hl7_log "%s\n", "=" x 100;

        printf $hl7_ice "%s %s\n", $vars->{lab_number}, '=' x 100;
        while ( my @pair = map { $_ ||= 'NULL' } each %$vars ) {
            printf $hl7_ice "%s: %s\n", @pair;
        }
    }
    else { # log to db:
        my $request_id = $vars->{request_id};
        { # request_hl7_log:
            my %h = (
                request_id => $request_id,
                response   => $response,
                service    => 'WinPath',
            ); # p %h;
            $dbix->insert('request_hl7_log', \%h);
        }
        { # request_history:
            my %h = (
                request_id => $request_id,
                user_id    => $nbt_user_id,
                action     => 'dispatched request data to WinPath',
            ); # p %h;
            $dbix->insert('request_history', \%h);
        }
    }
    print $response if $RESPONSE_OUTPUT; # flag passed by HILIS, returns HL7 response
}

# ------------------------------------------------------------------------------
sub _get_request_number {
	my $vars = shift;
	return join '/', $vars->{request_number}, $vars->{year} - 2000;
}

sub _get_query_params {
    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
            rrd.clinical_details
            rsd.specimen_date
            GROUP_CONCAT(DISTINCT(s.description))|specimen
        /,
        q{GROUP_CONCAT(DISTINCT(s.sample_code) ORDER BY s.sample_code) AS
            sample_code},
    ); # p @cols;

    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{rs2.request_id=r.id}              => 'request_specimen|rs2'           ,
        q{rs2.specimen_id=s.id}             => 'specimens|s'                    ,
        q{rs.referral_type_id=rt.id}        => 'referral_types|rt'              ,
        q{ts.request_id=r.id}               => 'request_lab_test_status|ts'     ,
        q{ts.lab_test_id=lt.id}             => 'lab_tests|lt'                   ,
        q{ts.status_option_id=so.id}        => 'lab_test_status_options|so'     ,
        # left joins - may not be populated when H+E requested:
        q{=>rrd.request_id=r.id}            => 'request_report_detail|rrd'      ,
        q{=>rsd.request_id=r.id}            => 'request_specimen_detail|rsd'    ,
        q{=>rhl.request_id=r.id}            => 'request_hl7_log|rhl'            ,
    );

    my %where = @REQUEST_ID
        ? ( 'r.id' => { -in => \@REQUEST_ID } ) # for testing
        : ( # H+E status change on ref date, providing HL7 message not already sent:
          -and => [
            [
                'rs.organisation_code' => { -in => \@locations },
                'rt.description'       => 'practice',
            ],
            [
                -not => { # not already successfully sent:
                    'rhl.response' => { -like => 'Application Accept %' },
                    'rhl.service'  => 'WinPath',
                },
                'rhl.request_id' => undef, # request_id IS NULL
            ],
            'lt.test_name'  => 'he', # H+E
            'DATE(ts.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);
}