package LIMS::Validate; # returns hashref for Data::FormValidator profile, or arrayref for FormValidator::Simple profile # uses LIMS::Validate::Roles::ConstraintMethods for constraint_method helpers use Data::Dumper; use URI::Escape qw( uri_unescape); use Moose; # all constraint_method helpers located in: with 'LIMS::Validate::Roles::ConstraintMethods'; has models => ( is => 'ro', isa => 'HashRef' ); # LIMS::Base::validation_models() has messages => ( is => 'ro', isa => 'HashRef' ); # $self->cfg('msg')->{dfv_msgs} has settings => ( is => 'ro', isa => 'HashRef' ); # $self->cfg('settings') # has lab_tests_count => ( is => 'ro', isa => 'Int', lazy_build => 1 ); __PACKAGE__->meta->make_immutable; #------------------------------------------------------------------------------- sub new_patient { # profile validated OK my $self = shift; my %profile = ( field_filters => { last_name => 'lc', first_name => 'lc', middle_name => 'lc', unit_number => 'uc', nhs_number => 'digit', # remove spaces & non-digits month => \&remove_jquery_watermark, year => \&remove_jquery_watermark, day => \&remove_jquery_watermark, }, constraint_methods => { nhs_number => $self->join_these( $self->check_nhsno_is_valid(), # default msg OK $self->check_nhsno_is_unique(), # name = 'is_unique' ), year => $self->get_date_constraints(), }, msgs => { constraints => { is_unique => $self->messages->{not_unique}, yyyy_format => $self->messages->{year_digits}, future_date => $self->messages->{future_date}, valid_date => $self->messages->{invalid_date}, }, }, ); # get js_new_patient() profile: my $js_new_patient = $self->js_new_patient(); # warn Dumper $js_new_patient; # if nhs_number optional (determined in js_new_patient): if ( grep $_ =~ 'nhs_number', @{ $js_new_patient->{optional} } ) { $profile{require_some} = { # require one from this group patient_id => [ 1, qw(nhs_number unit_number) ], }; } # warn Dumper $js_new_patient; map { $profile{$_} = $js_new_patient->{$_}; } keys %$js_new_patient; # warn Dumper \%profile; return \%profile; } sub js_new_patient { my $self = shift; my $settings = $self->settings; # warn Dumper $settings; my @required = qw( last_name first_name day month year gender referral_source_id ); my @optional = qw( middle_name patient_number ); $settings->{nhs_number_mandatory} ? push @required, 'nhs_number' : push @optional, 'nhs_number'; return { required => \@required, optional => \@optional, } } #------------------------------------------------------------------------------- sub edit_patient { # profile validated OK my $self = shift; # get js_edit_patient() profile: my $js_edit_patient = js_edit_patient(); # warn Dumper $js_edit_patient; my %profile = ( field_filters => { last_name => 'lc', first_name => 'lc', middle_name => 'lc', nhs_number => 'digit', # remove spaces & non-digits }, constraint_methods => { nhs_number => $self->join_these( $self->check_nhsno_is_valid(), $self->check_param_ownership(['nhs_number','Patient']), # name = 'ownership' ), year => $self->get_date_constraints(), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, yyyy_format => $self->messages->{year_digits}, future_date => $self->messages->{future_date}, valid_date => $self->messages->{invalid_date}, }, }, ); # add js_edit_patient profile: map { $profile{$_} = $js_edit_patient->{$_}; } keys %$js_edit_patient; push @{ $profile{optional} }, '_record_id'; # required if editing patient return \%profile; } # doesn't support constraint => sub {} sub js_edit_patient { my @required = qw( last_name first_name day month year gender error_code_id ); my @optional = qw( middle_name nhs_number use_patient_id this_record_only all_records request_id ); return { required => \@required, optional => \@optional, require_some => { # require one from this group: confirm_change => [ 1, qw( all_records this_record_only ) ], }, }; } #------------------------------------------------------------------------------- sub email_contacts { my $self = shift; # email_contacts uses a 2-col unique key, so need to supply both: my @fields = qw(type contact_address); return { required => [ qw( display_name scope referral_source_id type contact_address status is_active ) ], optional => ['department_id','_record_id'], # _record_id for validation of edit submission constraint_methods => { contact_address => $self->check_email_is_valid(), type => $self->check_param_ownership( [ \@fields, 'EmailContact' ] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, }; } #------------------------------------------------------------------------------- sub email_report { my $self = shift; return { required => [ qw(mailto sender) ], constraint_methods => { mailto => $self->check_email_is_valid(), # mailto => $self->check_secure_email_domain(), # done in C now }, msgs => { constraints => { # foo => $self->messages->{invalid_domain}, # checked in C ::Request now }, }, } } #------------------------------------------------------------------------------- sub new_request { # profile validated OK my $self = shift; my $settings = $self->settings; # warn Dumper $settings; # get request_number messages: my $msgs = $self->get_request_number_messages(); # formatted to share with ajax method # add block_reference message: $msgs->{constraints}->{block_reference} = $self->messages->{need_block_ref}; # add date constraints: $msgs->{constraints}->{yyyy_format} = $self->messages->{year_digits}; $msgs->{constraints}->{future_date} = $self->messages->{future_date}; $msgs->{constraints}->{valid_date} = $self->messages->{invalid_date}; $msgs->{constraints}->{valid_datetime} = $self->messages->{invalid_datetime}; my @required = qw( referral_source_id referrer_code specimen patient_id ); my @optional = ( qw( trial_id trial_number external_reference ), # request details qw( urgent private doi copy_to sender_ioa ), # additional options qw( storage research treatment monitoring ), # consent qw( day month year minute hour ), # datetime specimen taken 'error_code_id', ); # request_number is required unless auto-incrementing: push @required, 'request_number' unless $settings->{autoincrement_requests}; return { required => \@required, optional => \@optional, field_filters => { specimen => 'uc', minute => \&remove_jquery_watermark, month => \&remove_jquery_watermark, hour => \&remove_jquery_watermark, year => \&remove_jquery_watermark, day => \&remove_jquery_watermark, }, constraint_methods => { request_number => $self->get_request_number_constraints(), specimen => $self->get_new_request_specimen_constraints(), year => $self->get_date_constraints(), }, dependency_groups => { # if either filled in, both required: # trial_group => [ qw( trial_id trial_number) ], # using dependencies }, dependencies => { trial_number => 'trial_id', # make trial_id required if trial_no entered }, msgs => $msgs, }; } #------------------------------------------------------------------------------- sub date_constraints { my $self = shift; return { optional => [ qw/constraint_type days date_from date_to/ ], constraint_methods => { date_from => $self->check_EU_date_is_valid(), date_to => $self->check_EU_date_is_valid(), days => $self->is_integer(), }, msgs => { constraints => { valid_date => $self->messages->{invalid_date}, FV_num_int => $self->messages->{need_integer}, }, }, } } #------------------------------------------------------------------------------- sub change_password { # profile validated OK my $self = shift; return $self->get_change_password_profile(); } #------------------------------------------------------------------------------- sub js_change_pwd { # only for JavaScript::FormValidator - using FormValidator::Simple for server-side return { required => [ qw(old_password new_password new_password_confirm) ], }; } #------------------------------------------------------------------------------- sub change_user_location { return { required => [ qw(location_id password) ], } } #------------------------------------------------------------------------------- sub change_user_email { my $self = shift; return { required => [ qw(email email2 password) ], constraint_methods => { email => $self->join_these( $self->check_email_is_valid(), $self->check_param_ownership([ 'email', 'User' ]), ), email2 => $self->check_emails_match(), }, msgs => { constraints => { email_mismatch => 'e-mail addresses do not match', }, }, } } #------------------------------------------------------------------------------- sub config_settings_profile { # profile not tested in t/validation_profiles/ my $self = shift; # NB - new entries require entering in settings.txt as blank line # eg 'some_new_entry=' return [ admin_contact => [ 'NOT_BLANK', 'EMAIL_LOOSE' ], admin_timeout => [ 'NOT_BLANK', 'INT' ], application_name => [ 'NOT_BLANK' ], autoincrement_requests => [ 'NOT_BLANK', 'INT' ], default_user_timeout => [ 'NOT_BLANK', 'INT' ], entries_per_page => [ 'NOT_BLANK', 'INT' ], have_request_audit => [ 'NOT_BLANK', 'INT' ], lab_name_abbreviation => [ 'NOT_BLANK' ], lab_number_prefix => [ 'NOT_BLANK' ], local_network_restriction => [ 'NOT_BLANK', 'INT' ], login_display_all_cases => [ 'NOT_BLANK', 'INT' ], local_prefix => [ 'NOT_BLANK' ], max_request_number_length => [ 'NOT_BLANK', 'INT' ], min_char_length => [ 'NOT_BLANK', 'INT' ], # pas_address => [ 'NOT_BLANK' ], # replaced by PDS # pas_pwd => [ 'NOT_BLANK' ], # pas_username => [ 'NOT_BLANK' ], print_run_max => [ 'NOT_BLANK', 'INT' ], require_spell_check => [ 'NOT_BLANK' ], report_display_notes => [ 'NOT_BLANK' ], server_username => [ 'NOT_BLANK' ], service_address => [ 'NOT_BLANK' ], service_email => [ 'NOT_BLANK', 'EMAIL_LOOSE' ], service_name => [ 'NOT_BLANK' ], service_telno => [ 'NOT_BLANK' ], smtp => [ 'NOT_BLANK' ], unreported_duration => [ 'NOT_BLANK', 'INT' ], use_specimen_filter => [ 'NOT_BLANK', 'INT' ], use_clinical_trial_filter => [ 'NOT_BLANK', 'INT' ], valid_recipient_domains => [ 'NOT_BLANK' ], ]; } sub js_config_settings { my $self = shift; my $config_settings = $self->config_settings_profile; # warn Dumper $config_settings; # convert array(ref) to hash so we can extract keys: my %cfg = @$config_settings; # warn Dumper [ keys %cfg ]; # required = arrayref of %cfg keys: return { required => [ keys %cfg ], }; } #------------------------------------------------------------------------------- sub search { # profile validated OK my $self = shift; return { optional => [ qw( last_name first_name nhs_number unit_number trial_id trial_number lab_number specimen_code referral_source_id referrer_name urgent copy_to external_reference private dob_day dob_month dob_year request_day request_month request_year date_extend sql_simple_search specific_year previous_days date_from date_to logic kwd patient_id id sender_ioa ) ], field_filters => { # remove dd/mm/yyyy jQuery watermarks if used: specimen_code => 'alphanum', # to fix eg 'xbl,' request_month => \&remove_jquery_watermark, request_year => \&remove_jquery_watermark, request_day => \&remove_jquery_watermark, dob_month => \&remove_jquery_watermark, dob_year => \&remove_jquery_watermark, dob_day => \&remove_jquery_watermark, }, dependency_groups => { # if any one field is filled in, they all become required request_dates => [ qw(request_year request_month request_day) ], dob_dates => [ qw(dob_year dob_month dob_day) ], sql_simple => [ qw(sql_simple_search logic kwd) ], }, constraint_methods => { request_year => $self->get_date_constraints('request'), # optional prefix dob_year => $self->get_date_constraints('dob'), # optional prefix specimen_code => [ # TODO: join_these() doesn't work here $self->check_param_length(4), # prohibits multiple specimen search $self->get_specimen_constraints, ], nhs_number => $self->check_nhsno_is_valid(), }, msgs => { constraints => { yyyy_format => $self->messages->{year_digits}, future_date => $self->messages->{future_date}, max_length => $self->messages->{alphanumeric}, valid_date => $self->messages->{invalid_date}, }, }, } } # remove mi(n), hr, dd, mm & yyyy jQuery watermarks from date fields: sub remove_jquery_watermark { my $v = shift; # warn $v; $v =~ s/^(mi(n?)|hr|dd|[Mm][Mm]|yyyy)$//o; # warn $v; $v; # returns expression (maybe empty) } sub remove_spaces { my $v = shift; # warn $v; $v =~ s/\s//g; return $v } #------------------------------------------------------------------------------- sub error_codes { # profile validated OK my $self = shift; return { required => [ qw( code description active ) ], optional => [ '_record_id', # for error_code validation 'is_unique', # only required for new system err code, not report err codes ], field_filters => { code => 'lc', }, constraint_methods => { code => $self->check_param_ownership( ['code', 'ErrorCode'] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, } }, } } #------------------------------------------------------------------------------- sub error_codes_config { my $self = shift; return { required => 'type', optional => 'error_code_id', # collected as arrayref } } #------------------------------------------------------------------------------- sub report_notifications { my $self = shift; my @required = qw( name type contact_address status is_active ); my @optional = qw( department_id referral_source_id _referral_source_id identifier ); my @require_some = qw( referral_source_id _referral_source_id identifier ); return { required => \@required, optional => \@optional, constraint_methods => { contact_address => $self->check_email_is_valid({nhs_net => 1}), # nhs.net only }, require_some => { # require one from this group id_type => [ 1, @require_some ], }, } } #------------------------------------------------------------------------------- sub report { my $self = shift; my @required = qw( status specimen_quality diagnosis_id ); # clinical_details optional/required now determined by config my @optional = qw( comment teaching option_id authorise morphology biopsy_site no_new_report general_notes final_diagnosis gross_description followup_option_id secondary_diagnosis_id maybe_diagnosis_revision confirm_outstanding_tests delete_secondary_diagnosis confirm_outstanding_results _diagnosis_id _have_outstanding_tests _have_outstanding_results ); $self->{settings}->{allow_optional_request_details} ? push @optional, 'clinical_details' : push @required, 'clinical_details'; return { required => \@required, optional => \@optional, dependencies => { _have_outstanding_results => 'confirm_outstanding_results', _have_outstanding_tests => 'confirm_outstanding_tests', _want_gross_description => 'gross_description', _want_biopsy_details => 'biopsy_site', }, constraint_methods => { # require reason for changing diagnosis: _diagnosis_id => $self->check_report_params(), secondary_diagnosis_id => $self->check_secondary_diagnosis('duplicate_diagnosis'), }, msgs => { constraints => { duplicate_diagnosis => $self->messages->{duplicate_diagnosis}, diagnosis_resubmission => $self->messages->{report_confirm}, } } } } #------------------------------------------------------------------------------- sub general_notes { # doesn't need validation return { optional => [ 'general_notes' ], } } #------------------------------------------------------------------------------- sub anatomical_sites { my $self = shift; return { required => [ 'site_name', 'snomed' ], field_filters => { site_name => 'lc', snomed => 'uc', }, constraint_methods => { snomed => $self->check_snomed_code(), }, } } #------------------------------------------------------------------------------- sub report_error_code { my $self = shift; return { required => [ qw( code description active ) ], optional => '_record_id', # for error_code validation } } #------------------------------------------------------------------------------- sub request_error { # profile validated OK return { optional => [ qw(error_code_id LIC error_details request_error_code_id) ], require_some => { # require one from this group: error_group => [ 1, qw(LIC error_code_id request_error_code_id) ], }, } } #------------------------------------------------------------------------------- sub specimens { # profile validated OK my $self = shift; my $settings = $self->settings; my @required = qw( sample_code description active ); push @required, 'sample_type_id' if $settings->{lab_section_sample_type}; return { required => \@required, optional => '_record_id', # for sample_code validation field_filters => { sample_code => 'uc', }, constraint_methods => { sample_code => $self->join_these( $self->check_param_length(4), $self->check_no_spaces(), $self->check_param_ownership( ['sample_code', 'Specimen'] ), ), }, msgs => { constraints => { max_length => $self->messages->{too_long}, no_spaces => $self->messages->{single_word}, ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub initial_screen { # profile validated OK my $self = shift; my $settings = $self->settings; my @required = qw(screen_id); push @required, 'option_id' if $settings->{have_request_audit}; return { required => \@required, } } #------------------------------------------------------------------------------- sub referral_sources { # profile validated OK my $self = shift; return { required => [ qw( referral_type organisation_code is_active ) ], optional => [ qw( parent_organisation_id display_name practice_name practice_address practice_zip _record_id is_branch parent_practice_id ) ], field_filters => { organisation_code => 'uc', }, require_some => { # require one from this group source_name => [ 1, qw(display_name practice_name) ], }, dependency_groups => { # if any one field is filled in, they all become required practices => [ qw(practice_name practice_address practice_zip) ], }, dependencies => { # if referral_type is hospital, require parent_organisation: referral_type => { hospital => [ qw( parent_organisation_id ) ], }, is_branch => 'parent_practice_id', }, constraint_methods => { organisation_code => $self->join_these( $self->check_param_length(6), $self->check_no_spaces(), $self->check_param_ownership( ['organisation_code', 'ReferralSource'] ), ), display_name => $self->check_param_ownership( ['display_name', 'ReferralSource'] ), }, msgs => { constraints => { max_length => $self->messages->{too_long}, no_spaces => $self->messages->{single_word}, ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub general_practitioners { # edit function only - insufficient to require tests return { required => [ qw( name active ) ], # can only modify these 2 fields field_filters => { name => 'uc', }, } } #------------------------------------------------------------------------------- sub new_clinician { # profile validated OK my $self = shift; return { required => [ qw( prefix national_code surname initials_1 referral_source_id hospital_department_code ) ], optional => [ qw(initials_2 initials_3 initials_4) ], field_filters => { national_code => 'uc', }, constraint_methods => { national_code => $self->join_these( $self->check_no_spaces(), $self->check_numeric(), # name = 'numeric_format' $self->check_param_length(7), ), }, msgs => { constraints => { numeric_format => $self->messages->{numbers_only}, max_length => $self->messages->{too_high}, # no_spaces => $self->messages->{single_word}, # default OK }, }, } } #------------------------------------------------------------------------------- sub edit_referrer { # profile validated OK my $self = shift; return { required => [ qw(name national_code referral_type_id active) ], optional => '_record_id', constraint_methods => { national_code => $self->join_these( $self->check_referrer_code(), # name = 'referrer_code' $self->check_param_ownership( ['national_code', 'Referrer'] ), ), }, msgs => { constraints => { referrer_code => $self->messages->{referrer_code}, ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub new_location { # profile validated OK return { required => [ qw( referral_source_id ) ], optional => [ qw( unit_number ) ], } } #------------------------------------------------------------------------------- sub diagnosis { # profile validated OK my $self = shift; return { required => [ qw( name diagnostic_category_id active new_labtests ) ], optional => [ qw( icdo3 _record_id sub_category_id ) ], constraint_methods => { name => $self->check_param_ownership( ['name', 'Diagnosis'] ), }, dependencies => { # make ICDO3 required if sub_category_id entered sub_category_id => 'icdo3', }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub diagnostic_categories { # profile validated OK my $self = shift; return { required => [ qw( description category_type active ) ], optional => '_record_id', constraint_methods => { description => $self->check_param_ownership( ['description', 'DiagnosticCategory'] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub diagnosis_context { # validation not required return { required => [ qw( diagnosis_id context_warning_id ) ], } } #------------------------------------------------------------------------------- sub diagnosis_change { # validation not required return { required => [ qw( option_name description is_active ) ], } } #------------------------------------------------------------------------------- sub context_warnings { # validation not required return { required => [ qw( description is_active ) ], } } #------------------------------------------------------------------------------- sub patient_case { # validation not tested return { optional => [ 'unit_number' ], required => [ 'referral_source_id' ], } } #------------------------------------------------------------------------------- sub patient_merge { # validation not tested return { require_some => { # require ONE from this group - need to OMIT leading # digit of arrayref (defaults to 1 anyway) as it gets included in # $data->valid, which causes fatal error if pat.id = 1 used (eg test suite): patient_id => [ undef, qw(last_name unit_number dob_year) ], }, dependency_groups => { # if any one field is filled in, they all become required dates => [ qw(dob_year dob_month dob_day) ], }, optional => [ qw(last_name first_name unit_number dob_year dob_month dob_day) ], } } #------------------------------------------------------------------------------- sub trials { # profile validated OK my $self = shift; return { required => [ qw( trial_name active ) ], optional => '_record_id', constraint_methods => { trial_name => $self->check_param_ownership( ['trial_name', 'ClinicalTrial'] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub screening_terms { # profile validated OK my $self = shift; my @fields = qw(description category_id); # 2-col unique key return { required => [ qw(description category_id active) ], optional => '_record_id', constraint_methods => { description => $self->check_param_ownership([ \@fields, 'Screen' ]), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, }; } #------------------------------------------------------------------------------- sub lab_tests { # profile validated OK my $self = shift; # lab_tests uses a 3-col unique key, so need to supply all 3: my @fields = qw(test_name lab_section_id test_type); return { required => [ qw(field_label test_name lab_section_id test_type has_results is_active) ], optional => [ '_record_id', 'sample_type_id', 'data_type_id' ], dependencies => { has_results => { yes => [ 'data_type_id' ], # data_type required if has_results = yes }, }, field_filters => { test_name => 'lc', }, constraint_methods => { field_label => $self->join_these( $self->check_param_length(25), $self->check_param_ownership([ \@fields, 'LabTest' ]), ), test_name => $self->check_no_spaces(), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, max_length => $self->messages->{too_long}, no_spaces => $self->messages->{single_word}, }, }, }; } #------------------------------------------------------------------------------- sub lab_sections { # profile validated OK my $self = shift; my $settings = $self->settings; my @required = qw( section_name has_result_summary has_section_notes has_test_sign_out has_results_import has_foreign_id auto_expand is_active ); push @required, 'sample_type_id' if $settings->{lab_section_sample_type}; push @required, 'has_labels' if $settings->{have_label_printer}; return { required => \@required, optional => '_record_id', constraint_methods => { section_name => $self->check_param_ownership( [ 'section_name', 'LabSection' ] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, }; } #------------------------------------------------------------------------------- sub screen_categories { my $self = shift; return { required => [ qw( name is_active ) ], optional => '_record_id', constraint_methods => { category_name => $self->check_param_ownership( [ 'name', 'ScreenCategory' ] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, }; } #------------------------------------------------------------------------------- sub result_data_types { my $self = shift; return { required => [ qw( description is_active ) ], optional => '_record_id', constraint_methods => { description => $self->check_param_ownership( [ 'description', 'LabTestResultDataType' ] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub parent_organisations { # profile validated OK my $self = shift; return { required => [ qw( parent_code description referral_type ) ], optional => '_record_id', field_filters => { description => 'uc', # needs to be UPPERCASE parent_code => 'uc', }, constraint_methods => { parent_code => $self->join_these( $self->check_param_length(6), $self->check_no_spaces(), $self->check_param_ownership( [ 'parent_code', 'ParentOrganisation' ] ), ), description => $self->check_param_ownership( [ 'description', 'ParentOrganisation' ] ), }, msgs => { constraints => { max_length => $self->messages->{too_long}, ownership => $self->messages->{not_unique}, no_spaces => $self->messages->{single_word}, }, }, }; } =begin if we need this, move it to Roles::ConstraintMethods #------------------------------------------------------------------------------- sub patient_data { # uses lyo.kato DatePlugin (DATE_GREATER_THAN) return [ { date => [ qw(year month day) ] } => [ 'DATE' ], { grouped => [qw(year month day)] } => [ ['DATE_GREATER_THAN', DateTime->now ] ], ]; } =cut #------------------------------------------------------------------------------- sub patient_search_data { # profile validated OK my $self = shift; return { optional => [ qw(patient_id name year month day patient_no) ], # id from edit_patient rtn require_some => { data => [ 1, qw(patient_id name year patient_no) ], }, field_filters => { # remove dd/mm/yyyy jQuery watermarks if used: patient_no => \&remove_spaces, # in case NHS no in xxx xxxx xxxx format month => \&remove_jquery_watermark, year => \&remove_jquery_watermark, day => \&remove_jquery_watermark, }, dependency_groups => { # if any one field is filled in, they all become required dates => [ qw(year month day) ], }, constraint_methods => { year => $self->get_date_constraints() }, msgs => { constraints => { yyyy_format => $self->messages->{year_digits}, future_date => $self->messages->{future_date}, valid_date => $self->messages->{invalid_date}, }, }, # untaint_all_constraints => 1, }; } #------------------------------------------------------------------------------- sub user_functions { # profile validated OK my $self = shift; return { required => [ qw( function_name function_detail active ) ], optional => '_record_id', constraint_methods => { function_name => $self->join_these( $self->check_no_spaces(), $self->check_param_ownership( [ 'function_name', 'UserFunction' ] ), ), function_detail => $self->check_param_ownership( [ 'function_detail', 'UserFunction' ] ), }, msgs => { constraints => { no_spaces => $self->messages->{single_word}, ownership => $self->messages->{not_unique}, }, }, }; } #------------------------------------------------------------------------------- sub user_locations { # profile validated OK my $self = shift; return { required => [ qw( location_name active ) ], # email_contact optional => [ qw( _record_id region_code ) ], constraint_methods => { location_name => $self->check_param_ownership( [ 'location_name', 'UserLocation' ] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, }; } #------------------------------------------------------------------------------- sub user_groups { # profile validated OK my $self = shift; return { required => [ qw( group_name group_label group_detail active ) ], optional => '_record_id', constraint_methods => { group_name => $self->join_these( $self->check_no_spaces(), $self->check_param_ownership( [ 'group_name', 'UserGroup' ] ), ), group_label => $self->join_these( $self->check_param_ownership( [ 'group_label', 'UserGroup' ] ), ), }, msgs => { constraints => { no_spaces => $self->messages->{no_spaces}, ownership => $self->messages->{not_unique}, }, }, }; } #------------------------------------------------------------------------------- sub user_details { # Admin / User administration / User Manager function my $self = shift; # uses same profile as new_user(), except requires username my $profile = $self->new_user; push @{ $profile->{required} }, 'username'; # warn Dumper $profile; # preserve last login (eg updating user through admin panel): push @{ $profile->{optional} }, 'last_login'; # warn Dumper $profile; # also requires check of username param ownership: $profile->{constraint_methods}->{username} = $self->join_these( $self->check_param_ownership([ 'username', 'User' ]), $self->check_username(), ); $profile->{msgs}->{constraints}->{username} = $self->messages->{username}; # warn Dumper $profile; return $profile; } #------------------------------------------------------------------------------- sub new_user { # profile shared by 'Register New User' & 'User Manager' functions my $self = shift; my @name = qw(first_name last_name); my $settings = $self->settings; my @optional = qw( _record_id location reg_num ); # for validation of edited user my @required = qw( first_name last_name full_name password user_location_id email designation group_id active service ); return { optional => \@optional, required => \@required, field_filters => { last_name => 'lc', first_name => 'lc', username => 'lc', email => 'lc', }, constraint_methods => { last_name => $self->check_username(), # letters, apostrophies & hyphens only full_name => $self->check_param_ownership([ \@name, 'User' ]), service => $self->check_lims_service($settings->{_centre}), email => $self->join_these( $self->check_email_is_valid(), $self->check_param_ownership([ 'email', 'User' ]), ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, lims_service => $self->messages->{lims_service}, }, }, }; } #------------------------------------------------------------------------------- sub user_message { return { optional => [ 'user_location' ], # not required if using 'PM' link required => [ qw( user_id message) ], } } #------------------------------------------------------------------------------- sub result_summary_options { # profile validated OK my $self = shift; # result_summary_options uses a 2-col unique key, so need to supply both: my @fields = qw(description lab_section_id); return { required => [ qw( description lab_section_id is_active ) ], optional => [ qw( _record_id ) ], constraint_methods => { description => $self->check_param_ownership( [ \@fields, 'ResultSummaryOption' ] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub update_results { # return { required => [ qw( _section_id _section_name) ], # _section_name only used with foreign_id optional => [ 'test_id', # investigation/test id(s) 'section_notes', # textarea entry 'lab_section_id', # lab_section.id 'foreign_id', # free text entry (maybe move to results_data_entry) 'retain_req_status', # override status_option change ], } } #------------------------------------------------------------------------------- sub results_data_entry { return { required => [ qw( _section_name _section_id ) ], optional => [ 'results_summary', # free text entry '_results_summary', # drop-down entry 'complete_all_tests', # checkbox ], } } #------------------------------------------------------------------------------- sub update_request { # my $self = shift; return { required => [ qw( error_code_id ) ], # for both data types optional => [ qw( unit_number referral_source_id _location_name scope sender_ioa _referrer referrer_code specimen_code trial_id trial_number urgent external_reference private doi copy_to storage treatment research monitoring use_patient_case_id day month year hour minute ) ], field_filters => { minute => \&remove_jquery_watermark, month => \&remove_jquery_watermark, hour => \&remove_jquery_watermark, year => \&remove_jquery_watermark, day => \&remove_jquery_watermark, }, dependency_groups => { # if any one field is filled in, they all become required _request_data => [ qw( _request_data specimen_code _referrer ) ] # _request_data is hidden flag }, dependencies => { trial_number => 'trial_id', # make trial_id required if trial_no entered scope => '_location_name', # referral_source_id only submitted if changed }, constraint_methods => { specimen_code => $self->get_specimen_constraints(), year => $self->get_date_constraints(), }, msgs => { constraints => { yyyy_format => $self->messages->{year_digits}, future_date => $self->messages->{future_date}, valid_date => $self->messages->{invalid_date}, valid_datetime => $self->messages->{invalid_datetime}, }, } } } #------------------------------------------------------------------------------- sub delete_request { # # profile validated OK return { required => [ qw( confirm_delete reason ) ], optional => 'delete_patient_record', } } =begin # example of message construction which works with JS::DVF constraints => { reason => [ { name => 'no_spaces', constraint => '/^\\S*$/' }, { name => 'word_chars', constraint => '/^\\w+$/' } ], }, msgs => { constraints => { no_spaces => 'no spaces allowed', word_chars => 'require word chars', }, }, =cut #------------------------------------------------------------------------------- sub request_audit_options { my $self = shift; return { required => [ qw( description category_id active ) ], optional => [ qw( _record_id ) ], constraint_methods => { description => $self->check_param_ownership( ['description', 'AuditRequestOption'] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub consent_options { my $self = shift; return { required => [ qw( consent_name consent_label is_active ) ], optional => [ qw( _record_id ) ], constraint_methods => { consent_name => $self->join_these( $self->check_no_spaces(), $self->check_param_ownership(['consent_name', 'ConsentOption']), ), consent_label => $self->join_these( $self->check_no_spaces(), $self->check_param_ownership(['consent_label', 'ConsentOption']), ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, no_spaces => $self->messages->{single_word}, }, }, } } #------------------------------------------------------------------------------- sub request_options { my $self = shift; return { required => [ qw( option_name option_label is_active ) ], optional => [ qw( _record_id ) ], constraint_methods => { consent_name => $self->join_these( $self->check_no_spaces(), $self->check_param_ownership(['option_name', 'RequestOption']), ), consent_label => $self->join_these( $self->check_no_spaces(), $self->check_param_ownership(['option_label', 'RequestOption']), ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, no_spaces => $self->messages->{single_word}, }, }, } } #------------------------------------------------------------------------------- sub request_audit_categories { # profile validated OK my $self = shift; return { required => [ qw( description active ) ], optional => [ qw( _record_id ) ], constraint_methods => { description => $self->check_param_ownership( ['description', 'AuditRequestCategory'] ), }, msgs => { constraints => { ownership => $self->messages->{not_unique}, }, }, } } #------------------------------------------------------------------------------- sub referrer_search { # search profile - doesn't need validating my @fields = qw(name national_code); return { optional => \@fields, require_some => { data => [ 1, @fields ], }, } } #------------------------------------------------------------------------------- sub referral_source_search { # search profile - doesn't need validating my @fields = qw(display_name organisation_code referral_type_id); return { optional => \@fields, require_some => { data => [ 1, @fields ], }, } } #------------------------------------------------------------------------------- sub parent_organisation_search { # search profile - doesn't need validating my @fields = qw(description parent_code referral_type_id); return { optional => \@fields, require_some => { data => [ 1, @fields ], }, } } #------------------------------------------------------------------------------- sub phonelog { # profile validated OK my @optionals = qw( summary comments ); return { required => [ qw( user_id status contact ) ], optional => \@optionals, require_some => { text => [ 1, @optionals ], }, } } #------------------------------------------------------------------------------- sub worklist { # profile only used for obtaining form params my $self = shift; return { required => [ qw( lab_section_id ) ], optional => [ qw( lab_test_id test_status status_option_id lab_number_from sort_by request_id ), ], } } sub fish_custom_worklist { my $self = shift; return { required => [qw( request_id template )], constraint_methods => { template => sub { my $t = pop; my $template_name = uri_unescape($t); $template_name =~ m{\A[\w& -]+\.tt\z}msx; }, request_id => qr{\d+}, }, } } #------------------------------------------------------------------------------- sub worklist_update_status { return { required => [ qw( user_id status_option_id ) ], dependencies => { status_option_id => { 3 => [ 'confirm_delete' ], # 3 = DELETE }, } } } #------------------------------------------------------------------------------- sub histology_processing { # just used for valid fields: return { required => [ qw(user_id lab_section_id lab_test_id) ], # drop-down & 2 hidden fields optional => [ qw(frozen_tissue pieces_blocks), # results fields # status fields: 'initial cut-up', 'prepared dabs', 'cells for flow', 'final cut-up', 'complete', ], } } #------------------------------------------------------------------------------- sub histology_staining { # just used for valid fields: return { required => [ qw(user_id lab_section_id lab_test_id) ], # drop-down & 2 hidden fields optional => [ 'haematoxylin_eosin', # results fields # status fields: 'block out', 'microtomy', 'H & E stain', 'giemsa stain', 'QC', 'complete', ], } } #------------------------------------------------------------------------------- sub histology_immunochemistry { # just used for valid fields: return { required => [ qw(user_id lab_section_id lab_test_id) ], # drop-down & 2 hidden fields optional => [ 'haematoxylin_eosin', # results fields # status fields: 'microtomy', 'ICC staining', 'QC', 'complete', ], } } #------------------------------------------------------------------------------- sub hmrn_new_diagnoses { my @fields = qw(previous_week duration date_from date_to lab_number force_tmpl request_id); return { optional => \@fields, require_some => { # require at least one from this group duration_args => [ 1, @fields ], }, } } #------------------------------------------------------------------------------- sub hmrn_antecedent { return { required => [ 'event_id '], } } #------------------------------------------------------------------------------- sub hmrn_chronologies { my $self = shift; return { required => [], # none optional => [ qw( diagnosis first_appointment palliative_care deceased mdt_date ) ], constraint_methods => { first_appointment => $self->check_EU_date_is_valid(), palliative_care => $self->check_EU_date_is_valid(), diagnosis => $self->check_EU_date_is_valid(), deceased => $self->check_EU_date_is_valid(), mdt_date => $self->check_EU_date_is_valid(), }, msgs => { constraints => { valid_date => $self->messages->{invalid_date}, }, }, } } #------------------------------------------------------------------------------- sub hmrn_mdt_date { my $self = shift; return { required => [ 'date' ], constraint_methods => { date => $self->check_EU_date_is_valid(), }, ajax_methods => { # for jQuery ajax call date => 'check_date_valid', }, msgs => { constraints => { valid_date => $self->messages->{invalid_date}, }, }, } } #------------------------------------------------------------------------------- sub hmrn_imaging { my $self = shift; my $constraint_methods = $self->get_hmrn_param_constraints([ qw/deauville suv_max/ ]); $constraint_methods->{scan_date} = $self->check_EU_date_is_valid(); return { required => [ qw(dataset scan_type scan_stage scan_date) ], optional => [ qw(option_id details suv_max deauville) ], ajax_methods => { # for jQuery ajax call scan_date => 'check_date_valid', }, constraint_methods => $constraint_methods, msgs => { constraints => { valid_date => $self->messages->{invalid_date}, }, }, } } #------------------------------------------------------------------------------- sub hmrn_referral { my $self = shift; return { required => [ qw(referral_date date_first_seen referral_type_id from_source_id to_source_id) ], optional => [ qw() ], constraint_methods => { referral_date => $self->join_these( $self->check_EU_date_is_valid(), $self->check_date_order( [ qw(referral_date date_first_seen) ] ), ), date_first_seen => => $self->join_these( $self->check_EU_date_is_valid(), $self->check_date_order( [ qw(referral_date date_first_seen) ] ), ), }, ajax_methods => { # for jQuery ajax call referral_date => 'check_date_valid', date_first_seen => 'check_date_valid', }, msgs => { constraints => { valid_date => $self->messages->{invalid_date}, date_order => $self->messages->{date_order}, }, }, }; } #------------------------------------------------------------------------------- sub hmrn_treatment { my $self = shift; my $hmrn_treatment_types = $self->models->{hmrn_treatment_types}; # force creation of hashref map: my $txTypeIdFor = &$hmrn_treatment_types(); # warn Dumper $txTypeIdFor; my $clinical_trial_id = $txTypeIdFor->{'clinical trial'}; # warn Dumper $clinical_trial_id; my $chemotherapy_id = $txTypeIdFor->{'chemotherapy'}; # warn Dumper $chemotherapy_id; return { required => [ qw( location_id tx_type_id ) ], # minimum data set optional => [ qw( start_date end_date response_id tx_detail_id tx_cycles ) ], # tx_cycles client validation also in # edit_treatment.tt & treatment.tt constraint_methods => { tx_cycles => $self->is_decimal(), # was is_integer(), start_date => $self->join_these( $self->check_EU_date_is_valid(), $self->check_date_order( [ qw(start_date end_date) ] ), ), end_date => $self->join_these( $self->check_EU_date_is_valid(), $self->check_date_order( [ qw(start_date end_date) ] ), ), }, dependencies => { # if tx_type = chemoTx or trial, require tx_detail: tx_type_id => { $clinical_trial_id => [ qw( tx_detail_id ) ], #tx_cycles -> was here but made optional instead $chemotherapy_id => [ qw( tx_detail_id ) ], #tx_cycles -> was here but made optional instead }, }, ajax_methods => { # for jQuery ajax call start_date => 'check_date_valid', end_date => 'check_date_valid', }, msgs => { constraints => { valid_date => $self->messages->{invalid_date}, date_order => $self->messages->{date_order}, }, }, } } #------------------------------------------------------------------------------- sub hmrn_demographics { my $self = shift; my @optional = qw( gp_id practice_id ); return { required => [ qw( address post_code status ) ], # GP can only be selected AFTER practice - default loaded in Model if absent # and practice id not re-submitted when GP submitted: optional => \@optional, require_some => { # require one from this group gp_or_practice => [ 1, @optional ], }, constraint_methods => { post_code => $self->check_post_code_is_valid(), }, } } #------------------------------------------------------------------------------- sub hmrn_myeloid { my $self = shift; my @optional = qw( epo transfusion cytopenias karyotype cd34 ); # JD - removed 'rcm' my @required = qw( splenomegaly detection_spleen hepatomegaly detection_liver wbc hb pcv neutrophils monocytes plts ecog lymphs pcv ); # JD - swapped 'haematocrit_vol' for 'pcv' my $constraint_methods = $self->get_hmrn_param_constraints([ @required, @optional ]); return { required => \@required, optional => \@optional, require_some => { # require at least one from this group mds_or_mpd => [ 1, @optional ], }, dependency_groups => { # if any one field is filled in, they all become required mds => [ qw( transfusion cytopenias karyotype cd34 ) ], # MDS fields mpd => [ qw( epo ) ], # MPD fields (JD - removed rcm) }, constraint_methods => $constraint_methods, } } #------------------------------------------------------------------------------- sub hmrn_lymphoid { my $self = shift; my @optional = qw( binet plts stage ); #JD - removed 'scans' my @required = qw( ecog hb bm wbc sweats lymphs fever albumin wt_loss b2m ct mri pet ldh paraprotein pp_level pcv neutrophils monocytes igs ); # JD - swapped 'haematocrit_vol' for 'pcv'...... added 'mri' and 'pet' also my $constraint_methods = $self->get_hmrn_param_constraints([ @required, @optional ]); return { required => \@required, optional => \@optional, require_some => { # require at least one from this group cll_or_non_cll => [ 1, @optional ], }, dependency_groups => { # if any one field is filled in, they all become required cll => [ qw( binet plts ) ], }, constraint_methods => $constraint_methods, } } #------------------------------------------------------------------------------- sub hmrn_plasmacell { my $self = shift; my @required = qw( paraprotein pp_level bence_jones serum_kappa serum_lambda igs bone_disease bone_lesions b2m mri creatinine skeletal_survey hb calcium albumin serum_flc wbc plts pcv neutrophils lymphs monocytes ecog kappa_lambda_ratio ); # JD - swapped 'haematocrit_vol' for 'pcv' my @optional = (); # none my $constraint_methods = $self->get_hmrn_param_constraints([ @required, @optional ]); # JD - added @optional return { required => \@required, optional => \@optional, # added by JD constraint_methods => $constraint_methods, } } #------------------------------------------------------------------------------- sub hmrn_precursor { my $self = shift; my @required = qw( ecog hb wbc plts pcv neutrophils lymphs monocytes ); # JD - swapped 'haematocrit_vol' for 'pcv' my @optional = (); # none my $constraint_methods = $self->get_hmrn_param_constraints([ @required, @optional ]); # JD - added @optional return { required => \@required, optional => \@optional, # added by JD constraint_methods => $constraint_methods, } } #------------------------------------------------------------------------------- sub outreach_questionnaire { my $self = shift; =begin # refactored - all optional now my @required = qw( hospital_referral new_medication serious_infection weight_loss night_sweats persistent_night_sweats rib_pain persistent_rib_pain back_pain persistent_back_pain arm_pain persistent_arm_pain leg_pain persistent_leg_pain cervical_swelling axillary_swelling abdominal_swelling inguinal_swelling location_preference transport_arrangements transport_difficulty ); my @optional = qw( weight waiting_duration excessive_wait imperial_stones imperial_pounds hospital_referral_details new_medication_details monitoring_comments serious_infection_details transport_difficulty_details swelling_details mobility self_care usual_activity discomfort anxiety health_index ); my @combined = (@required, @optional); # temporary during switch-over return { required => [ ], optional => \@combined, require_some => { # require one from this group: # weight => [ 1, qw/weight imperial_stones/ ], }, dependencies => { transport_difficulty => { Y => [ 'transport_difficulty_details' ] }, serious_infection => { Y => [ 'serious_infection_details' ] }, hospital_referral => { Y => [ 'hospital_referral_details' ] }, new_medication => { Y => [ 'new_medication_details' ] }, waiting_duration => [ 'excessive_wait' ], }, } =cut my @optional = qw( pain adenopathy weight_loss night_sweats pain_option_id nodal_option_id opinion mobility self_care usual_activity discomfort anxiety health_index ); return { required => [ ], optional => \@optional, } } #------------------------------------------------------------------------------- sub outreach_demographics { my $self = shift; return { required => [ qw( address post_code practice_id gp_id dispatch_to status ) ], optional => [ qw(contact_number) ], constraint_methods => { post_code => $self->check_post_code_is_valid(), }, } } #------------------------------------------------------------------------------- sub outreach_followup { return { required => [ 'followup_option_id' ], optional => [ qw(pack_due return_due appointment_date) ], } } #------------------------------------------------------------------------------- sub outreach_lab_results { return { immunology => { required => [ qw( department) ], optional => [ qw( IgA IgG IgM electrophoresis globulin paraprotein sp_haemoph sp_pneumoc sp_tetanus sflc_kappa sflc_lambda sflc_ratio ) ], }, biochemistry => { required => [ qw( department ) ], optional => [ qw(sodium potassium urea alk_phos albumin phosphate total_protein creatinine calcium bilirubin magnesium alt) ], }, flow_cytometry => { required => [ qw(total_b_cells kappa lambda sIg_neg cd5_pos neoplastic_b_cells total_plasma_cells cd19_neg_pc department) ], optional => [], }, haematology => { required => [ qw( department ) ], optional => [ qw(hb wbc plts lymphs) ], }, } } #------------------------------------------------------------------------------- sub pre_screen_data { return { required => [ qw(surname specimen lab_section_id) ], optional => [ qw( plasma_cell b_lymphoid t_lymphoid rituximab outreach stem_cell ) ], } } #------------------------------------------------------------------------------- sub pre_screen_new { return { required => [ qw(specimen lab_section_id) ], require_some => { # require one from this group lab_tests => [ 1, qw(plasma_cell b_lymphoid t_lymphoid rituximab outreach stem_cell) ], }, } } #------------------------------------------------------------------------------- =begin # passing data from form as lab_test_id_(\d) now: sub results_data { my $self = shift; my $lab_tests_count = $self->lab_tests_count; return { optional => [ ( 1 .. $lab_tests_count ) ], } } =cut #------------------------------------------------------------------------------- sub storage_common { my $self = shift; my @xna_dependencies = qw( concentration volume method ); my $msgs = $self->messages; return { required => [ qw( specimen sample vialId source part_number ) ], optional => [ qw( volume concentration method comment specimen_id ) ], field_filters => { vialId => 'uc', # plate reader returns uc letters sample => 'lc', # so dependencies can work with uc & lc entries }, dependencies => { # if sample is [rd]na, require concentration, volume & method: sample => { plasma => [ 'volume' ], dna => \@xna_dependencies, rna => \@xna_dependencies, }, }, constraint_methods => { vialId => $self->check_vial_Id_length(), volume => $self->check_numeric(), # integer (not decimal) concentration => $self->check_numeric(), # integer (not decimal) }, msgs => { constraints => { invalid_length => $msgs->{invalid_length}, }, } }; } #------------------------------------------------------------------------------- sub storage_input { my $self = shift; my $profile = $self->storage_common; # replace vialId constraint method with joint: my $constraint = $self->join_these( $self->check_vial_Id_length(), $self->check_vial_Id_unique(), $self->check_vial_Id_format(), ); $profile->{constraint_methods}{vialId} = $constraint; # add msgs (already have invalid_length in storage_common): $profile->{msgs}{constraints}{$_} = $self->messages->{$_} for qw( invalid_format not_unique ); return $profile; } #------------------------------------------------------------------------------- sub storage_update { shift->storage_common } # don't want vialId uniqueness, etc #------------------------------------------------------------------------------- sub storage_delete { my $self = shift; # warn Dumper $self->messages; return { required => [ qw( vialId vial_id )], optional => [ qw(reason_required reason) ], dependencies => { reason_required => 'reason', }, constraint_methods => { vialId => $self->check_vial_id('vial_confirm'), }, msgs => { constraints => { vial_confirm => $self->messages->{vial_mismatch}, }, }, }; } #------------------------------------------------------------------------------- sub storage_output { my $self = shift; return { required => [ 'vialId' ], constraint_methods => { vialId => $self->check_param_length(10), # max_length if single int }, msgs => { constraints => { max_length => $self->messages->{too_long}, }, }, } } #------------------------------------------------------------------------------- # only loaded if storage_locations.yml sub storage_rack { { required => [ 'storage_location' ] } } #------------------------------------------------------------------------------- sub lab_test_data_type { return { required => [ qw( data_type_id is_active ) ], } } #------------------------------------------------------------------------------- sub status_options { return { required => [ qw(description is_active) ], } } #------------------------------------------------------------------------------- sub pre_authorisation_check { return { required => [ 'diagnosis_id' ], } } #------------------------------------------------------------------------------- sub lab_test_result_options { return { required => [ qw(data_type_id value is_active) ], optional => '_record_id', } } #------------------------------------------------------------------------------- sub specimen_lab_test { # doesn't need validating return { optional => [ 'specimen_id' ], } } #------------------------------------------------------------------------------- sub section_status_options { # doesn't need validating return { optional => [ 'option_data' ], # composite of status_option_id & position } } #------------------------------------------------------------------------------- # results data validators; called by C::R::FormData::validate_results_data_entry # need to return validation method & error message: sub data_entry_integer { my $self = shift; return { method => $self->is_integer(), err_msg => $self->messages->{need_integer}, } } sub data_entry_decimal { my $self = shift; return { method => $self->is_decimal(), err_msg => $self->messages->{need_decimal}, } } sub data_entry_date { my $self = shift; return { method => $self->check_yyyymmdd_date_is_valid(), err_msg => $self->messages->{invalid_date}, } } sub data_entry_datetime { my $self = shift; return { method => $self->check_yyyymmdd_date_is_valid(), err_msg => $self->messages->{invalid_datetime}, } } =begin sub _build_lab_tests_count { my $self = shift; my $count = $self->models->{get_lab_tests_count}; return $count; } =cut 1;