Module OPENFILE(input,output);

 TYPE
      line = packed array[1..80] of char;
      descr  = PACKED RECORD    (* line descriptor *)
                 length:  integer;
                 pointer: ^line   end;

 PROCEDURE sys$crelog ( %IMMED tblflg: integer;
			   %STDESCR lognam: PACKED ARRAY [INTEGER] OF char;
  			   eqlnam: descr;
			   %IMMED acmode: integer); FORTRAN;

 Function FILESTAT(%STDESCR filnam:line):integer; extern;

 Procedure PREPAREFILENAME(var FILNAM: line; var FILNAMDESCR:descr);
  var i:integer;
  begin
    new(FILNAMDESCR.POINTER);
      (* copy line, convert to upper case, find length *)
    i := 1;
    while (i < 80) AND (filnam[i] <> ' ') do begin
      if ('a'<=filnam[i]) and (filnam[i]<='z') then
        filnamdescr.pointer^[i] := chr(ord(filnam[i]) -32)
      else
        filnamdescr.pointer^[i] := filnam[i] ;
      i := i + 1
	end;
    filnamdescr.length := i - 1
 end;


 Function OPENFORREAD(var filnam:line; var f:text): integer;
  var filnamdescr: descr; RETCODE:integer;
  begin
      (* Prepare file name *)
    PREPAREFILENAME(filnam,filnamdescr);
     (* check file charecteristics :
           1 ==> implicit crlf
           2 ==> imbedded carriage control
           3 ==> file not found  *)
    RETCODE := filestat(filnamdescr.pointer^);
    OPENFORREAD := RETCODE;
    if RETCODE <> 3 then begin
        (* Create logical name in process logical name table *)
      sys$crelog (2, 'PAS$INFILE', filnamdescr, 0);
      open (f,'PAS$INFILE', OLD);
      reset (f)   end
 end;

 Procedure OPENFORWRITE(var filnam:line; var f:text);
  var filnamdescr: descr;
  begin
      (* Prepare file name *)
    PREPAREFILENAME(filnam,filnamdescr);
      (* Create logical name in process logical name table *)
    sys$crelog (2, 'PAS$OUTFILE', filnamdescr, 0);
    open (f,'PAS$OUTFILE', NEW);
    rewrite (f)
 end;

end .