Hi, Greetings!!!
I am trying to process an rtf file , get the content from a
paragraph,construct a table with the processed data and update it at the
"Comments:'' table which is at the end of the file.
My expected table structure is not updated while merging the contents.
Your comments/suggestions will be much appreciated.Thanks.
#! C:\Strawberry\perl\bin
use strict;
use Win32::OLE;
use Win32::OLE::Const;
use File::Spec::Functions 'canonpath';
#use Data::Dumper;
use File::Basename;
use Cwd 'abs_path';
use utf8;
use Encode;
Win32::OLE->Option (CP => Win32::OLE::CP_UTF8);
my $document_name = $ARGV[0];
$document_name =~ s/\\/\\\\/g;
print "document_name:$document_name\n";
my $wd = Win32::OLE->new('Word.Application', 'Quit')
or die "Couldn't run Word";
my $ob_report_dump_file = 'ob_report.txt';
my $report_dump_filename = abs_path($ob_report_dump_file);
my $ob_report_file = $report_dump_filename.'/'.$ob_report_dump_file;
my $report_file = 'customized_report.rtf';
my $report_refined_filename = abs_path($report_file);
my $report_refined_file = $report_refined_filename.'/'.$report_file;
open(my $fh, '+>:encoding(UTF-8)', $ob_report_file) or die "Could not open file
'$ob_report_file' $!";
my $word = Win32::OLE->GetActiveObject('Word.Application')
|| Win32::OLE->new('Word.Application','Quit')
or die Win32::OLE->LastError();
my $document = $word->Documents->Open($document_name)
or die Win32::OLE->LastError();
my $paragraphs = $document->Paragraphs();
my $n_paragraphs = $paragraphs->Count();
for my $p (1..$n_paragraphs) {
my $paragraph = $paragraphs->Item($p);
#my $text = $paragraph->Range->Text();
my $text = substr($paragraph->Range->Text, 0, -1);
next if $text =~ /^\s*$/;
next if $text =~ //;
$text = '' if $text =~/Comments:/g;
$text = '' if $text =~/Signature.*/g;
$text = '' if $text =~/Date Signed.*/g;
#print $text;
print $fh $text."\n";
}
close $fh;
$document->Save;
$document->Close;
my ($fhr,$efw,$afi,$edd,%Clinical_data,$trimester);
my (@BPD,@HC,@AC,@FL,@EFW);
open(FILE, $ob_report_file) or die "Can't open `$ob_report_file': $!";
open(my $out_fh, '+> :encoding(UTF-8)', "$report_refined_file") or die
"Could not open file '$report_refined_file' $!";
while ( my $line = <FILE> )
{
chomp;
#2D Measurements
if ( $line =~ /^BPD\s+/ ) {
for (1 .. 4)
{
push (@BPD, scalar <FILE> );
}
}
if ( $line =~ /^HC\s+/ ) {
for (1 .. 4)
{
push (@HC, scalar <FILE> );
}
}
if ( $line =~ /^AC\s+/ ) {
for (1 .. 4)
{
push (@AC, scalar <FILE> );
}
}
if ( $line =~ /^FL\s+/ ) {
for (1 .. 4)
{
push (@FL, scalar <FILE> );
}
}
$efw = scalar <FILE> if ( $line =~ /^Hadlock\(AC\,/ ) ;
$fhr = $line if ( $line =~ /^FHR/ ) ;
$afi = $line if ( $line =~ /^AFI:/ ) ;
if ($line =~ /^LMP:/)
{
%Clinical_data = split(/\s+/, $line);
#print Dumper(\%Clinical_data);
#print $Clinical_data{'LMP:'};
}
}
$efw =~ s/[\n\r]//g;
$fhr =~ s/[\n\r]//g;
$afi =~ s/[\n\r]//g;
my $comments = <<'EOF';
COMMENTS:
Single live intrauterine pregnancy
Presentation is CEPHALIC
Fatal movements and cardiac activity are noted.
EOF
print $out_fh $comments;
print $out_fh $fhr."\n" ;
#Option 1 for constructing the table
use utf8;
use Text::Table ();
binmode STDOUT, ':utf8';
my @cols = qw/Fetal_Biometry Diameter(cms) Growth(%) Gestational_Age/;
my $sep = \'│';
my $major_sep = \'‚ïë';
my $tb = Text::Table->new( $sep,
( map { +( " $_ ", $sep ) } @cols ) );
my $num_cols = @cols;
my @BPD = qw(BPD 2.44cm 35.57% 14w1d);
my @HCD = qw(HCD 9.08cm 20.90% 14w1d);
$tb->load( [@BPD] );
$tb->load( [@HCD] );
my $make_rule = sub {
my ($args) = @_;
my $left = $args->{left};
my $right = $args->{right};
my $main_left = $args->{main_left};
my $middle = $args->{middle};
return $tb->rule(
sub {
my ( $index, $len ) = @_;
return ( '─' x $len );
},
sub {
my ( $index, $len ) = @_;
my $char = (
( $index == 0 ) ? $left
: ( $index == 1 ) ? $middle
: ( $index == $num_cols + 1 ) ? $right
: $middle
);
return $char x $len;
},
);
};
my $start_rule = $make_rule->(
{
left => '‚îå',
main_left => '‚ï•',
right => '‚îê',
middle => '┬',
}
);
my $mid_rule = $make_rule->(
{
left => '‚îú',
main_left => '‚ï´',
right => '┤',
middle => '┼',
}
);
my $end_rule = $make_rule->(
{
left => '‚îî',
main_left => '‚ï®',
right => '‚îò',
middle => '┴',
}
);
print $out_fh ($start_rule, $tb->title,
( map { $mid_rule, $_, } $tb->body() ), $end_rule);
#Option 2 for constructing the table
select $out_fh;
my($bpd_name,$bpd_cms,$bpd_percent,$bpd_ga);
my($hc_name,$hc_cms,$hc_percent,$hc_ga);
my($ac_name,$ac_cms,$ac_percent,$ac_ga);
my($fl_name,$fl_cms,$fl_percent,$fl_ga);
# header
print <<EOF;
+-----------------------+--------------------+-----------------+--------------------------+
| Fetal Biometry | Diameter(cms)| Growth(%) | Gestational Age |
+-----------------------+--------------------+-----------------+--------------------------+
EOF
format bpd_measurements =
@<@||||||||||||@<@||||||||||@<@|||||||||@<@|||||||||||||@<
'|', $bpd_name, '|', $bpd_cms, '|', $bpd_percent, '|', $bpd_ga, '|'
.
$~ = 'bpd_measurements';
$bpd_name="BPD";
$bpd_cms = $BPD[1];
$bpd_percent = $BPD[2];
$bpd_ga = $BPD[3];
write;
format hc_measurements =
@<@||||||||||||@<@||||||||||@<@|||||||||@<@|||||||||||||@<
'|', $hc_name, '|', $hc_cms, '|', $hc_percent, '|', $hc_ga, '|'
.
$~ = 'hc_measurements';
$hc_name="HC";
$hc_cms = $HC[1];
$hc_percent = $HC[2];
$hc_ga = $HC[3];
write;
format al_measurements =
@<@||||||||||||@<@||||||||||@<@|||||||||@<@|||||||||||||@<
'|', $ac_name, '|', $ac_cms, '|', $ac_percent, '|', $ac_ga, '|'
.
$~ = 'al_measurements';
$ac_name="AC";
$ac_cms = $AC[1];
$ac_percent = $AC[2];
$ac_ga = $AC[3];
write;
format fl_measurements =
@<@|||||||||||||@<@||||||||||@<@|||||||||@<@|||||||||||||@<
'|', $fl_name , '|', $fl_cms, '|', $fl_percent, '|', $fl_ga, '|'
.
$~ = 'fl_measurements';
$fl_name="FL";
$fl_cms = $FL[1];
$fl_percent = $FL[2];
$fl_ga = $FL[3];
write;
# footer
print
"+-----------------------+--------------------+-----------------+--------------------------+\n";
print $out_fh "EFW ~ ± $efw.\n";
print $out_fh "Liquor volume is ADEQUATE (" .$afi .')';
$bpd_ga =~ s/[\n\r]//g;
my $ob3_comments = <<"EOF";
Placenta is noted ANTERIOR Grade- III
Internal os is closed
No obvious gross fatal anomalies seen*
IMPRESSION:
-------------------
* SINGLE LIVE INTRAUTERINE PREGNANCY OF $bpd_ga GESTATION.
* PRESENTATION : CEPHALIC
* PLACENTA :ANTERIOR
* LIQUOR :ADEQUATE
* NO EVIDENCE OF CORD AROUND THE NECK
* ESTIMATED DELIVERY DATE $Clinical_data{'LMP:'}
-------------------------------------------------------------
Limitations of Obstetrics ultrasound scanning :
-------------------------------------------------------------
*Although a structural screening scan is undertaken, detection of structural
anomalies will never be 100%. Detection rates vary and may be reduced by
factors like maternal obesity, abdominal scars, gestation age, inappropriate
fetal position and reduced amniotic fluid volume. Even in the best of hands, a
small percentage of fetal anomalies will remain undetected. Internationally
accepted detection rate of major abnormalities is around 70%. As this is a
level I obstetric scan center. To the extent visualized no gross
sonographically congenital anomalies could be detected in the present study and
fetal position. However not all anomalies could be rule out. To rule out
cardiac anomalies fetal echo is suggested. Sometimes fetal parts could not be
seen in advanced stage of pregnancy and due to poor or inadequate acoustic
window. Sometimes not all four limbs can be clearly visualized due fetal
position and acoustic window. This has been clearly explained to the patient.
Signature(seal):
Date Signed:
----------------------------------------------------------------THANK
YOU!!!----------------------------------------------------
EOF
print $out_fh $ob3_comments;
close FILE;
close $out_fh;
$document->close;
my $source_doc = $report_refined_file;
my $dest_doc = $document_name;
use Win32::OLE::Const 'Microsoft Word';
Win32::OLE->Option (CP => Win32::OLE::CP_UTF8);
binmode STDOUT, 'encoding(utf8)';
use Win32::OLE::Const 'Microsoft Office [0-9.]+ Object Library';
use constant msoEncodingUTF8 => 65001;
my $Word = new Win32::OLE 'Word.Application', 'Quit';
$Word->Documents->open( $source_doc )
or die "Unable to open $source_doc ", Win32::OLE->LastError();
my $text = $Word->ActiveDocument->Content->Text;
$Word->ActiveDocument->Close;
$Word->Documents->open( $dest_doc )
or die "Unable to open $dest_doc ", Win32::OLE->LastError();
my $dest_text = $Word->ActiveDocument->Content->Text;
$Word->ActiveDocument->Content->InsertAfter({ Text => $text });
$Word->ActiveDocument->Close;
#$Word->Documents->save;
$Word->Documents->Save({
FileName => $dest_doc,
FileFormat => wdFormatEncodedText,
Encoding => msoEncodingUTF8
});
$Word->Documents->close;
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
