#!/usr/bin/env perl
use Data::Dumper;
use Pod::Usage;
use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../lib';
use Module::Find;
BEGIN {
# set default to make script safe to run anywhere
$ENV{ROSEDB_DEVINIT} //= 'config/rosedb_devinit_test.pl';
Module::Find::useall LIMS::DB;
}
use HMDS::Perl;
use Term::ReadKey;
use Getopt::Long;
use Test::More;
my $req = LIMS::DB::Request->new;
check( $req->db->database );
my ( $cll_panel, $cd5_panel ); #used later to make linked quantification tests
# get lab_section
my $section = (
LIMS::DB::LabSection::Manager->get_lab_sections(
query => [
section_name => 'Multiplex Ligation-dependent Probe Amplification',
]
)
)->[0]
or die "Can't find Multiplex Ligation-dependent Probe Amplification";
# now work through the rfc changes...
{ # RFC Corrections to existing single tests:
my $old_tests = LIMS::DB::LabTest::Manager->get_lab_tests(
query => [
lab_section_id => $section->id,
field_label =>
[ '14q32.33 (AKT1)', '14q32.33 (MTA1)', '14q32.33 (KIAA0125)' ]
]
);
for my $test (@$old_tests) {
my $new_label = $test->field_label =~ s/\A14q/4q/rmsx;
$test->field_label($new_label);
my $new_name = $test->test_name =~ s/\A14q/4q/rmsx;
$test->test_name($new_label);
$test->save();
}
}
{
my $panel_acc_date;
{ # RFC Change to existing investigation:
$cll_panel = (
LIMS::DB::LabTest::Manager->get_lab_tests(
query => [
lab_section_id => $section->id,
field_label => 'MLPA CLL',
]
)
)->[0];
$cll_panel->field_label('Pre-treatment CLL (P038)');
$cll_panel->test_name('pre_treatment_cll_p038');
$cll_panel->save();
$panel_acc_date = $cll_panel->accreditation->accreditation_date;
}
{ # RFC Additional investigations:
$cd5_panel = LIMS::DB::LabTest->new(
test_type => 'panel',
test_name => 'cd5_diagnostic_p037',
field_label => 'CD5+ diagnostic (P037)',
lab_section => $section,
has_results => 'no',
is_active => 'yes'
);
$cd5_panel->accreditation( accreditation_date => $panel_acc_date );
$cd5_panel->sample_types(
{ specimen_type => 'biopsy - fixed' },
{ specimen_type => 'biopsy - unfixed' },
{ specimen_type => 'liquid' },
);
$cd5_panel->save();
}
{ # NOTE rename mlpa myeloma panel in line with new panels
my $myeloma_panel = LIMS::DB::LabTest->new(
test_type => 'panel',
test_name => 'mlpa_myeloma',
lab_section => $section,
);
$myeloma_panel->load();
$myeloma_panel->field_label('Myeloma');
$myeloma_panel->test_name('myeloma');
$myeloma_panel->save();
}
}
{ # RFC Linking of investigations to single tests
# MLPA Myeloma
my @myeloma_labels = (
'1p12 (FAM46C)',
'1p21.1 (COL11A1)',
'1p21.3 (DPYD)',
'1p31.3 (RPE65)',
'1p31.3 (LEPR-5)',
'1p32.1 (DAB1)',
'1p32.2 (PPAP2B)',
'1p32.3 (CDKN2C)',
'1p32.3 (FAF1)',
'1q21.3 (CKS1B1)',
'1q23.3 (NUF2)',
'1q23.3 (PBX1)',
'1q23.3 (RP11-541J2)',
'1q23.3 (RP11-480N10)',
'5q31.3 (PCDHA1)',
'5q31.3 (PCDHAC1)',
'5q31.3 (PCDHB2)',
'5q31.3 (PCDHB10)',
'5q31.3 (SLC25A2)',
'5q31.3 (PCDHGA11)',
'9p24.1 (JAK2)',
'9q34.3 (COL5A1)',
'12p13.31 (CD27)',
'12p13.31 (VAMP1)',
'12p13.31 (NCAPD2)',
'12p13.31 (CHD4)',
'13q14.2 (RB1)',
'13q14.2 (DLEU2-intr 1)',
'13q22.1 (DIS3)',
'14q32.32 (TRAF3)',
'15q12 (GABRB3)',
'15q26.3 (IGF1R)',
'16q12.1 (CYLD)',
'16q23.1 (WWOX)',
'17p13.1 (TP53)',
);
make_panel_lab_test_relationships( 'Myeloma', \@myeloma_labels, $section );
ok( 1, 'Myeloma' );
my @pre_treatment_cll_labels = (
'4q32.33 (AKT1)',
'4q32.33 (MTA1)',
'4q32.33 (KIAA0125)',
'10q23.31 (PTEN)',
'11q22.3 (ATM)',
'11q22.3 (RDX)',
'11q23.1 (PPP2R1B)',
'11q23.3 (CADM1)',
'12p13.31 (CD27)',
'12p13.3 (STAT6)',
'12q14.3 (HMGA2)',
'12q23.2 (IGF1)',
'12q23.2 (PAH)',
'13q14.2 (RB1)',
'13q14.2 (DLEU2)',
'13q14.2 (KCNRG)',
'13q14.2 (DLEU1)',
'13q14.3 (ATP7B)',
'17p13.1 (TP53)',
'19p13.2 (CDKN2D)',
'19p13.2 (LDLR)',
'19q12 (CCNE1)',
'19q13.2 (AKT2)',
'19q13.42 (MIR498)',
'SF3B1 K700E',
'MYD88 L265P',
'NOTCH1 P2514*fs'
);
make_panel_lab_test_relationships( 'Pre-treatment CLL (P038)',
\@pre_treatment_cll_labels, $section );
ok( 1, 'Pre-treatment CLL (P038)' );
{ # NOTE missing test add before linking
my $alk_test = LIMS::DB::LabTest->new(
test_type => 'test',
test_name => '2p23_2_alk',
field_label => '2p23.2 (ALK)',
lab_section => $section,
is_active => 'yes',
has_results => 'yes',
);
$alk_test->sample_types(
{ specimen_type => 'biopsy - fixed' },
{ specimen_type => 'biopsy - unfixed' },
{ specimen_type => 'liquid' },
);
# add result types etc
$alk_test->add_data_types(
{ data_type => { description => 'mlpa' }, is_active => 'yes' } );
$alk_test->save();
# copy accreditation date off another probe in same scope
my $example_probe = LIMS::DB::LabTest->new(
test_type => 'test',
field_label => '1p12 (FAM46C)',
lab_section => $section,
);
$example_probe->load();
$alk_test->accreditation( accreditation_date =>
$example_probe->accreditation->accreditation_date );
$alk_test->save();
}
my @cd5_diagnostic_labels = (
'2p24.3 (MYCN)',
'2p23.2 (ALK)',
'2p16.1 (REL)',
'6q21 (AIM1)',
'6q21 (SEC63)',
'6q23.3 (TNFAIP3)',
'6q25.1 (LATS1)',
'6q25.3 (IGF2R)',
'6q26 (PARK2)',
'8p21.3 (TNFRSF10B)',
'8p21.3 (TNFRSF10A)',
'8q24.11 (EIF3H)',
'8q24.21 (MYC)',
'9p21.3 (CDKN2A)',
'9p21.3 (CDKN2B)',
'11q22.3 (ATM)',
'12p13.32 (CCND2)',
'12p12.1 (LRMP)',
'12q14.1 (CDK4)',
'12q15 (IFNG)',
'12q24.33 (CHFR)',
'13q14.2 (FNDC3A)',
'13q14.2 (MIR15A)',
'13q14.3 (DLEU7)',
'13q14.2 (RB1)',
'13q14.2 (DLEU2)',
'13q14.2 (KCNRG)',
'13q14.3 (ATP7B)',
'17p13.1 (TP53)'
);
make_panel_lab_test_relationships( 'CD5+ diagnostic (P037)',
\@cd5_diagnostic_labels, $section );
ok( 1, 'CD5+ diagnostic (P037)' );
}
{
# RFC modifications to mlpa quantification test (molecular section)
# change to existing test
# get lab_section
my $section = (
LIMS::DB::LabSection::Manager->get_lab_sections(
query => [ section_name => 'Molecular', ]
)
)->[0]
or die "Can't find Molecular section?!?!?";
# rename test
my $quant_selected = LIMS::DB::LabTest->new(
test_type => 'test',
lab_section => $section,
test_name => 'mlpa_quantification',
);
$quant_selected->load();
$quant_selected->field_label('Quantification (selected)');
$quant_selected->test_name('quantification_selected');
$quant_selected->save();
# get ref to DNA quantification test
my $quant_unselected = LIMS::DB::LabTest->new(
test_type => 'test',
field_label => 'DNA quantification',
# test_name => 'dna_quantification',
lab_section => $section,
is_active => 'yes'
);
$quant_unselected->load();
# $quant_unselected->save();
# RFC link the tests
# myeloma panel already linked to quant_selected
my $link = LIMS::DB::LinkedLabTest->new(
parent_lab_test => $cd5_panel,
linked_lab_test => $quant_unselected,
);
$link = LIMS::DB::LinkedLabTest->new(
parent_lab_test => $cll_panel,
linked_lab_test => $quant_unselected,
);
}
# add accreditation relations
done_testing();
# add the panel_lab_test relationships
sub make_panel_lab_test_relationships {
my ( $panel_label, $panel_test_labels, $section ) = @_;
# get array of tests
my $myeloma_linked = (
LIMS::DB::LabTest::Manager->get_lab_tests(
query => [
lab_section_id => $section->id,
field_label => $panel_test_labels,
]
)
);
# get mlpamyeloid panel
my $panel = (
LIMS::DB::LabTest::Manager->get_lab_tests(
query => [
lab_section_id => $section->id,
field_label => $panel_label,
]
)
)->[0];
# assertions
die "errors in field names"
if scalar @$myeloma_linked != scalar @$panel_test_labels;
die "errors in panel name" if not defined $panel->test_name;
foreach my $test (@$myeloma_linked) {
my $linked_test = LIMS::DB::PanelLabTest->new(
panel_test_id => $panel->id,
lab_test_id => $test->id,
);
$linked_test->save();
}
}
# default check we are connecting to the correct database. Override with
# --no-checks
sub check {
my $dbname = shift;
my $nochecks;
GetOptions( 'no-checks|nochecks' => \$nochecks, )
or die pod2usage;
# check the db is correct
if ( not defined $nochecks ) {
say 'Database: ' . $dbname . "\nproceed? <y/n>";
ReadMode(4); # dont buffer STDIN
my $confirm = lc( ReadKey(5) // 'n' );
ReadMode(1);
if ( $confirm ne 'y' ) {
die 'Bailing out! Set ROSEDB_DEVINIT to change defaults';
}
}
return;
}
__END__
=pod
=encoding UTF-8
=for stopwords mlpa_updates.pl
=head1 NAME
mlpa_updates.pl -
=head1 USAGE
./mlpa_updates.pl [--no-checks]
ROSEDB_DEVINIT='config/rosedb_devinit_test.pl' ./mlpa_updates.pl
=head1 DESCRIPTION
=head1 REQUIRED ARGUMENTS
=head1 OPTIONS
=head1 EXIT STATUS
=head1 CONFIGURATION
=head1 DEPENDENCIES
=head1 BUGS AND LIMITATIONS
=head1 AUTHOR
Garry Quested <garry.quested@nhs.net>
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2018, HMDS. All Rights Reserved.
This script is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
