/*                      SYS:[OPERATOR]FIXED.PLI                              */
/*                          MICHAEL FALICK                                   */
/*                            20-NOV-1981                                    */
/*                                                                           */
/*   This program will copy a fixed or variable length file with a record    */
/* length of up to 4000 bytes to a fixed length file with a length specified */
/* by the user.  It will copy all records or as many as are specified by the */
/* user.                                                                     */


FIXED_LENGTH: PROC OPTIONS (MAIN);

%INCLUDE PLI_FILE_DISPLAY;

DCL INFILE               FILE RECORD INPUT,
    INPTR                POINTER;
DCL OUTFILE              FILE RECORD OUTPUT ENV (FIXED_LENGTH_RECORDS,
                                                 DEFAULT_FILE_NAME('.FXD')),
    OUTPTR               POINTER;
DCL REC                  CHAR (4000) VAR INIT (' ');
DCL INFILE_NAME          CHAR (100) VAR INIT (' ');
DCL OUTFILE_NAME         CHAR (100) VAR INIT (' ');
DCL REC_LENGTH           FIXED BIN (15);
DCL PIC_LENGTH           PIC 'Z,ZZZ,ZZZ,ZZ9';
DCL EDITED               CHAR (13) VAR INIT (' ');
DCL I                    FIXED BIN (15) INIT (0);
DCL EOF                  BIT(1) INIT ('0'B);
DCL ANSWER               CHAR (1) INIT ('Y');
DCL VALUE                CHAR (10) VAR INIT (' ');
DCL LINE                 CHAR (132) VAR INIT (' ');
DCL COUNTER              FIXED BIN (31);

ON UNDEFINEDFILE (INFILE) BEGIN;
  PUT SKIP(2) LIST ('%FXD-E-OPENIN, Error opening input file');
  PUT SKIP EDIT ('-FXD-E-NOSUCHFILE, File: "',INFILE_NAME,'" cannot be opened for input.')
                (A,X(0),A,X(0),A);
  PUT SKIP(2) LIST ('   Re-enter input file:  ');
  GET LIST (INFILE_NAME);
  OPEN FILE (INFILE)     TITLE(INFILE_NAME);
END;

ON UNDEFINEDFILE (OUTFILE) BEGIN;
  PUT SKIP(2) LIST ('%FXD-E-OPENOUT, Error opening output file');
  PUT SKIP EDIT ('-FXD-E-OPENOUT, File: "',OUTFILE_NAME,'" cannot be opened for output.')
                (A,X(0),A,X(0),A);
  PUT SKIP(2) LIST ('   Re-enter output file:  ');
  GET LIST (OUTFILE_NAME);
  OPEN FILE (OUTFILE) ENV (MAXIMUM_RECORD_SIZE(REC_LENGTH)) 
                      TITLE (OUTFILE_NAME);
END;

PUT SKIP LIST 
   ('                  WESTAT FIXED LENGTH RECORD UTILITY');
PUT SKIP(2) LIST ('   Enter name of input file:  ');
GET LIST (INFILE_NAME);
OPEN FILE (INFILE)       TITLE(INFILE_NAME);
ALLOCATE PLI_FILE_DISPLAY SET (INPTR);
CALL DISPLAY(INFILE,INPTR->PLI_FILE_DISPLAY);

PUT SKIP LIST ('   Enter name of output file:   ');
GET LIST (OUTFILE_NAME);
PUT SKIP LIST ('   Enter fixed length of output file records:  ');
GET LIST (VALUE);
DO WHILE (VERIFY(VALUE,'0123456789 ') ^= 0);
  PUT SKIP(2) LIST ('%FXD-E-CONVERR, Invalid numeric value');
  PUT SKIP EDIT (' \',VALUE,'\')(A,X(0),A,X(0),A);
  PUT SKIP(2) LIST ('   Re-enter fixed length:  ');
  GET LIST (VALUE);
END;
REC_LENGTH = FIXED(VALUE,15);
DO WHILE (REC_LENGTH < 1);
  PUT SKIP(2) LIST ('%FXD-E-TOOSHORT, Invalid record length');
  PUT SKIP EDIT (' \',VALUE,'\')(A,X(0),A,X(0),A);
  PUT SKIP(2) LIST ('   Re-enter fixed length:  ');
  GET LIST (VALUE);
  DO WHILE (VERIFY(VALUE,'0123456789 ') ^= 0);
    PUT SKIP(2) LIST ('%FXD-E-CONVERR, Invalid numeric value');
    PUT SKIP EDIT (' \',VALUE,'\')(A,X(0),A,X(0),A);
    PUT SKIP(2) LIST ('   Re-enter fixed length:  ');
    GET LIST (VALUE);
  END;
  REC_LENGTH = FIXED(VALUE,15);
END;

CALL OPENOUT;
CALL COPY;

PIC_LENGTH = DEC(REC_LENGTH);
EDITED = PIC_LENGTH;
DO I = 1 TO 13 WHILE (INDEX(EDITED,' ') ^= 0);
   EDITED = SUBSTR(PIC_LENGTH,I);
END;
PUT SKIP(2) EDIT
 ('%FXD-S-COPIED,',INPTR->EXPANDED_TITLE,'copied to',OUTPTR->EXPANDED_TITLE)
 (A,X,A,X,A,X,A);
PUT SKIP EDIT
  ('-FXD-I-RECLENGTH, ---- Fixed length',EDITED,'byte records.')
  (A,X,A,X,A);

OPENOUT: PROC;

 OPEN FILE (OUTFILE) ENV (MAXIMUM_RECORD_SIZE(REC_LENGTH)) 
                     TITLE (OUTFILE_NAME);
 ALLOCATE PLI_FILE_DISPLAY SET (OUTPTR);
 CALL DISPLAY (OUTFILE,OUTPTR->PLI_FILE_DISPLAY);
END OPENOUT;

COPY: PROC;

PUT SKIP EDIT ('   Copy all records in',INPTR->EXPANDED_TITLE,'? (Y/N)  ')
              (A,X,A,X(0),A);
GET LIST (ANSWER);
IF ((ANSWER = 'N') | (ANSWER = 'n')) THEN DO;
   PUT SKIP LIST ('   Enter number of records to be copied:  ');
   GET LIST (VALUE);
   DO WHILE (VERIFY(VALUE,'0123456789 ') ^= 0);
     PUT SKIP(2) LIST ('%FXD-E-CONVERR, Invalid numeric value');
     PUT SKIP EDIT (' \',VALUE,'\')(A,X(0),A,X(0),A);
     PUT SKIP(2) LIST ('   Re-enter number to be copied:  ');
     GET LIST (VALUE);
   END;
   COUNTER = FIXED(VALUE,31);
END;
ELSE COUNTER = 2147483647;

DCL OUTREC               CHAR (REC_LENGTH);

ON ENDFILE (INFILE) EOF = '1'B;

READ FILE (INFILE) INTO (REC);

DO WHILE ((COUNTER > 0) & (^EOF));
  OUTREC = REC;
  WRITE FILE (OUTFILE) FROM (OUTREC);
  READ FILE (INFILE) INTO (REC);
  COUNTER = COUNTER - 1;
END;
END COPY;

END FIXED_LENGTH;