package LIMS::Local::NGIS;

# shared methods for NGIS data extraction functions

use Moo;
use IO::All;
use Path::Tiny;
use YAML::Tiny;
use Data::Printer;
use Clone 'clone';
use FindBin '$Bin'; # p $Bin; exit;
use SQL::Abstract::More;
use Time::HiRes qw(gettimeofday tv_interval);
use Types::Standard qw(HashRef ArrayRef Str Num Bool InstanceOf Object);

use feature 'say';

# fixed data arrays ------------------------------------------------------------
use constant INCLUDED_LAB_SECTIONS => [
    'Multiplex Ligation-dependent Probe Amplification', 'FISH', 'Molecular',
    'Micro-array', 'High-throughput sequencing', 'Whole Genome Sequencing',
];
use constant LAB_NAME => 'YNEGLH Leeds HMDS';
use constant EXCLUDED_PARENT_CODES => [
    'RWM', 	  # Cardiff
    'RVA', 	  # Carmarthen
    'RT8', 	  # Conwy
    'RVF', 	  # Gwent
    'RT9', 	  # NE Wales
    'RT7', 	  # NW Wales
    'RVC', 	  # Swansea
    'RQF', 	  # Velidre, Wales
    '8EQ15',  # Drs Lab
    'MSDMDH', # Mater Dei
    'X99999', 'V81999' # unknowns
];
use constant PRESENTATION_TYPES => {
    AML       => 'M80',
    CLL       => 'M94',
    CML       => 'M84',
    MDS       => 'M82',
    MPN       => 'M85',
    PNH       => 'M82',
    Hodgkin   => 'M93',
    'B-ALL'   => 'M91',
    myeloma   => 'M92', # case-sensitive
    Aplastic  => 'M82',
    Cytopenia => 'M82', # MDS
    # forcing lymphomas to clinical indication code for high-grade lymphoma
    # (M99) which has more associated test-codes (M99.x) than M95 (B-NHL):
    'Suspected B-cell lymphoma' => 'M99',
    'Suspected lymphoma'        => 'M99',
    'Probable B-LPD'            => 'M99',
    # molecular-only screens:
    'CLL FISH only'                      => 'M94',   # CLL
    'HTS CLL/MZL only'                   => 'M94',   # CLL
    'Lymphoma FISH only'                 => 'M99',   # High-grade lymphoma
    'Molecular tests - BRAF V600E'       => 'M108',  # HCL
    'Molecular tests - cKIT'             => 'M86',   # Systemic mastocytosis
    'Molecular tests - IGH VH'           => 'M94',   # CLL
    'Molecular tests - JAK2 exon 12'     => 'M85',   # MPN
    'Molecular tests - MPL exon 10'      => 'M85',   # MPN
    'Molecular tests - MYD88'            => 'M104',  # Lymphoplasmacytic lymphoma / WM
    'Molecular tests - STAT3'            => 'M114',  # LGL
#   'Molecular tests - B-cell clonality' => '', # needs temp code
#   'Molecular tests - T-cell clonality' => '', # needs temp code
};
# last resort:
use constant FORCED_NGIS_CODES => {
    # for confirmation:
    # 'Cytocell MECOM' => 'XTR26.a', # rare-disease temp code (breaks table joins if used in db)
    'BCR-ABL-tests'      => 'M84.1',  # CML - regex match in try_presentation()
    'Cytocell CCND1/IGH' => 'M102.2', # MCL
    'CytoSNP'            => 'M82.2',  # MDS
    'CBFbeta MYH11'      => 'M80.7',  # AML
    'HTS myeloid'        => 'M82.1',  # MDS
    'RUNX1-RUNX1T1'      => 'M80.7',  # AML
};
#-------------------------------------------------------------------------------

has data => ( is => 'rw', isa => ArrayRef[HashRef], clearer => 1 );
has dbix => ( is => 'ro', isa => InstanceOf['Local::DB'], required => 1 );

has log_stash => ( is => 'rw', isa => HashRef, default => sub { {} } );
has local_lab_name => ( is => 'ro', isa => Str, builder => 1 );
has excluded_lab_tests => (
    is  => 'ro',
    isa => HashRef[ArrayRef],
    builder => 1,
);
has excluded_test_names => (
    is => 'ro',
    builder => sub { 'quantification|store_[dr]na' }, # for use in regex
);
# arrayref data:
has $_ => (
    is  => 'lazy',
    isa => ArrayRef,
) for qw/
    excluded_parent_codes
    excluded_lab_test_ids
    included_lab_sections
/;
# hashref data:
has $_ => (
    is  => 'lazy',
    isa => HashRef,
) for qw/
    extraction_dates_for_requests
    presentation_types
    section_lab_tests
    forced_ngis_codes
    panel_lab_tests
    ngis_lab_tests
    rna_tests
/;
# read/write arrays supplied by caller scipt:
has $_  => ( is => 'rw', isa => ArrayRef )
    for qw( col_headers null_fields timer_start );
# Boolean switches supplied by caller scipt:
has $_ => ( is => 'rw', isa => Bool ) for qw( query_output test_mode );

# __PACKAGE__->dbix->lc_columns = 0; # preserve mixed case on col names (now standardised)

# method builders --------------------------------------------------------------
sub _build_included_lab_sections { INCLUDED_LAB_SECTIONS }
sub _build_excluded_parent_codes { EXCLUDED_PARENT_CODES }
sub _build_presentation_types    { PRESENTATION_TYPES    }
sub _build_forced_ngis_codes     { FORCED_NGIS_CODES     }
sub _build_local_lab_name        { LAB_NAME              }

# methods requiring db or file read:
sub _build_excluded_lab_tests {
    my $self = shift;

    my $src = path($Bin, '..', '..', '..',
        qw/config settings .leeds ngis_excluded_lab_tests.yml/ )->realpath; # warn $src;
    my $yaml = YAML::Tiny->read($src) or die "cannot load yaml file"; # p $yaml;

    my $ref = $yaml->[0];
    { # may need to exclude D/RNA extractions in future:
        my @extractions = ( 'DNA extraction', 'RNA extraction',
            'CD138+ DNA', 'CD19+ DNA' );
        # push @{ $ref->{Molecular} }, @extractions;
    }
    return $ref;
}

sub _build_rna_tests {
    my $self = shift;

    my $dbix = $self->dbix;

    my @skipped_tests = ( 'FLT3 ITD', 'FLT3 TKD', 'NPM1' ); # can be done on both DNA & RNA

    my @rels = (                       'linked_lab_test|llt' ,
        'llt.parent_test_id=lt1.id' => 'lab_tests|lt1'       ,
        'llt.linked_test_id=lt2.id' => 'lab_tests|lt2'       ,
    );
    my @args = (
		-columns  => [ 'lt1.test_name', 1 ],
		-from     => [ -join => @rels ],
		-where    => {
            'lt1.field_label' => { -not_in => \@skipped_tests },
            'lt2.test_name'   => 'rna_extraction',
        },
    ); # p @args;
    my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
         $dbix->dump_query($sql, @bind) if $self->query_output; # exit;
    my $map = $self->dbix->query( $sql, @bind )->map;
    # add rna_extraction in case extraction tests are required in data return:
    $map->{rna_extraction} = 1;
    return $map;
}

sub _build_ngis_lab_tests {
    my $self = shift;

    my $dbix = $self->dbix;
    my $q = $dbix->select('ngis_lab_test', [qw/lab_test_id ngis_test_code/]);
    my %h;
    while ( my $ref = $q->array ) { # p $ref;
        my $lab_test_id = $ref->[0];
        push @{ $h{$lab_test_id} }, $ref->[1];
    }
    return \%h;
}

sub _build_excluded_lab_test_ids {
    my $self = shift;

    my @test_ids;

    my $dbix = $self->dbix;

    my %excluded_lab_tests = %{ $self->excluded_lab_tests };

    my @rels = ( 'lab_tests|lt', 'lt.lab_section_id=ls.id', 'lab_sections|ls' );
    my %args = (
        -columns  => 'lt.id',
        -from     => [ -join => @rels ],
    );
    while ( my($section, $ref) = each %excluded_lab_tests ) {
        $args{'-where'} = {
            'ls.section_name' => $section,
            'lt.field_label'  => { -in => $ref },
        };
        my ($sql, @bind) = SQL::Abstract::More->new->select(%args); # p $sql; p \@bind;
            $dbix->dump_query($sql, @bind) if $self->query_output; # exit;
        my @ids = $dbix->query($sql, @bind)->column; # ref
        push @test_ids, @ids;
    } # p @test_ids;
    return \@test_ids;
}

sub _build_panel_lab_tests {
    my $self = shift;

    my $dbix = $self->dbix;

    my @lab_sections = qw(FISH Molecular);

    my $excluded_lab_tests = $self->excluded_lab_tests;

    my @cols = (
    	'lt1.field_label|panel',
        'lt2.field_label|test',
    );
    my @rels = (                         'panel_lab_test|plt'  ,
        'plt.panel_test_id=lt1.id'    => 'lab_tests|lt1'       ,
        'plt.lab_test_id=lt2.id'      => 'lab_tests|lt2'       ,
        'lt1.lab_section_id=ls.id'    => 'lab_sections|ls'     ,
    );
    my %panel_tests;
    for my $section (@lab_sections) {
        # need to *locally* exclude DNA extraction, if not already excluded:
        my @local_excluded_tests = @{ $excluded_lab_tests->{$section} };
        push @local_excluded_tests, 'DNA extraction'
            unless grep { $_ eq 'DNA extraction' } @local_excluded_tests;

        my %where = (
            'lt1.field_label' => { -not_in => \@local_excluded_tests },
            'lt2.field_label' => { -not_in => \@local_excluded_tests },
            'ls.section_name' => $section,
            'lt1.is_active'   => 'yes',
        );
        my @args = (
            -columns  => \@cols,
            -from     => [ -join => @rels ],
            -where    => \%where,
        ); # p @args;
        my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
             $dbix->dump_query($sql, @bind) if $self->query_output; # exit;
        my $query = $dbix->query( $sql, @bind );

        my %h;
        while ( my $ref = $query->hash ) {
            my $panel = $ref->{panel};
            push @{ $h{$panel } }, $ref->{test};
        } # p %h;
        # re-arrange in order of size of panel, largest 1st:
        my @data = map [ +($_ => $h{$_}) ],
            sort { scalar @{ $h{$b} } <=> scalar @{ $h{$a} } } keys %h; # p @data;
        $panel_tests{$section} = \@data;
    }
    return \%panel_tests;
}

sub _build_section_lab_tests {
    my $self = shift;

    my $dbix = $self->dbix;

    my @lab_sections = qw(FISH Molecular);

    my @rels = ( 'lab_tests|lt', 'lt.lab_section_id=ls.id', 'lab_sections|ls' );
    my %args = (
		-columns  => [ qw/lt.field_label lt.id/ ],
		-from     => [ -join => @rels ],
		-where    => { 'ls.section_name' => undef }, # defined in block
    ); # p @args;
    my %h;
    for my $section (@lab_sections) {
        $args{'-where'}{'ls.section_name'} = $section;
        my ($sql, @bind) = SQL::Abstract::More->new->select(%args); # p $sql; p \@bind;
             $dbix->dump_query($sql, @bind) if $self->query_output; # exit;
        $h{$section} = $dbix->query( $sql, @bind )->map;
    } # p \%h;
    return \%h;
}

sub _build_extraction_dates_for_requests {
    my $self = shift;

    my $dbix = $self->dbix;
    my $data = $self->data;

    my @request_ids = map $_->{internal_request_id}, @$data;

    my @cols = (
        'ts.request_id',
        q!CASE WHEN lt.test_name = 'cd19_dna'  THEN 'CD19_DNA'
               WHEN lt.test_name = 'cd138_dna' THEN 'CD138_DNA'
               ELSE LEFT(lt.field_label, 3) END as type!,
        'ts.time',
    );
    my @rels = (                       'request_lab_test_status|ts',
        'ts.lab_test_id=lt.id'      => 'lab_tests|lt'              ,
        'ts.status_option_id=so.id' => 'lab_test_status_options|so',
    );
    my @extraction_tests = qw/dna_extraction rna_extraction cd138_dna cd19_dna/;
    my %where = (
        'so.description' => 'complete',
        'lt.test_name'   => { -in => \@extraction_tests },
        'ts.request_id'  => { -in => \@request_ids },
    );
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
    ); # p @args;
    my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
         $dbix->dump_query($sql, @bind) if $self->query_output; # exit;
    my $query = $dbix->query( $sql, @bind );

    my %h;
    while ( my $ref = $query->hash ) {
        my $request_id = $ref->{request_id};
        my $datetime   = $ref->{time};
        my $type       = $ref->{type};

        $h{$request_id}{$type} = $datetime;
    }
    return \%h;
}

#===============================================================================
sub preprocess_data {
    my ($self, $data) = @_; $self->runtimer('commencing data processing');
    # store data:
    $self->data($data);

    # pre-process data to reconstitute (some) molecular panels:
    $self->reconstitute_molecular_panels;
    # pre-process data to split (some) FISH panels (too complex to combine with above):
    $self->split_fish_panels; $self->runtimer('finished pre-processing data');
}

sub finalise_data {
    my ($self, $data) = @_; # p $data;

    # NGIS test code (unless already set eg geneq_csv_extract):
    $data->{test_id} ||= $self->get_ngis_test_code($data);

    $data->{datetime_processing_complete} = $self->get_processing_date($data);

    $data->{$_} = undef for @{ $self->null_fields }; # p $data;

    my @col_headers = @{ $self->col_headers }; # p @col_headers;
    return [ @{$data}{@col_headers} ];
}

sub fish_panel_names_without_ngis_codes {
    my $self = shift;

    my $dbix = $self->dbix;

    my $excluded_lab_tests = $self->excluded_lab_tests;

    my @rels = (                       'lab_tests|lt',
        'lt.lab_section_id=ls.id'   => 'lab_sections|ls',
        '=>nlt.lab_test_id=lt.id'   => 'ngis_lab_test|nlt'
    );
    my %where = (
        'ls.section_name' => 'FISH',
	    'lt.test_type'    => 'panel',
        'lt.field_label'  => { -not_in => $excluded_lab_tests->{FISH} },
        'nlt.lab_test_id' => undef,
    );
    my @args = (
		-columns  => 'lt.field_label',
		-from     => [ -join => @rels ],
		-where    => \%where,
    ); # p @args;
    my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
         $dbix->dump_query($sql, @bind) if $self->query_output; # exit;
    return $dbix->query( $sql, @bind )->column;
}

sub reconstitute_molecular_panels {
    my $self = shift; $self->runtimer('reconstituting molecular panels');

    my $data = $self->data; # p $data;

    # new data file:
    my @new;

    # keep track of request_id:
    my $last_request_id = 0;
    # holder for molecular tests data:
    my @molecular_tests = (); # will be destroyed and recreated after each request

    ROW:
    for my $row (@$data) { # p $row;
        my $lab_section = $row->{_section_name};
        my $request_id  = $row->{internal_request_id};
        # if new request, handle molecular tests data, if any:
        if ( @molecular_tests && $request_id != $last_request_id ) {
            #$log->info("molecular tests for $last_request_id:",
            #    { set => [ map $_->{test_name}, @molecular_tests ] } );
            my @rows = $self->molecular_tests_to_panels(\@molecular_tests); # p @rows;
            push @new, @rows;
            @molecular_tests = (); # reset for next request
        }
        push @new, $row and next ROW if $lab_section ne 'Molecular';
        # have molecular data row:
        push @molecular_tests, $row;
        # set last_request_id to current request_id:
        $last_request_id = $request_id;
    } # p %tests;
    # clear and re-store data:
    $self->clear_data;
    $self->data(\@new);
}

sub split_fish_panels { # only some FISH panels (those without an NGIS map):
    my $self = shift; $self->runtimer('splitting FISH panels');

    my $data = $self->data; # p $data;

    my @required_fish_panels = @{ $self->fish_panel_names_without_ngis_codes }; # p $required_fish_panels;
    my @fish_panel_lab_tests = @{ $self->panel_lab_tests->{FISH} };
    my $section_lab_tests    = $self->section_lab_tests;

    my %non_ngis_fish_panels;
    # skip panels from $fish_panel_lab_test with NGIS codes:
    for my $ref (@fish_panel_lab_tests) { # AoA
        my $panel_name = $ref->[0]; # p $panel_name;
        next unless grep { $panel_name eq $_ } @required_fish_panels;
        # debug("$panel_name in required_fish_panels");
        $non_ngis_fish_panels{$panel_name} = $ref->[1];
    } # p %non_ngis_fish_panels;

    # coderef for substituting test names (eg  "DLBCL + FL" panel -> "DAKO MYC")
    my $substitute_values = sub {
        my ($row, $new_test_name) = @_;
        $row->{test_name} = $new_test_name;
        # also need to change lab_test_id for finding NGIS test code:
        $row->{_lab_test_id} = $section_lab_tests->{FISH}->{$new_test_name};
        $row->{_test_type}   = 'test'; # for log in case it's unmapped
    };

    ROW:
    for my $row (@$data) {
        my $test_name = $row->{test_name};
        my $lab_num   = $row->{local_sample_id};
        # if test name matches one of FISH panels without an NGIS code:
        if ( grep $test_name eq $_, keys %non_ngis_fish_panels ) {
            # get FISH panel test names:
            my @panel_tests = @{ $non_ngis_fish_panels{$test_name} };
            { # change test_name to 1st element of $panel_tests
                my $new_test_name = shift @panel_tests;
                $self->debug("$lab_num: changing $test_name to $new_test_name");
                &$substitute_values($row,$new_test_name);
            }
            # now clone $row for each remaining element in @panel_tests:
            TEST:
            for my $t (@panel_tests) {
                my $new = clone $row;
                # repeat above substitutions:
                $self->debug("$lab_num: adding new row with test-name $t");
                &$substitute_values($new,$t);
                push @$data, $new;
            }
        }
    }
    # re-sort by lab_number (@data now out of sequence after pushing new rows)
    my @new = sort { $a->{internal_request_id} <=> $b->{internal_request_id} }
        @$data;
    # clear and re-store data:
    $self->clear_data;
    $self->data(\@new);
}

sub get_processing_date {
    my ($self, $ref) = @_;
    # FISH tests not done on D/RNA extraction so can't get a processing date:
    return if $ref->{_section_name} eq 'FISH';

    my $test_name = $ref->{_test_name}; # p $test_name;
    my $lab_num   = $ref->{local_sample_id};
    my $req_id    = $ref->{internal_request_id}; # p $req_id;

    # get request_ids and DNA/RNA extraction dates into hash map:
    my $extraction_dates = $self->extraction_dates_for_requests;
    # io('extraction_dates.txt')->appendln($_) for keys %$extraction_dates;

    # get extraction dates for DNA and/or RNA:
    my $extraction = $extraction_dates->{$req_id}; # p $extraction;
    $self->debug("no extraction for $lab_num $test_name") and return
        unless $extraction;

    # get expected material, RNA if test_name in %rna_tests, otherwise assume
    # DNA, except a small minority of tests done on cell-selected DNA (see below):
    my $material = $self->rna_tests->{$test_name} ? 'RNA' : 'DNA';
    # get extraction date for test material:
    my $date = $extraction->{$material};
    # some tests (eg MLPA myeloma) are done on CD19- or CD138-selected DNA -
    # key = CDxx_DNA in %extraction_dates (TODO: no way of knowing which used if >1):
    $date ||= ( $extraction->{CD19_DNA} || $extraction->{CD138_DNA} );
    # or give up - no extraction date available:
    $self->debug("no extraction date for $lab_num $test_name $material") and
        return unless $date;
    return $date;
}

sub get_request_history {
    my ($self, $request_id) = @_; # p $request_id;

    my $query = $self->dbix->select('request_history', 'action',
        {
            request_id => $request_id,
            action     => { -like => 'updated initial screen entry %' }
        }
    );
    my @screens;
    while ( my $action = $query->value ) { # p $action;
        if ( $action =~ /updated initial screen entry (.*)/ ) {
            push @screens, $1;
        }
    }
    return wantarray ? @screens : \@screens;
}

sub get_ngis_test_code {
    my ($self, $ref) = @_; # p $ref if $ref->{test_name} =~ /Burkitt mutation/;

    my $presentation = $ref->{_presentation};
    my $diagnosis_id = $ref->{_diagnosis_id};
    my $lab_test_id  = $ref->{_lab_test_id};
    my $lab_section  = $ref->{_section_name};
    my $test_name    = $ref->{test_name};       # say $test_name;
    my $test_type    = $ref->{_test_type};
    my $diagnosis    = $ref->{_diagnosis} || '[NOT REPORTED]';
    my $lab_num      = $ref->{local_sample_id};

    my $presentation_diagnosis = join '::', $presentation, $diagnosis; # p $presentation_diagnosis;

  # get NGIS code(s) for this lab-test:
    my $ngis_test_code = $self->ngis_lab_tests->{$lab_test_id}; # p $ngis_test_code; # aref
    unless ($ngis_test_code) { # p [$test_name, $test_type, $lab_section];
        my $title = join ' :: ', $test_name, $test_type, $lab_section;
        my $stash = $self->log_stash;
        $stash->{no_ngis_code}{$title}++; # $self->debug("$lab_num: no NGIS id for $test_name");

        return undef if $test_name =~ /[DR]NA extraction|CD1(9|38)\+ DNA/;

        push @{ $stash->{no_ngis_code_requests} },
            [ $lab_num, $test_name, $presentation, $diagnosis ];
        return $presentation_diagnosis;
    }
  # return NGIS test code if it's the only one (even if not supported clinical
  # indication; TODO: this might not be suitable, might need to consider diagnosis):
    return $ngis_test_code->[0] if scalar @$ngis_test_code == 1;

    my $all_test_codes = join ', ', @$ngis_test_code; # for log

  # now have multiple NGIS id's for lab-test
    # common message for debugging:
    my $msg = qq!$lab_num: multiple NGIS codes for '$test_name'!;

    # args for try_presentation():
    my %args = ( data => $ref, ngis_code => $ngis_test_code );

   # now need to examine diagnosis:
    if (! $diagnosis_id) { # p $ref;
        if ( my $ngis_code = $self->try_presentation(\%args) ) {
            # say "found $ngis_code from $presentation";
            # $self->debug("found $ngis_code from $presentation");
            return $ngis_code;
        } # say "$msg and request is not reported";
        # io($log)->appendln("$msg and request is not reported");
        my $stash = $self->log_stash;
        push @{ $stash->{unreported} }, [ $lab_num, $test_name, $presentation ];
        return $presentation_diagnosis;
    }
  # get clinical indication for diagnosis (eg AML NOS = M80)
    my $indication = $ref->{_clinical_indication_code}; # p $indication;
    if (! $indication) { # $self->debug('no clinical indication');
        if ( my $ngis_code = $self->try_presentation(\%args) ) {
            # $self->debug("found $ngis_code from $presentation");
            return $ngis_code;
        }
        #io($log)->appendln("$msg and '$diagnosis' has no clinical indication id"
        #    . " [presentation: $presentation]");
        my $stash = $self->log_stash;
        push @{ $stash->{no_clinical_indication} },
            [ $lab_num, $test_name, $presentation, $diagnosis ];
        return $presentation_diagnosis;
    } # p $indication; p $ngis_ids;

  # return NGIS code from list if has a matching clinical indication:
    for my $ngis_code (@$ngis_test_code) { # warn $ngis_code;
        # $self->debug("$lab_num: $indication -> $ngis_code") if $ngis_code =~ /^$indication/;
        return $ngis_code if $ngis_code =~ /^$indication/;
    }
  # last resort is to try to find NGIS code from presentation:
    if ( my $ngis_code = $self->try_presentation(\%args) ) {
        # $self->debug("found $ngis_code from $presentation");
        return $ngis_code;
    }

  # can't find an NGIS code for lab-test from presentation or diagnosis:
    #io($log)->appendln("$msg and diagnosis indication $indication [$diagnosis] "
    #    . "did not match any available NGIS test codes [presentation: $presentation]");
    # $self->debug("no NGIS id available for $test_name");
    {
        my @data = ( $lab_num, $test_name, $all_test_codes, $diagnosis,
            $indication, $presentation );
        my $stash = $self->log_stash;
        push @{ $stash->{no_available_ngis_code} }, \@data;
    }
    # return undef;
    return $presentation_diagnosis;
}

sub try_presentation { # try to look for a loose match with presentation term:
    my $self = shift;
    my $args = shift;

    my $presentation = $args->{data}->{_presentation};
    my $request_id   = $args->{data}->{internal_request_id};
    my $ngis_codes   = $args->{ngis_code};
    my $test_name    = $args->{data}->{test_name};
       # p $presentation; p $ngis_codes; p $test_name;

    # get any previous screening terms from history file:
    my @all_screens = $self->get_request_history($request_id);
    push @all_screens, $presentation; # p @all_screens;

    my %presentation_types = %{ $self->presentation_types };

    for my $screen (@all_screens) {
        for my $type ( keys %presentation_types ) { # p $type; # eg AML, MDS
            if ( $screen =~ /$type/ ) { # eg Suspected MDS =~ /MDS/
                # $self->debug("$screen matches $type");
                for my $code (@$ngis_codes) { # eg M84.2
                        # p $code; p $presentation_types{$type};
                    if ( $code =~ /^$presentation_types{$type}/ ) { # eg M84.2 =~ /^M84/
                        # $self->debug("$code matches $presentation_types{$type}");
                        return $code;
                    }
                }
            }
        }
    }
    { # if we get this far, no other match possible, force NGIS code if test
        # configured in $forced_ngis_codes:
        my %forced_ngis_codes = %{ $self->forced_ngis_codes };
        for my $test ( keys %forced_ngis_codes ) {
            return $forced_ngis_codes{$test} if $test_name eq $test;
        }
        # BCR-ABL p210 RQ or BCR-ABL multiplex:
        return $forced_ngis_codes{'BCR-ABL-tests'} if $test_name =~ /BCR-ABL/;
    }
    return undef;
}

sub molecular_tests_to_panels {
    my $self = shift;
    my $ref  = shift; # AoH's

    my @molecular_panel_lab_tests = @{ $self->panel_lab_tests->{Molecular} };
    my $section_lab_test_id       = $self->section_lab_tests->{Molecular};
    my @all_molecular_tests       = map $_->{test_name}, @$ref;
        # say 'test_names:'; p @all_molecular_tests;

    # panels ordered in size of array, largest 1st to prevent matches with
    # smaller panels having common members (eg AML 60+ & AML under-60):
    PANEL:
    for my $t (@molecular_panel_lab_tests) { # eg AML 60+ => [NPM1, FLT3 ITD]
        my ($panel_name, $panel_tests) = @$t; # p @$panel_tests;
        # don't need ordered list, use -u flag for speed boost:
        my $lc = List::Compare->new('-u', $panel_tests, \@all_molecular_tests);
        # if this panel list is a subset of all_molecular_tests:
        if ( $lc->is_LsubsetR ) { # is left-a-subset-of-right ?
            #$log->info("$panel_name panel found in molecular set:",
            #    { panel_tests => $panel_tests } );

            my @set = @$panel_tests; # localise for element substitutions
            my %seen = (); # reset test name stash for this panel

            # remove 1st element in @set into a variable:
            my $first_element_of_set = shift @set;
                # $self->debug("first_element_of_set: $first_element_of_set");

            # for test name of 1st entry in $ref matching 1st element of @set,
            # change it to the matched panel_name & flag the rest for deletion:
            DATA:
            for my $d (@$ref) { # p $d; # data href
                next DATA if $d->{DELETE_ME}; # already flagged for deletion
                my $test_name = $d->{test_name}; # p $test_name;
                my $lab_num   = $d->{local_sample_id};
                    # $self->debug("$lab_num: testing whether $test_name eq $first_element_of_set");
                if ( $test_name eq $first_element_of_set ) {
                    #$log->info("changing $test_name to $panel_name");
                     $self->debug("$lab_num: changing $test_name to $panel_name");
                    $d->{test_name} = $panel_name;
                    $d->{_test_type} = 'panel'; # for log in case it's unmapped
                    #  for finding NGIS test code:
                    $d->{_lab_test_id} = $section_lab_test_id->{$panel_name};
                 }
                elsif ( grep $test_name eq $_, @set ) {
                    # set a flag for later (only once per test in case it's
                    # re-requested or is part of another panel):
                    next DATA if $seen{$test_name}++;
                    #$log->info("$test_name is in $panel_name set, flagging for deletion");
                    # $self->debug("$test_name is in $panel_name set, flagging for deletion")
                    $d->{DELETE_ME}++;
                }
            }
        }
    } # p $ref;
    # $log->info('=' x 30);
    # return original hashrefs not flagged for deletion:
    my @data = map $_, grep {! $_->{DELETE_ME} } @$ref; # say 'new rows'; p @data;
    return wantarray ? @data : \@data;
}

sub set_t0 { $_[0]->timer_start([gettimeofday]) }

sub runtimer { # output in test mode only:
    my ($self, $str) = @_;
    say sprintf '%s: %.2f sec',
        $str, tv_interval $self->timer_start, [gettimeofday] if $self->test_mode;
}

sub debug { say $_[1] if $_[0]->test_mode }

=begin # called from get_test_request_date(), not used
sub get_manual_test_request {
    my ($request_id, $test_name) = @_;

    my @args = (
		-columns  => [ 'time' ],
		-from     => [ 'request_lab_test_history' ],
        -where    => {
            request_id => $request_id,
            action => {
                -rlike => '^(auto-)?requested( linked test)? ' . $test_name
            },
        },
        -order_by => [ '-time' ], # ORDER BY time DESC
        -limit    => 1,           # returns most recent only if >1
    ); # p @args;

    my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
        # $dbix->dump_query($sql, @bind) if $self->query_output; # exit;
    return $dbix->query($sql, @bind)->value;
}
=cut

=begin # not used - replaced by datetime_order_received
sub get_test_request_date {
    my $ref = shift; # p $ref;

    my $request_id = $ref->{internal_request_id};
    my $registered = $ref->{datetime_sample_received};
    my $test_name  = $ref->{test_name};
    my $screened   = $ref->{_datetime_screened};

    # use manual request date if exists, or auto-request date, or date of screening:
    my $manual_request_date = get_manual_test_request($request_id, $test_name);
    # auto-requested by sample-type, therefore date = registration:
    my $auto_request_date = $registration_lab_tests->{$test_name}
        ? $registered : 0; # zero OK as will be tested for truth below
        # p [$manual_request_date, $auto_request_date, $screened];

    return $manual_request_date || $auto_request_date || $screened;
}
=cut

=begin # not used:
sub get_registration_lab_test_requests {
    my @cols = ( 'DISTINCT t2.field_label', 1 );
    my @rels = ('specimen_lab_test|t1', 't1.lab_test_id=t2.id', 'lab_tests|t2');
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
    ); # p @args;
    my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind;
         $dbix->dump_query($sql, @bind) if $query_output; # exit;
    return $dbix->query($sql, @bind)->map;
}
=cut

1;