C4/Accounts.pm

   1 package C4::Accounts;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20
  21 use strict;
  22 #use warnings; FIXME - Bug 2505
  23 use C4::Context;
  24 use C4::Stats;
  25 use C4::Members;
  26 use C4::Circulation qw(ReturnLostItem);
  27
  28 use vars qw($VERSION @ISA @EXPORT);
  29
  30 BEGIN {
  31         # set the version for version checking
  32     $VERSION = 3.07.00.049;
  33         require Exporter;
  34         @ISA    = qw(Exporter);
  35         @EXPORT = qw(
  36                 &recordpayment
  37                 &makepayment
  38                 &manualinvoice
  39                 &getnextacctno
  40                 &reconcileaccount
  41                 &getcharges
  42                 &ModNote
  43                 &getcredits
  44                 &getrefunds
  45                 &chargelostitem
  46                 &ReversePayment
  47                 &makepartialpayment
  48                 &recordpayment_selectaccts
  49                 &WriteOffFee
  50         );
  51 }
  52
  53 =head1 NAME
  54
  55 C4::Accounts - Functions for dealing with Koha accounts
  56
  57 =head1 SYNOPSIS
  58
  59 use C4::Accounts;
  60
  61 =head1 DESCRIPTION
  62
  63 The functions in this module deal with the monetary aspect of Koha,
  64 including looking up and modifying the amount of money owed by a
  65 patron.
  66
  67 =head1 FUNCTIONS
  68
  69 =head2 recordpayment
  70
  71   &recordpayment($borrowernumber, $payment);
  72
  73 Record payment by a patron. C<$borrowernumber> is the patron's
  74 borrower number. C<$payment> is a floating-point number, giving the
  75 amount that was paid.
  76
  77 Amounts owed are paid off oldest first. That is, if the patron has a
  78 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
  79 of $1.50, then the oldest fine will be paid off in full, and $0.50
  80 will be credited to the next one.
  81
  82 =cut
  83
  84 #'
  85 sub recordpayment {
  86
  87     #here we update the account lines
  88     my ( $borrowernumber, $data ) = @_;
  89     my $dbh        = C4::Context->dbh;
  90     my $newamtos   = 0;
  91     my $accdata    = "";
  92     my $branch     = C4::Context->userenv->{'branch'};
  93     my $amountleft = $data;
  94     my $manager_id = 0;
  95     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
  96
  97     # begin transaction
  98     my $nextaccntno = getnextacctno($borrowernumber);
  99
 100     # get lines with outstanding amounts to offset
 101     my $sth = $dbh->prepare(
 102         "SELECT * FROM accountlines
 103   WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
 104   ORDER BY date"
 105     );
 106     $sth->execute($borrowernumber);
 107
 108     # offset transactions
 109     while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
 110         if ( $accdata->{'amountoutstanding'} < $amountleft ) {
 111             $newamtos = 0;
 112             $amountleft -= $accdata->{'amountoutstanding'};
 113         }
 114         else {
 115             $newamtos   = $accdata->{'amountoutstanding'} - $amountleft;
 116             $amountleft = 0;
 117         }
 118         my $thisacct = $accdata->{accountno};
 119         my $usth     = $dbh->prepare(
 120             "UPDATE accountlines SET amountoutstanding= ?
 121      WHERE (borrowernumber = ?) AND (accountno=?)"
 122         );
 123         $usth->execute( $newamtos, $borrowernumber, $thisacct );
 124         $usth->finish;
 125 #        $usth = $dbh->prepare(
 126 #            "INSERT INTO accountoffsets
 127 #     (borrowernumber, accountno, offsetaccount,  offsetamount)
 128 #     VALUES (?,?,?,?)"
 129 #        );
 130 #        $usth->execute( $borrowernumber, $accdata->{'accountno'},
 131 #            $nextaccntno, $newamtos );
 132         $usth->finish;
 133     }
 134
 135     # create new line
 136     my $usth = $dbh->prepare(
 137         "INSERT INTO accountlines
 138   (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id)
 139   VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)"
 140     );
 141     $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft, $manager_id );
 142     $usth->finish;
 143     UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
 144     $sth->finish;
 145 }
 146
 147 =head2 makepayment
 148
 149   &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
 150
 151 Records the fact that a patron has paid off the entire amount he or
 152 she owes.
 153
 154 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
 155 the account that was credited. C<$amount> is the amount paid (this is
 156 only used to record the payment. It is assumed to be equal to the
 157 amount owed). C<$branchcode> is the code of the branch where payment
 158 was made.
 159
 160 =cut
 161
 162 #'
 163 # FIXME - I'm not at all sure about the above, because I don't
 164 # understand what the acct* tables in the Koha database are for.
 165 sub makepayment {
 166
 167     #here we update both the accountoffsets and the account lines
 168     #updated to check, if they are paying off a lost item, we return the item
 169     # from their card, and put a note on the item record
 170     my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
 171     my $dbh = C4::Context->dbh;
 172     my $manager_id = 0;
 173     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 174
 175     # begin transaction
 176     my $nextaccntno = getnextacctno($borrowernumber);
 177     my $newamtos    = 0;
 178     my $sth =
 179       $dbh->prepare(
 180         "SELECT * FROM accountlines WHERE  borrowernumber=? AND accountno=?");
 181     $sth->execute( $borrowernumber, $accountno );
 182     my $data = $sth->fetchrow_hashref;
 183     $sth->finish;
 184
 185     if($data->{'accounttype'} eq "Pay"){
 186         my $udp =
 187             $dbh->prepare(
 188                 "UPDATE accountlines
 189                     SET amountoutstanding = 0, description = 'Payment,thanks'
 190                     WHERE borrowernumber = ?
 191                     AND accountno = ?
 192                 "
 193             );
 194         $udp->execute($borrowernumber, $accountno );
 195         $udp->finish;
 196     }else{
 197         my $udp =
 198             $dbh->prepare(
 199                 "UPDATE accountlines
 200                     SET amountoutstanding = 0
 201                     WHERE borrowernumber = ?
 202                     AND accountno = ?
 203                 "
 204             );
 205         $udp->execute($borrowernumber, $accountno );
 206         $udp->finish;
 207
 208          # create new line
 209         my $payment = 0 - $amount;
 210
 211         my $ins =
 212             $dbh->prepare(
 213                 "INSERT
 214                     INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id)
 215                     VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)"
 216             );
 217         $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id);
 218         $ins->finish;
 219     }
 220
 221     # FIXME - The second argument to &UpdateStats is supposed to be the
 222     # branch code.
 223     # UpdateStats is now being passed $accountno too. MTJ
 224     UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
 225         $accountno );
 226     #from perldoc: for SELECT only #$sth->finish;
 227
 228     #check to see what accounttype
 229     if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
 230         C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} );
 231     }
 232 }
 233
 234 =head2 getnextacctno
 235
 236   $nextacct = &getnextacctno($borrowernumber);
 237
 238 Returns the next unused account number for the patron with the given
 239 borrower number.
 240
 241 =cut
 242
 243 #'
 244 # FIXME - Okay, so what does the above actually _mean_?
 245 sub getnextacctno ($) {
 246     my ($borrowernumber) = shift or return undef;
 247     my $sth = C4::Context->dbh->prepare(
 248         "SELECT accountno+1 FROM accountlines
 249          WHERE    (borrowernumber = ?)
 250          ORDER BY accountno DESC
 251                  LIMIT 1"
 252     );
 253     $sth->execute($borrowernumber);
 254     return ($sth->fetchrow || 1);
 255 }
 256
 257 =head2 fixaccounts (removed)
 258
 259   &fixaccounts($borrowernumber, $accountnumber, $amount);
 260
 261 #'
 262 # FIXME - I don't understand what this function does.
 263 sub fixaccounts {
 264     my ( $borrowernumber, $accountno, $amount ) = @_;
 265     my $dbh = C4::Context->dbh;
 266     my $sth = $dbh->prepare(
 267         "SELECT * FROM accountlines WHERE borrowernumber=?
 268      AND accountno=?"
 269     );
 270     $sth->execute( $borrowernumber, $accountno );
 271     my $data = $sth->fetchrow_hashref;
 272
 273     # FIXME - Error-checking
 274     my $diff        = $amount - $data->{'amount'};
 275     my $outstanding = $data->{'amountoutstanding'} + $diff;
 276     $sth->finish;
 277
 278     $dbh->do(<<EOT);
 279         UPDATE  accountlines
 280         SET     amount = '$amount',
 281                 amountoutstanding = '$outstanding'
 282         WHERE   borrowernumber = $borrowernumber
 283           AND   accountno = $accountno
 284 EOT
 285         # FIXME: exceedingly bad form.  Use prepare with placholders ("?") in query and execute args.
 286 }
 287
 288 =cut
 289
 290 sub chargelostitem{
 291 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
 292 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
 293 # a charge has been added
 294 # FIXME : if no replacement price, borrower just doesn't get charged?
 295     my $dbh = C4::Context->dbh();
 296     my ($borrowernumber, $itemnumber, $amount, $description) = @_;
 297
 298     # first make sure the borrower hasn't already been charged for this item
 299     my $sth1=$dbh->prepare("SELECT * from accountlines
 300     WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
 301     $sth1->execute($borrowernumber,$itemnumber);
 302     my $existing_charge_hashref=$sth1->fetchrow_hashref();
 303
 304     # OK, they haven't
 305     unless ($existing_charge_hashref) {
 306         my $manager_id = 0;
 307         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 308         # This item is on issue ... add replacement cost to the borrower's record and mark it returned
 309         #  Note that we add this to the account even if there's no replacement price, allowing some other
 310         #  process (or person) to update it, since we don't handle any defaults for replacement prices.
 311         my $accountno = getnextacctno($borrowernumber);
 312         my $sth2=$dbh->prepare("INSERT INTO accountlines
 313         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
 314         VALUES (?,?,now(),?,?,'L',?,?,?)");
 315         $sth2->execute($borrowernumber,$accountno,$amount,
 316         $description,$amount,$itemnumber,$manager_id);
 317         $sth2->finish;
 318     # FIXME: Log this ?
 319     }
 320 }
 321
 322 =head2 manualinvoice
 323
 324   &manualinvoice($borrowernumber, $itemnumber, $description, $type,
 325                  $amount, $note);
 326
 327 C<$borrowernumber> is the patron's borrower number.
 328 C<$description> is a description of the transaction.
 329 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
 330 or C<REF>.
 331 C<$itemnumber> is the item involved, if pertinent; otherwise, it
 332 should be the empty string.
 333
 334 =cut
 335
 336 #'
 337 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
 338 # are :
 339 #               'C' = CREDIT
 340 #               'FOR' = FORGIVEN  (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
 341 #               'N' = New Card fee
 342 #               'F' = Fine
 343 #               'A' = Account Management fee
 344 #               'M' = Sundry
 345 #               'L' = Lost Item
 346 #
 347
 348 sub manualinvoice {
 349     my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
 350     my $manager_id = 0;
 351     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 352     my $dbh      = C4::Context->dbh;
 353     my $notifyid = 0;
 354     my $insert;
 355     my $accountno  = getnextacctno($borrowernumber);
 356     my $amountleft = $amount;
 357
 358 #    if (   $type eq 'CS'
 359 #        || $type eq 'CB'
 360 #        || $type eq 'CW'
 361 #        || $type eq 'CF'
 362 #        || $type eq 'CL' )
 363 #    {
 364 #        my $amount2 = $amount * -1;    # FIXME - $amount2 = -$amount
 365 #        $amountleft =
 366 #          fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
 367 #    }
 368     if ( $type eq 'N' ) {
 369         $desc .= " New Card";
 370     }
 371     if ( $type eq 'F' ) {
 372         $desc .= " Fine";
 373     }
 374     if ( $type eq 'A' ) {
 375         $desc .= " Account Management fee";
 376     }
 377     if ( $type eq 'M' ) {
 378         $desc .= " Sundry";
 379     }
 380
 381     if ( $type eq 'L' && $desc eq '' ) {
 382
 383         $desc = " Lost Item";
 384     }
 385 #    if ( $type eq 'REF' ) {
 386 #        $desc .= " Cash Refund";
 387 #        $amountleft = refund( '', $borrowernumber, $amount );
 388 #    }
 389     if (   ( $type eq 'L' )
 390         or ( $type eq 'F' )
 391         or ( $type eq 'A' )
 392         or ( $type eq 'N' )
 393         or ( $type eq 'M' ) )
 394     {
 395         $notifyid = 1;
 396     }
 397
 398     if ( $itemnum ) {
 399         $desc .= ' ' . $itemnum;
 400         my $sth = $dbh->prepare(
 401             'INSERT INTO  accountlines
 402                         (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
 403         VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
 404      $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
 405   } else {
 406     my $sth=$dbh->prepare("INSERT INTO  accountlines
 407             (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
 408             VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
 409         );
 410         $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
 411             $amountleft, $notifyid, $note, $manager_id );
 412     }
 413     return 0;
 414 }
 415
 416 =head2 fixcredit #### DEPRECATED
 417
 418  $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
 419
 420  This function is only used internally, not exported.
 421
 422 =cut
 423
 424 # This function is deprecated in 3.0
 425
 426 sub fixcredit {
 427
 428     #here we update both the accountoffsets and the account lines
 429     my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
 430     my $dbh        = C4::Context->dbh;
 431     my $newamtos   = 0;
 432     my $accdata    = "";
 433     my $amountleft = $data;
 434     if ( $barcode ne '' ) {
 435         my $item        = GetBiblioFromItemNumber( '', $barcode );
 436         my $nextaccntno = getnextacctno($borrowernumber);
 437         my $query       = "SELECT * FROM accountlines WHERE (borrowernumber=?
 438     AND itemnumber=? AND amountoutstanding > 0)";
 439         if ( $type eq 'CL' ) {
 440             $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
 441         }
 442         elsif ( $type eq 'CF' ) {
 443             $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
 444       accounttype='Res' OR accounttype='Rent')";
 445         }
 446         elsif ( $type eq 'CB' ) {
 447             $query .= " and accounttype='A'";
 448         }
 449
 450         #    print $query;
 451         my $sth = $dbh->prepare($query);
 452         $sth->execute( $borrowernumber, $item->{'itemnumber'} );
 453         $accdata = $sth->fetchrow_hashref;
 454         $sth->finish;
 455         if ( $accdata->{'amountoutstanding'} < $amountleft ) {
 456             $newamtos = 0;
 457             $amountleft -= $accdata->{'amountoutstanding'};
 458         }
 459         else {
 460             $newamtos   = $accdata->{'amountoutstanding'} - $amountleft;
 461             $amountleft = 0;
 462         }
 463         my $thisacct = $accdata->{accountno};
 464         my $usth     = $dbh->prepare(
 465             "UPDATE accountlines SET amountoutstanding= ?
 466      WHERE (borrowernumber = ?) AND (accountno=?)"
 467         );
 468         $usth->execute( $newamtos, $borrowernumber, $thisacct );
 469         $usth->finish;
 470         $usth = $dbh->prepare(
 471             "INSERT INTO accountoffsets
 472      (borrowernumber, accountno, offsetaccount,  offsetamount)
 473      VALUES (?,?,?,?)"
 474         );
 475         $usth->execute( $borrowernumber, $accdata->{'accountno'},
 476             $nextaccntno, $newamtos );
 477         $usth->finish;
 478     }
 479
 480     # begin transaction
 481     my $nextaccntno = getnextacctno($borrowernumber);
 482
 483     # get lines with outstanding amounts to offset
 484     my $sth = $dbh->prepare(
 485         "SELECT * FROM accountlines
 486   WHERE (borrowernumber = ?) AND (amountoutstanding >0)
 487   ORDER BY date"
 488     );
 489     $sth->execute($borrowernumber);
 490
 491     #  print $query;
 492     # offset transactions
 493     while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
 494         if ( $accdata->{'amountoutstanding'} < $amountleft ) {
 495             $newamtos = 0;
 496             $amountleft -= $accdata->{'amountoutstanding'};
 497         }
 498         else {
 499             $newamtos   = $accdata->{'amountoutstanding'} - $amountleft;
 500             $amountleft = 0;
 501         }
 502         my $thisacct = $accdata->{accountno};
 503         my $usth     = $dbh->prepare(
 504             "UPDATE accountlines SET amountoutstanding= ?
 505      WHERE (borrowernumber = ?) AND (accountno=?)"
 506         );
 507         $usth->execute( $newamtos, $borrowernumber, $thisacct );
 508         $usth->finish;
 509         $usth = $dbh->prepare(
 510             "INSERT INTO accountoffsets
 511      (borrowernumber, accountno, offsetaccount,  offsetamount)
 512      VALUE (?,?,?,?)"
 513         );
 514         $usth->execute( $borrowernumber, $accdata->{'accountno'},
 515             $nextaccntno, $newamtos );
 516         $usth->finish;
 517     }
 518     $sth->finish;
 519     $type = "Credit " . $type;
 520     UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
 521     $amountleft *= -1;
 522     return ($amountleft);
 523
 524 }
 525
 526 =head2 refund
 527
 528 #FIXME : DEPRECATED SUB
 529  This subroutine tracks payments and/or credits against fines/charges
 530    using the accountoffsets table, which is not used consistently in
 531    Koha's fines management, and so is not used in 3.0
 532
 533 =cut
 534
 535 sub refund {
 536
 537     #here we update both the accountoffsets and the account lines
 538     my ( $borrowernumber, $data ) = @_;
 539     my $dbh        = C4::Context->dbh;
 540     my $newamtos   = 0;
 541     my $accdata    = "";
 542     my $amountleft = $data * -1;
 543
 544     # begin transaction
 545     my $nextaccntno = getnextacctno($borrowernumber);
 546
 547     # get lines with outstanding amounts to offset
 548     my $sth = $dbh->prepare(
 549         "SELECT * FROM accountlines
 550   WHERE (borrowernumber = ?) AND (amountoutstanding<0)
 551   ORDER BY date"
 552     );
 553     $sth->execute($borrowernumber);
 554
 555     #  print $amountleft;
 556     # offset transactions
 557     while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
 558         if ( $accdata->{'amountoutstanding'} > $amountleft ) {
 559             $newamtos = 0;
 560             $amountleft -= $accdata->{'amountoutstanding'};
 561         }
 562         else {
 563             $newamtos   = $accdata->{'amountoutstanding'} - $amountleft;
 564             $amountleft = 0;
 565         }
 566
 567         #     print $amountleft;
 568         my $thisacct = $accdata->{accountno};
 569         my $usth     = $dbh->prepare(
 570             "UPDATE accountlines SET amountoutstanding= ?
 571      WHERE (borrowernumber = ?) AND (accountno=?)"
 572         );
 573         $usth->execute( $newamtos, $borrowernumber, $thisacct );
 574         $usth->finish;
 575         $usth = $dbh->prepare(
 576             "INSERT INTO accountoffsets
 577      (borrowernumber, accountno, offsetaccount,  offsetamount)
 578      VALUES (?,?,?,?)"
 579         );
 580         $usth->execute( $borrowernumber, $accdata->{'accountno'},
 581             $nextaccntno, $newamtos );
 582         $usth->finish;
 583     }
 584     $sth->finish;
 585     return ($amountleft);
 586 }
 587
 588 sub getcharges {
 589         my ( $borrowerno, $timestamp, $accountno ) = @_;
 590         my $dbh        = C4::Context->dbh;
 591         my $timestamp2 = $timestamp - 1;
 592         my $query      = "";
 593         my $sth = $dbh->prepare(
 594                         "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
 595           );
 596         $sth->execute( $borrowerno, $accountno );
 597
 598     my @results;
 599     while ( my $data = $sth->fetchrow_hashref ) {
 600                 push @results,$data;
 601         }
 602     return (@results);
 603 }
 604
 605 sub ModNote {
 606     my ( $borrowernumber, $accountno, $note ) = @_;
 607     my $dbh = C4::Context->dbh;
 608     my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
 609     $sth->execute( $note, $borrowernumber, $accountno );
 610 }
 611
 612 sub getcredits {
 613         my ( $date, $date2 ) = @_;
 614         my $dbh = C4::Context->dbh;
 615         my $sth = $dbh->prepare(
 616                                 "SELECT * FROM accountlines,borrowers
 617       WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
 618           AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
 619       );
 620
 621     $sth->execute( $date, $date2 );
 622     my @results;
 623     while ( my $data = $sth->fetchrow_hashref ) {
 624                 $data->{'date'} = $data->{'timestamp'};
 625                 push @results,$data;
 626         }
 627     return (@results);
 628 }
 629
 630
 631 sub getrefunds {
 632         my ( $date, $date2 ) = @_;
 633         my $dbh = C4::Context->dbh;
 634
 635         my $sth = $dbh->prepare(
 636                                 "SELECT *,timestamp AS datetime
 637                   FROM accountlines,borrowers
 638                   WHERE (accounttype = 'REF'
 639                                           AND accountlines.borrowernumber = borrowers.borrowernumber
 640                                                           AND date  >=?  AND date  <?)"
 641     );
 642
 643     $sth->execute( $date, $date2 );
 644
 645     my @results;
 646     while ( my $data = $sth->fetchrow_hashref ) {
 647                 push @results,$data;
 648
 649         }
 650     return (@results);
 651 }
 652
 653 sub ReversePayment {
 654   my ( $borrowernumber, $accountno ) = @_;
 655   my $dbh = C4::Context->dbh;
 656
 657   my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
 658   $sth->execute( $borrowernumber, $accountno );
 659   my $row = $sth->fetchrow_hashref();
 660   my $amount_outstanding = $row->{'amountoutstanding'};
 661
 662   if ( $amount_outstanding <= 0 ) {
 663     $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
 664     $sth->execute( $borrowernumber, $accountno );
 665   } else {
 666     $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
 667     $sth->execute( $borrowernumber, $accountno );
 668   }
 669 }
 670
 671 =head2 recordpayment_selectaccts
 672
 673   recordpayment_selectaccts($borrowernumber, $payment,$accts);
 674
 675 Record payment by a patron. C<$borrowernumber> is the patron's
 676 borrower number. C<$payment> is a floating-point number, giving the
 677 amount that was paid. C<$accts> is an array ref to a list of
 678 accountnos which the payment can be recorded against
 679
 680 Amounts owed are paid off oldest first. That is, if the patron has a
 681 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
 682 of $1.50, then the oldest fine will be paid off in full, and $0.50
 683 will be credited to the next one.
 684
 685 =cut
 686
 687 sub recordpayment_selectaccts {
 688     my ( $borrowernumber, $amount, $accts ) = @_;
 689
 690     my $dbh        = C4::Context->dbh;
 691     my $newamtos   = 0;
 692     my $accdata    = q{};
 693     my $branch     = C4::Context->userenv->{branch};
 694     my $amountleft = $amount;
 695     my $manager_id = 0;
 696     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 697     my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
 698     'AND (amountoutstanding<>0) ';
 699     if (@{$accts} ) {
 700         $sql .= ' AND accountno IN ( ' .  join ',', @{$accts};
 701         $sql .= ' ) ';
 702     }
 703     $sql .= ' ORDER BY date';
 704     # begin transaction
 705     my $nextaccntno = getnextacctno($borrowernumber);
 706
 707     # get lines with outstanding amounts to offset
 708     my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
 709
 710     # offset transactions
 711     my $sth     = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
 712         'WHERE (borrowernumber = ?) AND (accountno=?)');
 713     for my $accdata ( @{$rows} ) {
 714         if ($amountleft == 0) {
 715             last;
 716         }
 717         if ( $accdata->{amountoutstanding} < $amountleft ) {
 718             $newamtos = 0;
 719             $amountleft -= $accdata->{amountoutstanding};
 720         }
 721         else {
 722             $newamtos   = $accdata->{amountoutstanding} - $amountleft;
 723             $amountleft = 0;
 724         }
 725         my $thisacct = $accdata->{accountno};
 726         $sth->execute( $newamtos, $borrowernumber, $thisacct );
 727     }
 728
 729     # create new line
 730     $sql = 'INSERT INTO accountlines ' .
 731     '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id) ' .
 732     q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)|;
 733     $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id );
 734     UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
 735     return;
 736 }
 737
 738 # makepayment needs to be fixed to handle partials till then this separate subroutine
 739 # fills in
 740 sub makepartialpayment {
 741     my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
 742     my $manager_id = 0;
 743     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 744     if (!$amount || $amount < 0) {
 745         return;
 746     }
 747     my $dbh = C4::Context->dbh;
 748
 749     my $nextaccntno = getnextacctno($borrowernumber);
 750     my $newamtos    = 0;
 751
 752     my $data = $dbh->selectrow_hashref(
 753         'SELECT * FROM accountlines WHERE  borrowernumber=? AND accountno=?',undef,$borrowernumber,$accountno);
 754     my $new_outstanding = $data->{amountoutstanding} - $amount;
 755
 756     my $update = 'UPDATE  accountlines SET amountoutstanding = ?  WHERE   borrowernumber = ? '
 757     . ' AND   accountno = ?';
 758     $dbh->do( $update, undef, $new_outstanding, $borrowernumber, $accountno);
 759
 760     # create new line
 761     my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
 762     .  'description, accounttype, amountoutstanding, itemnumber, manager_id) '
 763     . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)';
 764
 765     $dbh->do(  $insert, undef, $borrowernumber, $nextaccntno, $amount,
 766         "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id);
 767
 768     UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
 769
 770     return;
 771 }
 772
 773 =head2 WriteOff
 774
 775   WriteOff( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount, $branch );
 776
 777 Write off a fine for a patron.
 778 C<$borrowernumber> is the patron's borrower number.
 779 C<$accountnum> is the accountnumber of the fee to write off.
 780 C<$itemnum> is the itemnumber of of item whose fine is being written off.
 781 C<$accounttype> is the account type of the fine being written off.
 782 C<$amount> is a floating-point number, giving the amount that is being written off.
 783 C<$branch> is the branchcode of the library where the writeoff occurred.
 784
 785 =cut
 786
 787 sub WriteOffFee {
 788     my ( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount, $branch ) = @_;
 789     $branch ||= C4::Context->userenv->{branch};
 790     my $manager_id = 0;
 791     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 792
 793     # if no item is attached to fine, make sure to store it as a NULL
 794     $itemnum ||= undef;
 795
 796     my ( $sth, $query );
 797     my $dbh = C4::Context->dbh();
 798
 799     $query = "
 800         UPDATE accountlines SET amountoutstanding = 0
 801         WHERE accountno = ? AND borrowernumber = ?
 802     ";
 803     $sth = $dbh->prepare( $query );
 804     $sth->execute( $accountnum, $borrowernumber );
 805
 806     $query ="
 807         INSERT INTO accountlines
 808         ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id )
 809         VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ? )
 810     ";
 811     $sth = $dbh->prepare( $query );
 812     my $acct = getnextacctno($borrowernumber);
 813     $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id );
 814
 815     UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber );
 816
 817 }
 818
 819 END { }    # module clean-up code here (global destructor)
 820
 821 1;
 822 __END__
 823
 824 =head1 SEE ALSO
 825
 826 DBI(3)
 827
 828 =cut
 829