program hh_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 HOUSEHOLD 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;
              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..4å of char;
              line1: arrayÕ1..4å of shortnopt;
              pt1  : packed arrayÕ1..132å of char;
              line2: arrayÕ5..8å of shortnopt;
              pt2  : packed arrayÕ1..132å of char;
              end;
  listtype =  arrayÕ1..1793å of shortline;
const
  s0 = shortnopt('   ','00000',
          '  000   00 0 0000000 0000000 0000000 0000000  0000000000  '
       !! '00000  00000 00  00000  00000 000000  00000    0000000    00000000   00000000');
  pt = '                                                  '
     !!'                                                  '
     !!'                                ';
  l0 = longline('    ',(s0,s0,s0,s0),pt,(s0,s0,s0,s0),pt);
var
  input:  text;
  output: file of longline;
  hh,temphh :     packed arrayÕ1..4å of char;
   s:     0..8;
   t:     0..8;
   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..8;
   t : integer;

begin
rewrite(output,'unit=sprint');
t := 1;
while t <= r do begin
  hhÕ1å := listÕtå.hhidÕ1å; hhÕ2å := listÕtå.hhidÕ2å; hhÕ3å := listÕtå.hhidÕ3å; hhÕ4å := listÕtå.hhidÕ4å;
  s := 0;  output@ := l0;  output@.hhid := hh;
  repeat
    s := s + 1;
    if (listÕtå.hhidÕ5å='2')and(s<5) then s := 5;
    if (s < 5)
       then begin output@.pt1 := listÕtå.pass; output@.line1Õså := nopt(listÕtå); end
       else begin output@.pt2 := listÕtå.pass; output@.line2Õså := nopt(listÕtå); end;
    t := t + 1;
    temphhÕ1å := listÕtå.hhidÕ1å; temphhÕ2å := listÕtå.hhidÕ2å; temphhÕ3å := listÕtå.hhidÕ3å; temphhÕ4å := listÕtå.hhidÕ4å;
    until (t > r) or (temphh<>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.
