Updates were made a few times here, but I'm finished now:

#! perl -w

######################################################
# Program to automate document extraction 
######################################################

use strict;
use File::Copy;
use File::Spec::Functions qw(catfile);

sub read_template_file {
   # Might as well make the infile and outfile parameters.
   my $infile  = shift;
   my $outfile = shift;
   
   open IN, "<$infile"  or die "Couldn't open $infile, $!";
   open OUT,">$outfile" or die "Couldn't open $outfile, $!";

   ##   print OUT join '|', split /,/ while <IN>;

   while(<IN>) {
     chomp;
   
     my @fields = split /,/;
     my $path_str = $fields[6];

     do { warn "Empty field 7"; next } unless $path_str;

     my @path = split /\\/, $path_str;
   
     # assuming you want to remove a few directories
     my $fixed_path = join "\\", @path[0,5,6];
      
     my $out = join '|', @fields[0..5], $fixed_path, "\n";

     print OUT $out;

     # CRITICAL POINT: if you want to do other actions
     # on @fields or $fixed_path, you must do them here.
     # The values of the variables will be overwritten each
     # pass through the loop.
     find_copy_rename($fixed_path, $fields[0]);
     create_text_file($fields[0]);
   }
   close IN;
   # Moved here after the loop.
   close OUT;
}

sub find_copy_rename {
  # There used to be a loop here, but it didn't make
  # sense because it was looping over one item.
  my ($fetchdir, $mrn) = @_;
  my $now = `date`;
  opendir MYDIR, $fetchdir or die "Could not opendir $fetchdir: $!\n";
  my @allfiles = grep { $_ ne '.' and $_ ne '..' } readdir MYDIR ;
  closedir(MYDIR);

  my @files    = grep { !-d } @allfiles ;
  my @dirs     = grep {  -d } @allfiles ;

  print @files." files and ".@dirs." directories in $fetchdir\n" ;
  print map "$_\n", @allfiles;

  my @select_files = grep /\.rtf\z/i, @files;

  for my $file (@select_files) {
    copy catfile($fetchdir,$file), catfile("C:\\temp", $file);
  }

  my $newdir = 'C:\\temp';

  opendir MYDIR, $newdir or die "Could not opendir $newdir: $!\n";
  my @all_files = grep { $_ ne '.' and $_ ne '..' } readdir MYDIR ;
  closedir(MYDIR);

  my @change_files = grep { !-d } @all_files;
 
  foreach my $get_files (@change_files) {

    my $newfile = $get_files;

    $newfile =~ s/\$mrn.$now.rtf$/word1.rtf/;

    if (-e $newfile) {
       warn "can't rename $get_files to $newfile: $newfile exists\n";
    } elsif (rename "$newdir/$get_files", "$newdir/$newfile") {
      print "file was renamed to $newfile\n"
    } else {
      warn "rename $get_files to $newfile failed: $!\n";
    }
  }
}

sub create_text_file {
  # I'm not sure what belongs here.  The existing code
  # does not make much sense to me.
  # Again you were looping over one thing.
  # You tested an assignment statement, probably a bug.
  # And you opened a file for output and didn't write to it.
}

read_template_file('c:/doclist.chr','c:/doclist.txt');
[download]

Rather than trying to combine these already disparate chunks of functionality into a single monolithic block, why not break them out into separate subroutines? Smaller, simpler pieces of code are easier to read, maintain and debug. Your main script then only has to be a few lines long, calling the subroutines in sequence, passing the output from the previous call into the next.

I appreciate your response, but I'm fairly new to Perl. Perhaps if you could suggest how could I modify my code properly. I'll appreciate your help.