Validating a DRGFilt Control File

QUESTION

I find the DRGFilt control file format kind of hard to understand. How can I be sure that I got it right?

ANSWER

We hear you: the control file format is showing its age: it was derived from a format that originated on punch cards (!).

We use the following Perl script to validate our control files in-house:

Sample usage
In the examples below, replace "control-file" with the name of the control file you are validating, and "data-file" with the name of the data file you are running against. For extra credit, replace "pt-id" with the patient, claim or record ID you are looking for.

Unix

• perl chkcntl.pl control-file < data-file | more
• head -20 data-file | perl chkcntl.pl control-file | more
• fgrep pt-id data-file | perl chkcntl.pl control-file

Windows

• perl.exe chkcntl.pl control-file < data-file | more
• perl.exe chkcntl.pl control-file < data-file > output.txt

Sample Perl Code

# chkcntl.pl - program to check a control file

my($sgl,$dxl,$recLen,%h) = Load(shift(@ARGV));

while (defined(my $l = <>)) {
    $l =~ s/\r|\n//g;
    # pad out input with astericks if too short
    while (length($l) < $recLen) { $l .= '*'; }

    my $output = "";
    foreach my $key (sort (keys %h)) {
    my $ref = $h{$key};
    my($name,$off,$len) = @$ref;

    my $val = substr($l,$off,$len);
    $output .= sprintf("%4.4s@%3d for %2d:",$name,$off,$len);

    if ($name =~ /^(dx|surg)$/i) {
        $output .= AddBar($val, ($name =~ /dx/i)? $dxl : $sgl);
    } else {
        $output .= $val;
    }

    $output .= "\n";
    }
    print $output,"\n";
}

exit(0);
#-----------------------------------------------------------------
sub AddBar {
    my $val = shift;
    my $len = shift;

    my $inLen = length($val);
    my @f = ();

    for (my $i = 0; $i < $inLen; $i += $len) {
    push(@f,substr($val,$i,$len));
    }

    return join('|',@f);
}

sub Load {
    my $fname = shift;

    my %h;  # keyed by offset, value is name
    my($dxl,$sgl) = (5,4);
    my $recLen = 0;
    my($poa,$exempt);

    open(FILE,$fname) || die "Could not open '$fname': $!";
    while (defined(my $l = <FILE>)) {
    next unless ($l =~ /^[a-zA-Z]/);
        #age  000 03
    my($name,$offset,$length) = unpack("a4xa3xa2",$l);

    if ($name =~ /sgl/i) {
        $sgl = $length;
        next;
    }
    if ($name =~ /dxl/i) {
        $dxl = $length;
        next;
    }
    if ($name =~ /poa/i) {
        $poa = $length;
        next;
    }
    if ($name =~ /exmp/i) {
        $exempt = $length;
        next;
    }

    my $key = sprintf("%03d",$offset);
    my $ref = [ $name, $offset, $length ];
    foreach my $el (@$ref) { $el =~ s/^\s+|\s+$//g; }
    $h{$key} = $ref;

    }
    close(FILE);

    # figure out end of record: max offset + length
    my ($max) = (reverse (sort keys %h));
    my $ref = $h{$max};
    my $recLen = $$ref[1] + $$ref[2];

    return ($sgl,$dxl,$recLen,%h);
}
# eof