RSS Git Download  Clone
Raw Blame History
package Reporter::SQL::Lib;

use SQL::Abstract::More; # extends SQL::Abstract to support joins
use Reporter::Class; # provides Moo, Modern::Perl & Data::Printer::p

use lib '/home/raj/perl-lib';
use Local::QueryLibrary;

has sql_abs => ( is => 'lazy', builder => sub { SQL::Abstract::More->new } );
has sql_lib => ( is => 'lazy', builder => sub { Local::QueryLibrary->new } );
has dbix    => ( is => 'ro',   required => 1 ); # for get_table_col lookups

#-------------------------------------------------------------------------------
sub request_data {
    my ($self, $request_number, $yr) = @_;

    my @cols = ( qw/
        r.id
        r.request_number
        r.year
        r.created_at|registered
        p.last_name
        p.first_name
        p.nhs_number
        p.dob
        rs.display_name|location /,
        'group_concat(s.sample_code order by s.sample_code)|specimen',
    ); # p @cols;

    # SQL::Abstract::More join (rr & d = left joins, unused but retained for syntax):
    my @joins = (
            # table|alias               # FK-PK relationship
        qw{
            requests|r                  r.patient_case_id=pc.id
            patient_case|pc             pc.patient_id=p.id
            patients|p                  pc.referral_source_id=rs.id
            referral_sources|rs         =>{rr.request_id=r.id}
            request_report_view|rr      =>{rr.diagnosis_id=d.id}
            diagnoses|d                 rs2.request_id=r.id
            request_specimen|rs2        rs2.specimen_id=s.id
            specimens|s
        }
    );
    my %where = (
        'r.request_number' => $request_number,
        'r.year' => $yr + 2000,          
    );
    
    my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where);
    return ($sql, @bind);
}

#-------------------------------------------------------------------------------
sub report_data {
    my ($self, $where) = @_; # p $where; # request_id & user_id - pass straight through

    my @cols = (
        $self->get_table_cols( request_draft_report => 'r' ), # tbl|alias
        'd1.name|diagnosis', 'd2.name|secondary_diagnosis',
    ); # p @cols;
    my @joins = qw(
        request_draft_report|r    r.diagnosis_id=d1.id
        diagnoses|d1              =>{r.secondary_diagnosis_id=d2.id}
        diagnoses|d2
    );

    my ($sql, @bind) = $self->create_query(\@cols, \@joins, $where);
    return ($sql, @bind);
}

#-------------------------------------------------------------------------------
sub get_diagnoses {
    my ($self, $str) = @_; # p $str;
    
    my ($sql, @bind) = $self->sql_abs->select(
        -columns  => [ qw( id name|diagnosis icdo3 ) ],
        -from     => 'diagnoses',
        -where    => { name => { rlike => $str } },
    );
    return ($sql, @bind);
}

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

    my @cols = qw( ls.section_name rrs.results_summary );
    my @joins = (
        'request_result_summaries|rrs',     'rrs.lab_section_id=ls.id',
        'lab_sections|ls'
    );
    my %where = ( 'rrs.request_id' => $request_id );

    my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where);
    return ($sql, @bind);
}

#-------------------------------------------------------------------------------
sub all_previous_reports {
    my ($self, $user_id) = @_; # p $user_id;
    
    my @cols = qw( r.request_number r.year d.name|diagnosis rrd.created_at );
    my @joins = (
        # tbl|alias                     # FK-PK relationship
        'requests|r',                   'r.id=rrd.request_id',
        'request_draft_report|rrd',     'rrd.diagnosis_id=d.id',
        'diagnoses|d'
    );
    my %where = ( 'rrd.user_id' => $user_id );
    my @sort_by = qw( r.created_at r.request_number );

    my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where, \@sort_by);
    return ($sql, @bind);
}

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

    my @cols = qw( ls.section_name|section lt.field_label|test ltr.result );
    my @joins = qw(
        request_lab_test_results|ltr        ltr.lab_test_id=lt.id
        lab_tests|lt                        lt.lab_section_id=ls.id
        lab_sections|ls
    );
    my %where = ( 'ltr.request_id' => $request_id );

    my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where);
    return ($sql, @bind);
}

#-------------------------------------------------------------------------------
sub create_query {
    my ($self, $cols, $joins, $where, $sort_by) = @_; # aref, aref, href, optional aref

    my ($sql, @bind) = $self->sql_abs->select(
        -columns  => $cols,
        -from     => [ -join => @$joins ],
        -where    => $where,
        -order_by => $sort_by || [],
    ); # p $sql;
    return ($sql, @bind);
}

#-------------------------------------------------------------------------------
sub get_table_cols {
    my ($self, $table, $prefix) = @_; # str, optional str
	
	my @cols = map { # use prefix if supplied:
        $prefix ? ( join '.', $prefix, $_->{field} ) : $_->{field};
    } $self->dbix->query('show columns from ' . $table)->hashes; # p @cols;
	return wantarray ? @cols : \@cols; # return array unless called as scalar
}

1;