{.U+}

program blood;

{This program calculates blood gas concentration given blood gas partial
 pressures.  See procedure display heading for details.

 By C. S. Tritt
 02/04/86 vs. 4.0}

{$I bldcalc2.pas}
{$I iolib.pas}

const

  baseex: real = 0.0;
  ph: real = 7.42;
  temp: real = 37.0;
  pco2: real = 42.0;
  po2: real = 160.0;
  hct: real = 40.0;
  hb: real = 15.0;
  slope: real = -0.288;
  intercep: real = 7.46;

var

  pkco2, solco2, o2sat, corrpo2, bicarb, o2con, co2con: real;

  parm: parmlist;

  goodio, calcflag, indph: boolean;

  co2methno, j: integer;

  species: strof14;

  entstrng: string[27];

  method: methray;

  co2meth, continue, ritefile, independ: char;

  desttag: text;

procedure display_heading;

begin
  clrscr;
  writeln('Chuck''s Blood Gas Content Calculator');
  writeln;
  writeln('This program calculates the concentration of gases in the blood.');
  writeln('It uses the methods of Kelman (1967), Lutz (1975) Gabel (1981) and');
  writeln('Loeppky (1983).  To retain a parameter value,  enter a RETURN in');
  writeln('response to the prompt.  Constants used in the calculation of percent');
  writeln('hemoglobin saturation by the method of Lutz should be in a ASCII');
  writeln('text file.  The first line of the file should contain only the species');
  writeln('name (maximum 14 letters).  The second line of the file should contain');
  writeln('the parameters separated by single spaces and in the following order');
  writeln('Bohr factor, a, b, K1, K2, K3, K4, K5, K6.  Standard files of ');
  writeln('Lutz parameters exist and have the same names as the species.  It ');
  writeln('is the responsiblity of the user to determine if this program is ');
  writeln('suitable for a particular application.  This program has been placed');
  writeln('in the public domain by the author and may be copied.  The financial');
  writeln('support of the Department of Anesthesology, The Ohio State University, ');
  writeln('is greatfully acknowledged.');
  writeln;
  writeln('Version 4.0'); writeln('By C. S. Tritt'); writeln('Feb. 4, 1986');
  writeln;
end; {display_heading}

begin {Mainline}

  method[1] := 'Lutz';
  method[2] := 'Kelman';
  method[3] := 'Loeppky';
  entstrng := 'Enter new value or RETURN: ';

  display_heading;
  wait;
  clrscr;

  getlutz(species, parm);
  writeln;
  getco2m(co2meth, co2methno, method);

  {Determine if pH or base execess should be independent}
  repeat
    writeln;
    write('Independent pH entry? (y or n) ');
    read(kbd, independ);
    independ := upcase(independ);
    if independ = 'Y' then indph := true else indph := false;
  until (independ = 'Y') or (independ = 'N');
  writeln;

  getroute(ritefile, desttag);
  wait;
  clrscr;

  {Get conditions from user}
  repeat
    putreal(po2, 5, 1, 'PO2 in mmHg', con);
    getreal(po2, entstrng);
    echoreal(po2, 5, 1);
    writeln;
    putreal(pco2, 6, 2, 'PCO2 in mmHg', con);
    getreal(pco2, entstrng);
    echoreal(pco2, 6, 2);
    writeln;
    if indph then
    begin
      putreal(ph, 5, 3, 'pH', con);
      getreal(ph, entstrng);
      echoreal(ph, 5, 3);
      writeln;
    end
    else
    begin
      putreal(baseex, 5, 1, 'base excess in mEq/l', con);
      getreal(baseex, entstrng);
      echoreal(baseex, 5, 1);
      writeln;
    end;
    putreal(hct, 4, 1, 'haematocrit in percent', con);
    getreal(hct, entstrng);
    echoreal(hct, 4, 1);
    writeln;
    putreal(hb, 5, 2, 'hemoglobin in gm/100 ml', con);
    getreal(hb, entstrng);
    echoreal(hb, 5, 2);
    writeln;
    putreal(temp, 4, 1, 'temperature in C', con);
    getreal(temp, entstrng);
    echoreal(temp, 4, 1);
    writeln;
    wait;

    {Do calculations}
    clrscr;
    if not indph then
    begin
      ph := fphcalc2(pco2, slope, intercep, baseex, temp, true, calcflag);
      calcheck(calcflag, 'Error calculating base excess', desttag);
    end;
    pkco2 := fpkcalc(temp, ph, calcflag);
    calcheck(calcflag, 'Error calculating pK', desttag);
    solco2 := fsolco2(temp, calcflag);
    calcheck(calcflag, 'Error calculating Sco2', desttag);
    bicarb := fbicarb(pco2, ph, pkco2, solco2, calcflag);
    calcheck(calcflag, 'Error calculating HCO3-', desttag);
    if indph then
    begin
      baseex := fbaseex(bicarb, ph, calcflag);
      calcheck(calcflag, 'Error calculating base excess', desttag);
    end;
    corrpo2 := fpo2cor(po2, ph, baseex, temp, parm[1], calcflag);
    calcheck(calcflag, 'Error calculating corrected Po2', desttag);
    o2sat := fo2sat(corrpo2, parm, calcflag);
    calcheck(calcflag, 'Error calculating o2 saturation', desttag);
    o2con := fo2con(po2, o2sat, hb, calcflag);
    calcheck(calcflag, 'Error calculating o2 concentration', desttag);
    case co2meth of
      '1' : begin
              co2con := fco2conl(pco2, solco2, bicarb, calcflag);
              co2methno := 1;
            end;
      '2' : begin
              co2con := fco2conk(pco2, ph, o2sat, hct, pkco2, solco2,
                calcflag);
              co2methno := 2;
            end;
      '3' : begin
              co2con := fco2conf(pco2, ph, o2sat, hb, pkco2, solco2, calcflag);
              co2methno := 3;
            end;
 end;
    calcheck(calcflag, 'Error calculating co2 content', desttag);

    {Redisplay inputs}
    writeln(desttag);
    putstring(method[co2methno], 'CO2 content method: ', desttag);
    putstring(species, 'Species: ', desttag);
    writeln(desttag);
    putreal(po2, 5, 1, 'PO2 in mmHg', desttag);
    putreal(pco2, 6, 2, 'PCO2 in mmHg', desttag);
    if indph then putreal(ph, 5, 3, 'pH', desttag)
      else putreal(baseex, 5, 1, 'base excess in mEq/l', desttag);
    putreal(hct, 4, 1, 'Haematocrit in percent', desttag);
    putreal(hb, 5, 2, 'Hemoglobin concentration in gm/100 ml', desttag);
    putreal(Temp, 4, 1, 'temperature in C', desttag);

    {Display results}
    writeln(desttag);
    putreal(bicarb, 4, 1, 'HCO3- concentration in mEq/l', desttag);
    if indph then putreal(baseex, 5, 1, 'base excess in mEq/l',
      desttag)
      else putreal(ph, 5, 3, 'pH', desttag);
    putreal(o2sat, 5, 1, 'hemoglobin saturation in percent', desttag);
    putreal(o2con, 4, 1, 'O2 concentration in volume percent', desttag);
    putreal(co2con, 5, 1, 'CO2 concetration in volume percent', desttag);

    {Check for quit}
    writeln(desttag);
    write('Do you wish to continue? ( y or n ) ');
    read(kbd, continue);
    continue := upcase(continue);
    clrscr {Clear the screen}
  until (continue = 'N');
  {$I-}
  close(desttag);
  iocheck(goodio, 'Problem closing output file.');
  {$I+}
end.