BEFORE

484257-1,DE ARMAS,BLANC,Cristiane Takita,1/21/03,MD Wkly Note,H:\APPS\IMPAC\DB\ESCRIBE\00\00004EAC.006

467488,FOURNIER,JANET,Cristiane Takita,1/22/03,MD Wkly Note,H:\APPS\IMPAC\DB\ESCRIBE\12\00004E04.012

306684,SECHI,OSVAL,Aaron Wolfson,1/22/03,MD Wkly Note,H:\APPS\IMPAC\DB\ESCRIBE\08\00004E14.022

310941,PAUL,TAMEA,B-Chen Wen,1/22/03,MD Wkly Note,H:\APPS\IMPAC\DB\ESCRIBE\01\00004E35.009

##</code><code>##

484257|DE ARMAS|BLANC|Cristiane Takita|1/21/03|MD Wkly Note|H:\00\00004EAC.006

467488|FOURNIER|JANET|Cristiane Takita|1/22/03|MD Wkly Note|H:\12\00004E04.012

306684|SECHI|OSVAL|Aaron Wolfson|1/22/03|MD Wkly Note|H:\08\00004E14.022

310941|PAUL|TAMEA|B-Chen Wen|1/22/03|MD Wkly Note|H:\01\00004E35.009

##</code><code>##

310941|PAUL|TAMEA|B-Chen Wen|1/22/03|MD Wkly Note@@H:\01\00004E35.009\31094100004E35009.rtf

##</code><code>##

#! perl -w

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

use strict;

####################
# Read Template File
####################

sub main {

my $infile  = 'c:/doclist.chr';
my $outfile = 'c:/doclist.txt';
   
   
   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];

     &find_copy_rename;

     &create_text_file;      
     
}
exit;
close IN;
}

###########################
# End of Read Template File
###########################

#############################################
# Find, Copy, and Rename File to MRN+Date.rtf
#############################################

use File::Find;
use File::Copy;

sub find_copy_rename {

my @dir = $fixed_path; 
my $dir = @dir;

if ($File::Find::dir ne $dir)
    {
        $File::Find::prune = 1;
        return 0;
    }

    return 0 if ($_ !~ /\.rtf$/);

    copy($File::Find::name, "C:\\temp\\$_") or die "Failed to copy $_: $!\n";
    return 1;
}

find(\&process_files, $dir);



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";
    }
 }
###############################
# Create Text File per each MRN 
###############################
sub create_text_fle {

foreach my $text_file (@fields[0]) {

      if ($mrn = @fields[0])
       {

         my $newpatientrec = $newfile;

         open NEWPATIENT,">$newfile" or die "Couldn't open $outfile, $!";            

         close NEWPATIENT;
       }

   my $out = join '|', @fields[0..5], $fixed_path, "\n";

   print OUT $out; 

}

}