program calculat;

**********************************************************************
*                                                                    *
* SURVEY OF CONSUMER FINANCES            EMPLOYER SPONSORED PENSIONS *
*                                                                    *
*                     BENEFIT ESTIMATION PROGRAM                     *
*                                                                    *
* RICHARD CURTIN                                     PAUL PICKELMANN *
*                                                    SCOT ALLEN      *
*                                                                    *
*                (c) 1986  THE UNIVERSITY OF MICHIGAN                *
*                                                                    *
**********************************************************************

def
  seq: integer;
  todayd, sex, oppsex, married,  birthd, minbend, hired, quitd, benifitd:  real;
  surveyd, lastwage, pcinfl, pcwage, shrs, swage, sssbase, sssben: real;
  basegrow, bengrow, lninfl,  lnintr, pcintr, lnwage, lnbase,lnben:  real;
  nrq, lrq, erq, vdq, drq, dsq, cnq, cnqann, prag, mrage, contann: real;
  qapprovl, qchild21, qcodable, qhazduty, qjrdable,
  qjrdeath, qpastsrv, qssbenif, qssdable, qveteran,
  qvolcntr, qwdman, qwdvol: boolean;
  coefpumi,coefpume,coefpuma,coefjumi,coefjume,coefjuma : real;
  coefprmi,coefprme,coefprma,coefjrmi,coefjrme,coefjrma : real;
  coefpdmi,coefpdme,coefpdma,coefjdmi,coefjdme,coefjdma : real;
  coefdsmi, coefdsme, coefdsma : real;
  icrprof1,icrprof2,icrprof3,icrfort1,icrfort2,icrfort3,icrvol : real;
  icoenar, immannar, imvolnar, imannar, ivol1nar, ivol2nar : real;
  mincutss, maxcutss, anntype, continpmt, vestopt, vestyrs : real;

procedure  eval;  external;
function   aage(b,a: real): real;  external;
function   apvla (b: real): real;  external;
function   ss  (k,t: real): real;  external;
function   wage  (t: real): real;  external;
function   annpay(pvamt,curdate:real):real; external;

const filestringmax = 38;
type  filestring = string(filestringmax); ptpstr = string(2);

var
  pcivar, maxben55, maxben65 : real;
  qexpectd, qagemin, qagemax, qdatemin, qdatemax, pentype: real;
  qasy, qwage, holdat, holdsx, holdbd, mrdate, mronoff: real;
  codeid,hhid,i7: integer;
  date, time: alfa;
  dtp, newdtp, ptp, newptp, qtp, newqtp: ptpstr;
  failedcase: boolean;
  flag, newflag:       char;
  edms,edsex: integer;
  edbirthd, edhired, edexpectd, edhrs, edwage, edivar: real;
  pensionb,dableb,vestedb,vestedd,quitb,pvfactor: real;
  edfile,
  infile,
  outfile,
  outputh,
  probfile:   text;
  t:          real;
  inversion,
  edversion:  integer;
  edname,
  inname,
  probname,
  outhname,
  planfile,
  outname:    filestring;
  a7 : packed array1..filestringmax of char;
  passthru: string(133);
%page
Growth Rate Conversions

PCLN: Returns percentage change rate given natural rate
function pcln(l:real): real;
begin pcln := 100*exp(l)-100; end;

LNPC: Returns natural rate given percentage change rate
function lnpc(p:real): real;
begin lnpc := ln(1+p/100); end;
%page
EVALERR:  Write out current error to the error file
procedure evalerr(m: string(4));  external;
procedure evalerr;
begin
flag := '*';
failedcase := true;
writeln(probfile,m:4,hhid:6,codeid:5,seq:5,birthd:8:2,hired:8:2,
  qexpectd:8:2,benifitd:8:2,nrq:7:0,lrq:7:0,erq:7:0,vdq:7:0,drq:7:0,dsq:7:0,cnqann:7:0);
end;
%page
ONERROR:  Intercept divide by 0 errors and send to error file
%include onerror;
procedure onerror;
begin
  if ferror in 19, 21, 25 then begin
    faction :=  ; evalerr('/BY0'); end;
end;
%page
REMALPHAS:  Replaces non-numeric output flags with numeric codes for -outdata
function remalphas(oldptp:ptpstr):ptpstr;
begin
  if oldptp = 'NR' then remalphas := '01' else
  if oldptp = 'LR' then remalphas := '02' else
  if oldptp = 'ER' then remalphas := '03' else
  if oldptp = 'VD' then remalphas := '04' else
  if oldptp = 'DR' then remalphas := '05' else
  if oldptp = 'SB' then remalphas := '06' else
  if oldptp = 'CN' then remalphas := '07' else
  if oldptp = '--' then remalphas := '09';
  if oldptp = 'NC' then remalphas := '11' else
  if oldptp = 'LC' then remalphas := '12' else
  if oldptp = 'EC' then remalphas := '13' else
  if oldptp = 'VC' then remalphas := '14' else
  if oldptp = 'DC' then remalphas := '15' else
  if oldptp = 'SC' then remalphas := '16' else
  if oldptp = '-C' then remalphas := '19';
end;

PENCAPS:  Places a maximum on the pension value
function pencaps(curpen,curage:real):real;
var tempmax : real;
begin
  if (curpen < 0) and (curpen <> -1) then pencaps := -1 else begin
  if curage <= 55 then tempmax := maxben55
  else if curage >= 65 then tempmax := maxben65
  else tempmax := maxben55 + (trunc(curage - 55)) * ((maxben65-maxben55)/10);
  tempmax := tempmax * exp(lnbase*(curage+birthd-surveyd));
  if (tempmax > curpen) then pencaps := curpen
  else pencaps := tempmax; end;
end;
%page
CALLEVAL:  Call EVAL to execude the pension procedures and then compute pensionb
procedure calleval;
begin
if mronoff = 1.0 then begin
benifitd := quitd; eval;
if mrage <> 999 then mrdate := birthd + mrage else mrdate := 9999;
if quitd > mrdate then quitd := mrdate; end else mrage := 999;
minbend := max(quitd,birthd+65.0);
repeat
   benifitd := minbend;
   eval;
   until  benifitd=minbend;
vestedb := vdq;
vestedd := benifitd;
benifitd := quitd;
minbend  := quitd;
eval;
ptp := '--';  dtp := '--';
pensionb := erq;  dableb := drq;
if       erq>0    then ptp := 'ER';
if       drq>0    then dtp := 'DR';
if       nrq>0    then begin ptp := 'NR';  pensionb := nrq;  end;
if lrq>max(0,nrq) then begin ptp := 'LR';  pensionb := lrq;  end;
if  pensionb>drq  then begin dtp := ptp;   dableb := pensionb;  end;
qtp := ptp;  quitb := pensionb;
if  pensionb<=0  then begin pensionb := vestedb;  benifitd := vestedd;
    if vestedb>0 then ptp := 'VD'  end;
if (pensionb = 0) and (cnq > 0) and (codeid < 5000) then begin
   pensionb := annpay(cnq,benifitd); ptp := 'CN'; end;
if (pensionb = 0) and (cnq < 0) then pensionb := -1;
if cnq > 0 then cnqann := annpay(cnq,benifitd) else
if cnq = 0 then cnqann := 0 else if cnq < 0 then cnqann := -1;
if (quitb <= 0) and (cnqann > 0) and (codeid < 5000) then begin quitb := cnqann; qtp := 'CN'; end;
if ((codeid < 3000) or (codeid >= 5000)) and (ptp <> '--') then begin
   if pentype=2.0 then begin ptp := 'SB';
      pensionb := dsq; end
   else if pentype=1.0 then begin ptp := dtp;
      pensionb := dableb; end; end;
if (codeid >= 5000) and (contann = 0) and (cnqann > 0) then begin
   pensionb := pensionb + cnqann; dableb := dableb + cnqann; vestedb := vestedb + cnqann;
   dtp := substr(dtp,1,1) !! 'C'; qtp := substr(qtp,1,1) !! 'C';
   quitb := quitb + cnqann;
   ptp := substr(ptp,1,1) !! 'C'; end;
end;
%page
RRANGE:  Read a real number from a file and if not in given range return given default value
procedure rrange(var f: text; try: boolean; var x: real; l,u,d: real);
begin
x := d;
if  try  then begin
  read(f,x);
  if  ((x<l) or (x>u)) and (x<>d)  then begin
    evalerr('DATA');  x := d;  end;
end;end;

IRANGE:  Read an integer from a file and if not in given range return given default value
procedure irange(var f: text; try: boolean; var x: integer; l,u,d: integer);
begin
x := d;
if  try  then begin
  read(f,x);
  if  ((x<l) or (x>u)) and (x<>d)  then begin
    evalerr('DATA');  x := d;  end;
end;end;

RLNRANGE:  Call RRANGE and then do a line feed
procedure rlnrange(var f: text; try: boolean; var x: real; l,u,d: real);
begin  rrange(f,try,x,l,u,d);  if  try  then  readln(f);  end;

ILNRANGE:  Call IRANGE and then do a line feed
procedure ilnrange(var f: text; try: boolean; var x: integer; l,u,d: integer);
begin  irange(f,try,x,l,u,d);  if  try  then  readln(f);  end;
%page
READEDFILE:  Read in the assumption file
procedure readedfile;
var  new1,new2,new3,new4: boolean;
begin
if  not (edversion in 00,10,11,12,13)  then  evalerr('EDVN');
new4 := (edversion=13);
new3 := (edversion=12) or new4;
new2 := (edversion=11) or new3;
new1 := (edversion=10) or new2;
rlnrange(edfile, new1, surveyd,      1980,        2000, 1983.5);
rlnrange(edfile, new1, todayd,       1980,        2000, 1983.5);
rlnrange(edfile, new1, pcinfl,        -25,          25,    0.0);
rlnrange(edfile, new1, pcintr,          0,          20,    1.0);
rlnrange(edfile, new1, pcwage,         -20,         20,    0.0);
rlnrange(edfile, new2, sssbase,          1,      60000,    1.0);
rlnrange(edfile, new2, basegrow,       -20,         20,    0.0);
rlnrange(edfile, new2, sssben,           1,      30000,    1.0);
rlnrange(edfile, new2, bengrow,        -20,         20,    0.0);
  rrange(edfile, new3, qagemin,         16,         80,   16.0);
rlnrange(edfile, new3, qagemax,         16,         80,   80.0);
  rrange(edfile, new3, qdatemin,      1925,       2075, 1925.0);
rlnrange(edfile, new3, qdatemax,      1925,       2075, 2075.0);
  rrange(edfile, new3, coefpumi,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefpume,      0.00,       5.00, 1.00);
rlnrange(edfile, new3, coefpuma,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefjumi,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefjume,      0.00,       5.00, 1.00);
rlnrange(edfile, new3, coefjuma,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefprmi,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefprme,      0.00,       5.00, 1.00);
rlnrange(edfile, new3, coefprma,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefjrmi,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefjrme,      0.00,       5.00, 1.00);
rlnrange(edfile, new3, coefjrma,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefpdmi,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefpdme,      0.00,       5.00, 1.00);
rlnrange(edfile, new3, coefpdma,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefjdmi,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefjdme,      0.00,       5.00, 1.00);
rlnrange(edfile, new3, coefjdma,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefdsmi,      0.00,       5.00, 1.00);
  rrange(edfile, new3, coefdsme,      0.00,       5.00, 1.00);
rlnrange(edfile, new3, coefdsma,      0.00,       5.00, 1.00);
  rrange(edfile, new3, maxben55,      0.00,  500000.00,500000.00);
rlnrange(edfile, new3, maxben65,      0.00,  500000.00,500000.00);
  rrange(edfile, new3, mincutss,      0.00,  500000.00,     0.00);
rlnrange(edfile, new3, maxcutss,      0.00,  500000.00,500000.00);
  rrange(edfile, new3,  icrprof1,      0.00,      30.00, 5.00);
rlnrange(edfile, new3,  icrfort1,      0.00,      10.00, 0.50);
  rrange(edfile, new3,  icrprof2,      0.00,      30.00, 5.00);
rlnrange(edfile, new3,  icrfort2,      0.00,      10.00, 0.50);
  rrange(edfile, new3,  icrprof3,      0.00,      30.00, 5.00);
rlnrange(edfile, new3,  icrfort3,      0.00,      10.00, 0.50);
  rrange(edfile, new3,  icoenar,      0.00,      30.00, 5.00);
rlnrange(edfile, new3,  imannar,      0.00,      30.00, 5.00);
  rrange(edfile, new3, ivol1nar,      0.00,      30.00, 0.00);
rlnrange(edfile, new3, ivol2nar,      0.00,      30.00, 0.00);
  rrange(edfile, new3, immannar,      0.00,     200.00, 100.00);
rlnrange(edfile, new3, imvolnar,      0.00,     200.00, 100.00);
  rrange(edfile, new3, anntype,       1.00,       3.00,   3.00);
rlnrange(edfile, new3, continpmt,     0.00,     100.00,  50.00);
  rrange(edfile, new3, vestopt,       0.00,       1.00,   0.00);
rlnrange(edfile, new3, vestyrs,       0.00,     25.00,    5.00);
rlnrange(edfile, new3, mronoff,       0.00,      1.00,    0.00);
rlnrange(edfile, new3, pentype,       0.00,      2.00,    0.00);

Not currently used, for test purposes only
ilnrange(edfile, new4, edms,             0,          3,    0);
ilnrange(edfile, new4, edsex,            0,          3,    0);
rlnrange(edfile, new4, edbirthd,      1880,       2000,    0);
rlnrange(edfile, new4, edhired,edbirthd+16,edbirthd+25,    0);
rlnrange(edfile, new4, edexpectd,  edhired,edbirthd+80,    0);
rlnrange(edfile, new4, edhrs,          200,       3000,    0);
rlnrange(edfile, new4, edwage,        1000,    1500000,    0);
rlnrange(edfile, new4, edivar,         -10,        +10,    0);
end;
%page
READPLAN:  Read in the household id, code id, and sequenc number
procedure readplan(var f:text);  begin
read(f,hhid,codeid,seq);  end;

READDATES:  Read in birthdate of spouse, sex of respondent, birth date of
 respondent, hire date, and expected quit date
procedure readdates(var f:text);
var  new2,new1,new0: boolean;
begin
new2 := not (inversion in 10,11,13,20,21,30,31,40,41);
new1 := not (inversion in 30,13);
new0 := not (inversion in 13);
rrange(f, new2, married,          0,         2000,         0);
rrange(f, new2, sex,              1,         2,         1);
if sex = 1 then oppsex := 2 else oppsex := 1;
rrange(f, new0, birthd,        1880,      1970,      1950);
if (married > 0) and (married < 1880) then married := birthd;
rrange(f, new0, hired,    birthd+16, birthd+65, birthd+20);
rrange(f, new1, qexpectd, hired,     birthd+80, birthd+65);
end;

READWAGE:  Read in hours worked, last wage, wage growth, volintary cont.
procedure readwage(var f: text);
  var new1,new0:boolean;
begin
new1 := not (inversion in 10,13,20,30,40);
new0 := not (inversion in 13);
rrange(f, new1,  shrs,       1,    2080,  2080);
rrange(f, new0, lastwage, 1, 1000000, 1);
rrange(f, new1,  pcivar,    -20,     +20,     0);
rrange(f, new1, icrvol, 0, 30, 0);
end;
%page
FAKEDATA:  For testing purposes only
procedure fakedata;
begin
pcivar := 0.0;
birthd :=   1935.0;
qexpectd := 2000.0;
lastwage := 20000;
end;

ADJUSTDATA: Used to control input variables when testing.  Also
 used to adjust rates for inflation and to adjust quitd.
procedure adjustdata;
begin
if     edsex<>0  then  sex := edsex;
if      edms<>0  then  married := edms;
if  edbirthd<>0  then  birthd := edbirthd;
if   edhired<>0  then  hired := edhired;
if edexpectd<>0  then  qexpectd := edexpectd;
if     edhrs<>0  then  shrs := edhrs;
if    edwage<>0  then  lastwage := edwage;
if    edivar<>0  then  pcivar  := edivar;

lninfl := lnpc(pcinfl);
lnintr := lnpc(pcintr) + lninfl;
lnwage := lnpc(pcwage+pcivar) + lninfl;
lnbase := lnpc(basegrow) + lninfl;
lnben := lnpc(bengrow) + lninfl;
if qexpectd<=surveyd then begin
  swage := 1.0;  swage := lastwage/wage(qexpectd);
  quitd := qexpectd;  end
else begin
  quitd := max(qdatemin,qexpectd);
  quitd := min(qagemax+birthd,qdatemax,quitd);
  quitd := max(qagemin+birthd,surveyd,quitd);
  swage := lastwage;  end;
qwage := wage(quitd);
qasy := quitd - hired;
end;
%page
MEAN:  Adds current value to the sum, used to compute the mean
procedure mean(curvar:real;var totalvar:real;var goodcnt : real);
begin
If curvar > 0
  then begin
    totalvar := totalvar + curvar;
    goodcnt := goodcnt + 1; end;
end;
%page
V1:  Run version 1 - One quit date, one output line per input line
procedure v1;
  var  a65, pv, rr, rr1, rr30: real;
       totalv1, countv1, meanv1 : array 1..16 of real;
       r1d, initloop: integer;
begin
writeln(outputh,'                                               ------------ Quit ------------ ---------------------- Pension ----------------------');
writeln(outputh,'  HHIDX Code Seq# Sex SpouseBD  BirthD  HireD    Date    Wage     Age    Asy  Tp   Age    %QW  %/Yr   30y  AnualAm Pr.Value A65eqvl');
writeln(outputh,'  ----- ---- ---- --- -------- ------- ------- ------- -------- ------ ------ -- ------ ------ ---- ------ ------- -------- -------');
for initloop := 1 to 14 do begin
  totalv1initloop := 0; countv1initloop := 0; meanv1initloop := -1; end;
while not eof(infile) do begin
  failedcase :=false;  flag := ' ';
  a65 := -1;  pv := -1;  rr := -1;  rr1 := -1;  rr30 := -1; r1d := 0;
  readplan(infile);
  readdates(infile);
  readwage(infile);
  if  eoln(infile)  then  passthru := ''  else  read(infile,passthru);
  readln(infile);
  adjustdata;
  calleval;
  if  pensionb>=0 then begin
      pensionb := pencaps(pensionb,(benifitd-birthd));
      holdat := anntype; anntype := 1.0; holdsx := sex; holdbd := birthd;
      if pentype = 2.0 then begin sex := oppsex; if married <> 0 then birthd := married; end;
      pv := apvla(benifitd)*pensionb; sex:=holdsx; birthd:=holdbd; if pentype <> 2.0 then
      begin anntype := holdat; pensionb := (1/apvla(benifitd))*pv; end;
      a65:= aage(benifitd,65)*pensionb;
      pv := pv * exp(lnintr * (todayd-benifitd));
      if qwage<>0 then begin
         rr  := 100*pensionb/qwage;
         rr1 := rr/qasy; r1d := 2;
         rr30:= rr1*30;  end; end;
  writeln(outputh,flag,' ',hhid:5,   ' ',codeid:4, ' ',seq:4,' ',sex:2:0,'  ',married:8:2,
    ' ',birthd:7:2,   ' ',hired:7:2,' ',quitd:7:2,' ',min(99999999,qwage):8:0,
    ' ',(quitd-birthd):6:2, ' ',qasy:6:2, ' ',ptp:2,
    ' ',(benifitd-birthd):6:2,' ',min(999.99,rr):6:2,
    ' ',min(9.99,rr1):4:r1d,' ',min(999.99,rr30):6:2,' ',min(9999999,pensionb):7:0,
    ' ',min(99999999,pv):8:0,' ',min(9999999,a65):7:0);
  mean(sex,totalv11,countv11); mean(married,totalv12,countv12);
  mean(birthd,totalv13,countv13); mean(hired,totalv14,countv14);
  mean(quitd,totalv15,countv15); mean(min(99999999,qwage),totalv16,countv16);
  mean(min(999.99,quitd-birthd),totalv17,countv17);
  mean(min(999.99,qasy),totalv18,countv18);
  mean(min(999.99,benifitd-birthd), totalv110, countv110);
  mean(min(999.99,rr),totalv111,countv111);
  mean(min(9.99,rr1),totalv112,countv112);
  mean(min(999.99,rr30),totalv113,countv113);
  mean(min(9999999,pensionb),totalv114,countv114);mean(min(99999999,pv),totalv115,countv115);
  mean(min(9999999,a65),totalv116,countv116);
  newflag := ' '; newptp := remalphas(ptp);
  writeln(outfile,newflag,' ',hhid:5,   ' ',codeid:4, ' ',seq:4,' ',sex:1:0,' ',married:7:2,
    ' ',birthd:7:2,   ' ',hired:7:2,' ',quitd:7:2,' ',min(99999999.99,qwage):11:2,
    ' ',(quitd-birthd):6:2,      ' ',qasy:6:2, ' ',newptp:2,
    ' ',(benifitd-birthd):6:2,                 ' ',min(999.99,rr):6:2,
    ' ',min(999.99,rr1):6:2,' ',min(999.99,rr30):6:2,  ' ',min(9999999.99,pensionb):10:2,
    ' ',min(99999999.99,pv):11:2,                     ' ',min(9999999.99,a65):10:2,' ',passthru);
  end;
  for initloop := 1 to 16 do begin
    if countv1initloop <> 0 then
    meanv1initloop := totalv1initloop / countv1initloop; end;
  write(outputh,'   MEAN           ',meanv11:4:2,' ',meanv12:7:2,' ',meanv13:7:2,' ',meanv14:7:2,' ');
  write(outputh,meanv15:7:2,' ',meanv16:8:0,' ',meanv17:6:2,' ');
  write(outputh,meanv18:6:2,' ','  ',' ',meanv110:6:2,' ');
  write(outputh,meanv111:6:2,' ',meanv112:4:2,' ',meanv113:6:2,' ');
  writeln(outputh,meanv114:7:0,' ',meanv115:8:0,' ',meanv116:7:0);
end;
%page
V2:  Run version 2 & 4 - Simulated data, upto 5 cases run through any number of plans
procedure v2;
const  maxcircumstance=5;
var  a65, rr, rr1, rr30, pv: real;  r1d: integer;
  totalv2, countv2, meanv2 : array 1..20 of real;
  looping2 : integer;
     c: 1..maxcircumstance;
     numcirc: 0..maxcircumstance;
     circinfo: array1..maxcircumstance of record
       bd,hd,qd,sw,sh,iv,sx,os,sb,vc: real;  end;
begin
numcirc := 0; newflag := ' ';
for looping2 := 1 to 20 do begin
  totalv2looping2 := 0; countv2looping2 := 0; meanv2looping2 := -1; end;
writeln(outputh,'                          -- Survey -- Wage ',
               '        Quit ');
writeln(outputh,'# Sex SpouseBD  BirthD  HireD   QuitD  Hour   Wage  IndVr VolCt ',
               'Age Asy');
writeln(outputh,'- --- -------- ------- ------- ------- ---- ------- ----- ----- ',
               '--- ---');
while  not eof(infile) do with circinfonumcirc+1 do begin
  numcirc := numcirc + 1;
  readdates(infile);  readwage(infile);  readln(infile);
  bd := birthd; hd := hired; qd := qexpectd; sx := sex; vc := icrvol;
  sw := lastwage;   sh := shrs;   iv := pcivar; sb := married; os := oppsex;
  writeln(outputh, numcirc:1,' ',sx:2:0,'  ',sb:8:2,' ',bd:7:2,' ',hd:7:2,' ',qd:7:2,
    ' ',sh:4:0,' ',sw:7:0,' ',iv:5:2,' ',vc:5:2,
    ' ',trunc(qd-bd):3,' ',qd-hd:3:0);
  end;
reset(infile,'file=' !! planfile);
writeln(outputh);
writeln(outputh);  write(outputh,'    ');
for c := 1 to numcirc do begin
  write(outputh,' ----------');
  if inversion>=40 then write(outputh,'-');
  write(outputh,c:2,' ----------');  end;
writeln(outputh);  write(outputh,'Code');
for c := 1 to numcirc do if inversion<40
  then write(outputh,' Tp Ag 30y AnualA A65eql')
  else write(outputh,' T %W %/Yr AnualA PrValue');
writeln(outputh);  write(outputh,'----');
for c := 1 to numcirc do if inversion<40
  then write(outputh,' -- -- --- ------ ------')
  else write(outputh,' - -- ---- ------ -------');
writeln(outputh);
while not eof(infile) do begin
  failedcase :=false;
  readplan(infile);  readln(infile);
  write(outfile,codeid:4);
  write(outputh,codeid:4);
  for c := 1 to numcirc do with circinfoc do begin
    birthd := bd;  hired := hd;  qexpectd := qd; married := sb; oppsex := os;
    lastwage := sw; shrs := sh; pcivar := iv; sex := sx; icrvol := vc;
    adjustdata;
    flag := ' '; a65 := -1; rr := -1; rr30 := -1;  rr1 := -1;  r1d := 0;
    pv := -1;
    calleval;
    pensionb := pencaps(pensionb,(benifitd-birthd));
    if  pensionb>=0 then begin
      holdat := anntype; anntype := 1.0; holdsx := sex; holdbd := birthd;
      if pentype = 2.0 then begin sex := oppsex; if married <> 0 then birthd:= married; end;
      pv := apvla(benifitd)*pensionb; sex:=holdsx; birthd:=holdbd; if pentype <> 2.0 then
      begin anntype := holdat; pensionb := (1/apvla(benifitd))*pv; end;
      a65:= aage(benifitd,65)*pensionb;
      pv := pv * exp(lnintr * (todayd - benifitd));
      if  qwage<>0  then begin
        rr  := 100*pensionb/qwage;
        rr1 := rr/qasy;  r1d := 2;
        rr30:= rr1*30;  end; end;
    newptp := remalphas(ptp);
    if inversion<40
      then begin write(outputh,' ',flag,ptp1,' ',trunc(benifitd-birthd):2,
             ' ',min(999,rr30):3:0,' ',pensionb:6:0,' ',a65:6:0);
        mean(trunc(benifitd-birthd), totalv24*(c-1)+1, countv24*(c-1)+1);
        mean(min(999,rr30),totalv24*(c-1)+2,countv24*(c-1)+2);
        mean(pensionb,totalv24*(c-1)+3,countv24*(c-1)+3);
        mean(a65,totalv24*(c-1)+4,countv24*(c-1)+4);
        write(outfile,' ',newflag,newptp2,' ',(benifitd-birthd):6:2,
             ' ',min(999.99,rr30):6:2,' ',min(9999999.99,pensionb):10:2,' ',min(9999999.99,a65):10:2); end
      else begin write(outputh,' ',ptp1,min(99,rr):3:0,' ',
             min(9.99,rr1):4:r1d,' ',min(999999,pensionb):6:0,' ',min(9999999,pv):7:0);
        mean(min(99,rr), totalv24*(c-1)+1, countv24*(c-1)+1);
        mean(min(9.99,rr1),totalv24*(c-1)+2,countv24*(c-1)+2);
        mean(min(999999,pensionb),totalv24*(c-1)+3,countv24*(c-1)+3);
        mean(min(9999999,pv),totalv24*(c-1)+4,countv24*(c-1)+4);
        write(outfile,' ',newptp2,' ',min(999.99,rr):6:2,' ',
             min(999.99,rr1):6:2,' ',min(9999999.99,pensionb):10:2,' ',min(99999999.99,pv):11:2); end;
    end;
  writeln(outfile); writeln(outputh);
end;
for looping2 := 1 to 20 do begin
  if countv2looping2 <> 0.0 then
    meanv2looping2 := totalv2looping2 / countv2looping2 else meanv2looping2 := 0; end;
if inversion<40
  then begin write(outputh,'MEAN');
       for looping2 := 1 to 5 do begin
         write(outputh,'    ',meanv24*(looping2-1)+1:2:0,' ');
         write(outputh,meanv24*(looping2-1)+2:3:0,' ',meanv24*(looping2-1)+3:6:0);
         write(outputh,' ',meanv24*(looping2-1)+4:6:0);end; end
   else begin write(outputh,'MEAN');
       for looping2 := 1 to 5 do begin
         write(outputh,'  ',meanv24*(looping2-1)+1:3:0);
         write(outputh,' ',meanv24*(looping2-1)+2:4:2,' ',meanv24*(looping2-1)+3:6:0);
         write(outputh,' ',meanv24*(looping2-1)+4:7:0);end; end;
writeln(outputh);
end;
%page
V3:  Run version 3 - All possible quit dates
procedure v3;
var
  nro, lro, ero, vdo, dso, dro, cno, cnoann, pensiono, vestedo, dableo, deatho, quito: real;
  flagq: char;

EVALAGE:  Attempt to flag problems
procedure evalage;
begin
calleval;
if  vestedd<quitd  then  evalerr('VDBG');
if  minbend<>quitd then  evalerr('BBeg');
if  (nrq=-1.0) or (erq=-1.0)  then  flagq := '-';
if  nro>nrq  then  evalerr('NRQ');
if  lro>lrq  then  evalerr('LRQ');
if  ero>erq  then  evalerr('ERQ');
if  vdo>vdq  then  evalerr('VDQ');
if  dso>dsq  then  evalerr('DSQ');
if  dro>drq  then  evalerr('DRQ');
if  cno>cnq then evalerr('CNQ');
if  quito   > quitb    then  evalerr('QUIT');
if  vestedo > vestedb  then  evalerr('VEST');
if  dableo  >  dableb  then  evalerr('DABL');
if cnoann>cnqann then evalerr('CTAN');
nro := nrq;
lro := lrq;
ero := erq;
vdo := vdq;
dso := dsq;
dro := drq;
cno := cnq;
pensiono := pensionb;
quito    := quitb;
vestedo  := vestedb;
dableo   :=  dableb;
cnoann := cnqann;
end;
%page
var
   vest65,benfirst,ben55,ben60,ben62,ben65,ben70,benlast: real;
   age,from,tooo,agefirst,agelast:integer;
begin
newflag := ' ';
while  not eof(infile)  do begin
  failedcase := false;
  nro :=-1;         lro :=-1;     ero :=-1;   vdo :=-1;   dso :=-1;
  dro := -1;    pensiono:=-1; vestedo :=-1; dableo:=-1; deatho:=-1;
  quito := -1;  agefirst:=-1; benfirst:=-1; ben55 :=-1; ben60 :=-1;
  agelast :=-1; benlast :=-1; ben62 :=-1;   ben65 :=-1; ben70:=-1;
  readplan(infile);  readdates(infile);  readwage(infile);
  readln(infile);
  page(outputh);
  writeln(outputh,'HHID:',hhid:1,' CodeID:',codeid:1,' Seq#:',seq:1,
    ' Sex:',sex:1:0,' SpouseBD:',married:7:2,' BirthD:',birthd:7:2,' HireD:',hired:7:2,' Hours:',shrs:4:0,' IndVr:',pcivar:5:2,' VolCt:',icrvol:5:2);
  writeln(outputh);
  writeln(outputh,'FF Date Age ASY   Wage      SSB    PensnB Tp  Vested BA  Vest65  DableB Tp   NRT     LRT     ERT     VDT     DRT     DST     CNT  ');
  writeln(outputh,'-- ---- --- --- -------- -------- ------- -- ------- -- ------- ------- -- ------- ------- ------- ------- ------- ------- -------');
  age := round(1984-birthd);
  from := round(max(qagemin,max(qdatemin,surveyd)-birthd));
  tooo := round(min(qagemax,qdatemax-birthd,from+55));
  age := from;
  repeat
    qexpectd := birthd + age;
    adjustdata;
    flag := ' ';  flagq := ' ';
    evalage;
    benifitd := birthd + 65;
    vest65 := vestedb;
    if  vest65>0  then  vest65 := aage(vestedd,65)*vestedb;
  quitb := pencaps(quitb,age);   Put cap on pension amounts
  vestedb := pencaps(vestedb,age);
  vest65 := pencaps(vest65,65.0);
  dableb := pencaps(dableb,age);
  nrq := pencaps(nrq,age);
  lrq := pencaps(lrq,age);
  erq := pencaps(erq,age);
  vdq := pencaps(vdq,age);
  drq := pencaps(drq,age);
  dsq := pencaps(dsq,age);
  cnqann := pencaps(cnqann,age);
    writeln(outputh,flag, flagq, quitd:5:0, age:4, quitd-hired:4:0,
      min(99999999,wage(quitd)):9:0,min(99999999,ss(0.0,quitd)):9:0,min(9999999,quitb):8:0, qtp:3,
      min(9999999,vestedb):8:0,vestedd-birthd:3:0,min(9999999,vest65):8:0,min(9999999,dableb):8:0, dtp:3,
      min(9999999,nrq):8:0,min(9999999,lrq):8:0,min(9999999,erq):8:0, min(9999999,vdq):8:0,min(9999999,drq):8:0,
      min(9999999,dsq):8:0,min(9999999,cnqann):8:0);
    newqtp := remalphas(qtp); newdtp := remalphas(dtp);
    writeln(outfile,newflag, newflag, quitd:8:2, age:4, (quitd-hired):7:2,
      min(99999999.99,wage(quitd)):12:2,  min(99999999.99,ss(0.0,quitd)):12:2, min(99999999.99,quitb):11:2, newqtp:3,
      vestedb:11:2, vestedd-birthd:6:2, vest65:11:2, dableb:11:2, newdtp:3,
      dsq:11:2, nrq:11:2, lrq:11:2, erq:11:2, vdq:11:2, drq:11:2, dsq:11:2, cnqann:11:2);
    if  (agefirst=-1) and (quitb>0)  then
      begin agefirst := age;  benfirst := quitb;  end;
    if  quitb-benlast > 0.5 then
      begin agelast := age;  benlast := quitb;  end;
    case  age  of
      55: ben55:=quitb;  60: ben60:=quitb;  65: ben65:=quitb;
      62: ben62:=quitb;  70: ben70:=quitb;
      otherwise  end;
    age := age + 1;
    until (age > tooo) or (age > mrage);
  end;
end;
%page
FILENAME:  Read name of next file in source line and open it
procedure filename(var n: filestring; var f: text; rw:char);
var  i:1..filestringmax;
     a: packed array1..filestringmax of char;
  diff: boolean;
begin
i := 1;  a := '';
while not eoln(input) and (input@=' ') do get(input);
while input@<>' ' do begin read(ai); i := i + 1;  end;
diff := not ((a1='*')and(i=2));
if diff then n := substr(str(a),1,i-1);
case rw of
  'r': if  n=''  then begin  reset(f,'unit=scards');  n := '*';  end
       else if  n<>'*'  then reset(f,'file='!!n);
  'w': if  diff  then rewrite(f,'file='!!n);
  end;
end;
%page
CALCULATE:  Main body of program
begin
hhid := 0;  codeid := 0;  seq := 0;  birthd := 0;  hired := 0;
qexpectd := 0;  benifitd := 0;  nrq := 0;  lrq := 0;  erq := 0;
vdq := 0;  drq := 0;  dsq := 0;
qapprovl:=true;  qchild21:=false;  qcodable:=false;  qhazduty:=false;
qjrdable:=false;  qjrdeath:=false;  qpastsrv:=false;  qssbenif:=false;
qveteran:=false;  qvolcntr:=false;  qwdman:=false;    qwdvol:=false;
qssdable:=true;
reset    (input);  inname := '';  edname := '';
outname := '*'; outhname := '*'; probname := '*';
while not eof(input) do begin
  datetime(date,time);
  rrange(input, true, t, 0, 4.2, 0);  inversion := round(10*t);
  filename( inname, infile, 'r');  filename( edname, edfile, 'r');
  if (inversion = 41) or (inversion = 42) then begin i7 := 1; a7 := '';
  while not eoln(input) and (input@=' ') do get(input);
  while input@<>' ' do begin read(a7i7); i7 := i7+1; end;
  if not((a71 = '*') and (i7 = 2)) then planfile := substr(str(a7),1,i7-1); end;
  filename(outname,outfile, 'w'); filename(outhname,outputh,'w'); filename(probname,probfile,'w');
  readln(input);
  rrange(edfile, true, t, 0, 1.2, 0); edversion := round(10*t);
  edversion := 12;
  writeln(probfile,'R',inversion/10:3:1,' ',time,' ',date);
  writeln(probfile);
  write(probfile,'Prob HHIDX Code Seq# Birthdt Hiredte Exquitd Benftdt');
  writeln(probfile,'   NRT    LRT    ERT    VET    DRT    DST    CNT ');
  write(probfile,'---- ----- ---- ---- ------- ------- ------- -------');
  writeln(probfile,' ------ ------ ------ ------ ------ ------ ------');
  readedfile;
  fakedata;
  adjustdata;
  page(outputh);
  writeln(outputh,'R',inversion/10:3:1,' ',time,' ',date);
  writeln(outputh);
  if (inversion < 40) then
  writeln(outputh,'         Files Used: ',inname,' ',edname,' ',outname,' ',outhname,' ',probname)
  else writeln(outputh,'         Files Used: ',inname,' ',edname,' ',planfile,' ',outname,' ',outhname,' ',probname);
  writeln(outputh,'        Survey Date: ',surveyd:8:2,'    Present Date: ',todayd:8:2);
  writeln(outputh,'        Price Index: ',pcinfl:8:2,'%');
  writeln(outputh,'        Wage Growth: ',pcln(lnwage):8:2,'% ',pcwage:8:2,'%');
  writeln(outputh,'      Interest Rate: ',pcln(lnintr):8:2,'% ',pcintr:8:2,'%');
  writeln(outputh,'     S.S. Wage Base: ',sssbase:8:2,'    S.S. Benifit: ',sssben:8:2);
  writeln(outputh,'   S.S. Base Growth: ',pcln(lnbase):8:2,'% ',basegrow:8:2,'%');
  writeln(outputh,'     Benefit Growth: ',pcln(lnben):8:2,'% ',bengrow:8:2,'%');
  writeln(outputh,'     Quit Age Range: ',qagemin:8:2,'  ',qagemax:8:2);
  writeln(outputh,'    Quit Date Range: ',qdatemin:8:2,'  ',qdatemax:8:2);
  writeln(outputh,'  S.S. Coefficients:       Min        Mean        Max');
  writeln(outputh,'  Primary Unreduced:      ',coefpumi:4:2,'        ',coefpume:4:2,'       ',coefpuma:4:2);
  writeln(outputh,'    Joint Unreduced:      ',coefjumi:4:2,'        ',coefjume:4:2,'       ',coefjuma:4:2);
  writeln(outputh,'    Primary Reduced:      ',coefprmi:4:2,'        ',coefprme:4:2,'       ',coefprma:4:2);
  writeln(outputh,'      Joint Reduced:      ',coefjrmi:4:2,'        ',coefjrme:4:2,'       ',coefjrma:4:2);
  writeln(outputh,'  Primary Disablity:      ',coefpdmi:4:2,'        ',coefpdme:4:2,'       ',coefpdma:4:2);
  writeln(outputh,'    Joint Disablity:      ',coefjdmi:4:2,'        ',coefjdme:4:2,'       ',coefjdma:4:2);
  writeln(outputh,'           Survivor:      ',coefdsmi:4:2,'        ',coefdsme:4:2,'       ',coefdsma:4:2);
  writeln(outputh,'    Maximum Benifit:   Age 55:',maxben55:10:2,'     Age 65:',maxben65:10:2);
  writeln(outputh,'    S.S. Wage Limit:      Min:',mincutss:10:2,'        Max:',maxcutss:10:2);
  writeln(outputh,'          CTE Basis:    Prof1:',icrprof1:6:2,'%         Fort1:',icrfort1:6:2,'%');
  writeln(outputh,'          CTE Basis:    Prof2:',icrprof2:6:2,'%         Fort2:',icrfort2:6:2,'%');
  writeln(outputh,'          CTE Basis:    Prof3:',icrprof3:6:2,'%         Fort3:',icrfort3:6:2,'%');
  writeln(outputh,'Contributions-Other:      COE:',icoenar:6:2,'%           MAN:',imannar:6:2,'%');
  writeln(outputh,'Contributions-Other:  Min VOL:',ivol1nar:6:2,'%       Max VOL:',ivol2nar:6:2,'%');
  writeln(outputh,'     Matching-Other:      MAN:',immannar:6:2,'%           VOL:',imvolnar:6:2,'%');
  writeln(outputh,'     Annuity Option:',anntype:4:0,'  (1=Single, 2=Joint, 3=Joint if married)    %Payment Continued:',continpmt:6:2,'%');
  writeln(outputh,'     Vesting Option:',vestopt:4:0,'  (0=Plan vesting, 1=New Vesting)           Work years required:',vestyrs:6:2);
  writeln(outputh,'    Man. Retirement:',mronoff:4:0,'  (0=Ignore MRAGE, 1=Use MRAGE)');
  writeln(outputh,'     Pension Choice:',pentype:4:0,'  (0=NRT/ERT/LRT/VDT, 1=DISABL, 2=DST)');
  writeln(outputh,'   Birthd: ',edbirthd:7:2, ' Hired: ',edhired:7:2,
                 ' ExpectQD: ',edexpectd:7:2);
  writeln(outputh,'    Hours: ',edhrs:7:2,    ' Wage ',edwage:7:0,
                   ' Growth: ',edivar:7:2,   ' Sex: ',edsex:1,
                  ' Married: ',edms:1);
  writeln(outputh);
  case  inversion of
    10,11,13,    12:  v1;          Person records, one quit date
    20,21,22,41, 42:  v2;          Simulated participant/plan data
    30,31,       32:  v3;          Person records, all quit dates
    otherwise  writeln(probfile,'Bad version ID ',inversion/10:3:1); end;
  end;
end.
