#!/usr/bin/env perl

=begin
monthly notification of CML patients on monitoring who have had in past 7 months:
    * inadequate sample
    * no repeat sample
see __DATA__ section for manual query

does PDS query for live/dead status and updates patient_demographics table
=cut

#===============================================================================
# if script re-run manually use stored PDS data to save repeat lookups
my $USE_STORAGE = 0; # *** check file date is current, not from previous run ***
#===============================================================================
my $JUST_TESTING = 0; # saves excel file, doesn't email
#===============================================================================
# exempt nhs numbers (incorrectly screened, post-transplant, moved away, etc)
my @not_required = (
    6305423733, 4849589804, 4583507917, 4581571391, 4125653828, 4320081552,
    4520144728, 4970949352, 7093663230, 4383715656, 4229408412, 4067746202,
    2002685827, 4065627206, 4081493650, 4300389845, 4862077994, 7020552889,
    4086666863, 4042407528, 6249677682, 6502643051, 4185999402, 4123539939,
    4562306629, 4125107742, 4821036037, 4506308816, 4423434601, 6391291896,
    4706975190, 6190115640, 6262695508, 4465870612, 4423523647, 4086517213,
    4520857686, 4860842626, 4302154233, 4486525876, 4069462945, 4860210255,
    6143792917, 4860444671, 4801510051, 4581634016, 4480117520, 4523432732,
    4822714632,
);
#===============================================================================
my @recipients  = qw( paul.evans.secure raj.secure ); # patient data
my $system_user = 'HMDS-HILIS4-LEEDS';
my $duration    = 7; # months
#===============================================================================
#my $addr  = '163.160.171.118:1983'; # rie-test
my $addr  = '163.160.171.247:1983';  # lthrie
# localhost just returns undef - see also localhost/script/cgi/soap.cgi but it
# can't yet handle Leeds-SMS.service urn:
my $proxy = $USE_STORAGE ? 'http://localhost' : 'http://'.$addr.'/lthspine';
my $urn   = 'Leeds-SMS.service';
#===============================================================================

use lib '/home/raj/perl5/lib/perl5';
use Storable;
use SOAP::Lite; # +trace => 'all'; # or switch on after object created
use Modern::Perl;
use SQL::Abstract::More;
use DateTime::Format::MySQL;
use Spreadsheet::WriteExcel::Simple;
use Data::Printer use_prototypes => 0;

use FindBin qw($Bin); # warn $Bin;
use lib ("$Bin/../../../lib", '/home/raj/perl-lib');
use LIMS::Local::ScriptHelpers;
use Local::DB;

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

# use Local::DB for query display if just testing:
my $dbix = Local::DB->dbix({dbname => 'hilis4'});
$Local::QueryLogger::NO_QUERY_LOGS = 1;
$Local::DBIx::Simple::Result::NO_AUTO_DATE_INFLATION = 1; # just need mysql date format

my $ref_date = $tools->date_subtract( months => $duration ); # p $ref_date;
my $filename = 'cml_patient_notifications.xls';
my $subject  = 'CML patients with no recent sample';
my $config   = $tools->config();
my $sqla     = SQL::Abstract::More->new;
my $xl       = Spreadsheet::WriteExcel::Simple->new;

#===============================================================================
# default unknown gp & practice id's:
my $default_practice_id = $dbix->select('referral_sources', 'id',
    { organisation_code => 'V81999' })->value; # p $default_practice_id;
my $default_gp_id = $dbix->select('referrers', 'id',
    { national_code => 'G9999998' })->value; # p $default_gp_id;
my $system_user_id = $dbix->select('users', 'id',
    { username => 'hmds-lth'})->value; # p $system_user_id;

#===============================================================================
# get patient, location & last sample date of all cml monitoring patients:
my $cml_patients = do {
    my @cols = ( qw/pc.patient_id p.last_name p.first_name p.dob p.nhs_number
        rs.display_name|location/ );
    push @cols, q!date_format(max(r.created_at), '%Y-%m-%d')|last_sample!; # p \@cols;
    my @rels = (
        'requests|r'                  => 'ris.request_id = r.id'            ,
        'request_initial_screen|ris'  => 'ris.screen_id = s.id'             ,
        'screens|s'                   => 'r.patient_case_id = pc.id'        ,
        'patient_case|pc'             => 'pc.patient_id = p.id'             ,
        'patients|p'                  => 'pc.referral_source_id = rs.id'    ,
        'referral_sources|rs'         => '=>pd.patient_id = p.id'           , # left join
        'patient_demographics|pd'
    );
    my @args = (
		-columns => \@cols,
		-from    => [ -join => @rels ],
		-where   => {
            's.description' => { -like => 'follow-up CML (PB)%' },
            'p.nhs_number'  => { -not_in => \@not_required },
            'pd.status'     => [ 'alive', undef ], # needs an undef or lose all non-pd entries
        },
        -group_by => 'p.id',
    ); # p @args;
	my ($sql, @bind) = $sqla->select(@args); # p $sql;  p \@bind;
        # $dbix->dump_query($sql, @bind); exit;
    $dbix->query($sql, @bind)->hash_map('nhs_number'); # includes col as key/val pair
}; # p $cml_patients;

#===============================================================================
# get patients with at least 1 ICDO3 or unauthorised request in past 7 months
my $recent_requests = do {
    my @nhs_nums = keys %$cml_patients;
    my @rels = (
        'requests|r'                   => '=>arv.id = r.id'            , # left join
        'authorised_reports_view|arv'  => 'rh.request_id = r.id'       ,
        'request_history|rh'           => 'r.patient_case_id = pc.id'  ,
        'patient_case|pc'              => 'pc.patient_id = p.id'       ,
        'patients|p'
    );
    my @args = (
		-columns  => 'distinct(p.nhs_number)',
		-from     => [ -join => @rels ],
		-where    => {
            'date(r.created_at)' => { '>=' => $ref_date->ymd },
            'p.nhs_number'       => { -in => \@nhs_nums },
            -or => {
                'rh.`action`'  => { '!=' => 'authorised' },
                'arv.icdo3'    => { '!=' => undef },
            }
        },
    ); # p @args;
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
       # $dbix->dump_query($sql, @bind); exit;
    $dbix->query($sql, @bind)->column; # aref
}; # p $recent_requests;

#===============================================================================
# remove patients with recent request(s) from cml_patients:
delete $cml_patients->{$_} for @$recent_requests; # warn scalar keys %$cml_patients;

#===============================================================================
# check PDS live/dead status of remaining patients (will not have dod recorded on HILIS):
{
    my $action = 'GetExtendedPatientDetails';

    my $soap = SOAP::Lite->new( proxy => $proxy );
    # SOAP::Lite->import(+trace => 'all'); # for debug

    $soap->on_action( sub { "urn:$urn/$action" } ); # .NET format uses '/' not '#'
    $soap->autotype(0);
    $soap->default_ns("urn:$urn");

    my %pds_results; # to store PDS results to save from having to re-run them
    # retrieve existing PDS results for use if $USE_STORAGE = 1
    my $stored_pds_results = ( -e $Bin.'/pds.data' )
        ? retrieve $Bin.'/pds.data' : {}; # p $stored_pds_results;

    PATIENT:
    while ( my ($nhs_num, $d) = each %$cml_patients ) { # $d = href
        # get aref of SOAP::Data objects suitable for soap call:
        my $data = _soap_data_format($nhs_num, $d); # p $data; # aref
        # next PATIENT;
        my $res = $soap->call($action,
            SOAP::Data->name('request')->value( SOAP::Data->value($data) )
        );
        if ($res->fault) {
            # get fault (->faultstring just returns generic 'server error' msg):
            my $fault = $res->fault->{detail}->{error}->{text}; # warn $fault;
            $d->{pds_status} = $fault; # fault detail
            next PATIENT;
        }
        my $result = $USE_STORAGE
            ? $stored_pds_results->{$nhs_num}
            : $res->result; # p $result; # p $result->{Person}->{DateOfDeath};
        # store result (ignored later if $USE_STORAGE):
        $pds_results{$nhs_num} = $result;

        if ( $result->{Person}->{DateOfDeath} ) {
            delete $cml_patients->{$nhs_num};
            _update_patient_demographics($d->{patient_id} => $result);
        }
        else { # add pds error-code value:
            $d->{pds_status} = $result->{ErrorCode};
        }
    }
    store \%pds_results, $Bin.'/pds.data' unless $USE_STORAGE; # no need - will be same
}

#===============================================================================
# save remaining patients to excel file, sorted by date of last sample:
my @cols = qw/last_name first_name dob nhs_number location last_sample pds_status/;
$xl->write_bold_row(\@cols);
# sort by last sample date:
my @nhs_nums = sort by_date keys %$cml_patients; # p \@nhs_nums; exit;
# p [ @{ $cml_patients->{$_} }{@cols} ] for @nhs_nums; exit;
$xl->write_row([ @{ $cml_patients->{$_} }{@cols} ]) for @nhs_nums;

#===============================================================================
if ($JUST_TESTING) {
    $xl->save($filename);
}
else {
    my %mail = (
        config     => $config,
        subject    => $subject,
        filename   => $filename,
        attachment => $xl->data,
    );
    $tools->send_mail(\%mail, \@recipients);
}

#===============================================================================
sub _soap_data_format {
    my ($nhs_num, $d) = @_;

    my $last_name = $d->{last_name};
    my $dob = $d->{dob};
    $dob =~ s/-//g; # requires 8-digit string
    my %h = (
        DateOfBirth => $dob,
        FamilyName  => $last_name,
        NHSNumber   => $nhs_num,
        UserID      => $system_user,
    );
    my @data = map { SOAP::Data->name($_)->value($h{$_}) } keys %h;
    return \@data;
}

sub _update_patient_demographics {
    my ($patient_id, $data) = @_; # p $data;
    # will have to update manually as it may already have been done:
    return 0 if $USE_STORAGE;

    my $dod = $data->{Person}->{DateOfDeath};
    # convert dod to mysql date format:
    $dod =~ s/^(\d{4})(\d{2})(\d{2})$/$1-$2-$3/;

    # address is either href or AoH:
    my $addressAddress = $data->{Address}->{Address}; # p $address; # why Address-Address?
    if ( ref $addressAddress eq 'ARRAY' ) { # AddrType = H, TMP, PST
        # replace arrayref with href where AddrType = 'H' (assumes there always is one):
        ($addressAddress) = grep $_->{AddrType} eq 'H', @$addressAddress;
    } # p $addressAddress;
    my $address = join ', ', map $addressAddress->{$_}, sort by_addr_line # AddLine1, AddrLine3, etc
        grep $_ =~ /AddrLine/, keys %$addressAddress; # p $address;
    my $post_code = $addressAddress->{Postcode};

    my $table = 'patient_demographics';
    my %data  = (
        practice_id => $default_practice_id,
        patient_id  => $patient_id,
        post_code   => $post_code,
        address     => $address,
        status      => 'dead',
        gp_id       => $default_gp_id,
        dod         => $dod,
    );
    # "on duplicate key update" cols - skip address, maybe just a capitalised
    # version of existing entry, also because gp practice not available from pds:
    my @odku = qw(dod time status);
    # update existing record or insert new:
    my $result = $dbix->update_or_insert($table, \%data, \@odku); # p $result->rows;
    if ($result->rows) { # patient_demographic_history entry:
        my %h = (
            patient_id => $patient_id,
            user_id    => $system_user_id,
            action     => q!set patient demographic status to 'dead'!
        );
        $dbix->insert('patient_demographic_history', \%h);
    }
}

sub by_date { # p $cml_patients->{$a}; p $cml_patients->{$b};
    _to_datetime($cml_patients->{$a}->{last_sample}) cmp
    _to_datetime($cml_patients->{$b}->{last_sample})
}
sub by_addr_line {
    my ($addr_line_num_a) = $a =~ /(\d)$/; # p $addr_line_num_a;
    my ($addr_line_num_b) = $b =~ /(\d)$/; # p $addr_line_num_b;
    return $addr_line_num_a <=> $addr_line_num_b;
}
sub _to_datetime { DateTime::Format::MySQL->parse_date(@_) }

__DATA__
drop table if exists tmp1; /* all cml monitoring patients */
create temporary table tmp1(nhs_number char(10));
insert into tmp1(nhs_number)
	select distinct(p.nhs_number)
	from requests as r
		join request_initial_screen as ris on ( ris.request_id  =  r.id )
		join screens as s on ( ris.screen_id  =  s.id )
		join patient_case as pc on ( r.patient_case_id  =  pc.id )
		join patients as p on ( pc.patient_id  =  p.id )
        left join patient_demographics pd on ( pd.patient_id = p.id )
	where p.nhs_number is not null
        and s.description like 'follow-up cml (pb)%'
        and pd.`status` <> 'dead';
select * from tmp1;

drop table if exists tmp2; /* all above with at least 1 ICDO3 or unauthorised request in past 7 months */
create temporary table tmp2(nhs_number char(10));
insert into tmp2(nhs_number)
	select distinct(p.nhs_number)
	from requests as r
		left join authorised_reports_view arv on ( arv.id  =  r.id )
		join request_history as rh on ( rh.request_id  =  r.id )
		join patient_case as pc on ( r.patient_case_id  =  pc.id )
		join patients as p on ( pc.patient_id  =  p.id )
		join tmp1 t on ( p.nhs_number = t.nhs_number )
	where date(r.created_at) >= date_sub(current_date, interval 7 month)
		and ( rh.`action` !='authorised' or arv.icdo3 is not null );
select * from tmp2;

/* all cml monitoring patients with no ICDO3 or unauthorised requests in past 7 months */
select p.last_name, p.first_name, p.dob, p.nhs_number, rs.display_name,
    date_format(max(r.created_at), '%Y-%m-%d') as 'last_date'
from requests as r
		join patient_case as pc on ( r.patient_case_id  =  pc.id )
		join patients as p on ( pc.patient_id  =  p.id )
        join referral_sources rs on ( pc.referral_source_id  =  rs.id )
        join tmp1 t1 on ( t1.nhs_number = p.nhs_number )
        left join tmp2 t2 on ( t1.nhs_number = t2.nhs_number )
where t2.nhs_number is null
group by p.id
order by max(r.created_at);