RSS Git Download  Clone
Raw Blame History
# gets all pack dispatches for all outreach patients and applies 'current status'
# logic from packs.tt

use DBIx::Simple;
use SQL::Library;
use Modern::Perl;
use Data::Dumper;
use Data::Printer;
use FindBin qw($Bin); # warn $Bin; exit;
use DateTime::Format::MySQL;

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

# don't need query-logging:
my $dbix = DBIx::Simple->new( Local::DB->dsn({ dbname => 'hilis4' }) );

# pack dispatches:
my $sql = join '', <DATA>; # print $sql; exit;

my $today_dt  = DateTime->today;
my $today_ymd = _to_string($today_dt->ymd); # p $today; exit;

my @all_outreach_patients =
    $dbix->select('views.outreach_patients', 'nhs_number')->flat;

my $patient_status_map = _status_map(@all_outreach_patients);

for my $nhs_number (@all_outreach_patients) { # p $nhs_number;
    # say "$nhs_number - patient died" and
        next if $patient_status_map->{$nhs_number} eq 'dead';

    my @data = $dbix->query($sql, $nhs_number)->hashes
    # all 2005/06 screened as community monitoring with no subsequent CMP requests:
    or say "!!! $nhs_number has no data" and next; # p @data;

    my $current_pack = $data[0]; # p $current_pack;

    my $outcome = $current_pack->{outcome} || ''; # p $outcome;
    # say "$nhs_number - patient died" and
        next if $outcome eq 'dead';

    my $registered = _to_string($current_pack->{registered});
    my $req_status = $current_pack->{request_status};

    if ( $req_status eq 'complete' ) {
        my $pack_due  = _to_string($current_pack->{pack_due});
        my $pack_sent = _to_string($current_pack->{pack_sent});

        if ( $pack_due && $pack_due >= $today_ymd ) {
            my $res = "$nhs_number - next assessment is due on "
            . $current_pack->{pack_due};
            # p $res;
        }
        elsif ( $pack_sent && $pack_sent < $today_ymd ) {
            my $delta = _delta_days($current_pack->{pack_sent}); # p $delta_pack_sent;

            my $res = "$nhs_number - pack was sent on " . $current_pack->{pack_sent}
            . " [$delta days ago but has not been received";
            # p $res; # last;
        }
        elsif ( grep $outcome eq $_, ('return to clinic','other') ) {
            my $res = "$nhs_number - $outcome";
             p $res;
        }
        else {
            my $res = "$nhs_number - current request status complete but pack "
            . 'due not > today and pack sent not < today';
            # p $res; p $current_pack;
        }
    }
    elsif ( $req_status eq 'new' ) {
        my $res = "$nhs_number - pack was received on $registered and laboratory"
        . ' tests have been initiated';
        # p $res;
    }
    elsif ( $req_status eq 'screened' ) {
        my $res = "$nhs_number - pack was received on $registered and initial results"
        . ' indicate that no urgent action is required';
        # p $res;
    }
    else {
        my $res = qq{!!! $nhs_number - current request status = "$req_status"};
        # p $res; # p $current_pack; last;
    }
}

sub _status_map {
    my (@nhs_numbers) = @_; # p @nhs_numbers;
    
    my $sql = q!select p.nhs_number, pd.status from patient_demographics pd
        join patients p on pd.patient_id = p.id where p.nhs_number in (??)!;
    my $map = $dbix->query($sql, @nhs_numbers)->map; # p $map;
    return $map;
}

sub _delta_days {
    return DateTime::Format::MySQL
        ->parse_date($_[0])
        ->delta_days($today_dt)
        ->delta_days;
}

# convert mysql date yyyy-mm-dd to yyyymmdd for simple gt or lt comparisons:
sub _to_string { 
    my $date = shift || return; # p $date;
    my ($yyyy, $mm, $dd) = $date =~ /^(\d{4})-(\d{2})-(\d{2})/;
    return $yyyy.$mm.$dd;
}

=begin # get early community monitoring requests with no outreach data:
select r.request_number, r.year, p.last_name, p.first_name, s2.description as
    'screened', s.sample_code
from requests r
	join patient_case pc on r.patient_case_id = pc.id
	join patients p on pc.patient_id = p.id
	join ( request_specimen rs join specimens s on rs.specimen_id = s.id )
		on rs.request_id = r.id
	join ( request_initial_screen ris join screens s2 on ris.screen_id = s2.id )
		on ris.request_id = r.id
where p.nhs_number in (??) /* grep output from !!! "$nhs_number has no data"
order by p.last_name, p.first_name, r.year desc, r.request_number desc
=cut

__DATA__
SELECT
    r.id,
    r.request_number,
    r.year,
    so.description as 'request_status',
    r.created_at as 'registered',
    fo.`option`,
    fo.`label` as 'outcome',
    rpd.pack_due,
    rpd.pack_sent,
    rpd.return_due
FROM requests r
	JOIN status_options so on r.status_option_id = so.id
	JOIN patient_case pc on r.patient_case_id = pc.id
	JOIN patients p on pc.patient_id = p.id
    JOIN ( request_specimen rs JOIN specimens s on rs.specimen_id = s.id
        and s.sample_code = 'CMP' ) on rs.request_id = r.id
	LEFT JOIN outreach.request_pack_dispatch rpd on rpd.request_id = r.id
	LEFT JOIN ( outreach.request_followup rfu JOIN outreach.followup_options fo
        on rfu.followup_option_id = fo.id )	on rfu.request_id = r.id
WHERE p.nhs_number = ?
ORDER BY r.created_at DESC
LIMIT 10