• Files
• Commits
• Log
• Graph
• Stats

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 @cols  = qw( id name|diagnosis icdo3 );
    my @joins = 'diagnoses|d'; # still works OK with single table
    my %where = ( name => { like => '%'.$str.'%' } ); # rlike => $str - not for sqlite

    my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where);
    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, $args) = @_; # p $user_id; p $args;
    $args ||= {}; # needs to exist to add group_by

    my @cols = (
        qw/ r.request_number r.year d.name|diagnosis rrd.created_at /,
        'group_concat(s.sample_code)|specimen', # sqlite doesn't support 'order by s.sample_code'
    );
    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',                  'rs2.request_id=r.id',
        'request_specimen|rs2',         'rs2.specimen_id=s.id',
        'specimens|s'
    );
    my %where = ( 'rrd.user_id' => $user_id );
    my @sort_by = qw( rrd.created_at r.year r.request_number );
    $args->{group_by} = 'r.id';

    my ($sql, @bind)
        = $self->create_query(\@cols, \@joins, \%where, \@sort_by, $args);
    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 {
    # aref, aref, href, optional aref, optional href (limit & offset)
    my ($self, $cols, $joins, $where, $sort_by, $args) = @_;

    my @params = (
        -columns  => $cols,
        -from     => [ -join => @$joins ],
        -where    => $where,
        -order_by => $sort_by || [],
    );
    push @params, ( -$_ => $args->{$_} )
        for grep $args->{$_}, qw(limit offset group_by); # p \@params;
    my ($sql, @bind) = $self->sql_abs->select(@params); # p $sql; p \@bind;
    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;