C4/Circulation/Issues.pm

   1 package C4::Circulation::Issues; #asummes C4/Circulation/Issues
   2
   3 #package to deal with Issues
   4 #written 3/11/99 by chris@katipo.co.nz
   5
   6 use strict;
   7 require Exporter;
   8 use DBI;
   9 use C4::Database;
  10 use C4::Accounts;
  11 use C4::InterfaceCDK;
  12 use C4::Circulation::Main;
  13 use C4::Circulation::Borrower;
  14 use C4::Scan;
  15 use C4::Stats;
  16 use C4::Print;
  17 use C4::Format;
  18 use C4::Input;
  19 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  20
  21 # set the version for version checking
  22 $VERSION = 0.01;
  23
  24 @ISA = qw(Exporter);
  25 @EXPORT = qw(&Issue &formatitem);
  26 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  27
  28 # your exported package globals go here,
  29 # as well as any optionally exported functions
  30
  31 @EXPORT_OK   = qw($Var1 %Hashit);
  32
  33
  34 # non-exported package globals go here
  35 use vars qw(@more $stuff);
  36
  37 # initalize package globals, first exported ones
  38
  39 my $Var1   = '';
  40 my %Hashit = ();
  41
  42 # then the others (which are still accessible as $Some::Module::stuff)
  43 my $stuff  = '';
  44 my @more   = ();
  45
  46 # all file-scoped lexicals must be created before
  47 # the functions below that use them.
  48
  49 # file-private lexicals go here
  50 my $priv_var    = '';
  51 my %secret_hash = ();
  52
  53 # here's a file-private function as a closure,
  54 # callable as &$priv_func;  it cannot be prototyped.
  55 my $priv_func = sub {
  56   # stuff goes here.
  57 };
  58
  59 # make all your functions, whether exported or not;
  60
  61
  62 sub Issue  {
  63    my ($env) = @_;
  64    my $dbh=&C4Connect;
  65    #clear help
  66    helptext('');
  67    #clearscreen();
  68    my $done;
  69    my ($items,$items2,$amountdue);
  70    my $itemsdet;
  71    $env->{'sysarea'} = "Issues";
  72    $done = "Issues";
  73    while ($done eq "Issues") {
  74      my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
  75      #C4::Circulation::Borrowers
  76      $env->{'loanlength'}="";
  77      if ($reason ne "") {
  78        $done = $reason;
  79      } elsif ($env->{'IssuesAllowed'} eq '0') {
  80        error_msg($env,"No Issues Allowed =$env->{'IssuesAllowed'}");
  81      } else {
  82        $env->{'bornum'} = $bornum;
  83        $env->{'bcard'}  = $borrower->{'cardnumber'};
  84        #deal with alternative loans
  85        #now check items
  86        ($items,$items2)=
  87        C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
  88        $done = "No";
  89        my $it2p=0;
  90        while ($done eq 'No'){
  91          ($done,$items2,$it2p,$amountdue,$itemsdet) =
  92             &processitems($env,$bornum,$borrower,$items,
  93             $items2,$it2p,$amountdue,$itemsdet);
  94        }
  95      #&endint($env);
  96      }
  97    }
  98    $dbh->disconnect;
  99     Cdk::refreshCdkScreen();
 100    return ($done);
 101 }
 102
 103
 104 sub processitems {
 105   #process a users items
 106    my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet,$odues)=@_;
 107    my $dbh=&C4Connect;
 108    $env->{'newborrower'} = "";
 109    my ($itemnum,$reason) =
 110      issuewindow($env,'Issues',$dbh,$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
 111    if ($itemnum eq ""){
 112      $reason = "Finished user";
 113    } else {
 114      my ($item,$charge,$datedue) = &issueitem($env,$dbh,$itemnum,$bornum,$items);
 115      if ($datedue ne "") {
 116        my $line = formatitem($env,$item,$datedue,$charge);
 117        unshift @$items2,$line;
 118        #$items2->[$it2p] = $line;
 119        $item->{'date_due'} = $datedue;
 120        $item->{'charge'} = $charge;
 121        $itemsdet->[$it2p] = $item;
 122        $it2p++;
 123        $amountdue += $charge;
 124      }
 125    }
 126    $dbh->disconnect;
 127    #check to see if more books to process for this user
 128    my @done;
 129    if ($env->{'newborrower'} ne "") {$reason = "Finished user";}
 130    if ($reason eq 'Finished user'){
 131      if (@$items2[0] ne "") {
 132        remoteprint($env,$itemsdet,$borrower);
 133        if ($amountdue > 0) {
 134          &reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},$amountdue);
 135        }
 136      }
 137      @done = ("Issues");
 138    } elsif ($reason eq "Print"){
 139      remoteprint($env,$itemsdet,$borrower);
 140      @done = ("No",$items2,$it2p);
 141    } else {
 142      if ($reason ne 'Finished issues'){
 143        #return No to let them know that we wish to
 144        # process more Items for borrower
 145        @done = ("No",$items2,$it2p,$amountdue,$itemsdet);
 146      } else  {
 147        @done = ("Circ");
 148      }
 149    }
 150    #debug_msg($env, "return from issues $done[0]");
 151    $dbh->disconnect;
 152    return @done;
 153 }
 154
 155 sub formatitem {
 156    my ($env,$item,$datedue,$charge) = @_;
 157    my $line = $datedue." ".$item->{'barcode'}." ".$item->{'title'}.": ".$item->{'author'};
 158    my $iclass =  $item->{'itemtype'};
 159    if ($item->{'dewey'} > 0) {
 160      my $dewey = $item->{'dewey'};
 161      $dewey =~ s/0*$//;
 162      $dewey =~ s/\.$//;
 163      $iclass = $iclass.$dewey.$item->{'subclass'};
 164    };
 165    my $llen = 65 - length($iclass);
 166    my $line = fmtstr($env,$line,"L".$llen);
 167    my $line = $line." $iclass ";
 168    my $line = $line.fmtdec($env,$charge,"22");
 169    return $line;
 170 }
 171
 172 sub issueitem{
 173    my ($env,$dbh,$itemnum,$bornum,$items)=@_;
 174    $itemnum=uc $itemnum;
 175    my $canissue = 1;
 176    ##  my ($itemnum,$reason)=&scanbook();
 177    my $query="Select * from items,biblio,biblioitems where (barcode='$itemnum') and
 178       (items.biblionumber=biblio.biblionumber) and
 179       (items.biblioitemnumber=biblioitems.biblioitemnumber) ";
 180    my $item;
 181    my $charge;
 182    my $datedue = $env->{'loanlength'};
 183    my $sth=$dbh->prepare($query);
 184    $sth->execute;
 185    if ($item=$sth->fetchrow_hashref) {
 186      $sth->finish;
 187      #check if item is restricted
 188      if ($item->{'notforloan'} == 1) {
 189        error_msg($env,"Item Not for Loan");
 190        $canissue = 0;
 191      } elsif ($item->{'wthdrawn'} == 1) {
 192        error_msg($env,"Item Withdrawn");
 193        $canissue = 0;
 194 #     } elsif ($item->{'itemlost'} == 1) {
 195 #       error_msg($env,"Item Lost");
 196 #       $canissue = 0;
 197      } elsif ($item->{'restricted'} == 1 ){
 198        error_msg($env,"Restricted Item");
 199        #check borrowers status to take out restricted items
 200        # if borrower allowed {
 201        #  $canissue = 1
 202        # } else {
 203        $canissue = 0;
 204        # }
 205      } elsif ($item->{'itemtype'} eq 'REF'){
 206        error_msg($env,"Item Not for Loan");
 207        $canissue=0;
 208      }
 209      #check if item is on issue already
 210      if ($canissue == 1) {
 211        my ($currbor,$issuestat,$newdate) =
 212          &C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
 213        if ($issuestat eq "N") {
 214          $canissue = 0;
 215        } elsif ($issuestat eq "R") {
 216          $canissue = -1;
 217          $datedue = $newdate;
 218          $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 219          if ($charge > 0) {
 220            createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 221          }
 222          &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 223        }
 224      }
 225      if ($canissue == 1) {
 226        #check reserve
 227        my ($resbor,$resrec) =  &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
 228        #debug_msg($env,$resbor);
 229        if ($resbor eq $bornum) {
 230          my $rquery = "update reserves
 231            set found = 'F'
 232            where reservedate = '$resrec->{'reservedate'}'
 233            and borrowernumber = '$resrec->{'borrowernumber'}'
 234            and biblionumber = '$resrec->{'biblionumber'}'";
 235          my $rsth = $dbh->prepare($rquery);
 236          $rsth->execute;
 237          $rsth->finish;
 238        } elsif ($resbor ne "") {
 239          my $bquery = "select * from borrowers
 240             where borrowernumber = '$resbor'";
 241          my $btsh = $dbh->prepare($bquery);
 242          $btsh->execute;
 243          my $resborrower = $btsh->fetchrow_hashref;
 244          my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
 245          $msgtxt = $msgtxt." $resborrower->{'initials'} $resborrower->{'surname'}";
 246          my $ans = msg_ny($env,$msgtxt,"Allow issue?");
 247          if ($ans eq "N") {
 248             # print a docket;
 249             printreserve($env,$resrec,$resborrower,$item);
 250             $canissue = 0;
 251          } else {
 252            my $ans = msg_ny($env,"Cancel reserve?");
 253            if ($ans eq "Y") {
 254              my $rquery = "update reserves
 255                set found = 'F'
 256                where reservedate = '$resrec->{'reservedate'}'
 257                and borrowernumber = '$resrec->{'borrowernumber'}'
 258                and biblionumber = '$resrec->{'biblionumber'}'";
 259              my $rsth = $dbh->prepare($rquery);
 260              $rsth->execute;
 261              $rsth->finish;
 262            }
 263          }
 264          $btsh->finish();
 265        };
 266      }
 267      #if charge deal with it
 268
 269      if ($canissue == 1) {
 270        $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 271      }
 272      if ($canissue == 1) {
 273        #now mark as issued
 274        $datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
 275        #debug_msg("","date $datedue");
 276        &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 277        if ($charge > 0) {
 278          createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 279        }
 280      } elsif ($canissue == 0) {
 281        info_msg($env,"Can't issue $item->{'cardnumber'}");
 282      }
 283    } else {
 284      my $valid = checkdigit($env,$itemnum);
 285      if ($valid ==1) {
 286        if (substr($itemnum,0,1) = "V") {
 287          #this is a borrower
 288          $env->{'newborrower'} = $itemnum;
 289        } else {
 290          error_msg($env,"$itemnum not found - rescan");
 291        }
 292      } else {
 293        error_msg($env,"Invalid Number");
 294      }
 295    }
 296    $sth->finish;
 297    #debug_msg($env,"date $datedue");
 298    return($item,$charge,$datedue);
 299 }
 300
 301 sub createcharge {
 302   my ($env,$dbh,$itemno,$bornum,$charge) = @_;
 303   my $nextaccntno = getnextacctno($env,$bornum,$dbh);
 304   my $query = "insert into accountlines
 305      (borrowernumber,itemnumber,accountno,date,amount,
 306      description,accounttype,amountoutstanding)
 307      values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
 308   my $sth = $dbh->prepare($query);
 309   $sth->execute;
 310   $sth->finish;
 311 }
 312
 313
 314
 315 sub updateissues{
 316   # issue the book
 317   my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
 318   my $loanlength=21;
 319   my $query="Select *  from biblioitems,itemtypes
 320   where (biblioitems.biblioitemnumber='$bitno')
 321   and (biblioitems.itemtype = itemtypes.itemtype)";
 322   my $sth=$dbh->prepare($query);
 323   $sth->execute;
 324   if (my $data=$sth->fetchrow_hashref) {
 325     $loanlength = $data->{'loanlength'}
 326   }
 327   $sth->finish;
 328   my $dateduef;
 329   if ($env->{'loanlength'} eq "") {
 330     my $ti = time;
 331     my $datedue = time + ($loanlength * 86400);
 332     my @datearr = localtime($datedue);
 333     $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 334   } else {
 335     $dateduef = $env->{'loanlength'};
 336   }
 337   $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
 338   values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
 339   my $sth=$dbh->prepare($query);
 340   $sth->execute;
 341   $sth->finish;
 342   $query = "Select * from items where itemnumber=$itemno";
 343   $sth=$dbh->prepare($query);
 344   $sth->execute;
 345   my $item=$sth->fetchrow_hashref;
 346   $sth->finish;
 347   $item->{'issues'}++;
 348   $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
 349   $sth=$dbh->prepare($query);
 350   $sth->execute;
 351   $sth->finish;
 352   #my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datedue);
 353   my @datearr = split('-',$dateduef);
 354   my $dateret = join('-',$datearr[2],$datearr[1],$datearr[0]);
 355 #  debug_msg($env,"query $query");
 356   return($dateret);
 357 }
 358
 359 sub calc_charges {
 360   # calculate charges due
 361   my ($env, $dbh, $itemno, $bornum)=@_;
 362   my $charge=0;
 363   my $item_type;
 364   my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
 365     where (items.itemnumber ='$itemno')
 366     and (biblioitems.biblioitemnumber = items.biblioitemnumber)
 367     and (biblioitems.itemtype = itemtypes.itemtype)";
 368   my $sth1= $dbh->prepare($q1);
 369   $sth1->execute;
 370   if (my $data1=$sth1->fetchrow_hashref) {
 371      $item_type = $data1->{'itemtype'};
 372      $charge = $data1->{'rentalcharge'};
 373      my $q2 = "select rentaldiscount from borrowers,categoryitem
 374         where (borrowers.borrowernumber = '$bornum')
 375         and (borrowers.categorycode = categoryitem.categorycode)
 376         and (categoryitem.itemtype = '$item_type')";
 377      my $sth2=$dbh->prepare($q2);
 378      $sth2->execute;
 379      if (my $data2=$sth2->fetchrow_hashref) {
 380         my $discount = $data2->{'rentaldiscount'};
 381         $charge = ($charge *(100 - $discount)) / 100;
 382      }
 383      $sth2->{'finish'};
 384   }
 385   $sth1->finish;
 386   return ($charge);
 387 }
 388
 389 END { }       # module clean-up code here (global destructor)