{$M 65520, 0, 655360}

Program Report2;

{***************************************************************************}

{* SUB-PROGRAMS IN ORDER OF APPEARANCE

{*

{* FUNCTION  LookUp

{* PROCEDURE DoSplitResponses

{* FUNCTION  AverageLine

{* FUNCTION  HDRLine

{* PROCEDURE LoadHDROpts

{* PROCEDURE ReportHeader

{* PROCEDURE GetSaveFiles

{* PROCEDURE AnalyzeData

{* PROCEDURE StoreLetters

{* PROCEDURE StoreData

{* PROCEDURE GetDataFile

{* PROCEDURE MakeReport

{* PROCEDURE MakeHeader

{* PROCEDURE SetHeader

{* PROCEDURE MakeLetter

{* PROCEDURE SetLetter

{* PROCEDURE MakeFormat

{* PROCEDURE SetFormat

{* PROCEDURE Menu

{***************************************************************************}

{*

{* GLOBAL DEFINITIONS

{*

{* USES UNIT Dos,

{* USES UNIT Crt,

{* USES UNIT Croft;

{*

{* GLOBAL CONSTANT MaxNumSurveySheets = 20;

{* GLOBAL CONSTANT AToJ: array[1..10] of char = 'ABCDEFGHIJ';

{* GLOBAL CONSTANT KToP: array[1..6] of char = 'KLMNOP';

{*

{* GLOBAL TYPE DataStr = array[1..MaxNumSurveySheets] of string;

{* GLOBAL TYPE Int10Array = array[1..10] of integer;

{* GLOBAL TYPE Char10Array = array[1..10] of char;

{* GLOBAL TYPE Str10Array = array[1..10] of string;

{*

{* GLOBAL VARIABLE InitFormatFile: string;

{* GLOBAL VARIABLE InitLetterFile: string;

{* GLOBAL VARIABLE InitHeaderFile: string;

{* GLOBAL VARIABLE NameLine,

{* GLOBAL VARIABLE SexLine,

{* GLOBAL VARIABLE EducationLine,

{* GLOBAL VARIABLE MonthLine,

{* GLOBAL VARIABLE DayLine,

{* GLOBAL VARIABLE YearLine,

{* GLOBAL VARIABLE IDLine,

{* GLOBAL VARIABLE IDNumberSplitLine,

{* GLOBAL VARIABLE SpecialCodesSplitLine,

{* GLOBAL VARIABLE SpecialCodesLine,

{* GLOBAL VARIABLE DataLine: DataStr;

{* GLOBAL VARIABLE NumSurveys: integer;

{*

{***************************************************************************}

{* SUB-PROGRAMS with LOCAL DEFINITIONS and other SUB-PROGRAMS CALLED

{*

{* FUNCTION  LookUp

{*   local variable LU: integer;

{* PROCEDURE DoSplitResponses

{*   local variable alpha,

{*   local variable bravo: integer;

{*   local variable NumQuestions: integer;

{*   local variable NumResponses: array[1..10] of integer;

{*   local variable ResponsesArray: CroftUnitRealArrayType;

{*   local variable Mean,

{*   local variable Median,

{*   local variable StanDev,

{*   local variable MinValue,

{*   local variable MaxValue: real;

{*   local variable AnswerGiven: boolean;

{*   calls FUNCTION  LookUp

{* FUNCTION  AverageLine

{*   local constant SearchChars: string = ', -';

{*   local variable LenInStr: integer;

{*   local variable Position: integer;

{*   local variable QuesNum1,

{*   local variable QuesNum2: integer;

{*   local variable Total: real;

{*   local variable Done: boolean;

{*   local variable Count: integer;

{*   local variable CharFound: char;

{*   local variable LenDataLine: integer;

{*   local variable alpha,

{*   local variable bravo: integer;

{*   local variable SubTotal: real;

{*   local variable ValGood: boolean;

{*   calls FUNCTION  LookUp

{* FUNCTION  HDRLine

{*   local variable InStr: string;

{*   local variable TempBool: boolean;

{* PROCEDURE LoadHDROpts

{*   local variable HF: text;

{*   local variable alpha: integer;

{*   calls FUNCTION  HDRLine

{* PROCEDURE ReportHeader

{*   local variable alpha,

{*   local variable bravo: integer;

{*   local variable Name,

{*   local variable Sex,

{*   local variable Education,

{*   local variable Month,

{*   local variable Day,

{*   local variable Year,

{*   local variable IDNumber,

{*   local variable IDNumberSplit,

{*   local variable SpecialCodes,

{*   local variable SpecialCodesSplit,

{*   local variable Responses: boolean;

{*   calls PROCEDURE LoadHDROpts

{* PROCEDURE GetSaveFiles

{*   local variable Lead8,

{*   local variable Ext: string;

{* PROCEDURE AnalyzeData

{*   local variable FF,

{*   local variable SF: text;

{*   local variable SaveFile1,

{*   local variable SaveFile2,

{*   local variable SaveFile3: string;

{*   local variable InStr: string;

{*   local variable alpha,

{*   local variable bravo: integer;

{*   local variable AveVal: real;

{*   local variable ResponsesSplit: boolean;

{*   local variable FormFeed: char;

{*   calls PROCEDURE GetSaveFiles

{*   calls PROCEDURE ReportHeader

{*   calls FUNCTION  AverageLine

{*   calls PROCEDURE DoSplitResponses

{* PROCEDURE StoreLetters

{*   local variable LF: text;

{*   local variable alpha: integer;

{*   local variable InStr: string;

{* PROCEDURE StoreData

{*   local variable SheetNum: integer;

{*   local variable DF: text;

{* PROCEDURE GetDataFile

{* PROCEDURE MakeReport

{*   local variable DataFile: string;

{*   local variable NameLine,

{*   local variable IDLine,

{*   local variable DataLine: DataStr;

{*   local variable LetterVals: Str10Array;

{*   calls PROCEDURE GetDataFile

{*   calls PROCEDURE StoreData

{*   calls PROCEDURE StoreLetters

{*   calls PROCEDURE AnalyzeData

{* PROCEDURE MakeHeader

{*   local variable HF: text;

{*   local variable alpha: integer;

{*   local variable ID: string;

{* PROCEDURE SetHeader

{*   local variable DirInfo: SearchRec;

{*   local variable HF: text;

{*   calls PROCEDURE MakeHeader

{* PROCEDURE MakeLetter

{*   local constant Letter: Char10Array = ('A','B','C','D','E','F','G','H','I','J');

{*   local variable LF: text;

{*   local variable Comments: string;

{*   local variable LetterVal: Str10Array;

{*   local variable alpha: integer;

{*   local variable NulVal: boolean;

{*   local variable ValStr: string;

{*   local variable RealVal: real;

{* PROCEDURE SetLetter

{*   local variable DirInfo: SearchRec;

{*   local variable LF: text;

{*   calls PROCEDURE MakeLetter

{* PROCEDURE MakeFormat

{*   local variable FF: text;

{*   local variable Done: boolean;

{*   local variable InStr: string;

{* PROCEDURE SetFormat

{*   local variable DirInfo: SearchRec;

{*   local variable FF: text;

{*   calls PROCEDURE MakeFormat

{* PROCEDURE Menu

{*   local constant NumOptions = 4;

{*   local variable Option: integer;

{*   calls PROCEDURE SetFormat

{*   calls PROCEDURE SetLetter

{*   calls PROCEDURE SetHeader

{*   calls PROCEDURE MakeReport

{* PROGRAM MAIN

{*   calls PROCEDURE SetFormat

{*   calls PROCEDURE SetLetter

{*   calls PROCEDURE SetHeader

{*   calls PROCEDURE Menu

{***************************************************************************}

{* SUB-PROGRAMS IN ALPHABETICAL ORDER

{*

{* FUNCTION  AnalyzeData

{* PROCEDURE AverageLine

{* FUNCTION  DoSplitResponses

{* FUNCTION  GetDataFile

{* PROCEDURE GetSaveFiles

{* PROCEDURE HDRLine

{* PROCEDURE LoadHDROpts

{* PROCEDURE LookUp

{* PROCEDURE MakeFormat

{* PROCEDURE MakeHeader

{* PROCEDURE MakeLetter

{* PROCEDURE MakeReport

{* PROCEDURE Menu

{* PROCEDURE ReportHeader

{* PROCEDURE SetFormat

{* PROCEDURE SetHeader

{* PROCEDURE SetLetter

{* PROCEDURE StoreData

{* PROCEDURE StoreLetters

{***************************************************************************}

Uses

  Dos,

  Crt,

  Croft;



Const

  MaxNumSurveySheets = 20;

  AToJ: array[1..10] of char = 'ABCDEFGHIJ';

  KToP: array[1..6] of char = 'KLMNOP';



Type

  DataStr = array[1..MaxNumSurveySheets] of string;

  Int10Array = array[1..10] of integer;

  Char10Array = array[1..10] of char;

  Str10Array = array[1..10] of string;



Var

  InitFormatFile: string;

  InitLetterFile: string;

  InitHeaderFile: string;

  NameLine,

  SexLine,

  EducationLine,

  MonthLine,

  DayLine,

  YearLine,

  IDLine,

  IDNumberSplitLine,

  SpecialCodesSplitLine,

  SpecialCodesLine,

  DataLine: DataStr;

  NumSurveys: integer;



Function LookUp(Alpha: char; LetterVals: Str10Array;

  var ValGood: boolean): real;

{***************************************************************************}

var

  LU: integer;

begin

  Alpha := upcase(alpha);

  case Alpha of

    ' ': LU := 0;

    'A': LU := 1;

    'B': LU := 2;

    'C': LU := 3;

    'D': LU := 4;

    'E': LU := 5;

    'F': LU := 6;

    'G': LU := 7;

    'H': LU := 8;

    'I': LU := 9;

    'J': LU := 10;

  end; {case}

  if (LetterVals[LU] = ' N/A') or (LU = 0) then

    ValGood := false

  else

    ValGood := true;

  if LU <> 0 then

    LookUp := ValReal(LetterVals[LU])

  else

    LookUp := 0;

end;



Procedure DoSplitResponses(var SF: text; DataLine: DataStr;

  LetterVals: Str10Array);

{***************************************************************************}

var

  alpha,

  bravo: integer;

  NumQuestions: integer;

  NumResponses: array[1..10] of integer;

  ResponsesArray: CroftUnitRealArrayType;

  Mean,

  Median,

  StanDev,

  MinValue,

  MaxValue: real;

  AnswerGiven: boolean;

begin

  NumQuestions := length(DataLine[1]);

  WrLn2T(SF, MultiChar('*',78));

  WrLn2T(SF,

'###   Mean Median  StDev   Min.   Max.   A   B   C   D   E   F   G   H   I   J');

  for bravo := 1 to NumQuestions do

    begin

      for alpha := 1 to 10 do

        NumResponses[alpha] := 0;

      AnswerGiven := false;

      for alpha := 1 to NumSurveys do

        begin

          if DataLine[alpha, bravo] in ['A'..'J'] then

            AnswerGiven := true;

          case DataLine[alpha,bravo] of

            'A':  Inc(NumResponses[1]);

            'B':  Inc(NumResponses[2]);

            'C':  Inc(NumResponses[3]);

            'D':  Inc(NumResponses[4]);

            'E':  Inc(NumResponses[5]);

            'F':  Inc(NumResponses[6]);

            'G':  Inc(NumResponses[7]);

            'H':  Inc(NumResponses[8]);

            'I':  Inc(NumResponses[9]);

            'J':  Inc(NumResponses[10]);

          end; {case}

        end;

      if AnswerGiven then

        begin

          Wr2T(SF, StrIntLen(bravo, 3));

          for alpha := 1 to NumSurveys do

            ResponsesArray[alpha] := LookUp(DataLine[alpha, bravo], LetterVals,

              DumBool);

          Stats(ResponsesArray, NumSurveys,

            Mean, Median, StanDev, MinValue, MaxValue);

          Wr2T(SF, ' ' + StrReal(Mean, 6, 2)

            + ' ' + StrReal(Median, 6, 2)

            + ' ' + StrReal(StanDev, 6, 2)

            + ' ' + StrReal(MinValue, 6, 2)

            + ' ' + StrReal(MaxValue, 6, 2)

            );

          for alpha := 1 to 10 do

            Wr2T(SF, ' '+StrIntLen(NumResponses[alpha],3));

          WrLn2T(SF,'');

        end;

    end;

end;



Function AverageLine(InStr: string; DataLine: DataStr;

  LetterVals: Str10Array; var AveVal: real): boolean;

{***************************************************************************}

const

  SearchChars: string = ', -';

var

  LenInStr: integer;

  Position: integer;

  QuesNum1,

  QuesNum2: integer;

  Total: real;

  Done: boolean;

  Count: integer;

  CharFound: char;

  LenDataLine: integer;

  alpha,

  bravo: integer;

  SubTotal: real;

  ValGood: boolean;

begin

  LenInStr := length(InStr);

  LenDataLine := length(DataLine[1]);

  ;

  Total := 0;

  Done := false;

  Count := 0;

  ;

  Position := Pos(':',InStr);

  if (Position <> 0) and (Position <> LenInStr) then

    begin

      repeat

        ParseInt(InStr, Position, QuesNum1);

        QuesNum2 := QuesNum1;

        if Position > LenInStr then

          Done := true;

        if (QuesNum1 = 0) and not(Done) then

          begin

            writeln(#7);

            writeln('Format file is bad!');

            writeln('A line contains a question of #0 in it!');

            PoliteHalt;

          end

        else

          begin

            if not(Done) then

              begin

                PosChars(SearchChars, InStr, Position, CharFound);

                if (Position > LenInStr) then

                  Done := true;

                if (CharFound <> ',') or (CharFound = '-') then

                  begin

                    ParseInt(InStr, Position, QuesNum2);

                    if Position > LenInStr then

                      Done := true;

                    if QuesNum2 = 0 then

                      begin

                        writeln(#7);

                        writeln('Format file is bad!');

                        write('A line contains a question of #0 in it or');

                        writeln(' number expected after dash not found!');

                        PoliteHalt;

                      end;

                  end;

              end;

            if (QuesNum1 > LenDataLine) or (QuesNum2 > LenDataLine) then

              begin

                Writeln(#7);

                writeln('Format file is bad!');

                write('Question number in format file exceeds number of');

                writeln(' questions in survey sheet!');

                PoliteHalt;

              end;

            for alpha := QuesNum1 to QuesNum2 do

              begin

                for bravo := 1 to NumSurveys do

                  begin

                    SubTotal :=

                      LookUp(DataLine[bravo, alpha], LetterVals, ValGood);

                    if ValGood then

                      begin

                        Total := Total + SubTotal;

                        Inc(Count);

                      end;

                  end;

              end;

          end;

      until Done;

      if Count = 0 then

        AverageLine := false

      else

        begin

          AverageLine := true;

          AveVal := Total/Count;

        end;

    end

  else

    AverageLine := false;

end;



Function HDRLine(var HF: text): boolean;

{***************************************************************************}

var

  InStr: string;

  TempBool: boolean;

begin

  readln(HF, InStr);

  GetQuote(InStr);

  if InStr = 'YES' then

    TempBool := true

  else

    TempBool := false;

  HDRLine := TempBool;

end;



Procedure LoadHDROpts(HeaderFile: string; var Name, Sex, Education, Month,

  Day, Year, IDNumber, IDNumberSplit, SpecialCodes, SpecialCodesSplit,

    Responses, ResponsesSplit: boolean);

{***************************************************************************}

var

  HF: text;

  alpha: integer;

begin

  Assign(HF, HeaderFile);

  Reset(HF);

  Name := HDRLine(HF);

  Sex := HDRLine(HF);

  Education := HDRLine(HF);

  Month := HDRLine(HF);

  Day := HDRLine(HF);

  Year := HDRLine(HF);

  IDNumber := HDRLine(HF);

  IDNumberSplit := HDRLine(HF);

  if IDNumberSplit then

    for alpha := 1 to 10 do

      readln(HF, IDNumberSplitLine[alpha]);

  SpecialCodes := HDRLine(HF);

  SpecialCodesSplit := HDRLine(HF);

  if SpecialCodesSplit then

    for alpha := 1 to 6 do

      readln(HF, SpecialCodesSplitLine[alpha]);

  Responses := HDRLine(HF);

  ResponsesSplit := HDRLine(HF);

  Close(HF);

end;



Procedure ReportHeader(var SF: text; SaveFile1, DataFile, HeaderFile,

  FormatFile, LetterFile: string; var ResponsesSplit: boolean);

{***************************************************************************}

var

  alpha,

  bravo: integer;

  Name,

  Sex,

  Education,

  Month,

  Day,

  Year,

  IDNumber,

  IDNumberSplit,

  SpecialCodes,

  SpecialCodesSplit,

  Responses: boolean;

begin

  Clr;

  LoadHDROpts(HeaderFile, Name, Sex, Education, Month, Day, Year,

    IDNumber, IDNumberSplit, SpecialCodes, SpecialCodesSplit, Responses,

      ResponsesSplit);

  WrLn2T(SF, MultiChar('*',78));

  WrLn2T(SF, 'REPORT File   "'+SaveFile1+'" made from');

  WrLn2T(SF, '  Data File   "'+DataFile+'"');

  WrLn2T(SF, '  Header File "'+HeaderFile+'"');

  WrLn2T(SF, '  Format File "'+FormatFile+'"');

  WrLn2T(SF, '  Letter File "'+LetterFile+'"');

  WrLn2T(SF, 'using '+StrInt(NumSurveys)+' sheet(s).');

  for alpha := 1 to NumSurveys do

    begin

      WrLn2T(SF,'SHEET '+StrInt(alpha));

      if Name then

        WrLn2T(SF,'  '+NameLine[alpha]);

      if Sex then

        WrLn2T(SF,'  '+SexLine[alpha]);

      if Education then

        WrLn2T(SF,'  '+EducationLine[alpha]);

      if Month then

        WrLn2T(SF,'  '+MonthLine[alpha]);

      if Day then

        WrLn2T(SF,'  '+DayLine[alpha]);

      if Year then

        WrLn2T(SF,'  '+YearLine[alpha]);

      if IDNumber then

        WrLn2T(SF,'  '+IDLine[alpha]);

      if IDNumberSplit then

        begin

          GetQuote(IDLine[alpha]);

          for bravo := 1 to 10 do

            WrLn2T(SF,'    '+IDNumberSplitLine[bravo]+'=  '

              +IDLine[alpha,bravo]);

        end;

      if SpecialCodes then

        WrLn2T(SF,'  '+SpecialCodesLine[alpha]);

      if SpecialCodesSplit then

        begin

          GetQuote(SpecialCodesLine[alpha]);

          for bravo := 1 to 6 do

            WrLn2T(SF,'    '+SpecialCodesSplitLine[bravo]+'=  '

              +SpecialCodesLine[alpha, bravo]);

        end;

      if Responses then

        WrLn2T(SF,'  '+DataLine[alpha]);

    end;

  WrLn2T(SF, MultiChar('*',78));

end;





Procedure GetSaveFiles(var SaveFile1, SaveFile2, SaveFile3: string;

  DataFile: string);

{***************************************************************************}

var

  Lead8,

  Ext: string;

begin

  Say('The header, format, and individual responses analysis data can be');

  Say('written to three separate files instead of one.');

  if AskYN('Do you want separate files','N') then

    begin

      write('What is the header data file name?:  ');

      readln(SaveFile1);

      SplitFileName(SaveFile1, Lead8, Ext);

      SaveFile1 := Lead8 + '.RPT';

      BackUpLine;

      writeln('Header data save file:  ', SaveFile1);

      write('What is the format data file name?:  ');

      readln(SaveFile2);

      SplitFileName(SaveFile2, Lead8, Ext);

      SaveFile2 := Lead8 + '.RPT';

      BackUpLine;

      writeln('Format data save file:  ', SaveFile2);

      write('What is the individual responses analysis file name?:  ');

      readln(SaveFile3);

      SplitFileName(SaveFile3, Lead8, Ext);

      SaveFile3 := Lead8 + '.RPT';

      BackUpLine;

      writeln('Individual Responses save file:  ', SaveFile3);

      Wait;

    end

  else

    begin

      SaveFile1 := Copy(DataFile, 1, length(DataFile) - 4)

        + '.RPT';

      SaveFile2 := SaveFile1;

      SaveFile3 := SaveFile1;

    end;

end;



Procedure AnalyzeData(FormatFile, DataFile, LetterFile, HeaderFile: string;

  LetterVals: Str10Array);

{***************************************************************************}

var

  FF,

  SF: text;

  SaveFile1,

  SaveFile2,

  SaveFile3: string;

  InStr: string;

  alpha,

  bravo: integer;

  AveVal: real;

  ResponsesSplit: boolean;

  FormFeed: char;

begin

  GetSaveFiles(SaveFile1, SaveFile2, SaveFile3, DataFile);

  if AskYN('Include form feed at the end of section?','N') then

    FormFeed := #12

  else

    FormFeed := #0;

  Assign(SF, SaveFile1);

  Rewrite(SF);

  ReportHeader(SF, SaveFile1,DataFile,HeaderFile,FormatFile,LetterFile,

    ResponsesSplit);

  write(SF, FormFeed);

  if SaveFile2 <> SaveFile1 then

    begin

      close(SF);

      Assign(SF, SaveFile2);

      Rewrite(SF);

    end;

  Assign(FF, FormatFile);

  Reset(FF);

  while not(EOF(FF)) do

    begin

      readln(FF, InStr);

      Wr2T(SF, InStr);

      if AverageLine(InStr, DataLine, LetterVals, AveVal) then

        WrLn2T(SF,' =   '+StrReal(AveVal,3,2))

      else

        WrLn2T(SF,'');

    end; {while}

  write(SF, FormFeed);

  if ResponsesSplit then

    begin

      if SaveFile3 <> SaveFile2 then

        begin

          close(SF);

          Assign(SF, SaveFile3);

          Rewrite(SF);

        end;

      DoSplitResponses(SF, DataLine, LetterVals);

      write(SF, FormFeed);

    end;

  close(SF);

  close(FF);

end;



Procedure StoreLetters(LetterFile: string; var LetterVals: Str10Array);

{***************************************************************************}

var

  LF: text;

  alpha: integer;

  InStr: string;

begin

  assign(LF, LetterFile);

  reset(LF);

    repeat

      readln(LF, InStr);

    until InStr = 'LETTERS:';

    for alpha := 1 to 10 do

      begin

        readln(LF, InStr);

        LetterVals[alpha] := copy(InStr, 4, length(InStr) - 3);

      end;

  close(LF);

end;



Procedure StoreData(var DataFile: string);

{***************************************************************************}

var

  SheetNum: integer;

  DF: text;

begin

  Assign(DF, DataFile);

  reset(DF);

  SheetNum := 0;

  repeat

    Inc(SheetNum);

    readln(DF, NameLine[SheetNum]);

    readln(DF, SexLine[SheetNum]);

    readln(DF, EducationLine[SheetNum]);

    readln(DF, MonthLine[SheetNum]);

    readln(DF, DayLine[SheetNum]);

    readln(DF, YearLine[SheetNum]);

    readln(DF, IDLine[SheetNum]);

    readln(DF, SpecialCodesLine[SheetNum]);

    readln(DF, DataLine[SheetNum]);

    GetQuote(DataLine[SheetNum]);

    readln(DF, DumStr);

  until EOF(DF);

  close(DF);

  NumSurveys := SheetNum;

end;



Procedure GetDataFile(var DataFile: string);

{***************************************************************************}

begin

  Clr;

  DataFile := GetDirFileOnly('*.DAT');

end;



Procedure MakeReport(FormatFile, LetterFile, HeaderFile: string);

{***************************************************************************}

var

  DataFile: string;

  NameLine,

  IDLine,

  DataLine: DataStr;

  LetterVals: Str10Array;

begin

  GetDataFile(DataFile);

  StoreData(DataFile);

  StoreLetters(LetterFile, LetterVals);

  AnalyzeData(FormatFile, DataFile, LetterFile, HeaderFile,

    LetterVals);

end;



Procedure MakeHeader(var HeaderFile: string);

{***************************************************************************}

var

  HF: text;

  alpha: integer;

  ID: string;

begin

  Clr;

  Assign(HF, HeaderFile);

  Rewrite(HF);

  if AskYN('Do you want the NAME line included in the report','Y') then

    WrLn2T(HF, 'NAME LINE:  "YES"')

  else

    WrLn2T(HF, 'NAME LINE:  "NO"');

  DeleteSkip;

  if AskYN('Do you want the SEX line included in the report','Y') then

    WrLn2T(HF, 'SEX LINE:  "YES"')

  else

    WrLn2T(HF, 'SEX LINE:  "NO"');

  DeleteSkip;

  if AskYN('Do you want the EDUCATION/GRADE line included in the report',

    'Y') then

      WrLn2T(HF, 'EDUCATION/GRADE:  "YES"')

    else

      WrLn2T(HF, 'EDUCATION/GRADE:  "NO"');

  DeleteSkip;

  if AskYN('Do you want the MONTH line included in the report', 'Y') then

    WrLn2T(HF, 'MONTH:  "YES"')

  else

    WrLn2T(HF, 'MONTH:  "NO"');

  DeleteSkip;

  if AskYN('Do you want the DAY line included in the report', 'Y') then

    WrLn2T(HF, 'DAY:  "YES"')

  else

    WrLn2T(HF, 'DAY:  "NO"');

  DeleteSkip;

  if AskYN('Do you want the YEAR line included in the report', 'Y') then

    WrLn2T(HF, 'YEAR:  "YES"')

  else

    WrLn2T(HF, 'YEAR:  "NO"');

  DeleteSkip;

  if AskYN(

    'Do you want the IDENTIFICATION NUMBER line included in the report', 'Y')

       then

         WrLn2T(HF, 'IDENTIFICATION NUMBER:  "YES"')

       else

         WrLn2T(HF, 'IDENTIFICATION NUMBER:  "NO"');

  DeleteSkip;

  if AskYN('Do you want the ID NUMBERs listed separately with an identifier'

      ,'N') then

        begin

          BackUpLine;

          WrLn2T(HF, 'IDENTIFICATION NUMBERS LISTED SEPARATELY: "YES"');

          for alpha := 1 to 10 do

            begin

              ID := '';

              Ask('Identifier for '+AToJ[alpha],ID);

              BackUpLine;

              WrLn2T(HF, AToJ[alpha]+':  '+ID);

            end;

        end

      else

        begin

          BackUpLine;

          WrLn2T(HF, 'IDENTIFICATION NUMBERS LISTED SEPARATELY:  "NO"');

        end;

  if AskYN('Do you want the SPECIAL CODES line included in the report', 'Y')

    then

      WrLn2T(HF, 'SPECIAL CODES:  "YES"')

    else

      WrLn2T(HF, 'SPECIAL CODES:  "NO"');

  DeleteSkip;

  if AskYN(

    'Do you want the SPECIAL CODES listed separately with an identifier',

      'N') then

        begin

          BackUpLine;

          WrLn2T(HF, 'SPECIAL CODES LISTED SEPARATELY: "YES"');

          for alpha := 1 to 6 do

            begin

              ID := '';

              Ask('Identifier for '+KToP[alpha],ID);

              BackUpLine;

              WrLn2T(HF, KToP[alpha]+':  '+ID);

            end;

        end

      else

        begin

          BackUpLine;

          WrLn2T(HF, 'SPECIAL CODES LISTED SEPARATELY:  "NO"');

        end;

  if AskYN('Do you want the RESPONSES line included in the report', 'Y') then

    WrLn2T(HF, 'RESPONSES:  "YES"')

  else

    WrLn2T(HF, 'RESPONSES:  "NO"');

  DeleteSkip;

  if AskYN('Do you want the RESPONSES listed individually with analysis','N')

    then

      WrLn2T(HF, 'INDIVIDUAL RESPONSES ANALYSIS:  "YES"')

    else

      WrLn2T(HF, 'INDIVIDUAL RESPONSES ANALYSIS:  "NO"');

  DeleteSkip;

  Close(HF);

end;



Procedure SetHeader(var HeaderFile: string);

{***************************************************************************}

var

  DirInfo: SearchRec;

  HF: text;

begin

  if HeaderFile <> 'Pick one.' then

    begin

      Clr;

      HeaderFile := GetDirFile('*.HDR');

      FindFirst(HeaderFile, AnyFile, DirInfo);

      if DosError <> 0 then

        MakeHeader(HeaderFile);

    end

  else

    begin

      FindFirst('*.HDR', AnyFile, DirInfo);

      if DosError <> 0 then

        begin

          writeln('No header files available ("*.HDR").');

          writeln('Creating "GENERIC.HDR"...');

          assign(HF, 'GENERIC.HDR');

          rewrite(HF);

          WriteLn(HF, 'NAME LINE:  "YES"');

          WriteLn(HF, 'SEX LINE:  "YES"');

          WriteLn(HF, 'EDUCATION/GRADE:  "YES"');

          WriteLn(HF, 'MONTH:  "YES"');

          WriteLn(HF, 'DAY:  "YES"');

          WriteLn(HF, 'YEAR:  "YES"');

          WriteLn(HF, 'IDENTIFICATION NUMBER:  "YES"');

          WriteLn(HF, 'IDENTIFICATION NUMBERS LISTED SEPARATELY:  "NO"');

          WriteLn(HF, 'SPECIAL CODES:  "YES"');

          WriteLn(HF, 'SPECIAL CODES LISTED SEPARATELY:  "NO"');

          WriteLn(HF, 'RESPONSES:  "YES"');

          WriteLn(HF, 'INDIVIDUAL RESPONSES ANALYSIS: "YES"');

          close(HF);

          writeln('"GENERIC.HDR" created.');

          HeaderFile := 'GENERIC.HDR';

          Wait;

        end

      else

        repeat

          HeaderFile := DirInfo.Name;

          FindNext(DirInfo);

        until DosError <> 0;

    end;

end;



Procedure MakeLetter(var LetterFile: string);

{***************************************************************************}

const

  Letter: Char10Array = ('A','B','C','D','E','F','G','H','I','J');

var

  LF: text;

  Comments: string;

  LetterVal: Str10Array;

  alpha: integer;

  NulVal: boolean;

  ValStr: string;

  RealVal: real;

begin

  Clr;

  Assign(LF, LetterFile);

  Rewrite(LF);

  Say('Letter File:  '+LetterFile);

  BackUpLine;

  Say('Entering nothing at a letter value prompt will default to "N/A" or');

  Say('"Not applicable".  This letter will not be averaged in.');

  Say('Real values (non-integers) and negatives may be used.');

  writeln('Enter your top-of-form comments and notes [max 255 characters].');

  writeln('Do not include "LETTERS:" as this designates end of comments.');

  Say(MultiChar('*',78));

  WrLn2T(LF,'Letter File:  '+LetterFile);

  WrLn2T(LF,'COMMENTS:');

  readln(Comments);

  BackUpLine;

  WrLn2T(LF, Comments);

  WrLn2T(LF, 'LETTERS:');

  for alpha := 1 to 10 do

    begin

      AskRealNul(Letter[alpha], -MaxInt, MaxInt, RealVal, NulVal);

      ValStr := StrReal(RealVal,0,2);

      BackUpLine;

      if NulVal then

        ValStr := 'N/A';

      WrLn2T(LF, Letter[alpha]+' = '+ValStr);

    end;

  Close(LF);

end;



Procedure SetLetter(var LetterFile: string);

{***************************************************************************}

var

  DirInfo: SearchRec;

  LF: text;

begin

  if LetterFile <> 'Pick one.' then

    begin

      Clr;

      LetterFile := GetDirFile('*.LTR');

      FindFirst(LetterFile, AnyFile, DirInfo);

      if DosError <> 0 then

        MakeLetter(LetterFile);

    end

  else

    begin

      FindFirst('*.LTR', AnyFile, DirInfo);

      if DosError <> 0 then

        begin

          writeln('No letter files available ("*.LTR").');

          writeln('Creating "A-J-1-10.LTR"...');

          assign(LF, 'A-J-1-10.LTR');

          rewrite(LF);

          writeln(LF, 'A-J-1-10.LTR');

          writeln(LF, 'LETTERS:');

          writeln(LF, 'A = 1');

          writeln(LF, 'B = 2');

          writeln(LF, 'C = 3');

          writeln(LF, 'D = 4');

          writeln(LF, 'E = 5');

          writeln(LF, 'F = 6');

          writeln(LF, 'G = 7');

          writeln(LF, 'H = 8');

          writeln(LF, 'I = 9');

          writeln(LF, 'J = 10');

          close(LF);

          writeln('"A-J-1-10.LTR" created.');

          LetterFile := 'A-J-1-10.LTR';

          Wait;

        end

      else

        repeat

          LetterFile := DirInfo.Name;

          FindNext(DirInfo);

        until DosError <> 0;

    end;

end;



Procedure MakeFormat(var FormatFile: string);

{***************************************************************************}

var

  FF: text;

  Done: boolean;

  InStr: string;

begin

  Done := false;

  ;

  Clr;

  Assign(FF, FormatFile);

  Rewrite(FF);

  Say('You make any comment, heading, or sub-heading as long as you');

  Say('end the line with a colon (:) and then the questions to be');

  Say('averaged.  Ex.: "Overall:  1-4, 5, 8 10 12-56".  A comma (,) or');

  Say('a space delimits a single question to be averaged and dash');

  Say('indicates a series.  All the series and singles on a line will');

  Say('be averaged together.  Numbers will be averaged following any');

  Say('colon in a line.  If there is no colon, nothing will be averaged.');

  Say('Enter ".S" or ".s" at the beginning of a line to stop and save.');

  Say(MultiChar('*',78));

  repeat

    readln(InStr);

    if (InStr = '.s') or (InStr = '.S') then

      Done := true

    else

      WriteLn(FF, InStr);

  until Done;

  Close(FF);

end;



Procedure SetFormat(var FormatFile: string);

{***************************************************************************}

var

  DirInfo: SearchRec;

  FF: text;

begin

  if FormatFile <> 'Pick one.' then

    begin

      Clr;

      FormatFile := GetDirFile('*.FRM');

      FindFirst(FormatFile, AnyFile, DirInfo);

      if DosError <> 0 then

        MakeFormat(FormatFile);

    end

  else

    begin

      FindFirst('*.FRM', AnyFile, DirInfo);

      if DosError <> 0 then

        begin

          writeln('No format files available ("*.FRM").');

          writeln('Creating "GROUP120.FRM"...');

          assign(FF, 'GROUP120.FRM');

          rewrite(FF);

          writeln(FF, 'GROUP120.FRM');

          writeln(FF,'OVERALL:  1 - 120');

          close(FF);

          writeln('"GROUP120.FRM" created.');

          FormatFile := 'GROUP120.FRM';

          Wait;

        end

      else

        repeat

          FormatFile := DirInfo.Name;

          FindNext(DirInfo);

        until DosError <> 0;

    end;

end;



Procedure Menu(var FormatFile, LetterFile, HeaderFile: string);

{***************************************************************************}

const

  NumOptions = 4;

var

  Option: integer;

begin

  Clr;

  Say('Program REPORT2 by 2Lt David Croft, 31st TES.');

  Say('');

  Say('Purpose:');

  Say('  Creates report files (.RPT) of data files (.DAT) created by');

  Say('SCAN.EXE and TRANS.EXE as part of the Questionnaire Analysis System');

  Say('(QAS) package.');

  Say('');

  Say('Notes:');

  Say('Max # of responses on a merged answer sheet allowable is 255.');

  Say('Max # of answer sheets in a *.DAT file allowable is '

    + StrInt(MaxNumSurveySheets) + '.');

  Say(

  'This program will generate initial .HDR, .LTR, and .FRM files if missing.'

    );

  writeln;

  Say('0) Quit -- or CONTROL-BREAK');

  Say('1) Set up the report format');

  Say('   Format currently set to "'+FormatFile+'".');

  Say('2) Set the scan sheet letters to numerical values');

  Say('   Letters currently set to values in "'+LetterFile+'".');

  Say('3) Set up the header format');

  Say('   Header currently set to "'+HeaderFile+'".');

  Say('4) Generate the report');

  writeln;

  AskNum('Option',NumOptions,Option);

  case Option of

    0:  halt;

    1:  SetFormat(FormatFile);

    2:  SetLetter(LetterFile);

    3:  SetHeader(HeaderFile);

    4:  MakeReport(FormatFile, LetterFile, HeaderFile);

  end; {case}

  Wait;

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

  Clr;

  InitFormatFile := 'Pick one.';

  InitLetterFile := 'Pick one.';

  InitHeaderFile := 'Pick one.';

  SetFormat(InitFormatFile);

  SetLetter(InitLetterFile);

  SetHeader(InitHeaderFile);

  repeat

    Menu(InitFormatFile, InitLetterFile, InitHeaderFile);

  until Forever;

end.