• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

# tests local billing rules
# so far just requests with HTS myeloid panel
# export DEBUG_ON to see debug output

use LIMS::Local::Billing;
use DateTime::Tiny;
use Clone 'clone'; # or use LLU::clone
use Test::More;

use constant TESTS => 34;

use strict;
use warnings;

use Data::Printer alias => 'p';

# example data - need to add presentation and request_lab_tests, and
# optionally change sample_code in test blocks:
my %data = qw(
    id                          1
    request_number              100
    year                        2000
    last_name                   billing
    first_name                  phil
    unit_number                 B1010
    nhs_number                  1111111111
    organisation_code           RR801
    referrer_code               C1234567
    sample_code                 PB
    category                    01
    on_call                     0
    dob                         1950-05-29
    hospital_department_code    823
); # gender, trial_name, etc optional - handled inside Billing.pm
 # created_at requires a DT object:
$data{created_at} = DateTime->today;

=begin
    presentation = 'HTS myeloid only'
    specimen = BMA
    tests = hts_myeloid only (plus 'irrelevant' dna_extraction)
    expect 1 BMASEQ with charge code 01 only
=cut
{
    my %h = get_data(); # p %h;
    $h{presentation} = 'HTS myeloid only';
    $h{request_lab_tests} = [ qw/hts_myeloid dna_extraction/ ];

    my @samples = (
        { %h, sample_code => 'BMA' }, # override default value,
    );
    my @rows = get_all_rows(@samples); # p @rows;
    # results:
    is( scalar @rows, 1, 'got expected 1 row' );
    is( content('sample',   1, @rows), 'HMBMASEQ', 'sample code BMASEQ');
    is( content('category', 1, @rows), '01',       'charge code 01');
}

=begin
    presentation = 'HTS myeloid only'
    specimens = BMA & PB
    tests = hts_myeloid only (plus 'irrelevant' dna_extraction)
    expect 1 BMASEQ with charge code 01 & 1 BMA with charge code ST
=cut
{
    my %h = get_data(); # p %h;
    $h{presentation} = 'HTS myeloid only';
    $h{request_lab_tests} = [ qw/hts_myeloid dna_extraction/ ];

    my @samples = ( # one per row:
        \%h, # using default PB sample_code
        { %h, sample_code => 'BMA' }, # override default value
    );
    my @rows = get_all_rows(@samples); # p @rows;
    # results:
    is( scalar @rows, 2, 'got expected 2 rows' );
    is( content('sample',   1, @rows), 'HMBMASEQ', 'sample code BMASEQ');
    is( content('category', 1, @rows), '01',       'charge code 01');
    is( content('sample',   2, @rows), 'HMBMA',    'sample code BMA');
    is( content('category', 2, @rows), 'ST',       'charge code ST');
}

=begin
    presentation = 'HTS myeloid only'
    specimen = BMA
    tests = hts_myeloid + some flow tests
    expect 1 BMASEQ with charge code 01
=cut
{
    my %h = get_data(); # p %h;
    $h{presentation} = 'HTS myeloid only';
    $h{request_lab_tests} = [ qw/hts_myeloid flow_test_1 flow_test_2/ ];

    my @samples = ( # one per row:
        { %h, sample_code => 'BMA' }, # override default value
    );
    my @rows = get_all_rows(@samples); # p @rows;
    # results:
    is( scalar @rows, 1, 'got expected 1 row' );
    is( content('sample',   1, @rows), 'HMBMASEQ', 'sample code BMASEQ');
    is( content('category', 1, @rows), '01',       'charge code 01');
}

=begin
    presentation = 'HTS myeloid only'
    specimens = BMA & PB
    tests = hts_myeloid + some flow tests
    expect 1 BMASEQ with charge code 01
=cut
{
    my %h = get_data(); # p %h;
    $h{presentation} = 'HTS myeloid only';
    $h{request_lab_tests} = [ qw/hts_myeloid flow_test_1 flow_test_2/ ];

    my @samples = ( # one per row:
        { %h, sample_code => 'BMA' }, # override default value
    );
    my @rows = get_all_rows(@samples); # p @rows;
    # results:
    is( scalar @rows, 1, 'got expected 1 row' );
    is( content('sample',   1, @rows), 'HMBMASEQ', 'sample code BMASEQ');
    is( content('category', 1, @rows), '01',       'charge code 01');
}

=begin
    presentation = 'Cytopenia'
    specimen = BMA
    tests = hts_myeloid only (plus 'irrelevant' dna_extraction)
    expect 1 BMASEQ with charge code 01
=cut
{
    my %h = get_data(); # p %h;
    $h{presentation} = 'Cytopenia';
    $h{request_lab_tests} = [ qw/hts_myeloid dna_extraction/ ];

    my @samples = (
        { %h, sample_code => 'BMA' }, # override initial value
    );
    my @rows = get_all_rows(@samples); # p @rows;
    # results:
    is( scalar @rows, 1, 'got expected 1 row' );
    is( content('sample',   1, @rows), 'HMBMASEQ', 'sample code BMASEQ');
    is( content('category', 1, @rows), '01',       'charge code 01');
}

=begin
    presentation = 'Cytopenia'
    specimens = BMA & PB
    tests = hts_myeloid only (plus 'irrelevant' dna_extraction)
    expect 1 BMASEQ & 1 BMA, both with charge code 01
=cut
{
    my %h = get_data(); # p %h;
    $h{presentation} = 'Cytopenia';
    $h{request_lab_tests} = [ qw/hts_myeloid dna_extraction/ ];

    my @samples = (
        \%h, # using default PB sample_code
        { %h, sample_code => 'BMA' }, # override initial value
    );
    my @rows = get_all_rows(@samples); # p @rows;
    # results:
    is( scalar @rows, 2, 'got expected 2 rows' );
    is( content('sample',   1, @rows), 'HMBMASEQ', 'sample code BMASEQ');
    is( content('category', 1, @rows), '01',       'charge code 01');
    is( content('sample',   2, @rows), 'HMBMA',    'sample code BMA');
    is( content('category', 2, @rows), '01',       'charge code 01');
}

=begin
    presentation = 'Cytopenia'
    specimen = BMA
    tests = hts_myeloid + some flow tests
    expect 1 BMASEQ & 1 BMA, both with charge code 01
=cut
{
    my %h = get_data(); # p %h;
    $h{presentation} = 'Cytopenia';
    $h{request_lab_tests} = [ qw/hts_myeloid flow_test_1 flow_test_2/ ];

    my @samples = (
        { %h, sample_code => 'BMA' }, # override initial value
    );
    my @rows = get_all_rows(@samples); # p @rows;
    # results:
    is( scalar @rows, 2, 'got expected 2 rows' );
    is( content('sample',   1, @rows), 'HMBMASEQ', 'sample code BMASEQ');
    is( content('category', 1, @rows), '01',       'charge code 01');
    is( content('sample',   2, @rows), 'HMBMA',    'sample code BMA');
    is( content('category', 2, @rows), '01',       'charge code 01');
}

=begin
    presentation = 'Cytopenia'
    specimens = BMA & PB
    tests = hts_myeloid + some flow tests
    expect 1 BMASEQ, 1 BMA & 1 PB, all with charge code 01
=cut
{
    my %h = get_data(); # p %h;
    $h{presentation} = 'Cytopenia';
    $h{request_lab_tests} = [ qw/hts_myeloid flow_test_1 flow_test_2/ ];

    my @samples = (
        \%h, # using default PB sample_code
        { %h, sample_code => 'BMA' }, # override default value
    );
    my @rows = get_all_rows(@samples); # p @rows;
    # results:
    is( scalar @rows, 3, 'got expected 3 rows' );
    is( content('sample',   1, @rows), 'HMBMASEQ', 'sample code BMASEQ');
    is( content('category', 1, @rows), '01',       'charge code 01');
    is( content('sample',   2, @rows), 'HMPB',     'sample code PB');
    is( content('category', 2, @rows), '01',       'charge code 01');
    is( content('sample',   3, @rows), 'HMBMA',    'sample code BMA');
    is( content('category', 3, @rows), '01',       'charge code 01');
}

done_testing(TESTS);

#==============================================================================
sub get_all_rows {
    my @requests = @_;

    my $llb = LIMS::Local::Billing->new( settings => {} ); # p $llb;
    $llb->bone_marrow_requests({}); # required but only need data for FLAIR trial

    for my $req (@requests) { # p $req; next;
        # apply local rules:
        $llb->apply_local_rules($req);
        # generate data row:
        my $data = $llb->parse_data($req);
        $llb->add_row($data);
    }

    my @rows = $llb->get_all_rows; # p @rows;
    return wantarray ? @rows : \@rows;
}

sub content {
    my ($str, $row_num, @rows) = @_;

    my %cols = ( # col number NOT array number
        sample   => 12, # duplicated in col 13
        category => 14, # charge code
    );

    my @parts = split '\|', $rows[$row_num - 1]; # p @parts;
    return $parts[$cols{$str} - 1];
 }

# clone %data for return then auto-increment %data id & request_id values for
# next request:
sub get_data {
    my %h = %data;
    $data{$_} += 1 for qw(id request_number);
    return wantarray ? %h : \%h;
}