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


VARIABLE: PROC OPTIONS (MAIN);

%INCLUDE PLI_FILE_DISPLAY;

DCL INFILE               FILE RECORD INPUT,
    INPTR                POINTER;
DCL OUTFILE              FILE RECORD OUTPUT ENV (DEFAULT_FILE_NAME('.VAR')),
    OUTPTR               POINTER;
DCL INREC                CHAR (4000) VAR INIT (' ');
DCL OUTREC               CHAR (4000) VAR INIT (' ');
DCL INFILE_NAME          CHAR (100) VAR INIT (' ');
DCL OUTFILE_NAME         CHAR (100) VAR INIT (' ');
DCL REC_LENGTH           FIXED BIN (15) INIT (0);
DCL COUNTER              FIXED BIN (31) INIT (0);
DCL LINE                 CHAR (132) VAR INIT (' ');
DCL ANSWER               CHAR (1) VAR INIT ('Y');
DCL VALUE                CHAR (10) VAR INIT (' ');
DCL EOF                  BIT(1) INIT ('0'B);

ON UNDEFINEDFILE (INFILE) BEGIN;
 PUT SKIP(2) LIST ('%VAR-E-OPENIN, Error opening input file');
 PUT SKIP EDIT ('-VAR-E-NOSUCHFILE, File: "',INFILE_NAME,'" not found.')
               (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 ('%VAR-E-OPENOUT, Error opening output file');
 PUT SKIP EDIT ('-VAR-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)    TITLE (OUTFILE_NAME)
                        ENV (MAXIMUM_RECORD_SIZE(INPTR->MAXIMUM_RECORD_SIZE));
END;

PUT SKIP LIST ('                 WESTAT VARIABLE 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);
OPEN FILE (OUTFILE)      TITLE (OUTFILE_NAME)
                         ENV (MAXIMUM_RECORD_SIZE(INPTR->MAXIMUM_RECORD_SIZE));
ALLOCATE PLI_FILE_DISPLAY SET (OUTPTR);
CALL DISPLAY (OUTFILE,OUTPTR->PLI_FILE_DISPLAY);

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 ('%VAR-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 DO;
  COUNTER = 2147483647;
END;

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

READ FILE (INFILE) INTO (INREC);

DO WHILE ((^EOF) & (COUNTER > 0));
  DO REC_LENGTH = 1 TO LENGTH(INREC) WHILE (SUBSTR(INREC,REC_LENGTH) ^= ' ');
  END;
  OUTREC = SUBSTR(INREC,1,REC_LENGTH-1);
  WRITE FILE (OUTFILE) FROM (OUTREC);  
  READ FILE (INFILE) INTO (INREC);
  COUNTER = COUNTER - 1;
END;

PUT SKIP(2) EDIT
    ('%VAR-S-COPIED,',INPTR->EXPANDED_TITLE,'copied to',OUTPTR->EXPANDED_TITLE)
    (A,X,A,X,A,X,A);

IF (OUTPTR->MAXIMUM_RECORD_SIZE = 0) THEN 
  PUT SKIP LIST ('-VAR-I-VARRECS, ---- Variable length records.');
ELSE DO;
DCL PIC_STRING                  PIC 'Z,ZZZ,ZZZ,ZZ9';
DCL EDITED                      CHAR (13) VAR INIT (' ');
DCL I                           FIXED BIN (15);
PIC_STRING = DEC(OUTPTR->MAXIMUM_RECORD_SIZE);
EDITED = PIC_STRING;
DO I = 1 TO 13 WHILE (INDEX(EDITED,' ') ^= 0);
  EDITED = SUBSTR(PIC_STRING,I);
END;
PUT SKIP EDIT 
    ('-VAR-I-VARRECS, ---- Variable length, maximum',EDITED,'bytes.')
    (A,X,A,X,A);
END;

END VARIABLE;