PROGRAM CALLNO (s1: string;lw,occ:real; s2:string) [FORMAT];
{ ------------------------------------------------------ }
{  Format exit to provide correct sorting sequences for  }
{  Library of Congress / National Library of Medecine    }
{  call numbers.                                         }
{                                                        }
{  Call numbers are assumed to consist of                }
{  (1) a main class of one to three letters              }
{  (2) a blank space                                     }
{  (3) a class number of one to three digits             }
{  (4) an optional decimal part consisting of a decimal  }
{       point and the decimal part of the class number   }
{       with one to three digits                         }
{  (5) an optional cutter number, consisting of a blank  }
{      space as a separator, and one to three letters    }
{      followed by one to three digits                   }
{                                                        }
{  Version 1.02   1995-09-12                             }
{ -----------------------------------------------------  }
{    Freely distributed for non-commercial use.          }
{             Ron Davies                                 }
{           48 - 200 Owl Drive,                          }
{          Ottawa, Canada K1V 9P7                        }
{          Fax : (613) 523-4417                          }
{ -----------------------------------------------------  }
VAR
  i            : real;
  j            : real;
  next         : real;
  charcode     : real;
  blanks       : string;
  mainclass    : string;
  cutter       : string;
  cutteralph   : string;
  cutternum    : string;
  classnum     : string;
  class1       : string;
  class2       : string;
  class3       : string;
  wrkstr       : string;
  garb         : string;
{ --------------------------------------------- }
{ Function  XTRACT                              }
{                                               }
{ Extracts parts of a string SOURCE to a string }
{ TARGET, starting at position START. DELIMITER }
{ contains the character used as a separator.   }
{ Function returns a position that can next be  }
{ used as next START, or a point beyond end of  }
{ the string, if all parts have been extracted. }
{ --------------------------------------------- }
function xtract( start:real;
                 delimiter: string;
                 source:string;
                 target:string) : real;
var
  len : real;
  pos : real;
begin
  len  := size(source) - start + 1;
  if len <= 0 then
   begin
    target := '';
    xtract := size(source) + 1;
   end
  else
    begin
      pos := position(source,delimiter,start);
      if pos = 0 then
        begin
           target := substr(source,start,len);
           xtract := size(source) + 1;
        end
      else
        begin
          len := pos - start;
          target := substr(source,start,len);
          if (start + len) = size(source) then
            xtract := size(source)+1
         else
            xtract := start + len;
        end;
    end;
end;

{ --------------------------------------------- }
{             MAIN LOGIC                        }
{ --------------------------------------------- }
BEGIN
   blanks := '      ';
   classnum := '';
   cutter := '';
   class1 := '';
   class2 := '';
   class3 := '';
   cutteralph := '';
   cutternum := '';

   wrkstr := s1;

   { EXTRACT DIFFERENT PARTS OF CALL NUMBER }
   { -------------------------------------- }
   i := 1;
   next := xtract(i,' ',wrkstr,mainclass);
   i := next+1;
   next := xtract(i,' ',wrkstr,classnum);
   i := next+1;
   next := xtract(i,' ',wrkstr,cutter);

   { SEPARATE PARTS OF CLASS NUMBER         }
   { -------------------------------------- }
   i := 1;
   next := xtract(i,'.',classnum,class1);
   i := next+1;
   next := xtract(i,'.',classnum,class2);
   i := next+1;
   next := xtract(i,'.',classnum,class3);

   { SEPARATE PARTS OF CUTTER NUMBER         }
   { --------------------------------------- }
   i := 0;
   j := size(cutter);
   { Find start of numeric portion of Cutter number }
   repeat
      i := i + 1;
     charcode := ord(substr(cutter,i,1));
   until ((charcode >= 48) and (charcode <= 57)) or (i>j);
   cutteralph := substr(cutter,1,i-1);
   cutternum  := substr(cutter,i,size(cutter));

   { CONCATENATE PARTS TO MAKE SORT KEY      }
   { --------------------------------------  }
   i := 3-(size(mainclass));
   wrkstr := mainclass | substr (blanks,1,i);
   i := 3-(size(class1));
   wrkstr := wrkstr | substr (blanks,1,i) | class1;
   i := 3-(size(class2));
   wrkstr := wrkstr |  class2 | substr (blanks,1,i);
   i := 3-(size(class3));
   wrkstr := wrkstr |  class3 | substr (blanks,1,i);
   i := 3-(size(cutteralph));
   wrkstr := wrkstr | cutteralph | substr(blanks,1,i);
   i := 3-(size(cutternum));
   wrkstr := wrkstr | substr (blanks,1,i) | cutternum;

   s2 := wrkstr;
END.