4 use C4::Circulation::Circ2;
12 my $issuebut, $returnbut, $mainholder;
13 my $borrnumber, $borrower, $borrowerlist;
14 my @items2, $currentissues;
16 my (@flagbold, @flagnormal, @flagnoissues, @flagtag, @textnoissues);
17 @flagbold=(-background=>undef, -foreground=>'blue', -underline=>1, -relief=>'sunken', -borderwidth=>1);
18 @flagnormal=(-background=>undef, -foreground=>'blue', -underline=>1, -relief=>'flat');
19 @flagtag=(-background=>undef, -foreground=>'blue', -underline=>1, -relief=>'flat');
20 @flagnoissues=(-background=>undef, -foreground=>'red', -underline=>1, -relief=>'flat');
21 @textnoissues=(-background=>undef, -foreground=>'red', -relief=>'flat');
22 @flagnoissuesbold=(-background=>undef, -foreground=>'red', -underline=>1, -relief=>'sunken', -borderwidth=>1);
24 my $MW=MainWindow->new(-height => 500, -width => 600);
25 $MW->fontCreate('C_normal',-family => 'courier', -size => -12);
26 my $titlebar=$MW->Frame(-height => 100, -width => 600, -relief => 'ridge', -borderwidth => '4');
27 my $frametop=$MW->Frame(-height => 100, -width => 600, -relief => 'ridge', -borderwidth => '2');
28 my $framebot=$MW->Frame(-height => 430, -width => 600, -relief => 'ridge', -borderwidth => '2');
29 my $kohalabel=$titlebar->Label(-text => 'Koha');
30 my $menulabel=$titlebar->Label(-text => 'Main Menu');
31 my $branchlabel=$titlebar->Label(-text => 'Stewart Elementary-lp');
32 $kohalabel->pack(qw/-side left -padx 10/);
33 $branchlabel->pack(qw/-side left -padx 10 -fill x -expand 1/);
34 $menulabel->pack(qw/-side left -padx 10/);
35 my $issuesbut=$frametop->Button(-text => 'Issues', -underline => 0, -command => sub { $data='Issues'; getborrnumber(); });
36 $issuesbut->pack(qw/-side left -padx 2 -pady 2 -expand 1 -fill x/);
37 my $returnsbut=$frametop->Button(-text => 'Returns', -underline => 0, -command => sub { $data='Returns'; returns(); });
38 $returnsbut->pack(qw/-side right -padx 2 -pady 2 -expand 1 -fill x/);
39 Tk::grid($titlebar, -col => 0, -row => 0, -sticky => 'nsew');
40 Tk::grid($frametop, -col => 0, -row => 1, -sticky => 'nsew');
41 Tk::grid($framebot, -col => 0, -row => 2, -sticky => 'nsew');
49 ($mainholder) && ($mainholder->destroy);
50 $mainholder=$framebot->Frame(-height => 500, -width => 600);
51 Tk::grid($mainholder, -col => 0, -row => 0, -sticky => 'nsew');
52 $mainholder->gridPropagate(0);
53 my $borrentryframe=$mainholder->Frame(-height => 40, -width => 200, -relief=>'ridge', -borderwidth=>4);
54 $borrentryframe->pack(-ipadx => 10, -ipady => 10);
55 $label=$borrentryframe->Label(-text => "Borrower CardNumber\nor Last Name:", -anchor => 'w');
56 Tk::grid($label, -col => 0, -row => 0, -sticky => 'nw');
57 $borrentry=$borrentryframe->Entry(-width => 15);
58 $borrentry->bind('<Return>' => \&checkborrower);
59 Tk::grid($borrentry, -col => 1, -row => 0, -sticky => 'nw');
61 #Check for surname entry instead of borrower card number
66 $key=$borrentry->get();
67 my ($borrowers, $flags) = findborrower($env, $key);
68 my @borrowers=@$borrowers;
70 $borrnumber=$borrowers[0]->{'borrowernumber'};
72 } elsif ($#borrowers>0) {
73 ($mainholder) && ($mainholder->destroy);
74 $mainholder=$framebot->Frame(-height => 500, -width => 500);
75 Tk::grid($mainholder, -col => 0, -row => 0, -sticky => 'nsew');
76 my $frame=$mainholder->Frame(-height => 500, -width => 500, -relief => 'ridge', -borderwidth => '5');
77 Tk::grid($frame, -col=>0, -row=>0, -sticky => 'nsew');
78 $frame->pack(-ipadx=>10, -ipady=>10);
79 my $label=$frame->Label(-text => 'Pick a Patron', -justify => 'center', -relief => 'ridge', -borderwidth => 3);
80 Tk::grid($label, -col => 0, -row => 0, -sticky => 'nsew');
81 $borrowerlist=$frame->Scrolled(Listbox, -width => '50', -height => '10', -setgrid => '1', -scrollbars => 'se', -font => 'C_normal');
82 $borrowerlist->bind('<Double-1>' => \&pickborrower);
83 $borrowerlist->bind('<Return>' => \&pickborrower);
84 Tk::grid($borrowerlist, -col => 0, -row => 1, -sticky => 'n', -pady => 10);
85 my $buttonframe=$frame->Frame(-height=>40, -width =>500);
86 Tk::grid($buttonframe, -col => 0, -row => 2);
87 my $okbutton=$buttonframe->Button(-text => 'OK', -command => \&pickborrower);
88 $okbutton->pack(-side => 'left', -padx => 10, -pady => 10);
89 my $cancelbutton=$buttonframe->Button(-text => 'Cancel', -command => \&getborrnumber);
90 $cancelbutton->pack(-side => 'left', -padx => 10, -pady => 10);
93 foreach $borrower (@borrowers) {
94 my $cardnumber=$borrower->{'cardnumber'};
95 my $categorycode=$borrower->{'categorycode'};
96 my $name=$borrower->{'surname'}.", ".$borrower->{'firstname'};
97 my $line = sprintf "%10s %4s %-25s", $cardnumber, $categorycode, $name;
98 push (@borrowerlist, $line);
100 $borrowerlist->insert(0,@borrowerlist);
101 $borrowerlist->activate(0);
102 $borrowerlist->focus();
107 my $line=$borrowerlist->get('active');
109 my $borcardnumber=(split(/\s+/, $line))[0];
110 my ($borrower,$flags)=getpatroninformation($env, 0, $borcardnumber);
111 $borrnumber = $borrower->{'borrowernumber'};
116 my ($borrower, $flags) = getpatroninformation($env,$borrnumber,0);
117 my ($items) = currentissues($env, $borrower);
119 #open O, ">>/root/tkcirc.out";
120 #foreach (sort {$items->{$a} cmp $items->{$b}} keys %$items) {
121 # $previssues.="$_->{'title'} $_->{'author'} $_->{'barcode'}\n";
123 # print O "PREVISSUES\n$previssues\n";
125 $mainholder->destroy;
126 $mainholder=$framebot->Frame();
127 Tk::grid($mainholder, -col => 0, -row => 0, -sticky => 'n');
128 $mainholder->gridPropagate(0);
129 $topline=$mainholder->Frame();
130 $topline->pack(-side => top, -fill => 'x', -expand => '1');
133 $barcodeduedate=$topline->LabFrame(-label=>'Item Information', -height=>80, -width=>100, -labelside=>acrosstop);
134 Tk::grid($barcodeduedate, -col => 0, -row => 0, -sticky => 'nsew');
135 $barcodelabel=$barcodeduedate->Label(-text => 'Item Barcode:', -justify => right, -anchor => e);
136 Tk::grid($barcodelabel, -col => 0, -row => 0, -sticky => 'e');
137 $barcodeentry=$barcodeduedate->Entry(-width => 15);
138 $barcodeentry->bind('<Return>' => \&issuebk);
139 $barcodeentry->bind('<Escape>' => \&getborrnumber);
140 $barcodeentry->grid(-col => 1, -row => 0);
141 $barcodeentry->focus;
142 $duedatelabel=$barcodeduedate->Label(-text => 'Due Date:', -justify => right, -anchor => e);
143 Tk::grid($duedatelabel, -col => 0, -row => 1, -sticky => 'e');
144 $duedateentry=$barcodeduedate->Entry(-width => 15);
145 $duedateentry->bind('<Return>' => \&issuebk);
146 $duedateentry->grid(-col => 1, -row => 1);
147 $middle=$topline->Frame(-width => 40);
148 Tk::grid($middle, -col => 1, -sticky => 'ew');
150 $biframe=$topline->LabFrame(-label=>'Patron Information', -labelside=>acrosstop);
151 Tk::grid($biframe, -col=>2, -row=>0, -sticky=>'nsew');
152 $borrowerinfo=$biframe->Text(-height => 4, -width => 40, -wrap => none, -relief=>flat);
153 my $line = "$borrower->{'cardnumber'} ";
154 $line .= "$borrower->{'surname'}, ";
155 $line .= "$borrower->{'title'} $borrower->{'firstname'}\n";
156 $line .= "$borrower->{'streetaddress'}, $borrower->{'city'}\n";
157 $line .= "$borrower->{'categorycode'} ";
158 $borrowerinfo->insert('0.0',$line);
159 open O, ">>/root/tkcirc.out";
162 foreach $flag (sort keys %$flags) {
163 print O "Configuring flag $flag\n";
164 $borrowerinfo->insert('end', $flag, "$flag", " ");
165 if ($flags->{$flag}->{'noissues'}) {
167 $borrowerinfo->tag('configure', "$flag", @flagnoissues);
168 $borrowerinfo->tag('bind', "$flag", "<Any-Leave>" => sub {shift->tag('configure', "$flag", @flagnoissues)});
169 $borrowerinfo->tag('bind', "$flag", "<Any-Enter>" => sub {shift->tag('configure', "$flag", @flagnoissuesbold)});
171 $borrowerinfo->tag('configure', "$flag", @flagtag);
172 $borrowerinfo->tag('bind', "$flag", "<Any-Leave>" => sub {shift->tag('configure', "$flag", @flagtag)});
173 $borrowerinfo->tag('bind', "$flag", "<Any-Enter>" => sub {shift->tag('configure', "$flag", @flagbold)});
176 $borrowerinfo->tag('bind', "$flag", "<1>" => sub {&patronnote($borrower,$flags, $flag)});
180 $borrowerinfo->insert('end', "\n", "");
181 $borrowerinfo->insert('end', "No issues allowed for this borrower!", "noissuestag");
182 $borrowerinfo->tag('configure', 'noissuestag', @textnoissues);
187 #$borrowerinfo->insert('0.0',$line);
188 $borrowerinfo->configure(-state => 'disabled');
190 my $ciframe=$mainholder->LabFrame(-label=>'Current Issues', -labelside=>acrosstop);
196 $currentissues=$ciframe->Table(-rows=>10, -columns=>5, -scrollbars=>'e', -fixedrows=>1, -takefocus=>1);
197 $currentissues->pack();
198 $currentissues->put(0,0,$currentissues->Label(-text=>"Due Date", -relief => 'groove', borderwidth=>'3'));
199 $currentissues->put(0,1,$currentissues->Label(-text=>"Bar Code", -relief => 'groove', borderwidth=>'3'));
200 $currentissues->put(0,2,$currentissues->Label(-text=>"Title", -relief => 'groove', borderwidth=>'3', -width=>35));
201 $currentissues->put(0,3,$currentissues->Label(-text=>"Author", -relief => 'groove', borderwidth=>'3', -width=>20));
202 $currentissues->put(0,4,$currentissues->Label(-text=>"Class", -relief => 'groove', borderwidth=>'3'));
203 $currentissues->see(0,0);
204 $currentissues->see(0,1);
205 $currentissues->see(0,2);
206 $currentissues->see(0,3);
207 $currentissues->see(0,4);
208 $currentissues->see(0,5);
210 my $piframe=$mainholder->LabFrame(-label=>'Previous Issues', -labelside=>acrosstop);
212 $previousissues=$piframe->Table(-rows=>10, -columns=>5, -scrollbars=>'e', -fixedrows=>1, -takefocus=>1);
213 $previousissues->pack();
214 $previousissues->put(0,0,$previousissues->Label(-text=>"Due Date", -relief => 'groove', borderwidth=>'3'));
215 $previousissues->put(0,1,$previousissues->Label(-text=>"Bar Code", -relief => 'groove', borderwidth=>'3'));
216 $previousissues->put(0,2,$previousissues->Label(-text=>"Title", -relief => 'groove', borderwidth=>'3', -width=>35));
217 $previousissues->put(0,3,$previousissues->Label(-text=>"Author", -relief => 'groove', borderwidth=>'3', -width=>20));
218 $previousissues->put(0,4,$previousissues->Label(-text=>"Class", -relief => 'groove', borderwidth=>'3'));
219 $previousissues->see(0,0);
220 $previousissues->see(0,1);
221 $previousissues->see(0,2);
222 $previousissues->see(0,3);
223 $previousissues->see(0,4);
225 my ($borrowerissues) = currentissues($env, $borrower);
227 #foreach (sort {$items->{$a} cmp $items->{$b}} keys %$items) {
228 foreach (sort keys %$borrowerissues) {
229 my $bookissue=$borrowerissues->{$_};
230 $previousissues->put($counter,0,$previousissues->Label(-text=>$bookissue->{'duedate'}, -relief=>'groove', -borderwidth=>'2'));
231 $previousissues->put($counter,1,$previousissues->Label(-text=>$bookissue->{'barcode'}, -relief=>'groove', -borderwidth=>'2'));
232 $previousissues->put($counter,2,$previousissues->Label(-text=>$bookissue->{'title'}, -relief=>'groove', -borderwidth=>'2'));
233 $previousissues->put($counter,3,$previousissues->Label(-text=>$bookissue->{'author'}, -relief=>'groove', -borderwidth=>'2'));
234 $previousissues->put($counter,4,$previousissues->Label(-text=>$bookissue->{'dewey'}.$bookissue->{'subclass'}, -relief=>'groove', -borderwidth=>'2'));
235 $previousissues->see($counter,0);
236 $previousissues->see($counter,1);
237 $previousissues->see($counter,2);
238 $previousissues->see($counter,3);
239 $previousissues->see($counter,4);
246 my ($borrower, $flags, $flag) = @_;
247 my $flaginfo=$flags->{$flag};
248 info_msg($env, "$borrower->{'surname'} $flag\n$flags->{$flag}->{'message'}");
252 my ($env, $message) = @_;
254 my $button = $MW->messageBox(-type => 'OK', -title => 'Error Message', -message => "$message");
259 my ($env, $message) = @_;
260 my $window=$MW->Toplevel();
261 $window->title('Informational Message');
262 my $text=$window->Scrolled('Text', -height=>4, -width=>40, -wrap=>'word', -scrollbars=>'oe');
263 $text->pack(-expand=>1, -fill=>'both');
264 $text->insert('0.0', "$message");
265 #$text->configure(-state => 'disabled');
266 my $button=$window->Button(-text=>'OK', -command => sub { $window->destroy()});
268 $window->bind('<Return>' => sub {$window->destroy()});
273 my ($env, $message) = @_;
274 my $button = $MW->messageBox(-type => 'OK', -title => 'Informational Message', -message => "$message");
279 my ($env, $message1, $message2, $message3) =@_;
280 my $message = $message1;
281 ($message2) && ($message.="\n$message2");
282 ($message3) && ($message.="\n$message3");
283 my $button = $MW->messageBox(-type => 'YesNo', -default => 'Yes', -title => 'Message', -message => "$message");
284 $button=substr($button,0,1);
291 my ($env, $message1, $message2, $message3) =@_;
292 my $message = $message1;
293 ($message2) && ($message.="\n$message2");
294 ($message3) && ($message.="\n$message3");
295 my $button = $MW ->messageBox(-type => 'YesNo', -default => 'No', -title => 'Message', -message => "$message");
296 $button=substr($button,0,1);
303 my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
305 my $query="Select * from biblioitems,itemtypes
306 where (biblioitems.biblioitemnumber='$bitno')
307 and (biblioitems.itemtype = itemtypes.itemtype)";
308 my $sth=$dbh->prepare($query);
310 if (my $data=$sth->fetchrow_hashref) {
311 $loanlength = $data->{'loanlength'}
315 if ($env->{'loanlength'} eq "") {
317 my $datedue = time + ($loanlength * 86400);
318 my @datearr = localtime($datedue);
319 $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
322 my $datedue = time + ($env->{'loanlength'} * 86400);
323 my @datearr = localtime($datedue);
324 $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
326 $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
327 values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
328 my $sth=$dbh->prepare($query);
331 $query = "Select * from items where itemnumber=$itemno";
332 $sth=$dbh->prepare($query);
334 my $item=$sth->fetchrow_hashref;
337 $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
338 $sth=$dbh->prepare($query);
341 my @datearr = split('-',$dateduef);
342 my $dateret = join('-',$datearr[2],$datearr[1],$datearr[0]);
347 # mark items as returned
348 my ($env,$dbh,$bornum,$itemno)=@_;
349 #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
350 my @datearr = localtime(time);
351 my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
352 my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where (borrowernumber = '$bornum') and (itemnumber = '$itemno') and (returndate is null)";
353 my $sth = $dbh->prepare($query);
356 updatelastseen($env,$dbh,$itemno);
357 # check for overdue fine
359 my $query = "select * from accountlines where (borrowernumber = '$bornum') and (itemnumber = '$itemno') and (accounttype = 'FU' or accounttype='O')";
360 my $sth = $dbh->prepare($query);
362 if (my $data = $sth->fetchrow_hashref) {
363 # alter fine to show that the book has been returned.
364 my $uquery = "update accountlines set accounttype = 'F' where (borrowernumber = '$bornum') and (itemnumber = '$itemno') and (accountno = '$data->{'accountno'}') ";
365 my $usth = $dbh->prepare($uquery);
368 $oduecharge = $data->{'amountoutstanding'};
371 # check for charge made for lost book
372 my $query = "select * from accountlines
373 where (borrowernumber = '$bornum')
374 and (itemnumber = '$itemno')
375 and (accounttype = 'L')";
376 my $sth = $dbh->prepare($query);
378 if (my $data = $sth->fetchrow_hashref) {
379 # writeoff this amount
381 my $amount = $data->{'amount'};
382 my $acctno = $data->{'accountno'};
384 if ($data->{'amountoutstanding'} == $amount) {
385 $offset = $data->{'amount'};
388 $offset = $amount - $data->{'amountoutstanding'};
389 $amountleft = $data->{'amountoutstanding'} - $amount;
391 my $uquery = "update accountlines
392 set accounttype = 'LR',amountoutstanding='0'
393 where (borrowernumber = '$bornum')
394 and (itemnumber = '$itemno')
395 and (accountno = '$acctno') ";
396 my $usth = $dbh->prepare($uquery);
399 my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
400 $uquery = "insert into accountlines
401 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
402 values ($bornum,$nextaccntno,now(),0-$amount,'Book Returned',
404 $usth = $dbh->prepare($uquery);
407 $uquery = "insert into accountoffsets
408 (borrowernumber, accountno, offsetaccount, offsetamount)
409 values ($bornum,$data->{'accountno'},$nextaccntno,$offset)";
410 $usth = $dbh->prepare($uquery);
415 UpdateStats($env,'branch','return','0','',$itemno);
422 # calculate charges due
423 my ($env, $dbh, $itemno, $bornum)=@_;
426 my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
427 where (items.itemnumber ='$itemno')
428 and (biblioitems.biblioitemnumber = items.biblioitemnumber)
429 and (biblioitems.itemtype = itemtypes.itemtype)";
430 my $sth1= $dbh->prepare($q1);
432 if (my $data1=$sth1->fetchrow_hashref) {
433 $item_type = $data1->{'itemtype'};
434 $charge = $data1->{'rentalcharge'};
435 my $q2 = "select rentaldiscount from borrowers,categoryitem
436 where (borrowers.borrowernumber = '$bornum')
437 and (borrowers.categorycode = categoryitem.categorycode)
438 and (categoryitem.itemtype = '$item_type')";
439 my $sth2=$dbh->prepare($q2);
441 if (my $data2=$sth2->fetchrow_hashref) {
442 my $discount = $data2->{'rentaldiscount'};
443 $charge = ($charge *(100 - $discount)) / 100;
454 my ($env,$itemnum,$dbh,$bornum)=@_;
455 my $sth=$dbh->prepare("Select
456 firstname,surname,issues.borrowernumber,cardnumber,returndate
457 from issues,borrowers where
458 issues.itemnumber='$itemnum' and
459 issues.borrowernumber=borrowers.borrowernumber
460 and issues.returndate is NULL");
462 my $borrower=$sth->fetchrow_hashref;
466 if ($borrower->{'borrowernumber'} ne ''){
467 if ($bornum eq $borrower->{'borrowernumber'}){
469 my ($renewstatus) = C4::Circulation::Renewals::renewstatus($env,$dbh,$bornum,$itemnum);
470 my ($resbor,$resrec) = checkreserve($env,$dbh,$itemnum);
471 if ($renewstatus == "0") {
472 info_msg($env,"</S>Issued to this borrower - No renewals<!S>");
474 } elsif ($resbor ne "") {
475 my $resp = msg_ny($env,"Book is issued to this borrower",
476 "and is reserved - Renew?");
478 $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
484 my $resp = msg_yn($env,"Book is issued to this borrower", "Renew?");
486 $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
493 my $text="Issued to $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'})";
494 my $resp = msg_yn($env,$text,"Mark as returned?");
496 &returnrecord($env,$dbh,$borrower->{'borrowernumber'},$itemnum);
502 return($borrower->{'borrowernumber'},$canissue,$newdate);
505 # Check for reserves for biblio
506 my ($env,$dbh,$itemnum)=@_;
508 my $query = "select * from reserves,items
509 where (items.itemnumber = '$itemnum')
510 and (reserves.cancellationdate is NULL)
511 and (items.biblionumber = reserves.biblionumber)
512 and ((reserves.found = 'W')
513 or (reserves.found is null))
515 my $sth = $dbh->prepare($query);
518 if (my $data=$sth->fetchrow_hashref) {
520 my $const = $data->{'constrainttype'};
522 $resbor = $data->{'borrowernumber'};
525 my $cquery = "select * from reserveconstraints,items
526 where (borrowernumber='$data->{'borrowernumber'}')
527 and reservedate='$data->{'reservedate'}'
528 and reserveconstraints.biblionumber='$data->{'biblionumber'}'
529 and (items.itemnumber=$itemnum and
530 items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
531 my $csth = $dbh->prepare($cquery);
533 if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
535 if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
537 if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
543 return ($resbor,$resrec);
548 my ($env,$interface)=@_;
550 my ($number,$reason)=dialog("Book Barcode:");
552 return ($number,$reason);
557 my %responses,@issueditems;
558 $env->{'loanlength'}=14;
559 $env->{'branchcode'}='STWE';
560 $barcode=$barcodeentry->get();
561 $barcodeentry->delete('0.0','end');
562 my ($patroninformation, $flags) = getpatroninformation($env,$borrnumber,0);
564 my ($iteminformation, $duedate, $rejected, $question, $questionnumber, $defaultanswer);
566 ($iteminformation, $duedate, $rejected, $question, $questionnumber,
567 $defaultanswer) = issuebook($env, $patroninformation, $barcode,
570 if ($rejected == -1) {
573 error_msg($env, $rejected);
578 my $response = msg_yn($env, "$question");
579 $responses{$questionnumber}=$response;
585 $iteminformation->{'duedate'}=$duedate;
586 push (@issueditems, $iteminformation);
587 my $counter=$#issueditems+1;
588 $currentissues->put($counter,0,$currentissues->Label(-text=>$iteminformation->{'duedate'}, -relief=>'groove', -borderwidth=>'2'));
589 $currentissues->put($counter,1,$currentissues->Label(-text=>$iteminformation->{'barcode'}, -relief=>'groove', -borderwidth=>'2'));
590 $currentissues->put($counter,2,$currentissues->Label(-text=>$iteminformation->{'title'}, -relief=>'groove', -borderwidth=>'2'));
591 $currentissues->put($counter,3,$currentissues->Label(-text=>$iteminformation->{'author'}, -relief=>'groove', -borderwidth=>'2'));
592 $currentissues->put($counter,4,$currentissues->Label(-text=>$iteminformation->{'dewey'}.$iteminformation->{'subclass'}, -relief=>'groove', -borderwidth=>'2'));
593 $currentissues->see($counter,0);
594 $currentissues->see($counter,1);
595 $currentissues->see($counter,2);
596 $currentissues->see($counter,3);
597 $currentissues->see($counter,4);
603 my $bornum=$borrnumber;
604 $barcode=$barcodeentry->get();
605 $barcodeentry->delete('0.0', 'end');
606 my $itemnum=$barcode;
607 #my ($env,$dbh,$itemnum,$bornum,$items)=@_;
608 $itemnum=uc $itemnum;
610 ## my ($itemnum,$reason)=&scanbook();
611 my $query="Select * from items,biblio,biblioitems where (barcode='$itemnum') and
612 (items.biblionumber=biblio.biblionumber) and
613 (items.biblioitemnumber=biblioitems.biblioitemnumber) ";
616 my $datedue = $env->{'loanlength'};
617 my $sth=$dbh->prepare($query);
619 if ($item=$sth->fetchrow_hashref) {
621 #check if item is restricted
622 if ($item->{'notforloan'} == 1) {
623 error_msg($env,"Item Not for Loan");
625 } elsif ($item->{'wthdrawn'} == 1) {
626 error_msg($env,"Item Withdrawn");
628 } elsif ($item->{'restricted'} == 1 ){
629 error_msg($env,"Restricted Item");
631 } elsif ($item->{'itemtype'} eq 'REF'){
632 error_msg($env,"Item Not for Loan");
635 #check if item is on issue already
636 if ($canissue == 1) {
637 my ($currbor,$issuestat,$newdate) =
638 &previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
639 if ($issuestat eq "N") {
641 } elsif ($issuestat eq "R") {
644 $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
646 createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
648 &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
651 if ($canissue == 1) {
653 my ($resbor,$resrec) = &checkreserve($env,$dbh,$item->{'itemnumber'});
654 #debug_msg($env,$resbor);
655 if ($resbor eq $bornum) {
656 my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
657 my $rsth = $dbh->prepare($rquery);
660 } elsif ($resbor ne "") {
661 my $bquery = "select * from borrowers
662 where borrowernumber = '$resbor'";
663 my $btsh = $dbh->prepare($bquery);
665 my $resborrower = $btsh->fetchrow_hashref;
666 my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
667 $msgtxt = $msgtxt." $resborrower->{'initials'} $resborrower->{'surname'}";
668 my $ans = msg_ny($env,$msgtxt,"Allow issue?");
671 printreserve($env,$resrec,$resborrower,$item);
674 my $ans = msg_ny($env,"Cancel reserve?");
676 my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
677 my $rsth = $dbh->prepare($rquery);
685 #if charge deal with it
687 if ($canissue == 1) {
688 $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
690 if ($canissue == 1) {
692 $datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
693 #debug_msg("","date $datedue");
694 &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
696 createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
698 } elsif ($canissue == 0) {
699 #info_msg($env,"Can't issue $item->{'cardnumber'}");
702 #my $valid = checkdigit($env,$itemnum);
705 if (substr($itemnum,0,1) = "V") {
707 $env->{'newborrower'} = $itemnum;
709 error_msg($env,"$itemnum not found - rescan");
712 error_msg($env,"Invalid Number");
716 #debug_msg($env,"date $datedue");
717 if (($datedue ne "") && ($canissue)) {
718 my $line=formatitem($env, $item, $datedue, $charge);
719 unshift @items2, $line;
721 my $currentissuestext='';
723 $currentissuestext.="$_\n";
725 $currentissues->configure(-state => 'normal');
726 $currentissues->delete('0.0','end');
727 $currentissues->insert('0.0',$currentissuestext);
728 $currentissues->configure(-state => 'disabled');
729 return($item,$charge,$datedue);
733 my ($env,$item,$datedue,$charge) = @_;
734 my $line = $datedue." ".$item->{'barcode'}." ".$item->{'title'}.": ".$item->{'author'};
735 my $iclass = $item->{'itemtype'};
736 if ($item->{'dewey'} > 0) {
737 my $dewey = $item->{'dewey'};
740 $iclass = $iclass.$dewey.$item->{'subclass'};
742 my $llen = 65 - length($iclass);
743 my $line = fmtstr($env,$line,"L".$llen);
744 my $line = $line." $iclass ";
745 my $line = $line.fmtdec($env,$charge,"22");
750 my $item = $barcodeentry->get();
751 $barcodeentry->delete('0.0', 'end');
752 my ($iteminformation,$borrower,$messages,$overduecharge) = returnbook($env, $item);
754 my $line = "$borrower->{'cardnumber'} ";
755 $line .= "$borrower->{'surname'}, ";
756 $line .= "$borrower->{'title'} $borrower->{'firstname'}\n";
757 $line .= "$borrower->{'streetaddress'}, $borrower->{'city'}\n";
758 $line .= "$borrower->{'categorycode'}";
759 $borrowerinfo->configure(-state => 'normal');
760 $borrowerinfo->delete('0.0', 'end');
761 $borrowerinfo->insert('0.0',$line);
762 $borrowerinfo->configure(-state => 'disabled');
764 $borrowerinfo->configure(-state => 'normal');
765 $borrowerinfo->delete('0.0', 'end');
766 $borrowerinfo->insert('0.0','Not Loaned Out');
767 $borrowerinfo->configure(-state => 'disabled');
769 #if ($bornum ne "") {
770 # ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
776 if ($iteminformation->{'itemnumber'} ne "" ) {
777 $iteminformation->{'borrower'}=$borrower->{'cardnumber'};
778 unshift @items,$iteminformation;
779 $iteminformation->{'dewey'}=~s/0*$//;
780 if ($items[20] > "") {
784 displayitemsreturned();
787 sub displayitemsreturned {
789 $itemsreturned->put($counter,0,$itemsreturned->Label(-text=>"Bar Code", -relief => 'groove', borderwidth=>'3'));
790 $itemsreturned->put($counter,1,$itemsreturned->Label(-text=>"Title", -relief => 'groove', borderwidth=>'3', -width=>35));
791 $itemsreturned->put($counter,2,$itemsreturned->Label(-text=>"Author", -relief => 'groove', borderwidth=>'3', -width=>20));
792 $itemsreturned->put($counter,3,$itemsreturned->Label(-text=>"Class", -relief => 'groove', borderwidth=>'3'));
793 $itemsreturned->put($counter,4,$itemsreturned->Label(-text=>"Borrower", -relief => 'groove', borderwidth=>'3'));
794 $itemsreturned->see($counter,0);
795 $itemsreturned->see($counter,1);
796 $itemsreturned->see($counter,2);
797 $itemsreturned->see($counter,3);
798 $itemsreturned->see($counter,4);
801 foreach $itemno (@items) {
802 $itemno->{'dewey'}=~s/0*$//;
803 $itemsreturned->put($counter,0,$itemsreturned->Label(-text=>$itemno->{'barcode'}, -relief => 'groove', borderwidth=>'2'));
804 $itemsreturned->put($counter,1,$itemsreturned->Label(-text=>$itemno->{'title'}, -relief => 'groove', borderwidth=>'2'));
805 $itemsreturned->put($counter,2,$itemsreturned->Label(-text=>$itemno->{'author'}, -relief => 'groove', borderwidth=>'2'));
806 $itemsreturned->put($counter,3,$itemsreturned->Label(-text=>$itemno->{'dewey'}.$itemno->{'subclass'}, -relief => 'groove', borderwidth=>'2'));
807 $itemsreturned->put($counter,4,$itemsreturned->Label(-text=>$itemno->{'borrower'}, -relief => 'groove', borderwidth=>'2'));
808 $itemsreturned->see($counter,0);
809 $itemsreturned->see($counter,1);
810 $itemsreturned->see($counter,2);
811 $itemsreturned->see($counter,3);
812 $itemsreturned->see($counter,4);
813 $itemsreturned->see(1,0);
820 ($mainholder) && ($mainholder->destroy);
821 $mainholder=$framebot->Frame(-height => 500, -width => 600);
822 Tk::grid($mainholder, -col => 0, -row => 0, -sticky => 'nsew');
823 #$mainholder->gridPropagate(0);
824 $topline=$mainholder->Frame();
825 $topline->pack(-side => top, -fill => 'x', -expand => '1');
828 my $barcodeframe=$topline->LabFrame(-label=>'Item Barcode', -height=>80, -width=>100, -labelside=>acrosstop);
829 Tk::grid($barcodeframe, -col => 0, -row => 0, -sticky => 'n');
830 $barcodeentry=$barcodeframe->Entry(-width => 15);
831 $barcodeentry->bind('<Return>' => \&returnbk);
832 $barcodeentry->grid(-col => 1, -row => 0, -sticky=>'e', -padx=>10, -pady=>10);
833 $barcodeentry->focus;
835 $biframe=$topline->LabFrame(-label=>'Patron Information', -labelside=>acrosstop);
836 Tk::grid($biframe, -col=>2, -row=>0, -sticky=>'nsew');
837 $borrowerinfo=$biframe->Text(-height => 4, -width => 40, -wrap => none, -relief=>flat);
838 $borrowerinfo->configure(-state => 'disabled');
839 $borrowerinfo->grid(-col=>1, -row=>0, -sticky=>'w');
842 $returnedframe=$mainholder->LabFrame(-label=>'Items Returned', -labelside=>acrosstop);
843 $returnedframe->pack;
844 $itemsreturned=$returnedframe->Table(-rows=>10, -columns => 5, -scrollbars=>e, -fixedrows => 1, -takefocus => 1);
845 $itemsreturned->pack(-side => top);
846 displayitemsreturned();
847 #$itemsreturned=$returnedframe->Scrolled(Text, -height=>20, -width=>80, -relief => 'flat', -scrollbars => 'e');
848 #$itemsreturned->insert('0.0','');
849 #$itemsreturned->configure(-state => 'disabled');
850 #$itemsreturned->pack(-side => top);
855 my ($env,$dbh,$itemnumber)= @_;
856 my $br = $env->{'branchcode'};
857 my $query = "update items
858 set datelastseen = now(), holdingbranch = '$br'
859 where (itemnumber = '$itemnumber')";
860 my $sth = $dbh->prepare($query);
869 my ($env,$dbh, $item) = @_;
877 my $query = "select * from items,biblio
878 where barcode = '$item'
879 and (biblio.biblionumber=items.biblionumber)";
880 my $sth=$dbh->prepare($query);
882 if ($itemrec=$sth->fetchrow_hashref) {
884 $itemno = $itemrec->{'itemnumber'};
885 $query = "select * from issues
886 where (itemnumber='$itemrec->{'itemnumber'}')
887 and (returndate is null)";
888 my $sth=$dbh->prepare($query);
890 if (my $issuerec=$sth->fetchrow_hashref) {
892 $query = "select * from borrowers where
893 (borrowernumber = '$issuerec->{'borrowernumber'}')";
894 my $sth= $dbh->prepare($query);
896 $env->{'bornum'}=$issuerec->{'borrowernumber'};
897 $borrower = $sth->fetchrow_hashref;
898 $bornum = $issuerec->{'borrowernumber'};
899 $itemno = $issuerec->{'itemnumber'};
900 $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
901 $reason = "Returned";
904 updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
905 $reason = "Item not issued";
907 my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
908 if ($resfound eq "y") {
909 my $bquery = "select * from borrowers
910 where borrowernumber = '$resrec->{'borrowernumber'}'";
911 my $btsh = $dbh->prepare($bquery);
913 my $resborrower = $btsh->fetchrow_hashref;
914 #printreserve($env,$resrec,$resborrower,$itemrec);
915 my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
916 error_msg($env,$mess);
921 $reason = "Item not found";
923 return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
927 my ($env,$dbh,$itemno) = @_;
928 my $itemdata = itemnodata($env,$dbh,$itemno);
929 my $query = "select * from reserves where found is null
930 and biblionumber = $itemdata->{'biblionumber'} and cancellationdate is NULL
931 order by priority,reservedate ";
932 my $sth = $dbh->prepare($query);
936 while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
937 if ($resrec->{'found'} eq "W") {
938 if ($resrec->{'itemnumber'} eq $itemno) {
941 } elsif ($resrec->{'constrainttype'} eq "a") {
944 my $conquery = "select * from reserveconstraints where borrowernumber
945 = $resrec->{'borrowernumber'} and reservedate = '$resrec->{'reservedate'}' and biblionumber = $resrec->{'biblionumber'} and biblioitemnumber = $itemdata->{'biblioitemnumber'}";
946 my $consth = $dbh->prepare($conquery);
948 if (my $conrec=$consth->fetchrow_hashref) {
949 if ($resrec->{'constrainttype'} eq "o") {
953 if ($resrec->{'constrainttype'} eq "e") {
959 if ($resfound eq "y") {
960 my $updquery = "update reserves
961 set found = 'W',itemnumber='$itemno'
962 where borrowernumber = $resrec->{'borrowernumber'}
963 and reservedate = '$resrec->{'reservedate'}'
964 and biblionumber = $resrec->{'biblionumber'}";
965 my $updsth = $dbh->prepare($updquery);
968 my $itbr = $resrec->{'branchcode'};
969 if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
970 my $updquery = "update items
971 set holdingbranch = 'TR'
972 where itemnumber = $itemno";
973 my $updsth = $dbh->prepare($updquery);
980 return ($resfound,$resrec);