#######################################################################
# 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 mainly are used to print reports for DNA reception  #
#                                                                     #
#######################################################################


package Labreport;
# use lib '/nfs/disk65/bsw/barcode';
use Tk;
use dodo_postscript;
use dodo_utilities;
use dodo_DB_P001;
use NewBrowseEntry;
use vars qw(@ISA);
use BarcodeRevised;
# use Ondemand_P001;
@ISA = qw(Postscript Utilities Database);

sub new
{
my $pkg = shift;
my $select ={};
bless $select,$pkg;
return $select;

}



sub Display
{
my $pkg 	 = shift;
my $unix_account = shift;

my $frame = $pkg->{Mainwin}->Frame(	-width 		=> 600,
					-height 	=> 300,
					-relief 	=> "ridge",
					-bg 		=> "gray85",
					-borderwidth 	=> 5
				)->grid(-row 		=> 1,
					-ipadx		=> 10,
					-ipady		=> 10,
					-column 	=> 1,
					-sticky 	=> 'we');
					
my $frame1 = $frame->Frame(		-width 		=> 100,
					-height 	=> 500,
					-relief 	=> "flat",
					-bg 		=> "gray85",
					-borderwidth 	=> 2
				)->grid(-row 		=> 6,
					-column 	=> 1,
					-columnspan	=> 2,
					-ipady		=> 20,
					-sticky 	=> 's');
					
					
$frame->Label(				-fg 		=> 'blue1',
					-bg 		=> 'grey85',
					-font 		=> '-adobe-helvetica-medium-r-normal--20-140-100-100-p-100-iso8859-1',
					-text 		=> "DNAprep Laboratory Reporter",
					-anchor 	=> 'n',
					-height 	=> 2,
					-width 		=> 10,
					-relief 	=> 'flat'
				)->grid(-row 		=> 1, 
					-column	 	=> 1,
					-columnspan 	=> 2,
					-sticky 	=> 'we');		


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

$frame->Label(				-fg 		=> 'black',
					-bg 		=> 'grey85',
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-text 		=> "Assignment Date",
					-anchor 	=> 'e',
					-height 	=> -1,
					-width 		=> 20,
					-relief 	=> 'flat'
				)->grid(-row 		=> 3, 
					-column	 	=> 1,
					-sticky 	=> 'we');
					
$frame->Label(				-fg 		=> 'black',
					-bg 		=> 'grey85',
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-text 		=> "Assigned To",
					-anchor 	=> 'e',
					-height 	=> -1,
					-width 		=> 20,
					-relief 	=> 'flat'
				)->grid(-row 		=> 4, 
					-column	 	=> 1,
					-sticky 	=> 'we');
					
$frame->Label(				-fg 		=> 'black',
					-bg 		=> 'grey85',
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-text 		=> "Plates",
					-anchor 	=> 'e',
					-height 	=> -1,
					-width 		=> 20,
					-relief 	=> 'flat'
				)->grid(-row 		=> 5, 
					-column	 	=> 1,
					-sticky 	=> 'we');
					
					
my $t;					
my $task = $frame->BrowseEntry(		-width 		=> 38,
					-fg 		=> 'blue1',
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-state 		=> 'readonly',
					-variable	=> \$t
				)->grid(-row 		=> 2,
					-column 	=> 2,
					-sticky 	=> 'we');
					
$task->Subwidget("slistbox")->Subwidget("listbox")->configure(	-font 	=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
								-height	=> 3,
								-fg 	=> 'blue1');



$task->insert('end',"Streak Worksheet", "Preparation Worksheet","ReAssigned Worksheet");
				
$t = "Preparation Worksheet";				

my $d;
my $date = $frame->BrowseEntry(		-width 		=> 38,
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-state 		=> 'normal',
					-variable	=> \$d
				)->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');

$date->Subwidget("entry")->Subwidget("entry")->configure(	-font 	=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
								-bg 	=> 'lemonchiffon1',
								-fg	=> 'black',);

$date->configure( -listcmd => sub {$pkg->Calculatedates(\$date);});
									
$d = join '-',	(localtime(time))[3],
		('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC')[(localtime(time))[4]],
		(localtime(time))[5] + 1900;					
# add list popolation here								
								
if(length($d) == 10){$d = "0$d";}								
								
my $w;								
my $worker = $frame->BrowseEntry(	-width 		=> 38,
					-fg 		=> 'blue1',
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-state 		=> 'readonly',
					-variable	=> \$w
				)->grid(-row 		=> 4,
					-column 	=> 2,
					-sticky 	=> 'we');
					
$worker->Subwidget("slistbox")->Subwidget("listbox")->configure(-font 	=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
								-height => 5,
								-fg 	=> 'blue1');
								
my $pl;								
my $plates = $frame->BrowseEntry(	-width 		=> 38,
					-fg 		=> 'blue1',
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-state 		=> 'readonly',
					-variable	=> \$pl
				)->grid(-row 		=> 5,
					-column 	=> 2,
					-sticky 	=> 'we');
					
$plates->Subwidget("slistbox")->Subwidget("listbox")->configure(-font 	=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
								-height => 5,
								-fg 	=> 'blue1');
								
$plates->configure( -listcmd => sub {$pkg->Gettasks(\$plates);});
								
my $ref;
my $sql;

$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.TEAMNAME = '53')				AND
		(TEAM_PERSON_ROLE.ROLETYPE 	= 'Subcloning')			AND	
		(TEAM_PERSON_ROLE.ISCURRENT	= 1)
	ORDER BY PERSON.EMAIL";

#$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
#		PERSON.EMAIL			IN ('mcj','ha1','aef','sjt','mmb','ks2','sdm','sm2','lmb','trt','jlc','kfc','bw1','wgl','aps','mmh') 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]";
	$worker->insert('end',"$_->[2] $_->[3]");
}	
my $exitstate;

if($unix_account eq 'dodo')
{
	$exitstate = 'disabled';
	$w = $pkg->{$ref->[0][0]};
}
else
{
	$exitstate = 'normal';
	$w = $pkg->{$pkg->{Who}};
}



$frame1->Button(		-fg 			=> 'black',
				-bg 			=> 'grey85',
				-width 			=> 10,
				-text 			=> "Print Task",
				-anchor 		=> 'center',
				-state 			=> 'normal',
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 	=> 'lemonchiffon1',
				-command 		=> sub {
								$d = uc($d);
								if($pkg->Checkdates($d) < 0)
								{
								my $chk;
								$pkg->Message("Invalid Date Format, $d\n\nDate must be in the form DD-MON-YYYY",\$chk);
								$pkg->{Mainwin}->waitVariable(\$chk);
								return;
								}
				
								if($t =~ /Streak Worksheet/)
									{$pkg->Streakworksheet($w, $d);}
								if($t =~ /Preparation Worksheet/)
									{$pkg->Prepworksheet($w, $d);}
								if($t =~ /ReAssigned Worksheet/)
									{$pkg->Reassignedworksheet($w, $d);}
								},
				-relief 		=> 'raised'
			)->grid(-row 			=> 1, 
				-column 		=> 1,
				-sticky 		=> 'we');
						
$frame1->Button(		-fg 			=> 'black',
				-bg 			=> 'grey85',
				-width 			=> 10,
				-text 			=> "Print Labels",
				-anchor 		=> 'center',
				-state 			=> 'normal',
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 	=> 'lemonchiffon1',
				-command 		=> sub {if($t =~ /Streak Worksheet/)
								{
								eval{
								$d = uc($d);
								if($pkg->Checkdates($d) < 0)
								{
								my $chk;
								$pkg->Message("Invalid Date Format, $d\n\nDate must be in the form DD-MON-YYYY",\$chk);
								$pkg->{Mainwin}->waitVariable(\$chk);
								return;
								}
								$pkg->Streaklabels($w,$pkg->{$w},$d);
								};if($@){print STDERR "$@ \n"; return;}
								}
								if($t =~ /Preparation Worksheet/)
								{
								eval{
								$pkg->Preplabels($w,$pkg->{$w},$d);
								};if($@){print STDERR "$@ \n"; return;}
								
								}
								if($t =~ /ReAssigned Worksheet/)
								{
								eval{
								$pkg->Preplabels($w,$pkg->{$w},$d,1);
								};if($@){print STDERR "$@ \n"; return;}
								
								}
								
								
								
								
								
								
								
								},
				-relief 		=> 'raised'
				)->grid(	-row 	=> 1, 
						-column => 2,
						-sticky => 'we');

$frame1->Button(		-fg 			=> 'Black',
				-bg 			=> 'grey85',
				-width 			=> 10,
				-text 			=> "Print Plate",
				-anchor 		=> 'center',
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground	=> 'lemonchiffon1',
				-activeforeground	=> 'red',
				-command 		=> sub {
								if($pl =~ /Cloneplate/)
									{$pkg->Cloneplate($pl, $w);}
								if($pl =~ /Rack/)
									{$pkg->EppendorfRack($pl, $w);}
								},
				-relief 		=> 'raised'
				)->grid(	-row 	=> 1, 
						-column => 3,
						-sticky => 'we');
					
$frame1->Button(		-fg 			=> 'red',
				-bg 			=> 'grey85',
				-width 			=> 10,
				-text 			=> "EXIT",
				-anchor 		=> 'center',
				-state 			=> $exitstate,
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground	=> 'lemonchiffon1',
				-activeforeground	=> 'red',
				-command 		=> sub {$pkg->{dbh}->disconnect; print "To sleep...Prechance To dream\n"; exit;},
				-relief 		=> 'raised'
				)->grid(	-row 	=> 1, 
						-column => 4,
						-sticky => 'we');



}




sub Streakworksheet
{
my ($pkg, $worker, $workdate)	= @_; 
my $f = 'ddMonyyyy';
my $chk;
my $role = $worker;
#$worker =~ s/[(]|[)]| |\d*//g;
#$role =~ s/\D*//g;
#$worker = $pkg->{$worker};
$role = $pkg->{$worker};

my $sql = "	SELECT 	CLONE_CULTURE.ID_CULTURE, 
			GLYSTOCK.CLONENAME, 
			CLONEPLATE.ID_CLONEPLATE,
			CLONEPLATE.DESCRIPTION, 
			UPPER(ROWCOL_MAP.MAPROW), 
			ROWCOL_MAP.MAPCOL,
			CHROMOSOMEDICT.SPECIESNAME,
			CHROMOSOMEDICT.CHROMOSOME
		FROM 	CLONE_CULTURE, GLYSTOCK, CLONEPLATE, CLONEWELL, ROWCOL_MAP, CLONE, CHROMOSOMEDICT
		WHERE	(ROWCOL_MAP.ID_MAP		= CLONEWELL.ID_MAP)				AND
			(CLONEPLATE.ID_CLONEPLATE	= CLONEWELL.ID_CLONEPLATE)			AND
			(CLONEWELL.ID_GLYSTOCK		= GLYSTOCK.ID_GLYSTOCK)				AND
			CHROMOSOMEDICT.ID_DICT		= CLONE.CHROMOSOME			AND
			CLONE.CLONENAME 		= GLYSTOCK.CLONENAME			AND
			(GLYSTOCK.ID_GLYSTOCK		= CLONE_CULTURE.ID_GLYSTOCK)			AND
			(CLONE_CULTURE.DATE_STREAKED	> to_date('$workdate','dd-Mon-yyyy'))		AND
			(CLONE_CULTURE.DATE_STREAKED	< to_date('$workdate','dd-Mon-yyyy') + 1) 	AND
			(CLONE_CULTURE.IS_AVAILABLE 	= 1)						AND
			(CLONE_CULTURE.OPERATOR		= '$role')
		ORDER BY CLONEPLATE.ID_CLONEPLATE, ROWCOL_MAP.MAPROW, ROWCOL_MAP.MAPCOL";

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

if(@{$ref})
{ 	$pkg->Setprinter("Select A Printer\n",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	if($chk == 1)
	{$pkg->Printstreaks(\$ref, $worker, $workdate);}
	
}else
{
	$pkg->Message("Sorry, There Is No Worksheet For $worker On $workdate",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
}



}

sub Prepworksheet
{
my ($pkg, $worker, $workdate)	= @_; 
my $chk;
my $role = $worker;
my $f = 'ddMonyyyy';

#$worker =~ s/[(]|[)]| |\d*//g;
#$role =~ s/\D*//g;
$role = $pkg->{$worker};


# Allow For Evening Preppers

my $status;
my $evening_preppers = {	10746 => 'ha1',
				14921 => 'ks2',
				14922 => 'lmb',
				14923 => 'sdm',
				14924 => 'sm2',
				13341 => 'jlc',
				14462 => 'kfc',
				18101 => 'bw1',
				18104 => 'trt'
				};				
			
# If an evening prepper....
if($evening_preppers->{$role})
{
	$status 	= 31;
}
else
{
	$status 	= 1;
} 	

#warn "Evening Prepper Version $workdate, $role, $status\n";
my $sql;
if($evening_preppers->{$role})
{

$sql = "	SELECT 	DNAPREP.ID_PREP, DNAPREP.CLONENAME, 
			DNAPREP.PREP_NUMBER,
			DNAPREPTYPEDICT.DESCRIPTION,
			CHROMOSOMEDICT.SPECIESNAME,
			CHROMOSOMEDICT.CHROMOSOME
		FROM 	DNAPREP, DNAPREPTYPEDICT, DNAPREP_STATUS, CLONE, CHROMOSOMEDICT
		WHERE	(DNAPREPTYPEDICT.ID_DICT	= DNAPREP.PREP_TYPE)			AND
			TO_CHAR(DNAPREP_STATUS.STATUSDATE,'DD-MON-YYYY') = '$workdate'		AND
			CHROMOSOMEDICT.ID_DICT		= CLONE.CHROMOSOME			AND
			CLONE.CLONENAME 		= DNAPREP.CLONENAME			AND
			(DNAPREP_STATUS.STATUS		= 31)				AND
			(DNAPREP_STATUS.ID_PREP		= DNAPREP.ID_PREP)			AND
			(DNAPREP.OPERATOR		= $role)
		ORDER BY DNAPREP.CLONENAME, DNAPREP.PREP_NUMBER";
}
else
{		
$sql = "	SELECT 	D.ID_PREP, D.CLONENAME, 
			D.PREP_NUMBER,
			DD.DESCRIPTION,
			CD.SPECIESNAME,
			CD.CHROMOSOME
		FROM 	DNAPREP D, DNAPREPTYPEDICT DD, DNAPREP_STATUS DS, CLONE C, CHROMOSOMEDICT CD
		WHERE	DD.ID_DICT				= D.PREP_TYPE					
		AND	CD.ID_DICT				= C.CHROMOSOME			
		AND	C.CLONENAME 				= D.CLONENAME
		AND	NOT EXISTS (	SELECT 	'X' 
					FROM 	DNAPREP_STATUS R 
					WHERE 	R.STATUS	= 31
					AND	R.ID_PREP	= DS.ID_PREP)
		AND	TO_CHAR(DS.STATUSDATE,'DD-MON-YYYY')	= '$workdate'
		AND	DS.STATUS				= 1				
		AND	DS.ID_PREP				= D.ID_PREP			
		AND	D.OPERATOR				= $role
		ORDER BY D.CLONENAME, D.PREP_NUMBER";
}		
my $ref = $pkg->Querydb($sql);



if($ref->[0][0])
{ 	$pkg->Setprinter("Select A Printer\n",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	if($chk == 1)
	{$pkg->Printpreps(\$ref, $worker, $workdate);}
	
}else
{
	$pkg->Message("Sorry, There Is No Worksheet For $worker On $workdate",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
}



}

sub Reassignedworksheet {
my ($pkg, $worker, $workdate)	= @_; 
my $chk;
my $role = $worker;
my $f = 'ddMonyyyy';

#$worker =~ s/[(]|[)]| |\d*//g;
#$role =~ s/\D*//g;
$role = $pkg->{$worker};

#warn "Evening Prepper Version $workdate, $role, $status\n";



my $sql = "	SELECT 	D.ID_PREP, D.CLONENAME, 
			D.PREP_NUMBER,
			DD.DESCRIPTION,
			CD.SPECIESNAME,
			CD.CHROMOSOME
		FROM 	DNAPREP D, DNAPREPTYPEDICT DD, DNAPREP_STATUS DS, CLONE C, CHROMOSOMEDICT CD, DNAPREP_STATUS R
		WHERE	DD.ID_DICT				= D.PREP_TYPE					
		AND	CD.ID_DICT				= C.CHROMOSOME			
		AND	C.CLONENAME 				= D.CLONENAME
		AND	R.STATUS				= 31
		AND	R.ID_PREP				= DS.ID_PREP			
		AND	TO_CHAR(DS.STATUSDATE,'DD-MON-YYYY')	= '$workdate'
		AND	DS.STATUS				= 1				
		AND	DS.ID_PREP				= D.ID_PREP			
		AND	D.OPERATOR				= $role
		ORDER BY D.CLONENAME, D.PREP_NUMBER";

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



if($ref->[0][0])
{ 	$pkg->Setprinter("Select A Printer\n",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	if($chk == 1)
	{$pkg->Printpreps(\$ref, "$worker (REASSIGNED FROM EVENING PREPPER)", $workdate);}
	
}else
{
	$pkg->Message("Sorry, There Is No ReAssigned Preps\nFor $worker On $workdate",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
}



}

sub Cloneplate
{
my ($pkg, $p, $w) = @_;
my $desc;

($p,$desc) = split /[(]|[)]/,$p;
$p =~ s/\D*//g;



my $sql = "	SELECT  	GLYSTOCK.CLONENAME, CLONEWELL.ID_MAP, DNAPREP_REQUEST.IS_FASTTRACK
		FROM		CLONEWELL, GLYSTOCK, DNAPREP_REQUEST, DNAREQUEST_STATUS
		WHERE		(DNAREQUEST_STATUS.STATUS	NOT IN (4,5))				AND
				(DNAREQUEST_STATUS.ISCURRENT	=	1)				AND
				(DNAREQUEST_STATUS.ID_REQUEST	=	DNAPREP_REQUEST.ID_REQUEST)	AND
				(DNAPREP_REQUEST.ID_GLYSTOCK	= 	GLYSTOCK.ID_GLYSTOCK)		AND
				(GLYSTOCK.IS_AVAILABLE		=	1)				AND
				(GLYSTOCK.ID_GLYSTOCK 		=	CLONEWELL.ID_GLYSTOCK)		AND
				(CLONEWELL.ID_CLONEPLATE 	= '$p')";
				
my $ref = $pkg->Querydb($sql);
if(@{$ref})
{ 	$pkg->Setprinter("Select A Printer\n",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	if($chk == 1)
	{$pkg->Printplate($p,$desc, $w,@{$ref});}
	
}else
{
	$pkg->Message("Sorry, There Is No Viable Glystocks In Cloneplate $p",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
}


}


sub EppendorfRack
{
my ($pkg, $p, $w) = @_;
my $i = 1;
my $ref;
my $ref2;

my $desc;

($p,$desc) = split /[(]|[)]/,$p;


my $sql = "	SELECT  	DNAPREP.CLONENAME, 
				DNAPREP.PREP_NUMBER, 
				CP.PRIORITY - 1, 
				DNAPREP.COMMENTS, 
				MD.STATUSDATE, 
				'Chr - '||CD.CHROMOSOME,
				DNAPREP.ID_PREP,
				P.EMAIL
		FROM		DNAPREP, DNAPREP_STATUS QC, DNAPREP_STATUS MD, CLONE C, 
				CHROMOSOMEDICT CD, CLONE_PRIORITY CP, TEAM_PERSON_ROLE TPR, PERSON P
		WHERE		P.ID_PERSON		= TPR.ID_PERSON		AND
				TPR.ID_ROLE			= DNAPREP.OPERATOR	AND
				CD.ID_DICT			= C.CHROMOSOME		AND
				C.CLONENAME			= DNAPREP.CLONENAME	AND
				CP.IS_CURRENT			= 1			AND
				CP.CLONENAME			= DNAPREP.CLONENAME	AND
				(DNAPREP.COMMENTS		like '$desc%')		AND
				(DNAPREP.ID_PREP = MD.ID_PREP) 			AND
				(MD.STATUS		= 1)				AND
				(MD.ID_PREP		= QC.ID_PREP)		AND
				(QC.STATUS		= 2)			AND
				(QC.ISCURRENT 		= 1)";



		
# The order of the STATUSDATE sets well order assuming no one messes with it in isolation		
$ref = $pkg->Querydb($sql);







foreach(@{$ref})
{

$sql = "	SELECT 	EP.OPERATOR
		FROM 	DNAPREP_STATUS EP
		WHERE	EP.STATUS 	= 31
		AND	EP.ID_PREP 	= $_->[6]
		AND 	ROWNUM 		= 1";
		
my $ep = $pkg->Querydb($sql);

if($ep->[0][0]){$_->[6] = $ep->[0][0];}else{$_->[6] = '--';}


	$_->[6] =~ s/ //g;
	$_->[7] =~ s/ //g;
	
	if(length($_->[0]) < 8){$_->[0] = "$_->[0]-$_->[1]";}
	else{while(length($_->[0]) < 11){$_->[0] = "$_->[0] ";} $_->[0] = "$_->[0]-$_->[1]";}
	
	
	
	while(length($_->[0]) < 22){$_->[0] = "$_->[0] ";}
	
	$_->[0] = "$_->[0]$_->[4]";
	
	($_->[1], $_->[1]) = split /-/,$_->[3];
	
	
	
$i++;
}				

if(@{$ref})
{ 	$pkg->Setprinter("Select A Printer",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	if($chk == 1)
	{#
	$pkg->Generalsort(\$ref,3);
	$pkg->Printplate("Gell Check Plate",$desc, $w,@{$ref});
	$pkg->Gellreport(\$ref,$w,$desc);
	}
	
}else
{
	$pkg->Message("Sorry, There Is No Viable Eppendorfs In Rack $p",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
}


}


sub Preplabels
{

my ($pkg,$worker, $role, $workdate, $reassign) = @_;
my $chk;



# Allow For Evening Preppers

my $status = 1;
#my $evening_preppers = {	10746 => 'Arbery',
#				14921 => 'Safdar',
#				14922 => 'Beard',
#				14923 => 'Miles',
#				14924 => 'Mclaren'};
				
my $evening_preppers = {	10746 => 'ha1',
				14921 => 'ks2',
				14922 => 'lmb',
				14923 => 'sdm',
				14924 => 'sm2',
				13341 => 'jlc',
				14462 => 'kfc',
				18101 => 'bw1',
				18104 => 'trt'
				}; 			

# If an evening prepper....
if($evening_preppers->{$role})
{	$sql = "SELECT 	DNAPREP.ID_PREP,
			DNAPREP.CLONENAME, 
			DNAPREP.PREP_NUMBER,
			DNAPREPTYPEDICT.DESCRIPTION,
			DNAPREP_STATUS.STATUS,
			DNAPREP_STATUS.STATUSDATE,
			CHROMOSOMEDICT.CHROMOSOME
		FROM	DNAPREP, DNAPREP_STATUS, DNAPREPTYPEDICT, CLONE, CHROMOSOMEDICT
		WHERE	TO_CHAR(DNAPREP_STATUS.STATUSDATE,'DD-MON-YYYY') = '$workdate'		AND
			CHROMOSOMEDICT.id_DICT		= CLONE.CHROMOSOME			AND
			CLONE.CLONENAME			= DNAPREP.CLONENAME			AND
			DNAPREP_STATUS.STATUS		= 31					AND
			DNAPREP_STATUS.ID_PREP 		= DNAPREP.ID_PREP			AND
			DNAPREPTYPEDICT.ID_DICT		= DNAPREP.PREP_TYPE			AND
			DNAPREP.OPERATOR		= $role
		ORDER BY DNAPREP.CLONENAME, DNAPREP.PREP_NUMBER";
		$status = 31;
}
elsif($reassign)
{
	$sql = "SELECT 	D.ID_PREP, 
			D.CLONENAME, 
			D.PREP_NUMBER,
			DD.DESCRIPTION,
			DS.STATUS,
			DS.STATUSDATE,
			CD.CHROMOSOME
		FROM 	DNAPREP D, DNAPREPTYPEDICT DD, DNAPREP_STATUS DS, CLONE C, CHROMOSOMEDICT CD, DNAPREP_STATUS R
		WHERE	DD.ID_DICT				= D.PREP_TYPE					
		AND	CD.ID_DICT				= C.CHROMOSOME			
		AND	C.CLONENAME 				= D.CLONENAME
		AND	R.STATUS				= 31
		AND	R.ID_PREP				= DS.ID_PREP			
		AND	TO_CHAR(DS.STATUSDATE,'DD-MON-YYYY')	= '$workdate'
		AND	DS.STATUS				= 1				
		AND	DS.ID_PREP				= D.ID_PREP			
		AND	D.OPERATOR				= $role
		ORDER BY D.CLONENAME, D.PREP_NUMBER";
}
else
{
	$sql = "SELECT 	D.ID_PREP, 
			D.CLONENAME, 
			D.PREP_NUMBER,
			DD.DESCRIPTION,
			DS.STATUS,
			DS.STATUSDATE,
			CD.CHROMOSOME
		FROM 	DNAPREP D, DNAPREPTYPEDICT DD, DNAPREP_STATUS DS, CLONE C, CHROMOSOMEDICT CD
		WHERE	DD.ID_DICT				= D.PREP_TYPE					
		AND	CD.ID_DICT				= C.CHROMOSOME			
		AND	C.CLONENAME 				= D.CLONENAME
		AND	NOT EXISTS (	SELECT 	'X' 
					FROM 	DNAPREP_STATUS R 
					WHERE 	R.STATUS	= 31
					AND	R.ID_PREP	= DS.ID_PREP)
		AND	TO_CHAR(DS.STATUSDATE,'DD-MON-YYYY')	= '$workdate'
		AND	DS.STATUS				= 1				
		AND	DS.ID_PREP				= D.ID_PREP			
		AND	D.OPERATOR				= $role
		ORDER BY D.CLONENAME, D.PREP_NUMBER";
}


	
my $preps = $pkg->Querydb($sql);

if(!$preps->[0][0])
{
	$pkg->Message("Sorry Could Not Find Any Labels to Print\n",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	return;
}

my $ref;
my $label 	= Barcode->new($pkg->{dbh});

$label->User($worker);
$label->Type('DR');		
$label->Printer("d336bc1");

foreach $ref(@{$preps})
{
my $mark;


$label->Barcode($ref->[0]);
$label->Name("$ref->[1]");
$label->Suffix("-$ref->[2] ($ref->[6])");

if($reassign){$mark = ' (EP)';}
if($status == 1)
{			
	$label->Owner("$ref->[3]");
	$label->Project("$ref->[1]-$ref->[2]$mark");  	# optional
}
else
{
	$label->Owner("By $evening_preppers->{$role}");
	$label->Project("$ref->[1]-$ref->[2] SEMI PREP");  	# optional
}

$label->Date("$ref->[5]");

my $bw = $label->Date();
$label->Labellist();	
}

$label->Printlabel();
my $p = $label->Printer();
my $t = $label->Type();
$pkg->Message("Labels Sent To Printer\n\n$p $t",\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);	

	

}

sub Streaklabels {
my ($pkg,$worker, $role, $workdate) = @_;

my $sql = "	SELECT 	CLONE_CULTURE.ID_CULTURE,
			GLYSTOCK.CLONENAME,
			UPPER(TRACKING.CLONEPLATE.DESCRIPTION||' ('||TRACKING.ROWCOL_MAP.MAPROW||TRACKING.ROWCOL_MAP.MAPCOL||')')
		FROM	TRACKING.CLONE_CULTURE, TRACKING.GLYSTOCK, TRACKING.CLONEPLATE, TRACKING.CLONEWELL, TRACKING.ROWCOL_MAP
		WHERE	(ROWCOL_MAP.ID_MAP		= CLONEWELL.ID_MAP)				AND
			(CLONEPLATE.ID_CLONEPLATE	= CLONEWELL.ID_CLONEPLATE)			AND
			(CLONEWELL.ID_GLYSTOCK		= GLYSTOCK.ID_GLYSTOCK)				AND
			(GLYSTOCK.ID_GLYSTOCK		= CLONE_CULTURE.ID_GLYSTOCK)			AND
			TO_CHAR(CLONE_CULTURE.DATE_STREAKED,'DD-MON-YYYY') = '$workdate'		AND
			(CLONE_CULTURE.IS_AVAILABLE 	= 1)						AND
			(CLONE_CULTURE.OPERATOR		= $role)
		ORDER BY CLONEPLATE.ID_CLONEPLATE, ROWCOL_MAP.MAPROW, ROWCOL_MAP.MAPCOL";





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

if(!$ref->[0][0])
{
	$pkg->Message("Sorry Could Not Find Any Labels to Print\n",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	return;
}



my $label 	= Barcode->new($pkg->{dbh});
$label->Type('DS');			# required
$label->Quantity(1);			# optional defaults to 1
$label->User($pkg->{Who});
$label->Printer('d336bc2');

foreach (@{$ref})
{
$label->Barcode($_->[0]);			
$label->Name("$_->[1]");     			# optional
$label->Suffix($worker);
$label->Date($workdate);
$label->Project("$_->[2]");  		# optional
$label->Labellist();				# Required

}


$label->Printlabel();
my $p = $label->Printer();
$pkg->Message("Labels Sent To Printer\n\n$p",\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);	

}

sub Generalsort
{
my ($pkg,$data,$field) = @_;


my @sorted = sort {
		my $A;
		my $B;
		my $num_a;
		my $num_b;
		
		
		
		$A = $a->[$field];
		#if($A =~ m/(\d+)/g){$num_a = $1;}
		$num_a = $A;
		$num_a =~ s/\D//g;
		
		$B = $b->[$field];
		#if($B =~ m/(\d+)/g){$num_b = $1;}
		$num_b = $B;
		$num_b =~ s/\D//g;
		
		if(($num_a)&&($num_b))
		{
		$num = 0;
		if($num_a > $num_b){$num = 1;}
		if($num_a < $num_b){$num = -1;}
		}
		elsif($num_a){$num = 1;}
		elsif($num_b){$num = -1;}
		else{$num = 0;}
		
		$l = length($a->[$field]);
		
		if(length($b->[$field]) < $l){$l = length($b->[$field]);}
		
		for $i(0..$l)
		{
		$A = uc(substr($a->[$field],$i,1));
		$B = uc(substr($b->[$field],$i,1));
		
		if($A ne $B)
		{
		
			if(($A =~ m/^\d/)&&($B !~ m/^\d/))
			{	
				$B = ord($B);
				$A = $B + 1;
				
			}elsif(($A !~ m/^\d/)&&($B =~ m/^\d/))
			{	
				$A = ord($A);
				$B = $A + 1;
				
			}elsif(($A =~ m/^\d/)&&($B =~ m/^\d/))
			{	
				
				$A = ord($A);
				$B = ord($B);
				
				if($num == -1){$B = $A + 1;}
				if($num == 1){$A = $B + 1;}
			}else
			{
				
				$A = ord($A);
				$B = ord($B);
			
			}
		
		last;
		}
		}
		
	
		return ($A <=> $B);
		
		} @{$$data};
	
$$data = \@sorted;
}

sub Calculatedates {								
my ($pkg, $date) = @_;
my $d;

$$date->delete(0,'end');
						
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;	
	if(length($d) == 10){$d = "0$d";}			
	$$date->insert('end',$d);
}

							
}

sub Checkdates {
my ($pkg, $date) = @_;

my ($d,$m,$y) = split /-/, $date, 3;

if(($d < 0)||($d > 31)){return -1;}
if(($y < 1000)||($y > 9999)){return -1;}
if(index("JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC", $m) == -1){return -1;}

return 1; 

}


sub Gettasks {
my ($pkg, $task) = @_;

$$task->delete(0,'end');

$sql = "	SELECT 	DISTINCT SUBSTR(DNAPREP.COMMENTS,1,INSTR(COMMENTS,'-')-1) 
		FROM 	DNAPREP, DNAPREP_STATUS
		WHERE 	DNAPREP_STATUS.STATUS		= 2			AND
			DNAPREP_STATUS.ISCURRENT	= 1			AND
			DNAPREP_STATUS.ID_PREP 		= DNAPREP.ID_PREP 	AND
			DNAPREP.COMMENTS IS NOT NULL";

eval{
$ref = $pkg->Querydb($sql);
};if($@){print STDERR "$@ \n"; return;}

$pkg->Generalsort(\$ref,1);

foreach(@{$ref})
{
	if($_->[0]){$$task->insert('end',"Eppendorf Rack ($_->[0])")};
}

								
$sql = "	SELECT  	CLONEPLATE.ID_CLONEPLATE, CLONEPLATE.DESCRIPTION 
		FROM		CLONEPLATE, CLONEPLATE_STATUS, CLONEWELL, GLYSTOCK, DNAPREP_REQUEST,
				DNAREQUEST_STATUS
		WHERE		(	DNAREQUEST_STATUS.STATUS	< 4 OR
					DNAREQUEST_STATUS.STATUS	> 5)			AND
				(DNAREQUEST_STATUS.ISCURRENT	= 1)				AND
				(DNAREQUEST_STATUS.ID_REQUEST	= DNAPREP_REQUEST.ID_REQUEST)	AND
				(DNAPREP_REQUEST.ID_GLYSTOCK	= 	GLYSTOCK.ID_GLYSTOCK)	AND
				(GLYSTOCK.IS_AVAILABLE		=	1)			AND
				(GLYSTOCK.ID_GLYSTOCK		= CLONEWELL.ID_GLYSTOCK)	AND
				(CLONEWELL.ID_CLONEPLATE	= CLONEPLATE.ID_CLONEPLATE)	AND
				(CLONEPLATE.ID_CLONEPLATE 	= CLONEPLATE_STATUS.ID_CLONEPLATE)	AND
				(CLONEPLATE_STATUS.STATUS 	= 3)					AND
				(CLONEPLATE_STATUS.ISCURRENT 	= 1)
		GROUP BY	CLONEPLATE.ID_CLONEPLATE, CLONEPLATE.DESCRIPTION
		ORDER BY 	CLONEPLATE.ID_CLONEPLATE DESC";
		
$ref = $pkg->Querydb($sql);

foreach(@{$ref})
{
	$$task->insert('end',"Cloneplate $_->[0] ($_->[1])");
}
				
}















1;
