Example of Core Sorting Routine

TEMPEMP

Information file about temporary employees:

 Last Name           First Name       Employee Number       Hire Date

 Gangley,            Tomas               000003              06/06/87
 Rields,             Evelyn              000007              07/12/87
 Everett,            Joyce               000029              10/19/87
  
 0        1         2         3         4         5         6         7
 1234567890123456789012345678901234567890123456789012345678901234567890

PERMEMP

Information file about permanent employees:

 Last Name          First Name        Employee Number       Hire Date
  
 Jones,              Eliza               000001              06/06/87
 Smith,              James               000005              06/06/87
 Jackson,            Johnathon           000006              06/06/87
 Washington,         Lois                000014              07/23/87
 Jackson,            Rosa                000022              08/15/87
  
 0        1         2         3         4         5         6         7
 1234567890123456789012345678901234567890123456789012345678901234567890

   program SORTFILE (input,output);
   
   {This program reads the files, TEMPEMP and PERMEMP, }
   {sorts by last name, and outputs to the file, ALLEMP}
   
   var
      tempFileNum: INTEGER;
      permFileNum: INTEGER;
      outFileNum : INTEGER;
      status     : INTEGER;

   procedure HPFOPEN  ; intrinsic;
   procedure HPSORTINIT; intrinsic;
   procedure HPSORTERRORMESS; intrinsic;
   procedure HPSORTEND; intrinsic;
   procedure FCLOSE; intrinsic;


   procedure OPEN_FILES;

   const
      designator  = 2;
      domain      = 3;
      access      = 11;
      record_size = 19;

   var
      tempFile  : packed array [1..10] of CHAR;
      permFile  : packed array [1..10] of CHAR;
      outFile   : packed array [1..10] of CHAR;
      permanent : INTEGER;
      new       : INTEGER;
      write     : INTEGER;
      size      : INTEGER;

   begin
      tempFile := '%TEMPEMP%';
      permanent := 1;
      HPFOPEN (tempFileNum, status, designator, tempFile, domain,
               permanent);

      permFile := '%PERMEMP%';
      HPFOPEN (permFileNum, status, designator, permFile, domain,
               permanent);

      new := 4;
      write := 1;
      size := 80;
      outFile := '%ALLEMP%';
      HPFOPEN (outFileNum, status, designator, outFile, domain, new,
               access, write, record_size, size);
   end;


   procedure DO_SORT;

   var
      inputfiles   : array [1..3] of INTEGER;
      outputfile   : array [1..2] of INTEGER;
      outputOption : INTEGER;
      numKeys      : INTEGER;
      keys         : array [1..4] of INTEGER;
      altseq       : packed array [1..2] of CHAR;
      message      : packed array [1..80] of CHAR;
      length       : INTEGER;
      statistics   : array [1..6] of INTEGER;

   begin
      inputfiles [1] := tempFileNum;
      inputfiles [2] := permFileNum;
      inputfiles [3] := 0;
      outputfile [1] := outFileNum;                     {from HPFOPEN}
      outputfile [2] := 0;
      outputOption := 0;   {output record format same as input record}
      numKeys := 1;                                       {one key   }
      keys[1] := 1;                                       {key begins}
      keys[2] := 20;                                      {key length}
      keys[3] := 0;                                       {byte data }
      keys[4] := 0;                                  {ascending order}
      altseq[1] := CHR(255);          {data = ASCII; sequence = ASCII}
      altseq[2] := CHR(255);                 {256 characters in ASCII}
      HPSORTINIT (status, inputfiles, outputfile, outputOption,,,
                  numKeys, keys, altseq,,,,,);
      if status <> 0 then             {If error in HPSORTINIT  }
      begin                       {Get message and write it to screen}
         Message := ' ';
         HPSORTERRORMESS (status, message, length);
         writeln (message);
      end;

      HPSORTEND (status, );

      if status <> 0 then             {If error in HPSORTEND   }
      begin                       {Get message and write it to screen}
         message := ' ';
         HPSORTERRORMESS (status, message, length);
         writeln (message);
      end;
   end;


   procedure CLOSE_FILES;

   var
      disposition : SHORTINT;
      securityCode : SHORTINT;

   begin
      disposition := 0;
      securityCode := 0;
      FCLOSE (tempFileNum, disposition, securityCode);
      FCLOSE (permFileNum, disposition, securityCode);
      disposition := 1;
      FCLOSE (outFileNum, disposition, securityCode);
   end;

   begin {main}
      OPEN_FILES;
      DO_SORT;
      CLOSE_FILES;
   end.