view release on metacpan or  search on metacpan

lib/Medical/DukePTP.pm  view on Meta::CPAN

use warnings;
use strict;

=head1 NAME

Medical::DukePTP - Calculate the Duke pre-test probability of CAD

=head1 VERSION

Version 0.3

=cut

our $VERSION = '0.3';


=head1 SYNOPSIS

    use Medical::DukePTP;
    
    my $rh_params = { 
        'smoking'      => 1,
        'diabetes'     => 1,
        'age'          => 55,
        'sex'          => 'male',
        'chest_pain'   => 'typical',
    };

    my $ptp = Medical::DukePTP::ptp( $rh_params );

=head1 BACKGROUND


Important diagnostic and prognostic outcomes can be predicted from 
information collected by the physician as a part of the initial 
assessement. Despite the fact that much of the clinical information 
collected by a physician is "soft" or subjective data, predictions
of outcome based on the information from the initial evaluation are accurate
and can be deployed in order to identify "high" and "low" risk patients.

This module implements the Duke pre-test probability of a patient 
having significant Coronary Artery Disease. This is accomplished by
taking into consideration symptom typicality, sex, age and cardiovascular
risk factors such as diabetes or high cholesterol.

The method is based on:

    Pryor D.B. et al., "Value of the history and physical in 
    identifying patients at increased risk of CAD", Ann Int Med 1993, 118:81-90

The PubMed entry for the paper:

L<http://www.ncbi.nlm.nih.gov/pubmed/8416322?ordinalpos=&itool=EntrezSystem2.PEntrez.Pubmed.Pubmed_ResultsPanel.SmartSearch&log$=citationsensor>

=head1 FUNCTIONS

=head2 ptp

Accepts a reference to a hash with parameters and returns a scalar 
which denotes the pre-test probability of coronary artery disease.
Note that the value is rounded upwards.

Required parameters include:

    sex : 'male' or 'female'
    age : numerical age of patient
    
Optional parameters

    chest_pain     : 'typical' or 'atypical'
    previous_MI    : history of previous Myocardial Infarction (1 for yes)
    ECG_Q_wave     : ECG Q waves of previous Myocardial Infarction (1 for yes) 
    ECG_ST-T_wave  : ECG ST changes at rest (1 for yes)
    smoking        : current smoker (1 for yes)
    hyperlipidemia : cholesterol > 6.5 mmol/l (>250 mg/dl) (1 for yes)
    diabetes       : diabetic (1 for yes)
    
This function will return I<undef> on error.

=cut

sub ptp {
    my $rh = shift;
    
    ##
    ## validate input structure

    return unless 
        ( defined $rh && $rh && ref($rh) eq 'HASH');
    
    ##
    ## validate input params
    
    foreach my $k qw(age sex) {
        return unless 
            ( defined( $rh->{$k} ) );
    }
    
    ##
    ## fill in some defaults 
    
    for my $k qw(smoking hyperlipidemia 
                 diabetes previous_MI ECG_Q_wave ECG_ST-T_wave) {
    
        $rh->{$k} ||= 0;
    }
    
    ##
    ## process the 'sex' 
    
    if ( $rh->{'sex'} eq 'male' ) {
        $rh->{'sex'} = 0;
    } elsif ( $rh->{'sex'} eq 'female') {
        $rh->{'sex'} = 1;
    } else {
        die "Unknown sex variable: $rh->{'sex'}";
    }
    
    ##
    ## process the chest pain typicality