2. Duplicate components in the lmf with same lot_test_id, parent_test_id, gender constraints, & age constraints but different ranges not in the lab system.
3. Entry of lab units and test type for each test.
P 00070 EUGLOB.CLT LYSIS EUGLOB Y 8202101752 R 00070 CLOT LYSIS 00000 00000 P 00080 V 8408071532 R 00080 00000 00000 P 00100 KETONES KET SER X 8301241424 R 00110 KETONE 00000 00000 R 00149 COMMENT 00000 00000 P 00200 ACID P'TASE AC PHOS X 8907111532 R 00210 AC PHOS .4 65280 65280 R 00249 COMMENT 00000 00000 P 00300 ALBUMIN ALBUMIN X 9510231323 R 00310 ALBUMIN 3.7 4.7 65280 65280 R 00349 COMMENT 00000 00000 P 00400 RESEARCH BLOOD RSCH BL X 9510250927 R 00410 RESEARCH BLOOD 00000 00000 P 00450 SPECIMEN PROCESS PROCESS X 9706191327 R 00452 PROCESS 00000 00000 P 00500 RESEARCH URINE RSCH UR X 9510250927 R 00510 RESEARCH URINE 00000 00000 P 00600 ALDOLASE ALDOLAS X 8109291136 R 00610 ALDOLASE 1 6 65280 65280 R 00649 COMMENT 00000 00000 P 00700 ALK P'TASE ALK PHO X 9510251413 R 00710 ALK PHO 37 116 06570 46355 R 00749 COMMENT 00000 00000 P 00800 ALK P,HEAT STBL ALKPHTS X 8301100953 R 00810 HEAT STABLESTBL 00000 00000 R 00849 COMMENT 00000 00000 P 00850 LDL CHOLEST. LDLCCAL X 9706191327 R 00855 LDL CHL-CALC 65 129 65280 65280 R 00860 CHOLEST.TOT. 100 200 65280 65280 R 00865 HDL CHOLEST. 00000 00000 R 00870 TRIGLYCERIDE 10 190 18250 46355 R 00870 TRIGLYCERIDE 10 150 10950 14600 R 00870 TRIGLYCERIDE 10 160 14600 18250 R 00879 COMMENT 00000 00000
P 00070 EUGLOB.CLT LYSIS EUGLOB Y 8202101752 P 00080 V 8408071532 P 00100 KETONES KET SER X 8301241424 P 00200 ACID P'TASE AC PHOS X 8907111532 P 00300 ALBUMIN ALBUMIN X 9510231323 P 00400 RESEARCH BLOOD RSCH BL X 9510250927 P 00500 RESEARCH URINE RSCH UR X 9510250927 P 00600 ALDOLASE ALDOLAS X 8109291136 P 00700 ALK P'TASE ALK PHO X 9510251413 P 00800 ALK P,HEAT STBL ALKPHTS X 8301100953 P 00850 LDL CHOLEST. LDLCCAL X 9602011224 P 00900 AMYLASE AMYLASE X 9510260900
R 00070 CLOT LYSIS 00000 00000 R 00080 00000 00000 R 00110 KETONE 00000 00000 R 00149 COMMENT 00000 00000 R 00210 AC PHOS .4 65280 65280 R 00249 COMMENT 00000 00000 R 00310 ALBUMIN 3.7 4.7 65280 65280 R 00349 COMMENT 00000 00000 R 00410 RESEARCH BLOOD 00000 00000 R 00510 RESEARCH URINE 00000 00000 R 00610 ALDOLASE 1 6 65280 65280 R 00649 COMMENT 00000 00000 R 00710 ALK PHO 37 116 06570 46355 R 00749 COMMENT 00000 00000 R 00810 HEAT STABLESTBL 00000 00000 R 00849 COMMENT 00000 00000 R 00855 LDL CHL-CALC 65 129 65280 65280 R 00860 CHOLEST.TOT. 100 200 65280 65280 R 00865 HDL CHOLEST. 00000 00000 R 00870 TRIGLYCERIDE 10 190 18250 46355 R 00870 TRIGLYCERIDE 10 150 10950 14600 R 00870 TRIGLYCERIDE 10 160 14600 18250 R 00879 COMMENT 00000 00000 R 00910 AMYLASE 18 93 65280 65280 R 00949 COMMENT 00000 00000
#!/usr/local/bin/perl ########################################################################### # # Programmer : Jon McKeeby # Date : July 1,1997 # Program : lotcall.pl # Purpose : Calls procedures to load lot info in CDR. # Called By : Called by crontab from dali.cc.nih.gov; # account of jmckeeby each Tuesday # # Notes : Linda Berry executes a LOT update on Tuesday nights and # as part of the process executes a program to create three # files. These files are used to update tables within the cdr # database, specifically cdr_lot_parent, cdr_lab_order_table, # and cdr_lot_normal_ranges. # # # # ---------------- # Change History # ---------------- # # Date Programmer Description # ------------------------------------------------------------------------- # 7/1/97 J. McKeeby Consolidated code, Commented. # # # ########################################################################### $DEF_PATH="/u/home/jmckeeby/cronjobs"; print STDOUT "Call LOT.pl\n"; `$DEF_PATH/lot.pl`;#Load main lot info for each test component print STDOUT "Call LOTPARENT.pl\n"; `$DEF_PATH/lotparent.pl`;#Load parent test info for each parent/proc print STDOUT "Call LOTNORM.pl\n"; `$DEF_PATH/lotnorm.pl`;#Load all normal ranges
#!/usr/local/bin/perl
###########################################################################
#
# Programmer : Jon McKeeby
# Date : July 1,1997
# Program : lot.pl
# Purpose : Loads lot data for individual component test.
# Called By : Called by lot.pl
# account of jmckeeby each Tuesday
#
# Notes : Linda Berry executes a LOT update on Tuesday nights and
# as part of the process executes a program to create three
# files. These files are used to update tables within the cdr
# database, specifically cdr_lot_parent, cdr_lab_order_table,
# and cdr_lot_normal_ranges.
#
# This procedure updates the cdr_lab_order_table
# table.
#
#
# ----------------
# Change History
# ----------------
#
# Date Programmer Description
# -------------------------------------------------------------------------
# 7/1/97 J. McKeeby Consolidated code, Commented.
#
#
#
###########################################################################
$cmd="ftp -n ";
$DEF_PATH="/u/home/jmckeeby/cronjobs";
$SYBASE="/u/sybase11";
$ROSE="rose.cc.nih.gov";
#Database Connection
use Sybase::DBlib;
$ENV{SYBASE} = $SYBASE;
$ENV{DSQUERY} = 'prod11';
$cmsfile = "$DEF_PATH/.user";
open(CMS,$cmsfile) || die "Cannot open user file. \n";
$line=;
chop($line);
@var=split(/:/,$line);
close CMS;
print "Getting files from ROSE\n";
$user = $var[0];
$ruser = $var[1];
$rpass = $var[2];
$template3 =
" open $ROSE
user $user $user
quote cwd $ruser
account $rpass
get lmf.out $DEF_PATH/lmf.out
bye
";
print(STDERR "Running command ($cmd) lmf.out.\n") if $verbose;
open(CMD, "|$cmd") || die"Could not start command: $cmd. \n";
print CMD $template3;
close(CMD);
#Initializations
$mod_date = &get_mod_date();
#$mod_date = '4/20/97'; #Used for testing.
print STDOUT "$mod_date\n";
$cr = "\n";
#Get sybase info to login.
$passfile = "$DEF_PATH/.pass";
open(PASS,$passfile) || die "Cannot open password file. \n";
$line=;
chop($line);
@var=split(/:/,$line);
close PASS;
$dbh = Sybase::DBlib->dblogin($var[0],$var[1]);#Login to Sybase:Common
$command = "use common";
$dbh->dbcmd($command);
$dbh->dbsqlexec;
if ($dbh->dbresults() != SUCCEED){
&process_error_results('NA','Use Common',$dbh); }
#Parse Through Massaged File
$opt_n = "$DEF_PATH/lmf.out";
open(INFILE, $opt_n) || die "Cannot open $opt_n\n";
$line = ;
chop ($line);
$temp = 0;
while ($line ne ""){
if (substr($line,0,1) eq "P"){#Parent Test
$parent = substr($line,4,5);
$pname = substr($line,13,19);
$pname = &remove_quotes(&remove_spaces($pname));
$count = 0;
}
if (substr($line,0,1) eq "R"){#Child
$temp = $parent;
$child = substr($line,9,5);
$cname = substr($line,18,16);
$cname = &remove_quotes(&remove_spaces($cname));
# print STDOUT "$parent :: $pname :: $count :: $child :: $cname\n";
$query = "select lot_test_number from cdr.dbo.cdr_lab_order_table $cr where lot_test_number = $child";
$dbh->dbcmd($query);
$dbh->dbsqlexec;
if ($dbh->dbresults() == SUCCEED){ #1
@data = $dbh->dbnextrow();
&process_add_results($fieldlist[0],'Select LOT',$dbh);
if (@data[0] ne ""){#Update if found.
$state = "Update cdr.dbo.cdr_lab_order_table set lp_parent_test_id= $parent, lot_name = $cname where lot_test_number = $child";
&process_db_update($state,$dbh);}
else {#Insert if not found.
# print STDOUT "INSERT $parent :: $child\n";
$state = "Insert cdr.dbo.cdr_lab_order_table(lot_test_number, lot_test_id, lp_parent_test_id, lot_name, lot_test_units, lot_test_type)";
$values = $cr . "values ($child,$child,$parent,$cname,NULL,NULL)";
&process_db_insert($state,$values,$item,$dbh);}
}
}
$line = ;
chop ($line);
}
close INFILE;
sub remove_spaces{
#remove spaces from string.
local ($strvalue) = @_;
local ($temp,$pos,$lenstr,$holder);
$lenstr = length($strvalue)-1;
while (substr($strvalue,$lenstr,1) eq " "){
$strvalue = substr($strvalue,0,$lenstr);
$lenstr = $lenstr-1;
}
$temp = $strvalue;
}
sub remove_quotes{
#remove wild characters and utilize dbsafestring.
#replace any characters found in gmchar with it associative html iso character.
local ($strvalue, $protocol, *gmchar) = @_;
local ($temp, $output, $pos, $lenstr, $holder);
$lenstr = length($strvalue)-1;
while (substr($strvalue,$lenstr,1) eq " "){
$strvalue = substr($strvalue, 0 , $lenstr);
$lenstr = $lenstr -1;
}
$varname = $strvalue;
$comment_out = 1;
if ($comment_out == 1){#Not removing special characters for db load
if ($varname =~ /^[A-Za-z0-9_\*\+-=\\\/\|.,<>\?'":;\&\^%\$#@!~\(\)\[\]\{\}\n\t\r ]*$/){
#Do Nothing
}
else{
foreach $holder ((keys(%gmchar))){
$temp= $gmchar{$holder};
$strvalue=~ s/$holder/$temp/ge;
}
}
$varname = $strvalue;
if ($varname =~ /^[A-Za-z0-9_\*\+-=\\\/\|.,<>\?'":;\&\^%\$#@!~\(\)\[\]\{\}\n\t\r ]*$/){
#Do Nothing
}
else{
$pos = 0;
while ($pos < length($strvalue)){
if ((ord(substr($strvalue,$pos,1))<31) || (ord(substr($strvalue,$pos,1))> 127)){
substr($strvalue,$pos,1) = "";
$pos = $pos + length("");
}
else {$pos = $pos +1;}
}
}
}
$quoteval = '"' . "'";
$temp = '"' . $dbh->dbsafestr($strvalue,$quoteval) . '"';
$output = $temp;
}
sub process_add_results{
#Make sure there are no additional results after a select.
local ($protocol,$loopname,$dbh) = @_;
local (@dummy);
while (@dummy = $dbh->dbnextrow()){
print STDOUT "MORE Than One Row Returned $protocol $loopname\n"};
}
sub process_error_results{
#If sybase returned error, make sure all rows were read (there should not be any)
#Print error to standard out.
local ($protocol,$loopname,$dbh) = @_;
local (@dummy);
print STDOUT "ERROR--$protocol::$loopname\n";
while (@dummy = $dbh->dbnextrow()){
print STDOUT "ERROR $protocol $loopname\n"; } #dummy loop
}
sub process_db_update{
#Perform a sybase db update.
local ($state,$dbh) = @_;
local (@dummy);
$dbh->dbcmd($state);
$dbh->dbsqlexec;
# print STDOUT "$state\n";
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Updating\n";}
}
sub process_db_insert{
#Perform s sybase db insert
local ($state,$values,$lab,$dbh) = @_;
local (@dummy,$insert);
$insert = $state . $values;
$dbh->dbcmd($insert);
$dbh->dbsqlexec;
# print STDOUT "$insert\n";
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Inserting $lab\n";}
}
sub get_mod_date{
#get the date modified, used for updating db.
local (@timeval,$mod_date, $currtime);
$currtime = time();
@timeval = localtime($currtime);
if (($timeval[4]+1)<10){
$timeval[4] = "0" . ($timeval[4]+1);}
else{
$timeval[4] = ($timeval[4]+1)
}
if (($timeval[3])<10){
$timeval[3] = "0" . ($timeval[3]);}
else{
$timeval[3] = ($timeval[3])
}
$mod_date = $timeval[4] . "/" . $timeval[3]. "/" . $timeval[5];
}
sub get_today_date{
#get today, used for determining MRD File.
local (@timeval,$mod_date, $currtime);
$currtime = time();
@timeval = localtime($currtime);
if (($timeval[4]+1)<10){
$timeval[4] = "0" . ($timeval[4]+1);}
else{
$timeval[4] = ($timeval[4]+1)
}
if (($timeval[3])<10){
$timeval[3] = "0" . ($timeval[3]);}
else{
$timeval[3] = ($timeval[3])
}
$today=($timeval[4]) . $timeval[3] . $timeval[5];
}
sub process_db_delete{
#Perform a sybase delete.
local ($state,$dbh) = @_;
local (@dummy);
$dbh->dbcmd($state);
$dbh->dbsqlexec;
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Deleting\n";}
}
#!/usr/local/bin/perl
###########################################################################
#
# Programmer : Jon McKeeby
# Date : July 1,1997
# Program : lotparent.pl
# Purpose : Loads lot parent data based on current lot.
# Called By : Called by lotcall.pl;
# account of jmckeeby each Tuesday
#
# Notes : Linda Berry executes a LOT update on Tuesday nights and
# as part of the process executes a program to create three
# files. These files are used to update tables within the cdr
# database, specifically cdr_lot_parent, cdr_lab_order_table,
# and cdr_lot_normal_ranges.
#
# This procedure updates the information in the cdr_lot_parent
# table.
#
#
# ----------------
# Change History
# ----------------
#
# Date Programmer Description
# -------------------------------------------------------------------------
# 7/1/97 J. McKeeby Consolidated code, Commented.
#
#
#
###########################################################################
$cmd="ftp -n ";
$DEF_PATH="/u/home/jmckeeby/cronjobs";
$SYBASE="/u/sybase11";
$ROSE="rose.cc.nih.gov";
#Database Connection
use Sybase::DBlib;
$ENV{SYBASE} = $SYBASE;
$ENV{DSQUERY} = 'prod11';
$cmsfile = "$DEF_PATH/.user";
open(CMS,$cmsfile) || die "Cannot open user file. \n";
$line=;
chop($line);
@var=split(/:/,$line);
close CMS;
print "Getting files from ROSE\n";
$user = $var[0];
$ruser = $var[1];
$rpass = $var[2];
$template3 =
" open $ROSE
user $user $user
quote cwd $ruser
account $rpass
get lmf.out $DEF_PATH/lmf.out
bye
";
print(STDERR "Running command ($cmd) lmf.out.\n") if $verbose;
open(CMD, "|$cmd") || die"Could not start command: $cmd. \n";
print CMD $template3;
close(CMD);
#Initializations
$mod_date = &get_mod_date();
#testing $mod_date = '4/20/97';
print STDOUT "$mod_date\n";
$cr = "\n";
#Get info to log on to sybase
$passfile = "$DEF_PATH/.pass";
open(PASS,$passfile) || die "Cannot open password file. \n";
$line=;
chop($line);
@var=split(/:/,$line);
close PASS;
$dbh = Sybase::DBlib->dblogin($var[0],$var[1]);#Login to Sybase:Common
$command = "use common";
$dbh->dbcmd($command);
$dbh->dbsqlexec;
if ($dbh->dbresults() != SUCCEED){
&process_error_results('NA','Use Common',$dbh); }
#Parse Through Massaged File
$opt_n = "$DEF_PATH/lmf.out";
open(INFILE, $opt_n) || die "Cannot open $opt_n\n";
$line = ;
chop ($line);
$temp = 0;
$state = "Update cdr.dbo.cdr_lot_parent set lp_active_flag = 'N'"; #Make all entrie inactive, set to active while parsing
&process_db_update($state,$dbh);
while ($line ne ""){
if (substr($line,0,1) eq "P"){#Parent Test
$parent = substr($line,4,5);
$pname = substr($line,13,19);
$pname = &remove_quotes(&remove_spaces($pname));
$paname = substr($line,32,10);
$paname = &remove_quotes(&remove_spaces($paname));
$pdept = substr($line,42,1);
$pdept = &remove_quotes(&remove_spaces($pdept));
$pdate = substr($line,47,10);
$pndate = "'" . substr($pdate,2,2) . '/' . substr($pdate,4,2) . '/19' . substr($pdate,0,2) . ' ' . substr($pdate, 6,2) . ':' . substr($pdate,8,2) . "'";
$query = "select lp_parent_test_id from cdr.dbo.cdr_lot_parent $cr where lp_parent_test_id = $parent";
$dbh->dbcmd($query);
$dbh->dbsqlexec;
if ($dbh->dbresults() == SUCCEED){ #1
@data = $dbh->dbnextrow();
&process_add_results($fieldlist[0],'Select LOT Parent',$dbh);
if (@data[0] ne ""){#Update if found.
$state = "Update cdr.dbo.cdr_lot_parent set lp_parent_name = $pname, ld_department_code = $pdept, lp_active_flag = 'Y', lp_abbrev_name = $paname, lp_creation_datetime = $pndate, lp_last_date_modified = '$mod_date' $cr where lp_parent_test_id = $parent";
&process_db_update($state,$dbh);}
else {#Insert if not found
#print STDOUT "INSERT $parent\n";
$state = "Insert cdr.dbo.cdr_lot_parent(lp_parent_test_id,lp_parent_name, ld_department_code, lp_active_flag, lp_abbrev_name, lp_creation_datetime, lp_last_date_modified)";
$values = $cr . "values ($parent,$pname, $pdept,'Y', $paname,$pndate,'$mod_date')";
&process_db_insert($state,$values,$item,$dbh);}
}
}
$line = ;
chop ($line);
}
close INFILE;
sub remove_spaces{
#remove spaces from string.
local ($strvalue) = @_;
local ($temp,$pos,$lenstr,$holder);
$lenstr = length($strvalue)-1;
while (substr($strvalue,$lenstr,1) eq " "){
$strvalue = substr($strvalue,0,$lenstr);
$lenstr = $lenstr-1;
}
$temp = $strvalue;
}
sub remove_quotes{
#remove wild characters and utilize dbsafestring.
#replace any characters found in gmchar with it associative html iso character.
local ($strvalue, $protocol, *gmchar) = @_;
local ($temp, $output, $pos, $lenstr, $holder);
$lenstr = length($strvalue)-1;
while (substr($strvalue,$lenstr,1) eq " "){
$strvalue = substr($strvalue, 0 , $lenstr);
$lenstr = $lenstr -1;
}
$varname = $strvalue;
$comment_out = 1;
if ($comment_out == 1){#Not removing special characters for db load
if ($varname =~ /^[A-Za-z0-9_\*\+-=\\\/\|.,<>\?'":;\&\^%\$#@!~\(\)\[\]\{\}\n\t\r ]*$/){
#Do Nothing
}
else{
foreach $holder ((keys(%gmchar))){
$temp= $gmchar{$holder};
$strvalue=~ s/$holder/$temp/ge;
}
}
$varname = $strvalue;
if ($varname =~ /^[A-Za-z0-9_\*\+-=\\\/\|.,<>\?'":;\&\^%\$#@!~\(\)\[\]\{\}\n\t\r ]*$/){
#Do Nothing
}
else{
$pos = 0;
while ($pos < length($strvalue)){
if ((ord(substr($strvalue,$pos,1))<31) || (ord(substr($strvalue,$pos,1))> 127)){
substr($strvalue,$pos,1) = "";
$pos = $pos + length("");
}
else {$pos = $pos +1;}
}
}
}
$quoteval = '"' . "'";
$temp = '"' . $dbh->dbsafestr($strvalue,$quoteval) . '"';
$output = $temp;
}
sub process_add_results{
#Make sure there are no additional results after a select.
local ($protocol,$loopname,$dbh) = @_;
local (@dummy);
while (@dummy = $dbh->dbnextrow()){
print STDOUT "MORE Than One Row Returned $protocol $loopname\n"};
}
sub process_error_results{
#If sybase returned error, make sure all rows were read (there should not be any)
#Print error to standard out.
local ($protocol,$loopname,$dbh) = @_;
local (@dummy);
print STDOUT "ERROR--$protocol::$loopname\n";
while (@dummy = $dbh->dbnextrow()){
print STDOUT "ERROR $protocol $loopname\n"; } #dummy loop
}
sub process_db_update{
#Perform a sybase db update.
local ($state,$dbh) = @_;
local (@dummy);
$dbh->dbcmd($state);
$dbh->dbsqlexec;
#print STDOUT "$state\n";
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Updating\n";}
}
sub process_db_insert{
#Perform s sybase db insert
local ($state,$values,$lab,$dbh) = @_;
local (@dummy,$insert);
$insert = $state . $values;
$dbh->dbcmd($insert);
$dbh->dbsqlexec;
#print STDOUT "$insert\n";
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Inserting $lab\n";}
}
sub get_mod_date{
#get the date modified, used for updating db.
local (@timeval,$mod_date, $currtime);
$currtime = time();
@timeval = localtime($currtime);
if (($timeval[4]+1)<10){
$timeval[4] = "0" . ($timeval[4]+1);}
else{
$timeval[4] = ($timeval[4]+1)
}
if (($timeval[3])<10){
$timeval[3] = "0" . ($timeval[3]);}
else{
$timeval[3] = ($timeval[3])
}
$mod_date = $timeval[4] . "/" . $timeval[3]. "/" . $timeval[5];
}
sub get_today_date{
#get today, used for determining MRD File.
local (@timeval,$mod_date, $currtime);
$currtime = time();
@timeval = localtime($currtime);
if (($timeval[4]+1)<10){
$timeval[4] = "0" . ($timeval[4]+1);}
else{
$timeval[4] = ($timeval[4]+1)
}
if (($timeval[3])<10){
$timeval[3] = "0" . ($timeval[3]);}
else{
$timeval[3] = ($timeval[3])
}
$today=($timeval[4]) . $timeval[3] . $timeval[5];
}
sub process_db_delete{
#Perform a sybase delete.
local ($state,$dbh) = @_;
local (@dummy);
$dbh->dbcmd($state);
$dbh->dbsqlexec;
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Deleting\n";}
}
#!/usr/local/bin/perl
###########################################################################
#
# Programmer : Jon McKeeby
# Date : July 1,1997
# Program : lotnorm.pl
# Purpose : Loads lot normals based on current lot.
# Called By : Called by lot.pl
# account of jmckeeby each Tuesday
#
# Notes : Linda Berry executes a LOT update on Tuesday nights and
# as part of the process executes a program to create three
# files. These files are used to update tables within the cdr
# database, specifically cdr_lot_parent, cdr_lab_order_table,
# and cdr_lot_normal_ranges.
#
# This procedure updates the normals in the cdr_lot_normal_ranges
# table. For any parent test being updated, old non-existent
# ranges are deleted.
#
# The ordinal number is used when creating the record in the
# cdr_lab_results table in real-time from lab data via the
# interface engine.
#
# ----------------
# Change History
# ----------------
#
# Date Programmer Description
# -------------------------------------------------------------------------
# 7/1/97 J. McKeeby Consolidated code, Commented.
#
#
#
###########################################################################
$cmd="ftp -n ";
$DEF_PATH="/u/home/jmckeeby/cronjobs";
$SYBASE="/u/sybase11";
$ROSE="rose.cc.nih.gov";
#Database Connection
use Sybase::DBlib;
$ENV{SYBASE} = $SYBASE;
$ENV{DSQUERY} = 'prod11';
$cmsfile = "$DEF_PATH/.user";
open(CMS,$cmsfile) || die "Cannot open user file. \n";
$line=;
chop($line);
@var=split(/:/,$line);
close CMS;
print "Getting files from ROSE\n";
$user = $var[0];
$ruser = $var[1];
$rpass = $var[2];
$template3 =
" open $ROSE
user $user $user
quote cwd $ruser
account $rpass
get lmf.out $DEF_PATH/lmf.out
bye
";
print(STDERR "Running command ($cmd) lmf.out.\n") if $verbose;
open(CMD, "|$cmd") || die"Could not start command: $cmd. \n";
print CMD $template3;
close(CMD);
#Initializations
$mod_date = &get_mod_date();
#Testing $mod_date = '4/20/97';
print STDOUT "$mod_date\n";
$cr = "\n";
#get sybase password/account info
$passfile = "$DEF_PATH/.pass";
open(PASS,$passfile) || die "Cannot open password file. \n";
$line=;
chop($line);
@var=split(/:/,$line);
close PASS;
$dbh = Sybase::DBlib->dblogin($var[0],$var[1]);#Login to Sybase:Common
$command = "use common";
$dbh->dbcmd($command);
$dbh->dbsqlexec;
if ($dbh->dbresults() != SUCCEED){
&process_error_results('NA','Use Common',$dbh); }
#Parse Through Massaged File
$opt_n = "$DEF_PATH/lmf.out";
open(INFILE, $opt_n) || die "Cannot open $opt_n\n";
$line = ;
chop ($line);
$temp = 0;
while ($line ne ""){
if (substr($line,0,1) eq "P"){#Parent Test
$parent = substr($line,4,5);
$pname = substr($line,13,19);
$pname = &remove_quotes(&remove_spaces($pname));
$count = 0;#Used to determine ordinal number, only when
$ctemp = 0;#child entry changes
$query = "delete cdr.dbo.cdr_lot_normal_ranges $cr where lp_parent_test_id = $temp and lnr_last_date_modified <> '$mod_date'";#delete any old entries for parent test previously processed.
&process_db_delete($query,$dbh);
}
if (substr($line,0,1) eq "R"){#Child/Component Entry
$temp = $parent;
$child = substr($line,9,5);
if ($child != $ctemp){
$ctemp = $child;
$count += 1;}
$cname = substr($line,18,16);
$cname = &remove_quotes(&remove_spaces($cname));
$item = &remove_spaces(substr($line,9,5));
$name = &remove_spaces(substr($line,18,15));
$low = &remove_spaces(substr($line,34,7));
if ($low eq ""){
$low = 0.0;}
$high = &remove_spaces(substr($line,41,7));
if ($high eq ""){
$high = 0.0;}
$sex = substr($line,49,1);
$daysl = &remove_spaces(substr($line,51,5));
$daysh = &remove_spaces(substr($line,57,5));
if (($daysl eq "00000")&($daysh eq "00000")){
$ager = 0;}
else{
$ager = 1;
}
if (($sex eq "M") | ($sex eq "F")){
$sexr = 1;
$sex = $sex;}
else {
$sexr = 0;
$sex = 'N';}
$rule = 0;#Determine rule strength,
#if age & gender, strength is 3,
#if age, strength is 2,
#if gender, strength is 1
#no contraints, strength is 0
if (($ager==1)&($sexr==1)){
$rule = 3;}
if (($ager==1)&($sexr==0)){
$rule = 2;}
if (($ager==0)&($sexr==1)){
$rule = 1;}
if ($daysl eq "00000")
{
$daysl = 0;}
if ($daysh eq "00000"){
$daysh = 0;}
#Determine existence in table.
$query = "select lot_test_number from cdr.dbo.cdr_lot_normal_ranges $cr where lot_test_number = $item and lnr_ordinal_number = $count and lnr_sex = '$sex' and lnr_lo_age_days = $daysl and lnr_hi_age_days = $daysh";
#print STDOUT "$query\n";
$dbh->dbcmd($query);
$dbh->dbsqlexec;
if ($dbh->dbresults() == SUCCEED){ #1
@data = $dbh->dbnextrow();
&process_add_results($fieldlist[0],'Select LOT',$dbh);
if (@data[0] ne ""){#Update if found in table.
$state = "Update cdr.dbo.cdr_lot_normal_ranges set lp_parent_test_id = $parent,lnr_normal_lo = $low,lnr_normal_hi = $high, lnr_lo_age_days = $daysl, lnr_hi_age_days = $daysh, lnr_sex = '$sex',lnr_rule_strength = $rule, lnr_last_date_modified = '$mod_date' $cr where lot_test_number = $item and lnr_ordinal_number = $count and lnr_sex = '$sex' and lnr_lo_age_days = $daysl and lnr_hi_age_days = $daysh";
&process_db_update($state,$dbh);
}
else {#Insert if not found.
$state = "Insert cdr.dbo.cdr_lot_normal_ranges (lot_test_number,lot_test_id, lnr_lo_age_days, lnr_hi_age_days, lnr_sex, lnr_normal_lo, lnr_normal_hi, lnr_rule_strength, lnr_last_date_modified, lp_parent_test_id, lnr_ordinal_number)";
$values = $cr . "values ($item,$item,$daysl,$daysh,'$sex',$low,$high,$rule, '$mod_date', $parent,$count)";
&process_db_insert($state,$values,$item,$dbh);}
}
}
$line = ;
chop ($line);
}
close INFILE;
sub remove_spaces{
#remove spaces from string.
local ($strvalue) = @_;
local ($temp,$pos,$lenstr,$holder);
$lenstr = length($strvalue)-1;
while (substr($strvalue,$lenstr,1) eq " "){
$strvalue = substr($strvalue,0,$lenstr);
$lenstr = $lenstr-1;
}
$temp = $strvalue;
}
sub remove_quotes{
#remove wild characters and utilize dbsafestring.
#replace any characters found in gmchar with it associative html iso character.
local ($strvalue, $protocol, *gmchar) = @_;
local ($temp, $output, $pos, $lenstr, $holder);
$lenstr = length($strvalue)-1;
while (substr($strvalue,$lenstr,1) eq " "){
$strvalue = substr($strvalue, 0 , $lenstr);
$lenstr = $lenstr -1;
}
$varname = $strvalue;
$comment_out = 1;
if ($comment_out == 1){#Not removing special characters for db load
if ($varname =~ /^[A-Za-z0-9_\*\+-=\\\/\|.,<>\?'":;\&\^%\$#@!~\(\)\[\]\{\}\n\t\r ]*$/){
#Do Nothing
}
else{
foreach $holder ((keys(%gmchar))){
$temp= $gmchar{$holder};
$strvalue=~ s/$holder/$temp/ge;
}
}
$varname = $strvalue;
if ($varname =~ /^[A-Za-z0-9_\*\+-=\\\/\|.,<>\?'":;\&\^%\$#@!~\(\)\[\]\{\}\n\t\r ]*$/){
#Do Nothing
}
else{
$pos = 0;
while ($pos < length($strvalue)){
if ((ord(substr($strvalue,$pos,1))<31) || (ord(substr($strvalue,$pos,1))> 127)){
substr($strvalue,$pos,1) = "";
$pos = $pos + length("");
}
else {$pos = $pos +1;}
}
}
}
$quoteval = '"' . "'";
$temp = '"' . $dbh->dbsafestr($strvalue,$quoteval) . '"';
$output = $temp;
}
sub process_add_results{
#Make sure there are no additional results after a select.
local ($protocol,$loopname,$dbh) = @_;
local (@dummy);
while (@dummy = $dbh->dbnextrow()){
print STDOUT "MORE Than One Row Returned $protocol $loopname\n"};
}
sub process_error_results{
#If sybase returned error, make sure all rows were read (there should not be any)
#Print error to standard out.
local ($protocol,$loopname,$dbh) = @_;
local (@dummy);
print STDOUT "ERROR--$protocol::$loopname\n";
while (@dummy = $dbh->dbnextrow()){
print STDOUT "ERROR $protocol $loopname\n"; } #dummy loop
}
sub process_db_update{
#Perform a sybase db update.
local ($state,$dbh) = @_;
local (@dummy);
$dbh->dbcmd($state);
$dbh->dbsqlexec;
#print STDOUT "$state\n";
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Updating\n";}
}
sub process_db_insert{
#Perform s sybase db insert
local ($state,$values,$lab,$dbh) = @_;
local (@dummy,$insert);
$insert = $state . $values;
$dbh->dbcmd($insert);
$dbh->dbsqlexec;
#print STDOUT "$insert\n";
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Inserting $lab\n";}
}
sub get_mod_date{
#get the date modified, used for updating db.
local (@timeval,$mod_date, $currtime);
$currtime = time();
@timeval = localtime($currtime);
if (($timeval[4]+1)<10){
$timeval[4] = "0" . ($timeval[4]+1);}
else{
$timeval[4] = ($timeval[4]+1)
}
if (($timeval[3])<10){
$timeval[3] = "0" . ($timeval[3]);}
else{
$timeval[3] = ($timeval[3])
}
$mod_date = $timeval[4] . "/" . $timeval[3]. "/" . $timeval[5];
}
sub get_today_date{
#get today, used for determining MRD File.
local (@timeval,$mod_date, $currtime);
$currtime = time();
@timeval = localtime($currtime);
if (($timeval[4]+1)<10){
$timeval[4] = "0" . ($timeval[4]+1);}
else{
$timeval[4] = ($timeval[4]+1)
}
if (($timeval[3])<10){
$timeval[3] = "0" . ($timeval[3]);}
else{
$timeval[3] = ($timeval[3])
}
$today=($timeval[4]) . $timeval[3] . $timeval[5];
}
sub process_db_delete{
#Perform a sybase delete.
local ($state,$dbh) = @_;
local (@dummy);
$dbh->dbcmd($state);
$dbh->dbsqlexec;
if ($dbh->dbresults() != SUCCEED){
print STDOUT "Error Deleting\n";}
}