# KVA
###################################
# General retrans sql routines
###################################

use strict;
use Data::Dumper;

package set_printer;

sub set_barcode_printer {
    my($pkg,$dbh,$teamname,$type)=@_;
    
    my $printer_var;
    my $set_printer = "SELECT  BP.DESCRIPTION
FROM    BARCODE_PRINTER BP, DEFAULT_PRINTERS DP, BARCODE_PREFIX BF
WHERE   BF.ID_PREFIX = ?
AND     BF.ID_LABEL  = BP.ACTIVE_LABEL
AND     BP.ISCURRENT = 1
AND     BP.ID_PRINTER = DP.ID_PRINTER
AND     DP.TEAMNAME = ?
AND     ROWNUM = 1";
    my $sth_set_printer=$dbh->prepare($set_printer);
    $sth_set_printer->execute($type,$teamname);
    $printer_var = $sth_set_printer->fetchrow();
    $sth_set_printer->finish();
    
    return ($printer_var);
    
}


package get_ret;

sub special_finservs {

my ($pkg, $dbh, $teamname) = @_;

#get the relevant finishing services for these
#samples. Only use team finishing service
#and have also set up a finishing group service
#to group and process these samples between teams 
#if their is a lag.

my $stat_sub_ops = "select distinct b.fsname, b.id_team_finserv, b.id_robot
from fin_team_finservice a, fin_finservice b 
where a.id_team_finserv = b.id_team_finserv
and a.teamname = ?
and b.finmethod = 'Service'
UNION
select distinct b.fsname, b.id_team_finserv, b.id_robot
from fin_finservice b
where b.id_team_finserv in (46,54)";

my $sth_sub_ops = $dbh->prepare($stat_sub_ops) || die "ERROR:$DBI::errstr";
$sth_sub_ops->execute($teamname) || die "ERROR:$DBI::errstr";
my ($fsname, $id, $robot);
my @ret;
while ( ($fsname, $id, $robot) = $sth_sub_ops->fetchrow() ){
    my $cat = "$fsname"."_id_"."$id";
    push @ret, $cat;
}
$sth_sub_ops->finish();

return(\@ret);

}


sub get_retrans_batches {

    my($pkg,$dbh,$ID_TEAM_FINSERV,$FSNAME)=@_;

my $get_batches = "select rb.id_rbatch, to_char(rb.batchdate,'DD-MON-YY HH24:MI:SS'), p.email, rr.id_rrequest, rr.dnaplate_name||rcm.maprow||rcm.mapcol, cp.projectname, tpr.teamname
from retrans_batch rb, retrans_request rr, rr_status rrs, team_person_role tpr, person p, rowcol_map rcm, beckman_box bb, bb_map bbm, subclone sc, ligation l, clone_project cp
where rb.id_rbatch = rr.id_rbatch
and rr.id_rrequest = rrs.id_rrequest
and rrs.iscurrent = 1
and rrs.status = 1
and rb.finisher = tpr.id_role
and tpr.id_person = p.id_person
and rr.dp_idmap = rcm.id_map
and rb.id_team_finserv = ?
and rr.dnaplate_name = bb.name
and bb.id_beckmanbox = bbm.id_beckmanbox
and bbm.id_map in (1,97)
and bbm.id_subclone = sc.id_subclone
and sc.id_ligation = l.id_ligation
and l.clonename = cp.clonename
order by rb.batchdate,rr.id_rrequest";

    my $batchlist_ref = $dbh->selectall_arrayref($get_batches,{},$ID_TEAM_FINSERV) || die "ERROR:$DBI::errstr";
    
    my %BATCH_HASH;
    foreach my $bref (@$batchlist_ref){
        my $batch_title;
        if ($FSNAME=~ /^RETRANS_GROUP$/){
            $batch_title = "BATCH_".@$bref[0]."_".@$bref[2]."_"."COUNT_UNKNOWN_YET"."_@$bref[5]"." sub ".@$bref[1]." (Tm".@$bref[6].")";
        } else {
            $batch_title = "BATCH_".@$bref[0]."_".@$bref[2]."_"."COUNT_UNKNOWN_YET"."_@$bref[5]"." sub ".@$bref[1];
        }
        push @{$BATCH_HASH{$batch_title}},@$bref[3];
    }

    return(\%BATCH_HASH);

}



sub get_bb_dna {
    my($pkg,$dbh,$ref_ret)=@_;
    
    my @retrans_id = @$ref_ret;
    
    my(%bb_ref,%dna_ref);
    
#    print "list of retrans id's are @retrans_id\n";

##old query bottom one replaces it.
#    my $stat_beck_dna = "select /*+ INDEX(d IX_BBSTATUS_STATUS) INDEX(b IX_BBMAP_BECKMANBOX) INDEX(c IX_DNAPLATEMAP_BBMAP) */ 
#distinct a.id_beckmanbox, c.id_dnaplate
#from rrplate_bb a, bb_map b, dnaplate_map c, bb_status d
#where a.id_beckmanbox = b.id_beckmanbox
#and a.id_beckmanbox = d.id_beckmanbox
#and b.id_bbmap = c.id_bbmap
#and d.status = 1
#and d.iscurrent = 1
#and a.id_rrplate =?";


    my $stat_beck_dna = "select /*+ INDEX(b IX_BBMAP_BECKMANBOX) INDEX(c IX_DNAPLATEMAP_BBMAP) */ 
distinct a.id_beckmanbox, c.id_dnaplate
from rrplate_bb a, bb_map b, dnaplate_map c
where a.id_beckmanbox = b.id_beckmanbox
and b.id_bbmap = c.id_bbmap
and a.id_rrplate = ?";
    my $sth_beck_dna=$dbh->prepare($stat_beck_dna);
    
    foreach my $id (@retrans_id){              
        $sth_beck_dna->execute($id);
        my($bb,$dna)=$sth_beck_dna->fetchrow();
        $bb_ref{$id} = $bb;
        $dna_ref{$id} = $dna;
    }
    $sth_beck_dna->finish();
    
    return (\%bb_ref,\%dna_ref);
    

}


sub get_requests_left {

    my($pkg,$dbh,$FSNAME,$ref_ids)=@_;
    
    my @ids_left=@$ref_ids;
    my @select_blocks;
    my $datacollector;

    my $stat_update = "select rb.id_rbatch, to_char(rb.batchdate,'DD-MON-YY HH24:MI:SS'), p.email, cp.projectname, tpr.teamname, count(rr.id_rrequest)
from retrans_batch rb, retrans_request rr, rr_status rrs, team_person_role tpr, person p, beckman_box bb, bb_map bbm, subclone sc, ligation l, clone_project cp
where rb.id_rbatch = rr.id_rbatch
and rr.id_rrequest = rrs.id_rrequest
and rrs.status = 1
and rrs.iscurrent = 1
and rb.finisher = tpr.id_role
and tpr.id_person = p.id_person
and rb.id_rbatch = ?
and rr.dnaplate_name = bb.name
and bb.id_beckmanbox = bbm.id_beckmanbox
and bbm.id_map in (1,97)
and bbm.id_subclone = sc.id_subclone
and sc.id_ligation = l.id_ligation
and l.clonename = cp.clonename
and cp.projectname = ?
group by rb.id_rbatch,rb.batchdate,p.email,cp.projectname, tpr.teamname";
    my $sth_update = $dbh->prepare($stat_update) || die "ERROR:$DBI::errstr"; 
    
    my ($batch,$date,$email,$project,$team,$count);
    my $requests_left;
    foreach my $id (@ids_left){
        my ($id1,$proj1)=split(/\*/,$id);
	$sth_update->execute($id1,$proj1) || die "ERROR:$DBI::errstr";	
	while (($batch,$date,$email,$project,$team,$count)= $sth_update->fetchrow()){
	    $requests_left+=$count;
            my $batch_title;
            if ($FSNAME=~ /^RETRANS_GROUP$/){
                $batch_title = "BATCH_".$batch."_".$email."_".$count."_$project"." sub ".$date." (Tm".$team.")";
            } else {
                $batch_title = "BATCH_".$batch."_".$email."_".$count."_$project"." sub ".$date;
            }
	    push @select_blocks,$batch_title;
	}
    }

    $sth_update->finish();
    
    my $ref=\@select_blocks;
    
    return($requests_left,$ref);
}


sub get_avail_retrans_plates {

    my($pkg,$dbh,$ID_TEAM_FINSERV)=@_;

    my $stat_retrans_maps = "select distinct 'R'||rr.id_rrplate|| ' made '||rrps.statusdate
from rrplate rr, rrplate_status rrps, rrplate_bb rrb, beckman_box bb, bb_status bbs, bb_map bbm
where rr.id_rrplate = rrps.id_rrplate
and rrps.status = 1
and rrps.iscurrent = 1
and rr.id_rrplate = rrb.id_rrplate
and rrb.id_beckmanbox = bb.id_beckmanbox
and bb.id_beckmanbox = bbs.id_beckmanbox
and bbs.status = 1
and bbs.iscurrent = 1
and bb.id_beckmanbox = bbm.id_beckmanbox
and rr.id_team_finserv = ?";

    my $retmap_ref = $dbh->selectall_arrayref($stat_retrans_maps,{},$ID_TEAM_FINSERV) || die "ERROR:$DBI::errstr";
    
    return($retmap_ref);
    
}


sub get_updatable_retrans_maps {

    my($pkg,$dbh,$ID_TEAM_FINSERV)=@_;

##only deliver those maps that have been printed out.
    my $stat_retrans_upd_maps = "select distinct 'R'||rr.id_rrplate|| ' made '||rrps.statusdate
from rrplate rr, rrplate_status rrps, rrplate_bb rrb, beckman_box bb, bb_status bbs, bb_map bbm, dnaplate_map dpm, dna_plate dp
where rr.id_rrplate = rrps.id_rrplate
and rrps.status = 2
and rrps.iscurrent = 1
and rr.id_rrplate = rrb.id_rrplate
and rrb.id_beckmanbox = bb.id_beckmanbox
and bb.id_beckmanbox = bbs.id_beckmanbox
and bbs.status = 1
and bbs.iscurrent = 1
and bb.id_beckmanbox = bbm.id_beckmanbox
and bbm.id_bbmap = dpm.id_bbmap
and dpm.id_dnaplate = dp.id_dnaplate
and rr.id_team_finserv = ?";

    my $retmap_upd_ref = $dbh->selectall_arrayref($stat_retrans_upd_maps,{},$ID_TEAM_FINSERV) || die "ERROR:$DBI::errstr";

    return($retmap_upd_ref);
    
}


sub get_dnaname {
    my($pkg,$dbh,$ret_plate)=@_;


    my $stat_getdnaname = "select distinct dnaplate_name 
from retrans_request 
where id_rrplate = ?";
    my $sth_getdnaname = $dbh->prepare($stat_getdnaname) || die "ERROR:$DBI::errstr";
    $sth_getdnaname->execute($ret_plate);

    my $names;
    my @list;
    while($names = $sth_getdnaname->fetchrow()){
        push @list,$names;
    }
    $sth_getdnaname->finish();

    return(\@list);
}


package insert_ret;

sub insert_retrans_reqsub {
    my($pkg,$dbh,$id_role,$ID_TEAM_FINSERV,$session_id,$prog,$who,$data_point,$request)=@_;
    
#    print "Attributes sent over -$pkg,$dbh,$id_role,$ID_TEAM_FINSERV,$session_id,$prog,$who,$data_point,$request\n";
 
    my %HoH = %$request;
    my($r,$count);
    my $rbatchid;
    
    #add sql to check the existance of the plate name;
    
    my $stat1 = "select rbatch_seq.nextval from dual";
    my $sth1 = $dbh->prepare($stat1) || die "ERROR:$DBI::errstr";
    
    my $stat2 = "insert into retrans_batch values (?,sysdate,?,?)";
    my $sth2 = $dbh->prepare($stat2) || die "ERROR:$DBI::errstr";
    
    my $stat3 = "select retrequest_seq.nextval from dual";
    my $sth3 = $dbh->prepare($stat3) || die "ERROR:$DBI::errstr";
    
    my $stat4 = "select format from beckman_box where name = ?";
    my $sth4 = $dbh->prepare($stat4) || die "ERROR:$DBI::errstr";
    
    my $stat5 = "select id_map from rowcol_map where maprow = ? and mapcol = ? and format = ?";
    my $sth5 = $dbh->prepare($stat5) || die "ERROR:$DBI::errstr";
    
    my $stat6 = "insert into retrans_request (ID_RREQUEST,ID_RBATCH,DNAPLATE_NAME,DP_IDMAP,ASSIGN_ORDER) values (?,?,?,?,?)";
    my $sth6 = $dbh->prepare($stat6) || die "ERROR:$DBI::errstr";
    
    my $stat7 = "insert into rr_status (ID_RREQUEST,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR) values (?,1,sysdate,1,?,?,?)";
    my $sth7 = $dbh->prepare($stat7) || die "ERROR:$DBI::errstr";
    
    #get the retransformation batch once.
    $sth1->execute || die "ERROR:$DBI::errstr";
    $rbatchid = $sth1->fetchrow();
    
#    print "Retransformation batch ID - $rbatchid\n";
    
    $sth2->bind_param(1,$rbatchid);
    $sth2->bind_param(2,$id_role);
    $sth2->bind_param(3,$ID_TEAM_FINSERV);
    $sth2->execute || die "ERROR:$DBI::errstr";
    
    #Numerically sort the information in the assign order.
    foreach my $assign_order (sort {$a <=> $b} keys %HoH){
        $count++;
        foreach my $keys (keys %{$HoH{$assign_order}}){
#            print "REQUEST $count (ASSIGN ORDER $assign_order)- $keys = $HoH{$assign_order}{$keys}\n";
            
            my $name = $keys;
            my($row,$col) = $HoH{$assign_order}{$keys}=~ /(\D+)(\d+)/;
            
#            print "NAME $name, ROW $row, COL $col\n";
            
            $sth3->execute || die "ERROR:$DBI::errstr";
            my $retreqid = $sth3->fetchrow();
            
            $sth4->bind_param(1,$name);
            $sth4->execute || die "ERROR:$DBI::errstr";
            my $plate_format = $sth4->fetchrow();
            
#            print "PLATE FORMAT - $plate_format\n";
            
            $sth5->bind_param(1,$row);
            $sth5->bind_param(2,$col);
            $sth5->bind_param(3,$plate_format);
            $sth5->execute || die "ERROR:$DBI::errstr";
            my $id_map = $sth5->fetchrow();
            
            $sth6->bind_param(1,$retreqid);
            $sth6->bind_param(2,$rbatchid);
            $sth6->bind_param(3,$name);
            $sth6->bind_param(4,$id_map);
            $sth6->bind_param(5,$assign_order);
            $sth6->execute || die "ERROR:$DBI::errstr";
            
            $sth7->bind_param(1,$retreqid);
            $sth7->bind_param(2,$session_id);
            $sth7->bind_param(3,$prog);
            $sth7->bind_param(4,$who);
            $sth7->execute || die "ERROR:$DBI::errstr";
            
#            print "DATA_POINT $data_point COMPARED WITH COUNT $count\n";
            last if $data_point == $count;
            
        }
    }
    
    $sth1->finish();
    $sth2->finish();
    $sth3->finish();
    $sth4->finish();
    $sth5->finish();
    $sth6->finish();
    $sth7->finish();


    return($rbatchid,$count);
}


sub sql_retmap {
    my($pkg,$dbh,$plate_size,$ID_TEAM_FINSERV,$teamname,$session_id,$prog,$who,$map_structure,$commited_maps)=@_;

#    print "WITHIN THE SQL_RETMAP SUBROUTINE\n";

    my $count=0;
    my %comm_maps = %$commited_maps;
    my %MAP_TO_PLATES;
    my %MAP_TO_BBOX;
    my %MAP_TO_DP;

#    print "INFO PASSED - $plate_size,$ID_TEAM_FINSERV,$teamname,$session_id,$prog,$who,$map_structure,$commited_maps\n";


# order of information in the list.
# my @list = ($ID_MAPPLATE, $ID_MAP, $ID_FREQUEST, $BLOCKNAME, $COLOUR);

#foreach map
#do this.......
#generate rrplate entry
    my $stat_rpval = "select rrplate_seq.nextval from dual"; 
    my $sth_rpval = $dbh->prepare($stat_rpval) || die "ERROR:$DBI::errstr";

    my $stat_rp = "insert into rrplate values (?,?,?)";
    my $sth_rp = $dbh->prepare($stat_rp) || die "ERROR:$DBI::errstr";

    my $stat_rps = "insert into rrplate_status (ID_RRPLATE,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR) values (?,1,sysdate,1,?,?,?)";
    my $sth_rps = $dbh->prepare($stat_rps) || die "ERROR:$DBI::errstr";

#generate beckmanbox entry
#make the is_original field 0, as it is a copy
#of the original dna sample.
    my $stat_bbval = "select seq_beckmanbox.nextval from dual";
    my $sth_bbval = $dbh->prepare($stat_bbval) || die "ERROR:$DBI::errstr"; 

    my $stat_bb = "insert into beckman_box (ID_BECKMANBOX,FORMAT,NAME,IS_ORIGINAL,TEAM) values (?,?,?,0,?)";
    my $sth_bb = $dbh->prepare($stat_bb) || die "ERROR:$DBI::errstr";

    my $stat_bbs = "insert into bb_status (ID_BECKMANBOX,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR) values (?,1,sysdate,1,?,?,?)";
    my $sth_bbs = $dbh->prepare($stat_bbs) || die "ERROR:$DBI::errstr";

#generate entry in bridging table (rrplate_bb)
    my $stat_rpbb = "insert into rrplate_bb values (?,?)";
    my $sth_rpbb = $dbh->prepare($stat_rpbb) || die "ERROR:$DBI::errstr";

#generate the dna_plate entry
    my $stat_dpval = "select seq_dnaplate.nextval from dual";
    my $sth_dpval = $dbh->prepare($stat_dpval) || die "ERROR:$DBI::errstr"; 

    my $stat_dp = "insert into dna_plate (ID_DNAPLATE,FORMAT,COPY_TYPE,TEAM) values (?,?,1,?)";
    my $sth_dp = $dbh->prepare($stat_dp) || die "ERROR:$DBI::errstr";

#foreach sample on that map
#do this.......
#get batch id related to the retrans_request
    my $stat_rb = "select id_rbatch,dnaplate_name,dp_idmap from retrans_request where id_rrequest = ?";
    my $sth_rb = $dbh->prepare($stat_rb) || die "ERROR:$DBI::errstr";

#update retrans_request entries with the rrplate id and well location id rp_idmap
    my $stat_upd_rr = "update retrans_request set id_rrplate = ?, rp_idmap = ? where id_rrequest = ? and id_rbatch = ?";
    my $sth_upd_rr = $dbh->prepare($stat_upd_rr) || die "ERROR:$DBI::errstr";

#update status in rr_status for relevant entries
    my $stat_upd_rrs = "update rr_status set iscurrent = 0 where id_rrequest = ? and status = 1";
    my $sth_upd_rrs = $dbh->prepare($stat_upd_rrs) || die "ERROR:$DBI::errstr";

#insert new status of 2-assigned to plate for relevant entries
    my $stat_ins_rrs = "insert into rr_status (ID_RREQUEST,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR) values (?,2,sysdate,1,?,?,?)";
    my $sth_ins_rrs = $dbh->prepare($stat_ins_rrs) || die "ERROR:$DBI::errstr";

#find the relevant subclone id related to the original sample
#where id_map related to the value in dp_idmap
    my $stat_subid = "select id_subclone from bb_map where id_map = ? and id_beckmanbox in (select id_beckmanbox from beckman_box where name = ?)";
    my $sth_subid = $dbh->prepare($stat_subid) || die "ERROR:$DBI::errstr";

#make new bb_map entries but link them to the new id_beckmanbox and the 
#old id_subclone and id_map should be the same as the rp_idmap
    my $stat_ins_bbmp = "insert into bb_map (ID_BBMAP,ID_SUBCLONE,ID_BECKMANBOX,ID_MAP) values (SEQ_BBMAP.nextval,?,?,?)";
    my $sth_ins_bbmp = $dbh->prepare($stat_ins_bbmp) || die "ERROR:$DBI::errstr";

#make new dnaplate_map entries 
#id_map should be the same as the rp_idmap
    my $stat_ins_dpmp = "insert into dnaplate_map (ID_DNAPLATEMAP,ID_BBMAP,ID_DNAPLATE,ID_MAP) values (SEQ_DNAPLATEMAP.nextval,SEQ_BBMAP.CURRVAL,?,?)";
    my $sth_ins_dpmp = $dbh->prepare($stat_ins_dpmp) || die "ERROR:$DBI::errstr";

#    print "plate_size = $plate_size\n";
    foreach my $keys (keys %comm_maps){
#        print ">>$keys - $comm_maps{$keys}<<\n";
        unless ($comm_maps{$keys} eq 'Non-commitable'){
            #retrieve and insert retrans plate entry.
            $sth_rpval->execute();
            my $rpval = $sth_rpval->fetchrow();
            
#            print "retrans plate value = $rpval\n";

            $sth_rp->bind_param(1,$rpval);
            $sth_rp->bind_param(2,$plate_size);
            $sth_rp->bind_param(3,$ID_TEAM_FINSERV);
            $sth_rp->execute();

            $sth_rps->bind_param(1,$rpval);
            $sth_rps->bind_param(2,$session_id);
            $sth_rps->bind_param(3,$prog);
            $sth_rps->bind_param(4,$who);
            $sth_rps->execute();

            #retrieve and insert beckman box entry.
            $sth_bbval->execute();
            my $bbval = $sth_bbval->fetchrow();

            my $name = 'R'.$rpval;
            $sth_bb->bind_param(1,$bbval);
            $sth_bb->bind_param(2,$plate_size);
            $sth_bb->bind_param(3,$name);
            $sth_bb->bind_param(4,$teamname);
            $sth_bb->execute();

            $sth_bbs->bind_param(1,$bbval);
            $sth_bbs->bind_param(2,$session_id);
            $sth_bbs->bind_param(3,$prog);
            $sth_bbs->bind_param(4,$who);
            $sth_bbs->execute();

            #insert rrplate_bb entry.
            $sth_rpbb->bind_param(1,$rpval);
            $sth_rpbb->bind_param(2,$bbval);
            $sth_rpbb->execute();

            #retrieve and insert dna plate entry.
            $sth_dpval->execute();
            my $dpval = $sth_dpval->fetchrow();
            
            $sth_dp->bind_param(1,$dpval);
            $sth_dp->bind_param(2,$plate_size);
            $sth_dp->bind_param(3,$teamname);
            $sth_dp->execute();
            
            # my @list = ($ID_MAPPLATE, $ID_MAP, $ID_FREQUEST, $BLOCKNAME, $COLOUR);
#            print "COMMITABLE MAPS >>$keys - $comm_maps{$keys}<< rplate id - $rpval & bbplate - $bbval \n";
            $MAP_TO_PLATES{'MAP-'.$keys} = $rpval;
            $MAP_TO_BBOX{'MAP-'.$keys} = $bbval;
            $MAP_TO_DP{'MAP-'.$keys} = $dpval;
            
            my $n;
            foreach $n (0 .. $#{$map_structure}){	
                my $struct = $map_structure->[$n]->{contents}->[0];
#                print "STRUCTURE - $struct\n";
                if ($struct eq $keys){
                    $count++;
#                    print "ENTRY $count $map_structure->[$n]->{plate_type}\n";
                    my $id_rrequest = $map_structure->[$n]->{contents}->[2];
#                    print "Retrans_request id - $id_rrequest\n";
                    my $rpid_map = $map_structure->[$n]->{contents}->[1];
                    #print "well id - $rpid_map\n";

#get batch id related to the retrans_request
                    $sth_rb->bind_param(1,$id_rrequest);
                    $sth_rb->execute();
                    my($id_rbatch,$dnaplatename,$dpid_map) = $sth_rb->fetchrow();

#                    print "dpmap_id - $dpid_map dnaplatename - $dnaplatename rbatch_id - $id_rbatch\n";

#update retrans_request entries with the rrplate id and well location id rp_idmap
                    $sth_upd_rr->bind_param(1,$rpval);
                    $sth_upd_rr->bind_param(2,$rpid_map);
                    $sth_upd_rr->bind_param(3,$id_rrequest);
                    $sth_upd_rr->bind_param(4,$id_rbatch);
                    $sth_upd_rr->execute();

#update status in rr_status for relevant entries
                    $sth_upd_rrs->bind_param(1,$id_rrequest);
                    $sth_upd_rrs->execute();

#insert new status of 2-assigned to plate for relevant entries
#                    print "variables to bind - $id_rrequest,$session_id,$prog,$who\n";
                    $sth_ins_rrs->bind_param(1,$id_rrequest);
                    $sth_ins_rrs->bind_param(2,$session_id);
                    $sth_ins_rrs->bind_param(3,$prog);
                    $sth_ins_rrs->bind_param(4,$who);
                    $sth_ins_rrs->execute();

#find the relevant subclone id related to the original sample
#where id_map related to the value in dp_idmap
                    $sth_subid->bind_param(1,$dpid_map);
                    $sth_subid->bind_param(2,$dnaplatename);
                    $sth_subid->execute();
                    my $id_subclone = $sth_subid->fetchrow();
                    
#                    print "ID SUBCLONE - $id_subclone\n";

#make new bb_map entries but link them to the new id_beckmanbox and the 
#old id_subclone and id_map should be the same as the rp_idmap
                    $sth_ins_bbmp->bind_param(1,$id_subclone);
                    $sth_ins_bbmp->bind_param(2,$bbval);
                    $sth_ins_bbmp->bind_param(3,$rpid_map);
                    $sth_ins_bbmp->execute();

#make new dnaplate_map entries
#id_map should be the same as the rp_idmap
                    $sth_ins_dpmp->bind_param(1,$dpval);
                    $sth_ins_dpmp->bind_param(2,$rpid_map);
                    $sth_ins_dpmp->execute();
                    
                }
            }           
        }
    }

$sth_rpval->finish();
$sth_rp->finish();
$sth_rps->finish();
$sth_bbval->finish();
$sth_bb->finish();
$sth_bbs->finish();
$sth_rpbb->finish();
$sth_dpval->finish();
$sth_dp->finish();
$sth_rb->finish();
$sth_upd_rr->finish();
$sth_upd_rrs->finish();
$sth_ins_rrs->finish();
$sth_subid->finish();
$sth_ins_bbmp->finish();
$sth_ins_dpmp->finish();


#    foreach my $keys (keys %MAP_TO_PLATES){
#        print "$keys linked to retransformation plate $MAP_TO_PLATES{$keys}\n";
#        print "$keys linked to beckman_box $MAP_TO_BBOX{$keys}\n";
#        print "$keys linked to dna_plate $MAP_TO_DP{$keys}\n";
#    }

#    foreach my $each (keys %MAP_TO_PLATES){
#        print "$each links to $MAP_TO_PLATES{$each}\n";
#    }

    my $ref  = \%MAP_TO_PLATES;
    my $ref2 = \%MAP_TO_BBOX;
    my $ref3 = \%MAP_TO_DP;
    return($ref,$ref2,$ref3);


}

sub change_retrans_finservice {
    
    my($pkg,$dbh,$CHANGE_FSNAME,$ID_FNSV,$samps)=@_;
    
    my %BATCH_SAMPLES=%$samps;
    my %BATCH_BLOCKS;
    
#where the number of active samples related to a batch
#is equal to the amount of samples in the block
#only the RETRANS_BATCH.ID_TEAM_FINSERV will require
#updating. If the samples are found to be more
#in the related retrans batch than those in the
#selected batch, then the required samples will have to be
#assigned to a new retrans batch which will be a 
#duplicate of the original but linked to a new
#finservice.

    my $stat2 = "select count(*) 
from retrans_request 
where id_rbatch = ? 
and id_rrequest in (select id_rrequest 
from rr_status 
where iscurrent = 1)";
    my $sth2 = $dbh->prepare($stat2);
    
    #update existing retrans_batch where required.
    my $upd_rbth = "update retrans_batch set id_team_finserv = ? where id_rbatch = ?";
    my $sth_rbth = $dbh->prepare($upd_rbth);
    
    #insert new retrans_batch where required.
    my $get_gnewrbth = "select RBATCH_SEQ.NEXTVAL from dual";
    my $sth_gnewrbth = $dbh->prepare($get_gnewrbth);
    
    my $ins_inewrbth = "insert into retrans_batch (select ?,sysdate,FINISHER,? from retrans_batch where id_rbatch = ?)";
    my $sth_inewrbth = $dbh->prepare($ins_inewrbth);

    #update the retrans_request to link to the
    #new retrans_batch.
    my $upd_rrequest = "update retrans_request set id_rbatch = ? where id_rrequest = ?";
    my $sth_rrequest = $dbh->prepare($upd_rrequest);
    
    foreach my $key (sort keys %BATCH_SAMPLES){
        $sth2->execute($key);
        my $rreq_count = $sth2->fetchrow();
        my $block_count= scalar(@{$BATCH_SAMPLES{$key}});

        if ($rreq_count eq $block_count){
            main::update("For block $BATCH_BLOCKS{$key}, batch id $key the id_finserv will be altered to $CHANGE_FSNAME."); 
              $sth_rbth->bind_param(1,$ID_FNSV);
              $sth_rbth->bind_param(2,$key);
              $sth_rbth->execute;
          } else {
              main::update("For block $BATCH_BLOCKS{$key}, batch id $key, a new batch will be made attached to $CHANGE_FSNAME, as there are still samples attached to this retrans batch.");
                $sth_gnewrbth->execute;
                my $new_rbatch = $sth_gnewrbth->fetchrow();

                #make new retrans batch
                main::update("New retrans_batch ID is $new_rbatch");
                $sth_inewrbth->bind_param(1,$new_rbatch);
                $sth_inewrbth->bind_param(2,$ID_FNSV);
                $sth_inewrbth->bind_param(3,$key);
                $sth_inewrbth->execute;

                #update the existing retrans_requests to be attached
                #to the new retrans_batch.
                foreach my $rrequest (sort @{$BATCH_SAMPLES{$key}}){
                    $sth_rrequest->bind_param(1,$new_rbatch);    
                    $sth_rrequest->bind_param(2,$rrequest);    
                    $sth_rrequest->execute;
                }
            }
    }
    
    $sth2->finish();
    $sth_rbth->finish();
    $sth_gnewrbth->finish();
    $sth_inewrbth->finish();
    $sth_rrequest->finish();
    
    
}


package retrans_reprint;

sub check_map_and_status {

    my ($pkg, $dbh, $rmap) = @_;
    
    my ($map_id,$status);
    
    my $statement = "select id_rrplate, status 
from rrplate_status  
where id_rrplate = ?  
and iscurrent = 1";
    my $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->bind_param(1, $rmap);
    $sth->execute || die "ERROR:$DBI::errstr";
    ($map_id,$status) = $sth->fetchrow();
    $sth->finish;
    
    return ($map_id,$status);
    
}

sub map_info {

    my ($pkg, $dbh, $rmap) = @_;
    
    my @RETURNMAPS;
    
    #for the maps need to retrieve the following:-
    #original dnaplate name
    #source dnaplate ID and well location
    #freezer location
    #retrans name, plate# and well location
    #batch id
    #finisher name

    my $statement = "select mapplate.ID_MAPPLATE, mapplate.PLATE_FORMAT, mapplate.ID_RUNTYPE, seqprotocol.NAME, mapplate_status.STATUSDATE, mapplate.PLATE_FORMAT
from mapplate, mapplate_status, seqprotocol
where mapplate.id_mapplate = mapplate_status.id_mapplate
and mapplate.id_protocol = seqprotocol.id_protocol
and mapplate_status.status =12
and mapplate_status.iscurrent = 1
and mapplate.id_mapplate = ?";
    
    my $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->bind_param(1, $rmap);
    $sth->execute || die "ERROR:$DBI::errstr";
    my ($ID_MAPPLATE, $PLATE_FORMAT, $ID_RUNTYPE, $PROTOCOL,$STATUSDATE,$PLATE_FORMAT) = $sth->fetchrow();
    $PROTOCOL =~ s/\s+.+//g;
    
    if ($ID_RUNTYPE eq ''){
        $ID_RUNTYPE = 'NULL';
    }
    
    my $map = "$ID_MAPPLATE" . "_" . "$PROTOCOL" . "-" . "$ID_RUNTYPE" . " " . "  $STATUSDATE". " " . "$PLATE_FORMAT well";
    
    push @RETURNMAPS, $map;
    $sth->finish;
    
    return(\@RETURNMAPS);
    
}

package update_ret;

sub upd_retrans_beckbox {
    my($pkg,$dbh,$prog,$who,$sessionid,$arr_ref)=@_;
    my @ret_ids = @$arr_ref;

#    print ">>RETRANS ID'S are - prog-$prog, who-$who, sessionid-$sessionid, retrans_ids - @ret_ids <<\n";

##get the related beckmanbox id
    my $stat1 = "select id_beckmanbox from rrplate_bb where id_rrplate = ?";
    my $sth1 = $dbh->prepare($stat1) || die "ERROR:$DBI::errstr";

##update the current beckmanbox entry
##and insert a new entry linked to 3 prepped
    my $stat2 = "update bb_status set iscurrent = 0 where id_beckmanbox = ? and status = 1 and iscurrent = 1";
    my $sth2 = $dbh->prepare($stat2) || die "ERROR:$DBI::errstr";

    my $stat3 = "insert into bb_status (ID_BECKMANBOX,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR) values (?,3,sysdate,1,?,?,?)";
    my $sth3 = $dbh->prepare($stat3) || die "ERROR:$DBI::errstr";

##update the current rrplate_status entry
##and insert a new retrans plate status entry of 3 done
    my $stat4 = "update rrplate_status set iscurrent = 0 where id_rrplate = ? and status = 2 and iscurrent = 1";
    my $sth4 = $dbh->prepare($stat4) || die "ERROR:$DBI::errstr";
    
    my $stat5 = "insert into rrplate_status (ID_RRPLATE,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR) values (?,3,sysdate,1,?,?,?)";
    my $sth5 = $dbh->prepare($stat5) || die "ERROR:$DBI::errstr";

#Select the finisher, id_rbatch,plate and dnaplate name to formulate
#an email.
    my $stat6 = "select d.email,a.id_rbatch,'R'||a.id_rrplate||f.maprow||f.mapcol RNAME,'-->',a.dnaplate_name||e.maprow||e.mapcol DNANAME
from retrans_request a, 
retrans_batch b, 
team_person_role c, 
person d, 
rowcol_map e,
rowcol_map f
where a.id_rbatch = b.id_rbatch
and b.finisher = c.id_role
and c.id_person = d.id_person
and a.dp_idmap = e.id_map
and a.rp_idmap = f.id_map
and a.id_rrplate = ?
order by a.id_rbatch,a.dp_idmap";
    my $sth6 = $dbh->prepare($stat6) || die "ERROR:$DBI::errstr";

#get a list of retrans request id's 
#linked to a specific plate.
    my $stat7 = "select id_rrequest from rr_status where status = 2 and iscurrent = 1 and id_rrequest in (select id_rrequest from retrans_request where id_rrplate = ?) order by id_rrequest";
    my $sth7 = $dbh->prepare($stat7) || die "ERROR:$DBI::errstr";

##update the rr_status entry
##and insert a new rr_status entry of 3 done
    my $stat8 = "update rr_status set iscurrent = 0 where status = 2 and iscurrent = 1 and id_rrequest = ?";
    my $sth8 = $dbh->prepare($stat8) || die "ERROR:$DBI::errstr";

    my $stat9 = "insert into rr_status (ID_RREQUEST,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR) values (?,3,sysdate,1,?,?,?)";
    my $sth9 = $dbh->prepare($stat9) || die "ERROR:$DBI::errstr";
    
    my %HoH;
    my %unique_list;
    my @email_list;
    foreach my $id (@ret_ids){
        
        $sth1->execute($id);
        my $beckmanbox = $sth1->fetchrow();
#        print ">>beckmanbox - $beckmanbox<<\n";

        $sth2->execute($beckmanbox);
        
        $sth3->bind_param(1,$beckmanbox);
        $sth3->bind_param(2,$sessionid);
        $sth3->bind_param(3,$prog);
        $sth3->bind_param(4,$who);
        $sth3->execute();
        
        $sth4->execute($id);
        
        $sth5->bind_param(1,$id);
        $sth5->bind_param(2,$sessionid);
        $sth5->bind_param(3,$prog);
        $sth5->bind_param(4,$who);
        $sth5->execute();
        
        $sth6->execute($id);
        my %hash_name;
        my ($email,$rbatch,$rname,$arrow,$dnaname);
        while (($email,$rbatch,$rname,$arrow,$dnaname)=$sth6->fetchrow()){
            unless($unique_list{$email}){
#                print "IN UNIQUE LIST LOOP - $email\n";
                $unique_list{$email}=1;
                push @email_list,$email;
            }
            $HoH{$email}{$id}{$rbatch}{$rname} = $dnaname;
        }
        
        $sth7->execute($id);
        my $rqids;
        my @req_ids;
        while($rqids=$sth7->fetchrow()){
            push @req_ids,$rqids;
        }

        foreach my $rids (sort @req_ids){
#            print "RETRANS REQUEST - $rids\n";
            $sth8->execute($rids);
            
            $sth9->bind_param(1,$rids);
            $sth9->bind_param(2,$sessionid);
            $sth9->bind_param(3,$prog);
            $sth9->bind_param(4,$who);
            $sth9->execute();
        }
        
    }
    
    $sth1->finish();
    $sth2->finish();
    $sth3->finish();
    $sth4->finish();
    $sth5->finish();
    $sth6->finish();
    $sth7->finish();
    $sth8->finish();
    $sth9->finish();
    
    return(\%HoH,\@email_list);
    
    
}

sub upd_ins_rp {

    my($pkg,$dbh,$ret_id,$sessionid,$prog,$who)=@_;

    #sql to update map entries.
                my $stat_urm = "update rrplate_status set iscurrent = 0 where status = 1 and iscurrent = 1 and id_rrplate = ?";
                my $sth_urm =  $dbh->prepare($stat_urm) || die "ERROR:$DBI::errstr";
                my $stat_irm = "insert into rrplate_status (ID_RRPLATE,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR) values (?,2,sysdate,1,?,?,?)";
                my $sth_irm =  $dbh->prepare($stat_irm) || die "ERROR:$DBI::errstr";            

    foreach my $ids (@$ret_id){
        $sth_urm->execute($ids);

        $sth_irm->bind_param(1,$ids);
        $sth_irm->bind_param(2,$sessionid);
        $sth_irm->bind_param(3,$prog);
        $sth_irm->bind_param(4,$who);
        $sth_irm->execute();
    }

    $sth_urm->finish();
    $sth_irm->finish();
    

}


1;


__END__

=head1 NAME

 retrans_general.pm

=head1 SYNOPSIS

 retrans_general.pm

=head1 DESCRIPTION
 
 Contains general sql to handle the retransformation interface functionality used in Crusade.

=head1 AUTHOR

 Karen Ambrose

=head1 HISTORY

 # $Log: retrans_general.pm,v $
# Revision 1.10  2005/11/23  15:14:08  kva
# Altered the special_finservs subroutine to include a new finservice set up for the retransformation interface.
#
# Revision 1.9  2003/08/04  16:22:48  kva
# Altered some of the sql to accept more variables namely get_retrans_batches and get_requests_left.
#
# Revision 1.8  2003/05/16  15:44:15  kva
# Altered the sql in the subroutine get_bb_dna.
#
# Revision 1.7  2003/05/01  15:38:16  kva
# Altered the set_barcode_printer subroutine to use bind variables.
#
# Revision 1.6  2003/03/26  09:37:23  kva
# *** empty log message ***
#

=cut
