Front page | perl.beginners |
Postings from June 2022
Win32::OLE merge rtf files - table structure missing
Thread Next
From:
perl kamal
Date:
June 14, 2022 05:26
Subject:
Win32::OLE merge rtf files - table structure missing
Message ID:
CAHJkbW4F06c_wyBMtRrRCJgz18PyWzAg60jH=BG7JpNm7Kw9vA@mail.gmail.com
#! 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;
Thread Next
-
Win32::OLE merge rtf files - table structure missing
by perl kamal