• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

# requires presence of config/.local/additional_tests.yml file, or skips tests

use Test::WWW::Mechanize::CGIApp;
use Test::Builder::Tester;

use Data::Dumper;

use strict;
use warnings;

use constant TESTS => 51;

use Test::More tests => TESTS;
# use Test::More 'no_plan';

=begin: tests:
=cut

BEGIN {
    require 't/test-lib.pl';
}

my $yaml = get_yaml('additional_tests'); # warn Dumper $yaml; exit;


my $dbh;
eval {
    $dbh = get_dbh() or die 'no database handle recieved from get_dbh';
};

my $dbix = get_dbix();
my $mech = get_mech();

SKIP: {
    skip('these tests require config/.local/settings/additional_tests.yml file',TESTS) unless $yaml;
    do_all_tests();
}


sub do_all_tests {

# need to see if 'require_spell_check' is required:
my $spell_check_required = is_spell_check_required(); # warn $spell_check_required;

# register data for auto_authorisation:

# get list of diagnoses from $yaml->{diagnosis}:
my $diagnosis = $yaml->{diagnosis};
my @diagnoses = keys %$diagnosis; # warn Dumper \@diagnoses; exit;

# select 1st entry:
my $new_diagnosis = $diagnoses[0]; # warn $new_diagnosis;
my $lab_test = $diagnosis->{$new_diagnosis}; # warn Dumper $lab_test; 

# just add 1st diagnosis from $yaml:
$dbix->insert('diagnoses', {
    name => $new_diagnosis, diagnostic_category_id => 1, active => 'yes',
});

# add new lab tests:
_add_lab_tests($lab_test);

do_login();

# register new:
$mech->get_ok('/request/add_new/2');
{
    $mech->submit_form(
        fields => {
            request_number => 3,
            specimen => 'PB',
            referrer_code => 'C1234567',
        },
    );                                                        # print_and_exit();
    
    $mech->has_tag(
        h3 => 'New request successful',
    );
}

# screen request:
$mech->get_ok('/screen/=/3');                                 # print_and_exit();
{
    $mech->form_name('initialScreen'); # 1st one is patient notes

    $mech->field(screen_id => 2); # PNH
    $mech->field(option_id => 1);
    $mech->submit();                                          # print_and_exit();
    
    $mech->text_contains(
        'Screened as PNH', 
        'OK: expected screen term found',
    );    													  # print_and_exit();
}

# sign out test:
$mech->get_ok('/worklist/display/1?display_format=Data+Entry'); # print_and_exit();
{
    $mech->field(request_lab_test_id => 1);
    $mech->field(status_option_id => 2);
    $mech->submit();                                          # print_and_exit();

    $mech->has_tag_like(
        p => qr(records updated successfully),
        'OK: update success',
    );                                                        # print_and_exit();
    
    for ( qw/PNH complete/ ) {
        $mech->has_tag(td => $_);
    }														 # print_and_exit();	
}

# report - don't auto-request test (to demonstrate no [pending] fields):
$mech->get_ok('/report/=/3');                                # print_and_exit();
{
    my %report = ( # PB so doesn't need biopsy_site or gross_description
        status  => 'default',
        clinical_details => 'some details here',
        morphology => 'morphology here',
        comment => 'comment here',
        specimen_quality => 'adequate',
        diagnosis_id => 2, # doesn't auto-request tests
    );

    $mech->form_name('reportForm');
    $mech->submit_form(fields => \%report);                  # print_and_exit();
    $mech->submit_form(form_name =>'reportForm') if $spell_check_required;
    lacks_dfv_errors();                                      #  print_and_exit();

    $mech->has_tag_like(
        p => qr(record updated successfully),
        'OK: update success',
    );                                                       # print_and_exit();

    # check 'reported by':
    $mech->has_tag_like(
        p => qr(Reported by),
        'OK: reporter information displayed'
    );
    
	# no pending tests:
    {
        test_out( 'not ok 1 - foo' );
        test_fail( +1 );
        $mech->has_tag_like( span => qr(\[pending\]), 'foo' );
        test_test( 'OK: no pending lab-tests' );              # print_and_exit();
	}
}
# change diagnosis to one auto-requesting tests:
$mech->get_ok('/report/=/3');                                 # print_and_exit();
{
    $mech->form_name('reportForm');
    $mech->field(diagnosis_id => 3); # auto-requests lab-test
    $mech->field(option_id => 1);
    $mech->submit();                                          # print_and_exit();
    $mech->submit_form(form_name =>'reportForm') if $spell_check_required;
    lacks_dfv_errors();                                       # print_and_exit();
      
    $mech->text_contains(
        $new_diagnosis,
        'OK: changed diagnosis found',
    );                                                        # print_and_exit();

    $mech->has_tag_like(
        p => qr(record updated successfully),
        'OK: update success',
    );                                                        # print_and_exit();

	# check have requested test:
    $mech->has_tag_like(
        span => qr(\[pending\]),
        'OK: new requested test'
    );														  # print_and_exit();
}
# check history:
$mech->get_ok('/history/=/3');                                # print_and_exit();
{
    my $sql = 'select field_label from lab_tests where id = ?';
    my @test_ids = keys %$lab_test; # warn Dumper \@test_ids;
    
    # just test 1st one in case only 1 new test
    $dbix->query($sql, $test_ids[0])->into(my $field_label); # warn $field_label;
    
    $mech->has_tag_like(
        td => qr(auto-requested $field_label triggered by diagnosis),
        'OK: expected history entry'
    );														  # print_and_exit();    
}

#===============================================================================
# result summaries:
# get list of diagnoses from $yaml:

my $result_summary = $yaml->{results_summary}; # warn Dumper $result_summary;
my @result_summaries = keys %$result_summary;  # warn Dumper \@result_summaries;

# select 1st entry:
my $rs_term = $result_summaries[0]; # warn $rs_term;
my $rs_lab_test = $result_summary->{$rs_term};  # warn Dumper $rs_lab_test; 

# just add 1st result_summary term from $yaml:
$dbix->insert('result_summary_options', {
    description => $rs_term, lab_section_id => 1, is_active => 'yes',
});

_add_lab_tests($rs_lab_test);

# register new:
$mech->get_ok('/request/add_new/2');
{
    $mech->submit_form(
        fields => {
            request_number => 4,
            specimen => 'PB',
            referrer_code => 'C1234567',
        },
    );                                                        # print_and_exit();
    
    $mech->has_tag(
        h3 => 'New request successful',
    );
}

# screen request:
$mech->get_ok('/screen/=/4');                                 # print_and_exit();
{
    $mech->form_name('initialScreen'); # 1st one is patient notes

    $mech->field(screen_id => 2); # PNH
    $mech->field(option_id => 1);
    $mech->submit();                                          # print_and_exit();
    
    $mech->text_contains(
        'Screened as PNH', 
        'OK: expected screen term found',
    );    													  # print_and_exit();
}

# sign out test:
$mech->get_ok('/worklist/display/1?display_format=Data+Entry'); # print_and_exit();
{
    $mech->field(request_lab_test_id => 3);
    $mech->field(status_option_id => 2);
    $mech->submit();                                          # print_and_exit();

    $mech->has_tag_like(
        p => qr(records updated successfully),
        'OK: update success',
    );                                                        # print_and_exit();
    
    for ( qw/PNH complete/ ) {
        $mech->has_tag(td => $_);
    }														 # print_and_exit();	
}

# link tcr-gamma (250) with FISHpanel (34) to test linked lab-tests function:
$dbix->insert( 'linked_lab_test', { parent_test_id => 34, linked_test_id => 250 });

# have substituted non-ascii-numeric chars on field labels:
my @lab_tests_for_blpd_gcc = qw(t_14_18_multiplex FISH_panel Store_DNA tcr_gamma);

$mech->get_ok('/search/=/4');                                #  print_and_exit();
{
	# no pending tests:
    for ( @lab_tests_for_blpd_gcc ) { 
        test_out( 'not ok 1 - foo' );
        test_fail( +1 );
        $mech->has_tag_like( span => qr($_), 'foo' );
        test_test( "OK: no pending $_ lab-test" );              # print_and_exit();
	}
}
$mech->get_ok('/result/=/4');                                 # print_and_exit();
{
    $mech->form_name('flow_results');
    $mech->field(_results_summary => 'B-LPD - germinal centre phenotype (CD5-)');
    $mech->submit();                                         # print_and_exit();
	
    $mech->has_tag_like(
        p => qr(results data update successful),
        'OK: update success',
    );                                                        # print_and_exit();
    for ( @lab_tests_for_blpd_gcc ) {
        $mech->has_tag_like(
			span => qr{$_ \(new\)},
			"OK: new $_ lab-test",              			 
		);													 # print_and_exit();
	}
}
$mech->get_ok('/history/=/4');                               #  print_and_exit();
{
	my $i = 1;
	$mech->has_tag_like(
		td => qr(new Flow result summary),
		"OK: expected history entry [$i] found",
	);
	$i++;
	for ( @lab_tests_for_blpd_gcc ) {
        $mech->has_tag_like( 
			td => qq(auto-requested $_ triggered by results summary),
			"OK: expected history entry [$i] found",
		);
        $i++;
	}
}
do_logout();
}

sub _add_lab_tests {
	my $data = shift;
    my %h = ( # common lab_test fields:
        lab_section_id => 1,
        test_type => 'test',
		has_results => 'no',
        is_active => 'yes',
    ); 
	# lab_test_sample_type:
	my $sample_type_ids = $dbix->select('lab_section_sample_type',
		['sample_type_id'], { lab_section_id => 1 } )->flat; # warn Dumper $sample_type_ids;

    while ( my($id, $test) = each %$data ) { # warn Dumper [$id, $test];
        # skip if already exists:
        next if $dbix->query('select 1 from lab_tests where id = ?', $id)->list;
        $test =~ s/(\W)+/_/g; # eliminate non-ascii-numerical chars

        @h{ qw(id field_label test_name) } = ( $id, $test, lc $test); # MUST USE SUPPLIED ID
        $dbix->insert('lab_tests', \%h);
		# lab_test_sample_type:
		$dbix->insert('lab_test_sample_type',
			{ lab_test_id => $id, sample_type_id => $_ }) for @$sample_type_ids;
    }
}