#######################################################################
# 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 Prepare;
use strict;

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



sub Initialiseobject
{
my $pkg = shift;

$pkg->{ListSQL} = "	SELECT 	UNIQUE CD.SPECIESNAME SPECIES, CD.CHROMOSOME
			FROM 	CHROMOSOMEDICT CD, CLONE C, GLYSTOCK G, CLONE_CULTURE CC, 
				DNAREQUEST_STATUS DS, DNAPREP_REQUEST DR, DNAPREP DP
			WHERE	CD.ID_DICT 		= C.CHROMOSOME	
			AND	C.CLONENAME		= G.CLONENAME	
			AND	G.ID_GLYSTOCK		= CC.ID_GLYSTOCK
			AND	DS.STATUS 		IN(2,3)
			AND	DS.ISCURRENT		= 1
			AND	DR.ID_REQUEST 		= DS.ID_REQUEST
			AND	DR.ID_REQUEST		= CC.ID_REQUEST
			AND	CC.DATE_STREAKED	< SYSDATE-0.5
			AND	CC.ID_CULTURE 		= DP.ID_CULTURE (+)
			AND	DP.ID_CULTURE		IS NULL		
			AND	CC.IS_AVAILABLE		= 1";

# REq status reissue   use the same glystock, do it again
# Req status rerequest use a different glystock cause old was bad
# req actioned glys that have been streaked. 
# Streak should change the request status of 1, 3 and 6 to 2 actioned hence only need to see
# actioned and reissued as culture may still be available if reissued further down the line

$pkg->{ResultSQL} =  "	SELECT 	C.CLONENAME, 
				CC.ID_CULTURE, 
				DS.STATUS, 
				CC.DATE_STREAKED, 
				P.EMAIL, 
				G.ID_GLYSTOCK,
				CP.PRIORITY - 2, 
				DR.ID_REQUEST,  
				RD.DESCRIPTION
			FROM 	CHROMOSOMEDICT CD, CLONE C, GLYSTOCK G, CLONE_CULTURE CC, DNAREQUEST_STATUS DS, CLONE_PRIORITY CP,
				DNAPREP_REQUEST DR, DNAPREPREQSTATUSDICT RD, TEAM_PERSON_ROLE T, PERSON P, DNAPREP DP
			WHERE	CD.CHROMOSOME 		like 'VAR1'	 
			AND	CD.SPECIESNAME 		like 'VAR2'	
			AND	CD.ID_DICT 		= C.CHROMOSOME	
			AND	P.ID_PERSON		= T.ID_PERSON	
			AND	T.ID_ROLE		= CC.OPERATOR
			AND	CP.IS_CURRENT		= 1
			AND	CP.CLONENAME		= C.CLONENAME		
			AND	C.CLONENAME		= G.CLONENAME	
			AND	G.ID_GLYSTOCK		= CC.ID_GLYSTOCK
			AND	DS.STATUS 		IN (2,3)	
			AND	RD.ID_DICT		= DS.STATUS	
			AND	DS.ISCURRENT		= 1		
			AND	DR.ID_REQUEST 		= DS.ID_REQUEST
			AND	DR.ID_REQUEST		= CC.ID_REQUEST	
			AND	CC.DATE_STREAKED	< SYSDATE-0.5	
			AND	CC.ID_CULTURE 		= DP.ID_CULTURE (+)
			AND	DP.ID_CULTURE		IS NULL		
			AND	CC.IS_AVAILABLE		= 1		
			ORDER BY  DR.IS_FASTTRACK DESC, DS.STATUS DESC, DR.ID_REQUEST, CC.DATE_STREAKED";




$pkg->{Button1Label}	= 'Prepare Clones';
$pkg->{Duplicatecheck}	= 1;

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

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

$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Status";
while(length($pkg->{Columnheaders}) < 67)
	{$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'],[3,13,'Date Streaked'],[4,6,'By'],[8,10,'Status']];				
undef $pkg->{Selection};

		
$pkg->Addtobrowse();
undef @{$pkg->{Contents}};
$pkg->Refresh();
$pkg->{Title}->configure(-text => "Operator : $pkg->{Who}\tRole Type : $pkg->{Roletype}\t\tPREPARE STREAKED DNAprep REQUESTS");
				
						
}


sub Killprep
{

my $pkg = shift;
my $sql;
my @multisql;
my $radio = 'Poor Growth';
my $chk;
my $ref;
my @killrequest;



# Need To ask For Failure Reason;
$pkg->radiocheck(\$radio,'Poor Growth','Selected By Mistake','Invalid Glystock');
$pkg->{Mainwin}->waitVariable(\$radio);
if($radio !~ /\D/){return;}
if($radio =~ /^Poor/)
	{$radio = 3;} #RE ISSUE		
elsif($radio =~ /^Invalid Glystock/)
	{$radio = 7;} #RE SEND
else
	{$radio = 1;} #NOT STREAKED - REVERT				



foreach (@{$pkg->{Contents}})
{
# can only kill entries that are actioned NOT reissued
eval{
	if($_->[2] == 2)
	{
	# Check to see how many preps completed on request
	$sql = "SELECT 	COUNT(DNAPREP.ID_PREP)
		FROM 	DNAPREP, DNAPREP_STATUS, CLONE_CULTURE, DNAREQUEST_STATUS
		WHERE 	(DNAPREP_STATUS.STATUS		= 7)				AND
			(DNAPREP_STATUS.ISCURRENT	= 1)				AND
			(DNAPREP.ID_PREP 		= DNAPREP_STATUS.ID_PREP)	AND
			(CLONE_CULTURE.ID_CULTURE	= DNAPREP.ID_CULTURE)		AND
			(DNAREQUEST_STATUS.ID_REQUEST	= CLONE_CULTURE.ID_REQUEST)	AND
			(DNAREQUEST_STATUS.STATUS	= 2)				AND
			(DNAREQUEST_STATUS.ISCURRENT	= 1)				AND
			(DNAREQUEST_STATUS.ID_REQUEST	= $_->[7])";
			
	$ref = $pkg->Querydb($sql);
	my $completed = $ref->[0][0];
			
	# Check to see how many preps live on request
	$sql = "SELECT 	COUNT(DNAPREP.ID_PREP)
		FROM 	DNAPREP, DNAPREP_STATUS, CLONE_CULTURE, DNAREQUEST_STATUS
		WHERE 	(DNAPREP_STATUS.STATUS		< 7)				AND
			(DNAPREP_STATUS.ISCURRENT	= 1)				AND
			(DNAPREP.ID_PREP 		= DNAPREP_STATUS.ID_PREP)	AND
			(CLONE_CULTURE.ID_CULTURE	= DNAPREP.ID_CULTURE)		AND
			(DNAREQUEST_STATUS.ID_REQUEST	= CLONE_CULTURE.ID_REQUEST)	AND
			(DNAREQUEST_STATUS.STATUS	= 2)				AND
			(DNAREQUEST_STATUS.ISCURRENT	= 1)				AND
			(DNAREQUEST_STATUS.ID_REQUEST	= $_->[7])";

	$ref = $pkg->Querydb($sql);
	
	# Use zero as we are dealing with agar not preps
	# Reissue request all preps gone, can only remove culture records if there are no viable prep records on that culture
		if($ref->[0][0] == 0)
		{	
			if($radio == 1)
			{		
			# Glystock wasn't streaked
			$sql = "DELETE 	CLONE_CULTURE
				WHERE	CLONE_CULTURE.ID_CULTURE 	= $_->[1]";
				
			push @multisql,$sql;
			
			 
			# ROLLING BACK THE REQUEST STATUS to issued
			$sql = "DELETE 	DNAREQUEST_STATUS
				WHERE	ISCURRENT 	= 1 		AND 
					ID_REQUEST 	= $_->[7]";
					
			push @multisql,$sql;
			
			
			$sql = "UPDATE 	DNAREQUEST_STATUS
				SET 	ISCURRENT = 1
				WHERE	STATUSDATE IN (	SELECT MAX(STATUSDATE) 
							FROM DNAREQUEST_STATUS 
							WHERE ID_REQUEST = $_->[7] and ISCURRENT = 0) AND
					ID_REQUEST = $_->[7]";
					
			}
			else
			{
	
			$sql = "UPDATE 	CLONE_CULTURE 
				SET 	IS_AVAILABLE 			= 0 
				WHERE 	CLONE_CULTURE.ID_CULTURE 	= $_->[1]";
			
			push @multisql,$sql;
		
	
			$sql = "UPDATE 	DNAREQUEST_STATUS 
				SET 	ISCURRENT = 0 
				WHERE 	ISCURRENT = 1 AND ID_REQUEST = $_->[7]";
	
			push @multisql,$sql;
			
			# complete request as a prep has made it through else resend/reissue
			if($completed > 0){$radio = 4;}
			$sql = "INSERT INTO 	DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
				VALUES					($_->[7] , $radio, SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
			
			if($radio != 7){push @multisql,$sql;}
			
			# How many times streaked Failed
			$sql = "SELECT	COUNT(ID_CULTURE), ID_REQUEST
				FROM	CLONE_CULTURE
				WHERE	IS_AVAILABLE				=	0	AND
					CLONE_CULTURE.ID_REQUEST 		= $_->[7] 
				GROUP BY ID_REQUEST";
			$ref = $pkg->Querydb($sql);
			
			#If there has been more than two failures kill the request and get a new glycerol
			if(($ref->[0][0] > 0)||($radio == 7))
			{
			push @killrequest, $_;
			
			push @multisql,$sql;
			
			$sql = "UPDATE GLYSTOCK
				SET	IS_AVAILABLE 	= 0
				WHERE	ID_GLYSTOCK	= $_->[5] ";
			
			push @multisql,$sql;
			
			
			$sql = "UPDATE 	DNAREQUEST_STATUS 
				SET 	ISCURRENT = 0 
				WHERE 	ISCURRENT = 1 AND ID_REQUEST = $_->[7]";
	
			push @multisql,$sql;
			
			$sql = "INSERT INTO 	DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
				VALUES					($_->[7] , 7, SYSDATE,0, $$, 'DODO','$pkg->{Who}')";
			
			push @multisql,$sql;
			
			$sql = "INSERT INTO 	DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
				VALUES					($_->[7] , 5, SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
			
			}
			
			}
			push @multisql,$sql;
			$pkg->MultiWritedb(@multisql);
			
		}
		else
		{ 
		undef $chk;
		$pkg->Message("Cannot Reject Clone Culture, $_->[1] ($_->[0]). DNAprep Records already Exist",\$chk);
		$pkg->{Mainwin}->waitVariable(\$chk);
		}
	
	undef @multisql;
	}
	};if($@){print STDERR "Function	: Prepare::Killprep\nRequest ID	: $_->[7]\nCulture ID	: $_->[1]\n\n$@\n";}
}

# Decide whether to automatically ask for a new glycerol based on the number of streak failures (2)
undef @{$pkg->{Contents}};

if(@killrequest[0])
{
my $mail;

$pkg->{Contents} = \@killrequest;
$pkg->Projectstatus(2,1);

$sql = "SELECT 	CLONE.CLONENAME, CHROMOSOMEDICT.SPECIESNAME, CHROMOSOMEDICT.CHROMOSOME
	FROM	CHROMOSOMEDICT, CLONE
	WHERE	CHROMOSOMEDICT.ID_DICT = CLONE.CHROMOSOME		AND
		(";

foreach(@killrequest)
{
	$sql = "$sql\nCLONE.CLONENAME 		= '$_->[0]' OR";
}
$sql = substr($sql,0,length($sql)-2);
$sql = "$sql)ORDER BY CHROMOSOMEDICT.SPECIESNAME, CHROMOSOMEDICT.CHROMOSOME, CLONE.CLONENAME";

$ref = $pkg->Querydb($sql);

my $mail = "DNA Reception Require New Glycerols For the following Clones\nDue to problems streaking the existing material\n";
$mail = "$mail\nThe existing requests on these clones have been terminated\n";

$mail = $mail."Chr\tSpecies\tClone\n";
foreach(@{$ref})
{$mail = "$mail\n$_->[2]\t$_->[1]\t$_->[0]";}


open (MAIL,"|/usr/bin/mail fpgg");
print MAIL "From: DODO                <>\n";
print MAIL "To: fpgg\n";
print MAIL "Subject: DNA Reception Need Fresh Glycerols\n\n";
print MAIL $mail;
close(MAIL);
}

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



}







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

my $evening_preppers = {	10746 => 'ha1',
				14921 => 'ks2',
				14922 => 'lmb',
				14923 => 'sdm',
				14924 => 'sm2',
				13341 => 'jlc',
				14462 => 'kfc',
				18101 => 'bw1',
				18104 => 'trt'
				};


eval{

$pkg->Prepmethod(\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);
if($chk == 0)
	{return;}

# If an evening prepper....
if($evening_preppers->{$pkg->{Worker}})
{
	$status 	= 31;
	$operator 	= $evening_preppers->{$pkg->{Worker}};
}
else
{
	$status 	= 1;
	$operator 	= $pkg->{Who};
} 

	
# Go through selection
foreach (@{$pkg->{Contents}})
{

	# For each clone selected, find how many other times its been prepared
	$sql = "SELECT MAX (DNAPREP.PREP_NUMBER) FROM DNAPREP WHERE DNAPREP.CLONENAME = '$_->[0]'";

	$ref = $pkg->Querydb($sql);
	
	$ref->[0][0] = $ref->[0][0] + 1;
	
	#if(($ref->[0][0] + $pkg->{Replicates}) > 10)
	#	{
	#	undef $chk;
	#	$pkg->Message("Too Many Preps On this Clone, $_->[0]. Contact Bug",\$chk);
	#	$pkg->{Mainwin}->waitVariable(\$chk);
	#	return;
	#	}
	
# Use comments to tell worker what starting material to use. 
	for $i (1..$pkg->{Replicates})
	{
	
		# Now create a DNAPREP record
		$sql = "INSERT INTO 	DNAPREP (	ID_PREP, ID_CULTURE, PREP_NUMBER, PREP_TYPE, OPERATOR, BANDQUALITY,
							IS_PRIORITY, CLONENAME)
						
					VALUES	(	SEQ_DNAPREP.NEXTVAL,$_->[1],$ref->[0][0],$pkg->{Method}, $pkg->{Worker}, 1,$_->[6],'$_->[0]')"; 
	
		push @multisql,$sql;
	
		# Add a Status
	
		$sql = "INSERT INTO 	DNAPREP_STATUS	(ID_PREP, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
			VALUES				(SEQ_DNAPREP.CURRVAL,$status,SYSDATE,1, $$, 'DODO','$operator')";
		
		push @multisql,$sql;
	#Prep Number
	
	$ref->[0][0]++;	
	}

if($_->[2] != 2)
{
#re action request status
	$sql = "UPDATE 	DNAREQUEST_STATUS 
		SET 	ISCURRENT = 0 
		WHERE 	ISCURRENT = 1 AND ID_REQUEST = $_->[7]";
	
	push @multisql,$sql;

	# RE ACTION
	$sql = "INSERT INTO 	DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)			
		VALUES					($_->[7] , 2,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
					
	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;

if($pkg->{dbh}){$pkg->{dbh}->commit;}

# Cannot Delete or Update DNAPREP records only add therfore don't need to lock these tables
$sql = "	SELECT 	DNAPREP_REQUEST.ID_REQUEST 
		FROM 	DNAPREP_REQUEST, DNAREQUEST_STATUS, GLYSTOCK, CLONE_CULTURE
		WHERE	(CLONE_CULTURE.ID_GLYSTOCK	= GLYSTOCK.ID_GLYSTOCK)		AND
			(GLYSTOCK.ID_GLYSTOCK		= DNAPREP_REQUEST.ID_GLYSTOCK)	AND
			(DNAREQUEST_STATUS.ISCURRENT	= 1)				AND
			(DNAREQUEST_STATUS.ID_REQUEST	= DNAPREP_REQUEST.ID_REQUEST)	AND
			(";
			
$sql = "	SELECT	GLYSTOCK.ID_GLYSTOCK
		FROM 	CLONE_CULTURE, GLYSTOCK
		WHERE	GLYSTOCK.ID_GLYSTOCK = CLONE_CULTURE.ID_GLYSTOCK	AND
			(";	



			
foreach(@{$pkg->{Data}})
{
	$sql = "$sql\nCLONE_CULTURE.ID_CULTURE 		= $_->[1] OR";
}

$sql = substr($sql,0,length($sql)-2);

$sql = "$sql\n)FOR UPDATE NOWAIT";

#$sql = "select * from dnaprep where id_prep =1";
return $sql;

}






sub Prepmethod
{
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');
$pkg->{Method} = "PAC/BAC Maxi Prep (1)";
$pkg->{Replicates} = 1;


$win->Label(					-fg 		=> 'black',
						-bg 		=> 'lightblue',
						-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-text 		=> "Select Preparation Method",
						-anchor 	=> 'e',
						-height 	=> -1,
						-width 		=> 25,
						-relief 	=> 'flat'
					)->grid(-row 		=> 1, 
						-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->{Method},
						-browsecmd	=> sub {
									if($pkg->{Method} =~ /Robot/)
									{$pkg->{Replicates} = 1;}
									else{$pkg->{Replicates} = 1;
									#Reset method defaults to 1for ALL
									}
									$win->grab();}
						)->grid(-row 	=> 1, 
						-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	=> 5);
								
								
# What methods are available								
$sql = "SELECT DESCRIPTION FROM DNAPREPTYPEDICT";
$ref = $pkg->Querydb($sql);
$i = 1;
foreach (@{$ref})
	{$bw->insert('end',$_->[0]." ($i)");$i++;}
							
						

$win->Label(					-fg 		=> 'black',
						-bg 		=> 'lightblue',
						-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-text 		=> "Number Of Replicates",
						-anchor 	=> 'e',
						-height 	=> -1,
						-width 		=> 25,
						-relief 	=> 'flat'
					)->grid(-row 		=> 2, 
						-column	 	=> 1,
						-sticky 	=> 'we');
			
								
$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->{Replicates},
						-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);						


$bw->insert('end', '1','2','3','4');

$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 		=> 3, 
						-column	 	=> 1,
						-sticky 	=> 'we');


								
$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 	=> 3, 
						-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->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}};
									$pkg->{Method} =~ s/\D*//g;
									$$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;

