# 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'); }