File Coverage

blib/lib/DotICD9.pm

Criterion	Covered	Total	%
statement	25	30	83.3
branch	9	16	56.2
condition			n/a
subroutine	4	4	100.0
pod	0	2	0.0
total	38	52	73.0

package DotICD9;
# DotICD9.pm - add the dots to ICD9 codes
# DTM -- Sun May 16 18:27:39 DST 1999

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw( Exporter );
@EXPORT = qw( );
$VERSION = '0.04';

sub new
{
my $self = shift;
return ( bless { }, $self );
}

sub dot
{
# parameters: icd9code without any dots, D or 3 || O or 2
# returns: properly formatted ICD9 code or 0 for error
	my $self = shift;
	my $icdcode = shift;
	$icdcode =~ s/\.//g; # shed decimal point if present
	$icdcode =~ y/ //d;  # remove space characters
	my $MAJOR   = shift;
	# MAJOR is 3 for diagnostic, 2 for procedure codes
	if    ( $MAJOR eq 'D' ){ $MAJOR = 3; }      # D or DIAG for diagnosis codes
	elsif ( $MAJOR =~ m/DIAG/i ){ $MAJOR = 3; }
	elsif ( $MAJOR eq 'O' ){ $MAJOR = 2; }      # O,SURG, or PROC for procedures
	elsif ( $MAJOR =~ m/SURG/i ){ $MAJOR = 2; }
	elsif ( $MAJOR =~ m/PROC/i ){ $MAJOR = 2; }
    my ( $codelen, $minor, $major );
    $codelen = length($icdcode);    # should be 2, 3, 4, or 5
    if( $icdcode =~ /^E/ ){ $major = $MAJOR + 1; }
	else{ $major = $MAJOR; }
    $minor = $codelen - $major;    # number of decimal places
    if( $minor < 0 ) {
		return 0; # strings goofed up error
    }
    elsif( $minor > 0 ) {
		$icdcode = substr($icdcode, 0, $major) . "." . substr( $icdcode, $major, $minor );
    }
    else {
		$icdcode = substr( $icdcode, 0, $major );
    }
	return $icdcode;
}

1;
__END__