
[tag flag write]transactions[/tag]
[perl tables=transactions]
	delete $Scratch->{ui_location};
	my $db = $Db{transactions};
	if(! $db) {
		$Scratch->{ui_error} = "<FONT CLASS=error>Error: no transactions database.</FONT><BR>";
		$Scratch->{ui_location} = $Tag->area("__UI_BASE__/error");
		return;
	}

	my ($value, $action_col);
	if($CGI->{archiveorder}) {
		$value = 1;
		$action_col = 'archived';
	}
	elsif($CGI->{unarchiveorder}) {
		$value = 0;
		$action_col = 'archived';
	}
	elsif($CGI->{deleteorder} and $Scratch->{can_delete}) {
		$value = 1;
		$action_col = 'deleted';
	}
	elsif($CGI->{vieworder} and ! $CGI->{viewnext}) {
		$CGI->{order} =~ s/^\0+//;
		$CGI->{order} =~ s/\0+$//;
		$Scratch->{ui_location} = $Tag->area('__UI_BASE__/order_view', $CGI->{order});
	}
	elsif($CGI->{xload}) {
		$Scratch->{ui_location} = $Tag->area('__UI_BASE__/dbdownload');
	}
	else {
		$CGI->{order} =~ s/^\0+//;
		$CGI->{order} =~ s/\0.*//s;
		$Scratch->{start_at} = "sm=$CGI->{order}";
	}

	if($action_col) {
		for(grep $_, @{$CGI_array->{order}}) {
			$db->set_field($_, $action_col, $value);
		}
	}
	if(@errors) {
		my $plural = @errors > 1 ? 's' : '';
		return "<FONT CLASS=error>Error$plural:<UL><LI>" .
				join ("<LI>", @errors)                    .
				"</UL></FONT><BR>";
	}
	if($CGI->{viewnext}) {
		my $ordnum = $CGI->{order};
		$ordnum =~ s/[\0,\s].*//;
		return if ! $ordnum;
		$ordnum++;
		my $maxtries = $Tag->var('UI_ORDER_VIEWNEXT_MAX_SKIP', 2) || 20;
		my $tries = 0;
		CHECKNEXT: {
			if (! $db->record_exists($ordnum) ) {
				if (++$tries <= $maxtries) {
					++$ordnum;
					redo CHECKNEXT;
				}
				undef $ordnum;
				last CHECKNEXT;
			}
			if ($db->field($ordnum, 'deleted') ) {
				$ordnum++;
				next CHECKNEXT;
			}
			if ($Values->{showarchive} and ! $db->field($ordnum, 'archived') ) {
				undef $ordnum;
				last CHECKNEXT;
			}
			else {
				last CHECKNEXT;
			}
		}
		if ($ordnum) {
			$Scratch->{ui_location} = $Tag->area(
									{
										href => '__UI_BASE__/order_view',
										form => "order=$ordnum",
									}
									);
		}
		else {
			$Scratch->{message} = "[L]No next order.[/L]";
		}
	}
	return;
[/perl]

