• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

use Test::WWW::Mechanize::CGIApp;

use strict;
use warnings;

use DateTime;
use POSIX;

use Test::More tests => 68;
# use Test::More 'no_plan';
 
=begin # tests:
1) register test patient through Register page
2) add new patient directly (invalid nhs_number)
3) change nhs_number to valid/unique & submit
4) add another new patient directly (duplicate nhs_number)
5) change nhs_number to valid/unique & submit
6) edit test patient - change dob to invalid date
7) change dob to valid & submit with both confirmation fields missing
8) change dob to valid & submit with one confirmation field missing
9) change dob to valid & submit with both confirmation fields supplied
10) edit test patient - supply invalid nhs_number
11) change nhs_number to valid but duplicate
12) change nhs_number to valid & unique
13) edit test patient - first name
14) edit test patient - delete nhs_number
15) add new request for patient with nhs number and try to change single record
=cut

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

    use DateTime;
    DateTime->DefaultLocale('en_GB');
}

my $mech = get_mech();

my $dbh;

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

warn $@ if $@;

drop_and_recreate('patients');

do_login();

$mech->get_ok('/register');                     # print_and_exit();

my %test_patient = (
    last_name =>  'white',
    first_name => 'alan',
    day => 20,
    month => 10,
    year => 1944,
    unit_number => 'N123456',
    gender => 'M',
    referral_source_id => 1,
);

# register test patient:
{
    $mech->submit_form(
        fields => {
            name => $test_patient{last_name},
        }
    );                                                        # print_and_exit();

    $mech->content_contains(
         "Found 0 records matching name=$test_patient{last_name}",
        'OK: patient not found',
    );
    
    $mech->submit_form(
        fields => \%test_patient,
    );                                                        # print_and_exit();

    my $dob = DateTime->new(
        year  => $test_patient{year},
        month => $test_patient{month},
        day   => $test_patient{day},
        formatter => get_formatter()
    );

    my $i=0;
    my $output = 'OK: patient demographics field [%s] detected';

    foreach (uc $test_patient{last_name}, $dob, @test_patient{qw(unit_number gender)} ) {
        $mech->content_contains(
             "<td>$_</td>",
            sprintf $output, ++$i,
        );
    }
    no warnings 'uninitialized'; # no middle_name, but need to check have empty span
    
    foreach ( @test_patient{ qw(first_name middle_name) } ) { # warn $_;
        $mech->content_like(
            qr(<span>$_</span>)i,
            sprintf $output, ++$i,
        );
    }
}

# add new patient directly (invalid nhs_number):
$mech->get_ok('/patient');        # print_and_exit();
{
    my %patient = (
        last_name =>  'green',
        first_name => 'leslie',
        day => 12,
        month => 11,
        year => 1974,
        unit_number => 10101101,
        gender => 'U',
        referral_source_id => 1,
        nhs_number => 123456789,
    );

    $mech->submit_form(
        fields => \%patient,
    );                                         # print_and_exit();
    
    # check we have dfv error:
    has_dfv_errors();
    has_invalid();
    
    # make nhs_number valid:
    $patient{nhs_number} = 1111111111;
    
    $mech->submit_form(
        fields => \%patient,
    );                                        # print_and_exit();

    $mech->content_contains(
        '<h2 class="header">New request</h2>',
        'OK: new patient record accepted',
    );                                         # print_and_exit();
    
    $mech->content_contains(
        "<td>$patient{nhs_number}</td>",
        'OK: expected nhs_number detected',
    );                                          # print_and_exit();
}

# add another new patient directly (duplicate nhs_number):
$mech->get_ok('/patient');  # print $fh $mech->content;
{
    my %patient = (
        last_name =>  'brown',
        first_name => 'may',
        day => 17,
        month => 1,
        year => 1934,
        unit_number => 11223344,
        nhs_number => 1111111111, # duplicate
        gender => 'F',
        referral_source_id => 1,
    );
    
    $mech->submit_form(
        fields => \%patient,
    );                         # print_and_exit();

    # check we have dfv error:
    has_dfv_errors();
    has_duplicate();

    # make nhs_number valid & unique:
    $patient{nhs_number} = 2222222222;
    
    $mech->submit_form(
        fields => \%patient,
    );                            # print_and_exit();
    
    # check we don't have dfv error:
    lacks_dfv_errors();

    # patient_case.id in edit url:
    $mech->content_contains(
        'patient/register_edit_patient/3',
        "OK: patient.id correct in edit url",
    );
    
    $mech->content_contains(
        '<td>3</td>',
        "OK: correct patient.id detected",
    );
}

# now select test_patient:
$mech->get_ok('/register'); # print_and_exit();
{
    $mech->submit_form(
        fields => {
            name => $test_patient{last_name},
        }
    );                              # print_and_exit();

    $mech->content_contains(
         "Found <b>1</b> record matching <b>name=$test_patient{last_name}</b>",
        'OK: found existing patient match',
    );

    # test edit link:
    $mech->follow_link_ok(
        # {n => 8}, "Logout $_ via eighth link on page",
        { url_regex => qr/edit/i, },
        'edit record using link',
    );                                                      # print_and_exit();
    
    # confirm edit page loaded:
    $mech->content_contains(
        'Patient &raquo; Edit Details',
        'edit page loaded OK',
    );                                                       # print_and_exit();
    
    # confirm warning dispalyed:
    $mech->content_contains(
        'WARNING: DO NOT USE FOR CHANGING PATIENT IDENTITY',
        'warning message loaded OK',
    );                                                        # print_and_exit();
}

# change dob to invalid:
{
    my $changed_month = 13;
    
    $mech->field('month', $changed_month);
    $mech->submit_form();                                    # print_and_exit();

    # check we have dfv error:
    has_dfv_errors();
    $mech->content_contains(
        dfv_format('invalid_date'),
        'OK: invalid date detected',
    );   
}

# change dob to valid:
{
    my $changed_month = 7;
    
    $mech->field('month', $changed_month);
    $mech->submit_form();                                     # print_and_exit();

    # only 1 record so don't need to select scope:
    $mech->has_tag(
        span => 'INFO: change affects this record only',
        'OK: change affects only 1 record',
    );
    
    # reason for change missing:
    has_dfv_errors();
    has_missing();
    
    # submit missing error code value:
    $mech->field('error_code_id', 1);
    $mech->submit_form();                                     # print_and_exit();

    # check we don't have dfv error:
    lacks_dfv_errors();

    # new dob detected:
    my $formatted_dob = DateTime->new(
        year  => $test_patient{year},
        month => $changed_month,
        day   => $test_patient{day},
        formatter => get_formatter()
    ); # warn $formatted_dob;
    
    # just check last_name & dob (others have td modification)
    $mech->has_tag_like(
        span => $formatted_dob,
        "OK: patient demographics dob field detected",
    );
    $mech->has_tag_like(
        td => uc $test_patient{last_name},
        "OK: patient demographics last name field detected",
    );                                                       # print_and_exit();
}

# give test_patient an nhs_number - invalid at 1st:
{
    $mech->follow_link_ok(
        { url_regex => qr/edit/i, },
        'edit record using link',
    );                                           # print_and_exit();
    $mech->field('nhs_number', 123456789);
    $mech->submit_form();                        # print_and_exit();

    # check we have dfv error:
    has_dfv_errors();
    has_invalid();
}

# correct nhs_number to valid, but duplicate:
{
    $mech->field('nhs_number', 1111111111);
    $mech->field('error_code_id', 1);
    
    $mech->submit_form();                 # print_and_exit();
    
    # check we still have dfv error:
    has_dfv_errors();
    has_duplicate();
}

# correct nhs_number to valid & unique:
{
    my $nhs_number = 3333333333;
    my $formatted_nhs_number = '333 333 3333';
    $mech->field('nhs_number', $nhs_number);
    $mech->field('error_code_id', 1);
    
    $mech->submit_form();                                     # print_and_exit();
    
    my $i=0; # just check last_name & nhs_number (others have td modification)
    foreach ( uc $test_patient{last_name}, $formatted_nhs_number ) {
        $i++;
        $mech->has_tag(
            td => $_,
            "OK: patient demographics field [$i] detected",
        );
    }
}

# edit first_name:
{
    $mech->follow_link_ok(
        { url_regex => qr/edit/i, },
        'edit record using link',
    );                                                        # print_and_exit();
    
    my $first_name = 'arthur';
    
    $mech->field('first_name', $first_name);
    $mech->field('error_code_id', 1);
    
    $mech->submit_form();                                     # print_and_exit();

    # check we don't have dfv error:
    lacks_dfv_errors();
    
    $mech->has_tag(
        span => ucfirst $first_name,
        'OK: amended field detected',
    );
}

# try to edit nhs_number to invalid:
{
    $mech->follow_link_ok(
        { url_regex => qr/edit/i, },
        'edit record using link',
    );                                  # print_and_exit();
    
    my $invalid_nhs_number = 123456789;
    
    $mech->field('nhs_number', $invalid_nhs_number);
    $mech->field('error_code_id', 1);
    
    $mech->submit_form();                  # print_and_exit();
    
    # check we have dfv error:
    has_dfv_errors();
    has_invalid();
}

# try to edit nhs_number to one already used:
{
    my $used_nhs_number = 2222222222;
    
    $mech->field('nhs_number', $used_nhs_number);
    $mech->field('error_code_id', 1);
    
    $mech->submit_form();                  # print_and_exit();
    
    # check we have dfv error:
    has_dfv_errors();
    has_duplicate();
}

# delete nhs_number:
{
    my $nhs_number = '';
    
    $mech->field('nhs_number', $nhs_number);
    $mech->field('error_code_id', 1);
    
    $mech->submit_form();                   # print_and_exit();
    
    # check we don't have dfv error:
    lacks_dfv_errors();
    
    # should have null value for nhs_number field (but can't test directly):
    $mech->content_contains(
        qq!<span class="grey">[NULL]</span>!,
        'OK: null value detected',
    );                                                        # print_and_exit();
}

# add new request to patient with NHS no:
$mech->get_ok('/request/add_new/2');                         # print_and_exit();
{
    $mech->has_tag(
        td => 1111111111,
        'OK: expected record found',
    );
    $mech->submit_form(
        fields => {
            request_number => 3,
            specimen => 'BMAT',
            referrer_code => 'G1234567',
            _referrer => 'Black, DE', # ajax function in form
        },                                                    
    );                                                        # print_and_exit();
    $mech->has_tag(
        h3 => 'New request successful',
        'OK: new record created',
    );
}
# check name:
$mech->get_ok('/search/=/3');                                # print_and_exit();
{
    $mech->has_tag_like(
        td => 'GREEN, Leslie',
        'OK: expected name found',
    );
    $mech->content_lacks(
        'GREEN, Leslie Anne',
        "OK: patient doesn't have middle name",
    );
}
# select for edit:
$mech->get_ok('/patient/edit_patient/2/3');                  # print_and_exit();
{
    # add midle name and select 'this_record_only':
    $mech->field( middle_name => 'anne' );
    $mech->field( this_record_only => 1 );
    $mech->field( error_code_id => 1 );
    $mech->submit;                                           # print_and_exit();
    
    my $msg = get_messages('request_edit')->{nhs_conflict};
    $mech->has_tag_like(
        p => $msg,
        'OK: cannot change record',
    );
}
# remove nhs number & resubmit:
$mech->get_ok('/patient/edit_patient/2/3');                  # print_and_exit();
{
    $mech->field( nhs_number => undef );
    $mech->field( middle_name => 'anne' );
    $mech->field( this_record_only => 1 );
    $mech->field( error_code_id => 1 );
    $mech->submit;                                           # print_and_exit();

    # check we don't have dfv error:
    lacks_dfv_errors();
}
# retrieve request #3 & check details:
$mech->get_ok('/search/=/3');                                # print_and_exit();
{
    $mech->has_tag_like(
        td => 'GREEN, Leslie Anne',
        'OK: expected name found',
    );
    $mech->content_lacks(
        1111111111,
        'OK: original NHS number gone',
    );
}
do_logout();