• Files
• Commits
• Log
• Graph
• Stats

# pulls all bristol post-code GP practices & GP's into referral_sources & referrers tables
# require up-to-date egpcur.csv & epraccur.csv

my $test_db = 'test'; # DO NOT CHANGE THIS (or will drop bristol.referrers)
my $live_db = 'bristol'; # can change this for testing

use Getopt::Std;
getopts('q');
our($opt_q);
$ENV{SQL_TRACE} = $opt_q;

use FindBin qw($Bin);
use Data::Printer;
use Modern::Perl;
use Text::CSV;
use IO::File;
use IO::All;

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

my $dbix = Local::DB->dbix({ dbname => 'bristol' });
my $csv  = Text::CSV->new({ binary => 1 }); # ddp $csv; exit;

# fix incorrect entry (NORTHVILLE FAMILY PRACTICE):
$dbix->update('bristol.parent_organisations', { parent_code => 'L81028' },
    { parent_code => 'L81029' });
$dbix->update('bristol.referral_sources', { organisation_code => 'L81028' },
    { organisation_code => 'L81029' });

# skip duplicate places:
my %skip_codes = map { $_ => 1 }
    qw(Y03960 Y04363 Y05460);
recreate_test_tables(); # exit;

my $src_file  = "$Bin/../../src/data/epraccur.csv";
open( my $io, '<', $src_file ) || die $!;

my %org_codes; # new ones
my %prac_names; # to prevent duplicate places with same name & different codes (surely not !!)

my $new_locations = "$Bin/new_bristol_practices.xlsx";
my $xl = Local::WriteExcel->new( filename => $new_locations );
$xl->write_bold_row([ qw/code organisation_name location_name/ ]);

ROW: while ( my $row = $csv->getline($io) ) { # p $row; next ROW;
    my $post_code = $row->[9];
    next ROW unless $post_code =~ /^BS/; # p $post_code;
    my ($org_code, $name, @address)
        = map $row->[$_], (0,1,4..7); # p $org_code;
    next ROW if $dbix->select("$live_db.parent_organisations", 1,
        { parent_code => $org_code })->value;
    next ROW if $prac_names{$name}++ || $skip_codes{$org_code};
    # $org_codes{$org_code}++; # for GP's

    { # create new parent_organisation:
        my $description = join ', ', $name, $post_code; # p $description;
        my %h = (
            parent_code => $org_code,
            description => $description,
            referral_type_id => 5,
        ); # p %h;
        $dbix->insert("$live_db.parent_organisations", \%h);
    }
    { # referral_source:
        # my $addr = join ', ', @address; # p $addr;
        # sort the mess into a consistent format:
        my @addr = map { split /,/ } @address; # p @addr;
        for (@addr) {
            my @words = split ' ', $_; # p @words;
            $_ = join ' ', map { ucfirst lc $_ } @words;
        } # p @addr;

        my @parts;  # add components as needed:
        unless ( lc $name eq lc $addr[0] ) { # sometimes 1st col repeated in 2nd
            push @parts, join ' ', map { ucfirst lc $_ } split / /, $name;
        }
        push @parts,
            grep $_ !~ /^(Avon|North Somerset|South Gloucestershire)$/, @addr;
        push @parts, $post_code;

        my $display_name = join ', ', @parts; # p $display_name;
        { # tidy up:
            $display_name =~ s/Weston-super-mare/Weston-super-Mare/;
            $display_name =~ s/\bOoh\b/OOH/;
            $display_name =~ s/\bGp\b/GP/;
            $display_name =~ s/\bCats\b/CATS/;
            $display_name =~ s/\bPct\b/PCT/;
            $display_name =~ s/\bHmp\b/HMP/;
            $display_name =~ s/\bDvt\b/DVT/;
            $display_name =~ s/\bapms\b/APMS/;
            $display_name =~ s/\bwgh\b/WGH/;
            $display_name =~ s/\bcgh\b/CGH/;
            $display_name =~ s/\bpaulton\b/Paulton/;
            $display_name =~ s/\b M\.a\.t\.s\b/M.A.T.S/;
        }
        my $parent_organisation_id = $dbix->select("$live_db.parent_organisations",
            'id', { parent_code => $org_code })->value;
        my %h = (
            display_name => $display_name,
            organisation_code => $org_code,
            parent_organisation_id => $parent_organisation_id,
            referral_type_id => 5,
        ); # p %h;
        $xl->write_row([$org_code, $name, $display_name]);
        $dbix->insert("$live_db.referral_sources", \%h);
    }
=begin # easier to run update GP's in app
    { # GP's:
        my $src_file  = "$Bin/../../src/data/egpccur.csv";
        open( my $io, '<', $src_file ) || die $!;
        ROW: while ( my $row = $csv->getline($io) ) { # p $row;
            my $org_code = $row->[14];
            next ROW unless $org_codes{$org_code};
            my ($gmc, $name) = map $row->{$_}, (0,1);
            my %h = (
                name => $name,
                national_code => $national_code,
                referral_type_id => 3,
            );
            $dbix->insert("$db.referrers", \%h);
    }
=cut
}
$xl->save;

sub recreate_test_tables {
    $dbix->dbh->do('SET FOREIGN_KEY_CHECKS = 0');
    for my $tbl ( qw/referrers referral_sources parent_organisations/ ) {
        say "dropping $test_db.$tbl";

        $dbix->dbh->do("DROP TABLE IF EXISTS $test_db.$tbl" );
            say "creating new $tbl";
        $dbix->dbh->do( qq!CREATE TABLE $test_db.$tbl LIKE bristol.$tbl! );
        my $sql = qq!INSERT INTO $test_db.$tbl
            SELECT * FROM bristol.$tbl!; # say $sql;
            say "copying data into $test_db.$tbl";
        $dbix->dbh->do($sql);
            say 'done';
    }
    $dbix->dbh->do('SET FOREIGN_KEY_CHECKS = 1');
}