Oakland CPM Archive/oakcpm.iso/sigm/vol094/tinit.pas

Pascal/Delphi Source File | 1984-04-29 | 5.1 KB | 269 lines

external terms::init(5);


{COPYRIGHT 1982 (C) BY CRAIG RUDLIN, M.D.  ALL RIGHTS RESERVED}






procedure make_file_name;
{$R-}
{$U-}
{$M-}
{$F-}
{$C-}

{put term_file in proper CP/M format for a file name}

begin
term_file[9]:='.';
term_file[10]:='T';
term_file[11]:='E';
term_file[12]:='R';

{now assign value to num_file and put it in proper CP/M format}
num_file:=term_file;
num_file[10]:='N';
num_file[11]:='U';
num_file[12]:='M';

end;




function xvalid:boolean; {internal function to see if file is a valid one}
{$R-}
{$U-}
{$M-}
{$F-}
{$C-}

begin
if (term_file = 'PROTOCOLS   ') OR (term_file = 'DIAGNOSES   ') OR
   (term_file = 'TESTS       ') OR (term_file = 'ACCOUNTS    ') OR
   (term_file = 'DRUGS       ') OR (term_file = 'PROCEDURES  ') OR
   (term_file = 'MATERIALS   ')



   then xvalid:= true else xvalid:= false;
end;


procedure get_file(invalid:boolean); {internal procedure to get type of file}
{$R-}
{$U-}
{$M-}
{$F-}
{$C-}


var
answer:data;
dummy:byte;

begin
            clear_screen;

            end_of_field:=false;
            end_of_record:=false;
            end_of_input:=false;
            answer:=blanks;

            if invalid then
            writeln('YOU HAVE ENTERED AN INVALID FILE.')
                else
            writeln('YOU DID NOT SPECIFY WHICH FILE TO USE.');

            writeln('PLEASE ENTER EITHER:');
                  writeln('PROTOCOLS':35);
            writeln('DIAGNOSES':35);
            writeln('TESTS':35);
            writeln('ACCOUNTS':35);
            writeln('PROCEDURES':35);
            writeln('DRUGS':35);
            writeln('MATERIALS':35);
            writeln;
            write('---> ');


            answer:=input(11,11,12,ucase,letters_only,answer);


    for dummy:= 1 to 12 do term_file[dummy]:=answer[dummy];

            if xvalid = false then get_file(true);
        {was a valid type of file answerif not get valid one}




end; {of internal procedure get_file}




procedure initialize;
{$R-}
{$U-}
{$M-}
{$F-}
{$C-}


{this procedure first reads the command line to determine which file of terms}
{to use...this allows this single program to create files of diagnoses,tests,}
{protocols, etc.  If the command line is blank, then the procedure asks the  }
{user to enter the appropriate file.  Next, the procedure opens the files. If}
{the file is not found, it is created.                        }

const
clear = '            '; {12 spaces}

var
counter,dummy:byte;
job:array[1..12] of char;




begin {**** of procedure initialize ****}

{read the command line.  If file is specified, then continue on to initialize}
{otherwise, must determine which file to enter. Check to make sure it is a   }
{valid type of file }


for b:= 1 to 80 do blanks[b]:=' '; {establish this filler}


job:= clear;      {initialize these variables to all spaces}
term_file:=clear;
num_file:= clear;
counter:=1;

if eoln(0) then get_file(false) else
        begin
            readln(command_line);



        {was a valid type of file entered? if not get valid one}


        while (command_line[counter] <> ' ') and (counter < 10) do
            begin
            term_file[counter]:=command_line[counter];
            counter:=counter + 1;
            end;

        if xvalid = false THEN  get_file(true);
        end;


clear_screen;
writeln('ONE MOMENT PLEASE.');
writeln;

make_file_name;

dummy:=1; {counter for job's array}
counter:=counter + 1; {skip the comma in the command line, that separates}
            {the file from the menu selection}


{don't read more characters than in the array for job, ie 12}

while (dummy < 13) and (command_line[counter] <> ' ') do
    begin
    job[dummy]:=command_line[counter];
    counter:=counter + 1;
    dummy:=dummy + 1;
    end;




{open necessary files}

reset(term_file,fterms);
if eof(fterms) then  {create the file}
    begin

    with terms do
    begin

    term:='MASTER               ';
    print_flag:=false;
    code:=2.0;
    parent:=0;
    left:=0;
    right:=0;


    rewrite(term_file,fterms);
    write(fterms:1,terms);

    rewrite(num_file,fnumterms);
    write(fnumterms:1,terms);

    end;{of with terms}

    numrecs:=2;

    {CP/M does not write the directory listing of a newly created file}
    {until it is closed. Pascal has no provision for explicitly closing}
    {a file. Until the file is closed, and the dir listing is written, }
    {CP/M will not permit the program to read the file...Hence it is   }
    {imperative to force the CP/M to create the directory listing.  This}
    {is done by "reset" the file.                      }

    reset(term_file,fterms);
    reset(num_file,fnumterms);

    end {of if eof}

ELSE
    BEGIN
    {determine number of records in term file}
    read(fterms:1,terms);
    numrecs:= round(terms.code);


    reset(num_file,fnumterms);
    if eof(fnumterms) then
        begin
        writeln('FILE OF ',command_line:10,' CODES NOT ON DISK!');
        terminate:=true;
        end
    END;

{if job is a valid menu selection, then go directly to that procedure and }
{skip the menu at this point}


if terminate = false then
begin

clear_screen;

if ((term_file = 'TESTS   .TER') or (term_file = 'MATERIAL.TER')) then
    needs_units:=true else needs_units:=false;

if job = 'ADD         ' then add(false,false) else
if job = 'DELETE      ' then delete(false,false) else
if job = 'FIND        ' then find(false,0)  else
if job = 'CHANGE      ' then change else
if job = 'DISPLAY     ' then print_terms(false) else
if job = 'PRINT       ' then print_terms(true);

end;


end; {of procedure}
. {of separate compilation}