#######################################################################
# 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 Tk;
use dodo_postscript;
use dodo_utilities;
use dodo_DB_P001;
use NewBrowseEntry;
use vars qw(@ISA);
@ISA = qw(Postscript Utilities Database);

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

}



sub Display
{
my $pkg = 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 		=> 5,
					-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');
					
					
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");

$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])");


}				
	
$t = "Streak Worksheet";				

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

							
								
								
for(0..6)
{
	$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;						
							
								
								
								
								
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 $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.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]");
}	
$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 {if($t =~ /Streak Worksheet/)
									{$pkg->Streakworksheet($w, $d);}
								if($t =~ /Preparation Worksheet/)
									{$pkg->Prepworksheet($w, $d);}
								if($t =~ /Cloneplate/)
									{$pkg->Cloneplate($t, $w);}
								if($t =~ /Rack/)
									{$pkg->EppendorfRack($t, $w);}	
									
									},
				-relief 		=> 'raised'
			)->grid(-row 			=> 1, 
				-column 		=> 1,
				-sticky 		=> 'we');
						
$frame1->Button(		-fg 			=> 'black',
				-bg 			=> 'grey85',
				-width 			=> 10,
				-text 			=> "Print Labels",
				-anchor 		=> 'center',
				-state 			=> 'disabled',
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 	=> 'lemonchiffon1',
				-command 		=> sub {},
				-relief 		=> 'raised'
				)->grid(	-row 	=> 1, 
						-column => 2,
						-sticky => 'we');
						
$frame1->Button(		-fg 			=> 'red',
				-bg 			=> 'grey85',
				-width 			=> 10,
				-text 			=> "EXIT",
				-anchor 		=> 'center',
				-state 			=> 'normal',
				-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 => 3,
						-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
		FROM 	CLONE_CULTURE, GLYSTOCK, CLONEPLATE, CLONEWELL, 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
			(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};


my $sql = "	SELECT 	DNAPREP.ID_PREP, DNAPREP.CLONENAME, DNAPREP.PREP_NUMBER,DNAPREPTYPEDICT.DESCRIPTION
		FROM 	DNAPREP, DNAPREPTYPEDICT, DNAPREP_STATUS
		WHERE	(DNAPREPTYPEDICT.ID_DICT	= DNAPREP.PREP_TYPE)				AND
			(DNAPREP_STATUS.STATUSDATE	> to_date('$workdate','dd-Mon-yyyy') )		AND
			(DNAPREP_STATUS.STATUSDATE	< to_date('$workdate','dd-Mon-yyyy') + 1) 	AND
			(DNAPREP_STATUS.STATUS		= 1)						AND
			(DNAPREP_STATUS.ISCURRENT	= 1)						AND
			(DNAPREP_STATUS.ID_PREP		= DNAPREP.ID_PREP)				AND
			(DNAPREP.OPERATOR		= '$role')
		ORDER by DNAPREP.CLONENAME, DNAPREP.PREP_NUMBER";

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

if(@{$ref})
{ 	$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 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	< 	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 	= '$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 $desc;

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


my $sql = "	SELECT  	DNAPREP.CLONENAME, DNAPREP.PREP_NUMBER, DNAPREP.IS_PRIORITY, 
				DNAPREP.COMMENTS, MD.STATUSDATE
		FROM		DNAPREP, DNAPREP_STATUS QC, DNAPREP_STATUS MD
		WHERE		(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)
		ORDER BY DNAPREP.COMMENTS";
		
# The order of the STATUSDATE sets well order assuming no one messes with it in isolation		
$ref = $pkg->Querydb($sql);

foreach(@{$ref})
{	
$sql =	"	SELECT COUNT(DNAPREP.ID_PREP)
		FROM	DNAPREP, DNAPREP_STATUS
		WHERE	DNAPREP_STATUS.STATUS		= 1			AND
			DNAPREP_STATUS.ISCURRENT	= 1			AND
			DNAPREP_STATUS.ID_PREP		= DNAPREP.ID_PREP	AND
			DNAPREP.CLONENAME 		= '$_->[0]'";

	my $ref2 = $pkg->Querydb($sql);
	if($ref2->[0][0] > 0){$_->[0] = "* $_->[0]";}

	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];
	#print "split set [1] = $_->[1]\n";
$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 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;
}





1;
