There's a serious barrier in there that will prevent the pieces from working together: the exit statement a couple of lines before the comment "# End of Read Template File". That will end your program right there. Suppose you got rid of that and made a few subroutines (note -- this is untested code).

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]