program pe_rec(input,output);
Å
**********************************************************************
*                                                                    *
* SURVEY OF CONSUMER FINANCES            EMPLOYER SPONSORED PENSIONS *
*                                                                    *
*                     BENEFIT ESTIMATION PROGRAM                     *
*                                                                    *
* RICHARD CURTIN                                     PAUL PICKELMANN *
*                                                    SCOT ALLEN      *
*                                                                    *
*                (c) 1986  THE UNIVERSITY OF MICHIGAN                *
*                                                                    *
**********************************************************************
Ì
Å READS PP OUTPUT, SORTS, AND BUILDS PERSON RECORDS Ì
type
  shortline = packed record
              xxx1: packed arrayÕ1..3å of char;
              hhid: packed arrayÕ1..5å of char;
              xxx2: packed arrayÕ1..135åof char;
              pass: packed arrayÕ1..132åof char;
Å MUST SPECIFY COMBINED WIDTH OF ALL PASS THROUGH VARIABLES
  AS THE UPPER BOUND IN THE RANGE ABOVE                     Ì
              end;
  shortnopt = packed record
              xxx1: packed arrayÕ1..3å of char;
              hhid: packed arrayÕ1..5å of char;
              xxx2: packed arrayÕ1..135åof char;
              end;
  longline  = packed record
              hhid : packed arrayÕ1..5å of char;
              line1: arrayÕ1..4å of shortnopt;
              pt1  : packed arrayÕ1..132å of char;
              end;
  listtype =  arrayÕ1..1793å of shortline;
Å MUST SPECIFY UPPER BOUND OF RANGE ABOVE AT LEAST EQUAL
  TO ONE PLUS THE NUMBER OF LINES IN THE INPUT FILE         Ì
const
  s0 = shortnopt('   ','00000',
          '  000   00 0 0000000 0000000 0000000 0000000  0000000000  '
       !! '00000  00000 00  00000  00000 000000  00000    0000000    00000000   00000000');
  pt = '                                                  '
     !!'                                                  '
     !!'                                ';
Å THE NUMBER OF BLANKS IN QUOTES ABOVE MUST MATCH THE
  COMBINED WIDTH OF PASS THROUGH VARIABLES GIVEN ABOVE      Ì
  l0 = longline('    ',(s0,s0,s0,s0),pt);
var
  input:  text;
  output: file of longline;
  hh :     packed arrayÕ1..5å of char;
   r:     integer;
   list: listtype;


procedure interchange(var line1, line2 : shortline);

var
   dummy : shortline;

begin
   dummy := line1;
   line1 := line2;
   line2 := dummy;
end;


procedure qsort(var list:listtype ; m,n : integer);
var
   i,j : integer;
   k : packed arrayÕ1..5å of char;

begin
   if m < n
      then
         begin
            i := m; j := n + 1; k := listÕmå.hhid;
            repeat
               repeat
                  i := i + 1;
               until listÕiå.hhid >= k;
               repeat
                  j := j - 1;
               until listÕjå.hhid <= k;
               if i < j
                  then
                     interchange(listÕiå, listÕjå);
            until i >= j;
            interchange(listÕmå,listÕjå);
            qsort(list, m, j-1);       ÅGo sort left halfÌ
            qsort(list, j+1, n);       ÅGo sort right halfÌ
         end;
end;

function nopt(inline:shortline):shortnopt;

begin
   nopt.xxx1 := inline.xxx1;
   nopt.hhid := inline.hhid;
   nopt.xxx2 := inline.xxx2;
end;

procedure combine;

var
   s : 0..4;
   t : integer;

begin
rewrite(output,'unit=sprint');
t := 1;
while t <= r do begin
  hh := listÕtå.hhid;
  s := 0;  output@ := l0;  output@.hhid := hh;
  repeat
    s := s + 1;
    output@.pt1 := listÕtå.pass; output@.line1Õså := nopt(listÕtå);
    t := t + 1;
    until (t > r) or (listÕtå.hhid<>hh);
  put(output);
  end;
end;

Å PROGRAM CONTROL STATEMENTS Ì
begin
r := 0;
reset(input,'unit=scards');
while not eof(input) do begin
      r := r + 1;
      readln(input,listÕrå.xxx1,listÕrå.hhid,listÕrå.xxx2,listÕrå.pass);
      end;
listÕr+1å.hhid := '99999';
qsort(list,1,r);
combine;

end.
