#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################
#                                                                     #
# THIS MODULE CONTAINS VARIOUS FUNCTIONS USED BY DODO.                #
# These functions allow DNA reception to select streaked clones for   #
# preparartion. Allows the preparation to be assigned to a worker     #
#                                                                     #
#######################################################################
package Reassign;
use strict;

sub new
{
my $pkg = shift;
my $setup = {};
$setup->{Contents} = [];
bless $setup,$pkg;
return $setup;
}



sub Initialiseobject
{
my $pkg 	= shift;
my $option 	= shift;
my @sqlA;
my @sqlB;
my $mess;

if(!$pkg->{Query1}){$pkg->{Query1} = 'ALL';}

# Role IDS of evening Preppers
#	10746 ha1
#     	14921 ks2
#     	14922 lmb
#     	14923 sdm
#	14924 sm2

my $evening_preppers = '13381,10746,14921,14922,14923,14924';

# $option = 0;
# Option 0, Show preps from all preppers
# Option 2, Show preps from Evening preppers
# Option 1, Show preps In Storage


# 30 = dnaprepstatusdict = storage, 31 = semi prepped
$option = 29 + $option;

# For use with old sids
#$option = 11;


$pkg->{ListSQL} = "	SELECT 	UNIQUE CD.SPECIESNAME, CD.CHROMOSOME
			FROM 	CHROMOSOMEDICT CD, CLONE C, DNAPREP DP, DNAPREP_STATUS DS 
			WHERE	CD.ID_DICT 		= C.CHROMOSOME
			AND	C.CLONENAME		= DP.CLONENAME
			AND	DP.ID_PREP		= DS.ID_PREP
			AND	DS.STATUS		= $option
			AND	DS.ISCURRENT		= 1";


$pkg->{ResultSQL} =  "		SELECT 	C.CLONENAME||'-'||DP.PREP_NUMBER,
				DP.ID_PREP,
				P.EMAIL,
				DS.STATUSDATE,
				CP.PRIORITY -1, 
				CD.SPECIESNAME, 
				CD.CHROMOSOME
			FROM 	CHROMOSOMEDICT CD, 
				CLONE C,
				TEAM_PERSON_ROLE T, 
				PERSON P,
				DNAPREP DP, 
				DNAPREP_STATUS DS,
				CLONE_PRIORITY CP
			WHERE	CD.CHROMOSOME 		like 'VAR1'
			AND	CD.SPECIESNAME 		like 'VAR2'
			AND	CD.ID_DICT 		= C.CHROMOSOME
			AND	CP.IS_CURRENT		= 1
			AND	CP.CLONENAME		= DP.CLONENAME
			AND	C.CLONENAME		= DP.CLONENAME
			AND	P.ID_PERSON		= T.ID_PERSON
			AND 	T.ID_ROLE		= DP.OPERATOR
			AND	DP.ID_PREP		= DS.ID_PREP
			AND	DS.STATUS		= $option
			AND	DS.ISCURRENT		= 1
			ORDER BY P.EMAIL, C.CLONENAME, DP.PREP_NUMBER, DS.STATUSDATE";
			
			

if	($option == 30)	{$mess = 'That Are In Storage';}
elsif	($option == 31)	{$mess = 'From Evening Preppers';}



$pkg->{Button1Label}	= 'Re Assign';
$pkg->{Duplicatecheck}	= 1;

$pkg->{Columnheaders} = "Clone";
while(length($pkg->{Columnheaders}) < 31)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}
	
$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Species";
while(length($pkg->{Columnheaders}) < 46)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}

$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Chr";
while(length($pkg->{Columnheaders}) < 54)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}

$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Current Prepper";
while(length($pkg->{Columnheaders}) < 71)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}
		
$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Date Assigned ";
while(length($pkg->{Columnheaders}) < 89)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}

	
$pkg->{Columnheaders} = "$pkg->{Columnheaders}|";
# [a,b] a = content array index, b = width of field to display -1
# Internal column headings = sum b + 2 end one + 3
$pkg->{Column} = [[0,29,'Clone'],[5,13,'Species'],[6,6,'Chr'],[2,16,'Current Prepper'],[3,14,'Date Assigned']];				
undef $pkg->{Selection};

		
$pkg->Addtobrowse();
undef @{$pkg->{Contents}};
$pkg->Refresh();



$pkg->{Title}->configure(-text => "Operator : $pkg->{Who}\tRole Type : $pkg->{Roletype}\t\tREASSIGN DNApreps $mess");
				
						
}


sub Killprep
{

my $pkg = shift;;
my $chk;

$pkg->Message("Cannot Reject Any Preps in REASSIGN\n If you have a problem contact\nBrian Wilson, bsw, extn. 7290",\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);


}







sub Action
{
my $pkg = shift;
my $sql;
my @multisql;
my $ref; 
my $chk;
my $i;


$pkg->Assign(\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);
if($chk == 0)
	{return;}
	
eval{
# Go through selection
foreach (@{$pkg->{Contents}})
{
	# Update Current plate status
	$sql = "UPDATE DNAPREP_STATUS SET ISCURRENT = 0 WHERE ISCURRENT = 1 AND ID_PREP = $_->[1]";
	push @multisql,$sql;
	
	# Action Prep
	$sql = "INSERT INTO 	DNAPREP_STATUS	(ID_PREP, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
		VALUES				($_->[1],1,SYSDATE,1, $$, 'DODO Re-assigned','$pkg->{Who}')";
		
	push @multisql,$sql;	
	
	# Update active prepper in DNAprep
	$sql = "UPDATE DNAPREP SET OPERATOR = $pkg->{Worker} WHERE ID_PREP = $_->[1]";
	
	push @multisql,$sql;
}



$pkg->MultiWritedb(@multisql);
undef @{$pkg->{Contents}};
$pkg->Refresh();
$pkg->Addtobrowse();
$pkg->Addtoresults();
};
if($@){print STDERR "Function	: Prepare::Action\nRequest ID	: $_->[7]\nCulture ID	: $_->[1]\n$@ \n";}
}

sub Lock
{
my $pkg = shift;
my $sql;
# NOT USING LOCKS ****************
return $sql;

}


sub Assign
{
my ($pkg, $chk) = @_;
my $win;
my $sql;
my $ref;
my $i;
# Ask For Prep type and replicates ===============================

$win = $pkg->{Mainwin}->Toplevel;
$win->protocol('WM_DELETE_WINDOW', sub{$pkg->Killmessage($win);});
$win->geometry("+375+340");
$win->title('DODO');


$win->Label(				-fg 		=> 'black',
						-bg 		=> 'lightblue',
						-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-text 		=> "Assign To ",
						-anchor 	=> 'e',
						-height 	=> -1,
						-width 		=> 25,
						-relief 	=> 'flat'
					)->grid(-row 		=> 2, 
						-column	 	=> 1,
						-sticky 	=> 'we');


								
my $bw = $win->BrowseEntry(			-width 		=> 20,
						-font 		=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-state 		=> 'readonly',
						-fg 		=> 'blue',
						-variable	=> \$pkg->{Worker},
						-listcmd	=> sub {$win->grab();},
						-browsecmd	=> sub {$win->grab();}
						)->grid(-row 	=> 2, 
						-column	 	=> 2,
						-sticky 	=> 'we'
						);
$bw->Subwidget("slistbox")->Subwidget("listbox")->configure(	-font 	=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
								-fg 	=> 'blue',
								-height	=> 4);	


$sql = "SELECT 	PERSON.EMAIL, TEAM_PERSON_ROLE.ID_ROLE, PERSON.FORENAME, PERSON.SURNAME
	FROM 	TEAM_PERSON_ROLE, PERSON
	WHERE	(PERSON.ISCURRENT		= 1)				AND
		(PERSON.ID_PERSON		= TEAM_PERSON_ROLE.ID_PERSON)	AND
		(TEAM_PERSON_ROLE.ROLETYPE 	= 'Subcloning')			AND	
		(TEAM_PERSON_ROLE.ISCURRENT	= 1)
	ORDER BY PERSON.EMAIL";
$ref = $pkg->Querydb($sql);

foreach (@{$ref})
{
	$_->[0] =~ s/ //g;
	$_->[2] =~ s/ //g;
	$_->[3] =~ s/ //g;
	$pkg->{"$_->[2] $_->[3]"} = "$_->[1]";
	$pkg->{$_->[0]} = "$_->[2] $_->[3]";
	$bw->insert('end',"$_->[2] $_->[3]");
}

$pkg->{Worker} = $pkg->{$pkg->{Who}};

#$win->Label(					-fg 		=> 'black',
#						-bg 		=> 'lightblue',
#						-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
#						-text 		=> "On Date",
#						-anchor 	=> 'e',
#						-height 	=> -1,
#						-width 		=> 25,
#						-relief 	=> 'flat'
#					)->grid(-row 		=> 3, 
#						-column	 	=> 1,
#						-sticky 	=> 'we');

#my $d;


# Stopped users retrospectively assigning preps

#my $date = $win->BrowseEntry(		-width 		=> 20,
#					-fg 		=> 'blue1',
#					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
#					-state 		=> 'readonly',
#					-variable	=> \$pkg->{Assigndate}
#				)->grid(-row 		=> 3,
#					-column 	=> 2,
#					-sticky 	=> 'we');
					
#$date->Subwidget("slistbox")->Subwidget("listbox")->configure(-font 	=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
#								-height	=> 7,
#								-fg 	=> 'blue1');

							
								
								
#for(0..7)
#{
#	$d = join '-',	(localtime(time - 86400*$_))[3],
#			('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC')[(localtime(time - 86400*$_))[4]],
#			(localtime(time - 86400*$_))[5] + 1900;				
#	$date->insert('end',$d);
#}							
														
								
#$d = join '-',	(localtime(time))[3],
#		('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC')[(localtime(time))[4]],
#		(localtime(time))[5] + 1900;	

#$pkg->{Assigndate} = $d;


$win->Button(			-fg 			=> 'black',
				-bg 			=> 'grey85',
				-width			=> 20,
				-text 			=> "OK",
				-anchor 		=> 'center',
				-state 			=> 'normal',
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 	=> 'green',
				-command 		=> sub {	 
									$pkg->{Worker} = $pkg->{$pkg->{Worker}};
									$$chk = 1;
									$pkg->Killmessage($win);
								},
				-relief 		=> 'raised'
		)->grid(	-row 			=> 4, 
				-column 		=> 1, 
				-sticky 		=> 'w');



$win->Button(			-fg 			=> 'black',
				-bg 			=> 'grey85',
				-width			=> 20,
				-text 			=> "Cancel",
				-anchor 		=> 'center',
				-state 			=> 'normal',
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 	=> 'red',
				-command 		=> sub {$$chk = 0; $pkg->Killmessage($win);},
				-relief 		=> 'raised'
		)->grid(	-row 			=> 4, 
				-column 		=> 2, 
				-sticky 		=> 'w');

$win->grab();


}




1;

