       IDENTIFICATION DIVISION.
       PROGRAM-ID. PCLPGM.
       AUTHOR. HONEYWELL.
       REMARKS. THIS PROGRAM BUILDS A PCL-COPY FILE
           FROM THE COPYSTD FILE BUILT BY CONV  JCL
            COPYRIGHT, (C) HONEYWELL INFORMATION SYSTEMS INC, 1979.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. SIGMA-6.
       OBJECT-COMPUTER. SIGMA-6.
       SPECIAL-NAMES. '1'  IS TOP
           CONSOLE IS REM.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT CNTLIN ASSIGN TO DISC.
           SELECT PCLOUT  ASSIGN TO DISC.
       DATA DIVISION.
       FILE SECTION.
       FD  CNTLIN  LABEL RECORDS ARE STANDARD
           DATA RECORD IS INREC.
       01  INREC                   PIC X(32).
       FD  PCLOUT
           LABEL RECORDS ARE STANDARD
           DATA RECORD IS OUTREC.
       01  OUTREC                  PIC X(80).
       WORKING-STORAGE SECTION.
       77 COPYRITE PIC X(60) VALUE
             'COPYRIGHT, (C) HONEYWELL INFORMATION SYSTEMS INC., 1979'.
       77  CRT-Y               PIC X.
       77  SUB1                COMP VALUE 1.
       77  SUB2                    COMP VALUE 0.
       01  NAME-HOLD               PIC X(32).
       01  NAME-HOLD-RED REDEFINES NAME-HOLD.
           05  HOLDBY1  PIC X  OCCURS 32.
       01  NAME-OUT                PIC X(32).
       01  NAME-OUT-RED REDEFINES NAME-OUT.
           05  OUTBY1   PIC X  OCCURS 32.
       01  COPY-OUT                PIC X(32).
       01  COPY-OUT-RED REDEFINES COPY-OUT.
           05  COPYBY1  PIC X  OCCURS 32.
       01  LABEL-NAME              PIC XXXX.
       01  SUF                     PIC X.
       01  PCLCOPY.
           05  NEWFILENAME     PIC X(32).
           05  FILLER          PIC X(6) VALUE 'TO LT#'.
           05  CPYLTNBR         PIC XXXX.
           05  FILLER              PIC X VALUE '/'.
           05  CPYFILENAME         PIC X(32).
       01  MOUNT-M.
           05  FILLER              PIC X(18)  VALUE
           '!MESSAGE MOUNT LT#'.
           05  MLTNBR              PIC XXXX.
           05  FILLER              PIC X(10) VALUE ' WITH RING'.
       01  REW-REC.
           02  FILLER PIC X(7) VALUE 'REW LT#'.
           02  REWLT PIC X(4).
       01  LIST-REC.
           02  FILLER PIC X(5) VALUE 'L LT#'.
           02  LISTLT PIC X(4).
           02  FILLER PIC XXX VALUE '(A)'.
       01  REM-REC.
           02  FILLER PIC X(7) VALUE 'REM LT#'.
           02  REMLT PIC X(4).
       01  RECV PIC X(10).
       PROCEDURE DIVISION.
       REQ-PAR.
           OPEN INPUT CNTLIN.
           OPEN OUTPUT PCLOUT.
           MOVE '!JOB ' TO OUTREC.
           WRITE OUTREC.
           MOVE '!LIMIT (CORE,26),(TIME,30),(9T,1),(ACCOUNT)' TO OUTREC .
           WRITE OUTREC.
           DISPLAY ' ' UPON REM.
           DISPLAY ' ' UPON REM.
           DISPLAY ' ENTER LABEL FOR LT#(4 CHAR) ' UPON REM.
           ACCEPT RECV FROM REM.
           MOVE RECV TO CPYLTNBR.
           MOVE CPYLTNBR TO MLTNBR.
           WRITE OUTREC FROM MOUNT-M.
           MOVE '!PCL ' TO OUTREC.
           WRITE OUTREC.
       PAR-1.
           DISPLAY ' ' UPON REM.
           DISPLAY ' ' UPON REM.
           DISPLAY
           ' DO YOU WISH TO KEEP (-C) SUFFIX?  ' UPON REM.
           DISPLAY ' ENTER Y OR N ' UPON REM
           ACCEPT RECV FROM REM.
           MOVE RECV TO CRT-Y.
           MOVE CRT-Y TO SUF.
           IF SUF   = 'N' GO TO READIT.
           IF SUF   NOT = 'Y' GO TO PAR-1.
       READIT.
           MOVE SPACES TO INREC.
           MOVE SPACES TO NAME-HOLD.
           READ CNTLIN AT END GO TO ENDIT.
           MOVE INREC TO NAME-HOLD.
           MOVE SPACES TO NAME-OUT.
           MOVE SPACES TO COPY-OUT.
       LOOP1.
           COMPUTE SUB1 = SUB1 + 1.
           IF SUB1  > 29 GO TO LOOP1-END.
           IF HOLDBY1 (SUB1) = ' ' GO TO LOOP1-END.
           COMPUTE SUB2 = SUB1 - 1.
           MOVE HOLDBY1 (SUB1) TO COPYBY1 (SUB2).
           MOVE HOLDBY1 (SUB1) TO OUTBY1  (SUB2).
           GO TO LOOP1.
_      LOOP1-END.
           COMPUTE SUB1 = SUB1 - 1.
           MOVE '-' TO COPYBY1 (SUB1).
           ADD 1 TO SUB1.
           MOVE 'C' TO COPYBY1 (SUB1).
       MOVE-FILE-NAME.
           MOVE COPY-OUT TO NEWFILENAME.
           IF SUF   = 'N'
               MOVE NAME-OUT TO CPYFILENAME ELSE
           MOVE COPY-OUT TO CPYFILENAME.
           WRITE OUTREC FROM PCLCOPY.
           MOVE 1  TO SUB1.
           GO TO READIT.
       ENDIT.
           MOVE CPYLTNBR TO REWLT.
           MOVE CPYLTNBR TO LISTLT.
           MOVE CPYLTNBR TO REMLT.
           WRITE OUTREC FROM REW-REC.
           WRITE OUTREC FROM LIST-REC.
           WRITE OUTREC FROM REW-REC.
           WRITE OUTREC FROM REM-REC.
           MOVE 'END'     TO OUTREC.
           WRITE OUTREC.
           DISPLAY ' ' UPON REM.
           DISPLAY ' ' UPON REM.
           DISPLAY ' PLEASE BATCH YOUR PCL JOB ' UPON REM.
           DISPLAY ' ' UPON REM.
           CLOSE CNTLIN PCLOUT.
           STOP RUN.
