Example: Mailing Labels

       IDENTIFICATION DIVISION.
       PROGRAM-ID.     LABELS.
       AUTHOR.         BILL ROGERS.
      *
      *  3-ACROSS MAILING LABELS
      *
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
            SELECT INPUT-FILE
                ASSIGN TO 'PERSON.DAT'.
            SELECT PRINT-FILE
                ASSIGN TO 'LABELS.TXT'.

       DATA DIVISION.
       FILE SECTION.

       FD INPUT-FILE
          DATA RECORD IS INPUT-RECORD.

       01  INPUT-RECORD.
           02  INPUT-ID             PICTURE X(10).
           02  INPUT-NAME           PICTURE X(25).
           02  INPUT-ADDRESS        PICTURE X(25).
           02  INPUT-CITY           PICTURE X(15).
           02  INPUT-STATE          PICTURE X(2).
           02  INPUT-ZIP            PICTURE X(5).

       FD PRINT-FILE
          DATA RECORD IS PRINT-LINE.

       01 PRINT-LINE                PICTURE X(80).

       WORKING-STORAGE SECTION.

       01  LABEL-TABLE.
           02  LABEL-ROW OCCURS 3 TIMES
                   INDEXED BY ROW-INDEX.
               03  LABEL-COLUMN OCCURS 3 TIMES
                       INDEXED BY COLUMN-INDEX.
                   04  FILLER       PICTURE X(1).
                   04  LABEL-FIELD  PICTURE X(25).

       01  NAME-FLIP-AREA.
           02  FIRST-NAME           PICTURE X(25).
           02  LAST-NAME            PICTURE X(25).
           02  WHOLE-NAME           PICTURE X(25).

       01  WORKING-TABLE.
           05  WORK-LETTER          OCCURS 30 TIMES       PICTURE X.

       01  X                        PICTURE 9(2) COMP.

       01  CONVERT-CASE-TEXT.
           02  FILLER               PICTURE X(52) VALUE
               'AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz'.
       01  CONVERT-CASE-TABLE REDEFINES CONVERT-CASE-TEXT.
           02  CONVERT-CASE-LETTER  OCCURS 26 TIMES
               INDEXED BY CONVERT-INDEX.
               03  CONVERT-UPPER    PICTURE X.
               03  CONVERT-LOWER    PICTURE X.

       01  CONVERT-FLAG             PICTURE X.

       01  EOF-FLAG                 PICTURE X.
           88 END-OF-INPUT-FILE     VALUE 'Y'.

       PROCEDURE DIVISION.
       MAIN-LINE.
           PERFORM INITIALIZATION-ROUTINE.
           PERFORM PRINT-LABELS
               UNTIL END-OF-INPUT-FILE.
           PERFORM EOJ-ROUTINE.
           STOP RUN.

       INITIALIZATION-ROUTINE.
           OPEN INPUT INPUT-FILE.
           OPEN OUTPUT PRINT-FILE.
           MOVE 'N' TO EOF-FLAG.
           READ INPUT-FILE
                AT END MOVE 'Y' TO EOF-FLAG.

       PRINT-LABELS.
           MOVE SPACES TO LABEL-TABLE.
           PERFORM BUILD-A-LABEL
               VARYING COLUMN-INDEX FROM 1 BY 1
                   UNTIL COLUMN-INDEX > 3
                       OR END-OF-INPUT-FILE.
           WRITE PRINT-LINE FROM LABEL-ROW (1).
           WRITE PRINT-LINE FROM LABEL-ROW (2).
           WRITE PRINT-LINE FROM LABEL-ROW (3).
           MOVE SPACES TO PRINT-LINE.
           WRITE PRINT-LINE AFTER ADVANCING 2 LINES.

       BUILD-A-LABEL.
           SET ROW-INDEX TO 1.
           PERFORM NAME-FLIP-FLOP.
           MOVE WHOLE-NAME TO WORKING-TABLE.
           PERFORM CHANGE-TO-MIXED-CASE
                   VARYING X FROM 2 BY 1
                   UNTIL X > 25.
           MOVE WORKING-TABLE TO LABEL-FIELD (ROW-INDEX, COLUMN-INDEX).
           SET ROW-INDEX UP BY 1.
           MOVE INPUT-ADDRESS TO WORKING-TABLE.
           PERFORM CHANGE-TO-MIXED-CASE
                   VARYING X FROM 2 BY 1
                   UNTIL X > 25.
           MOVE WORKING-TABLE TO LABEL-FIELD (ROW-INDEX, COLUMN-INDEX).
           SET ROW-INDEX UP BY 1.
           MOVE INPUT-CITY TO WORKING-TABLE.
           PERFORM CHANGE-TO-MIXED-CASE
                   VARYING X FROM 2 BY 1
                   UNTIL X > 25.
           STRING WORKING-TABLE  DELIMITED BY '  '
                  ', '           DELIMITED BY SIZE
                  INPUT-STATE    DELIMITED BY SIZE
                  ' '            DELIMITED BY SIZE
                  INPUT-ZIP      DELIMITED BY SIZE
             INTO LABEL-FIELD (ROW-INDEX, COLUMN-INDEX).
           READ INPUT-FILE
                AT END MOVE 'Y' TO EOF-FLAG.

       NAME-FLIP-FLOP.
           MOVE 1 TO X.
           MOVE SPACES TO NAME-FLIP-AREA.
           UNSTRING INPUT-NAME DELIMITED BY ', '
               INTO LAST-NAME FIRST-NAME.
           INSPECT LAST-NAME
               REPLACING ALL ',' BY SPACE.
           STRING FIRST-NAME DELIMITED BY '  '
                  ' '        DELIMITED BY SIZE
                  LAST-NAME  DELIMITED BY '  '
             INTO WHOLE-NAME.

       CHANGE-TO-MIXED-CASE.
      * Start with the assumption that we will convert this letter to
      * lower case (set flag to Yes) then look for exceptions that
      * should be left upper case (set flag to No).
           MOVE 'Y' TO CONVERT-FLAG.
           IF (WORK-LETTER (X - 1) = " ")
           OR (WORK-LETTER (X - 1) = "-")
           OR (WORK-LETTER (X - 1) = "'")
           OR (WORK-LETTER (X - 1) = ".")
                   MOVE 'N' TO CONVERT-FLAG.
           IF (WORK-LETTER (X - 2) = "M"
               AND WORK-LETTER (X - 1) = "c")
                   MOVE 'N' TO CONVERT-FLAG.
           IF CONVERT-FLAG = 'Y'
                   PERFORM CONVERT-TO-LOWER-CASE.

       CONVERT-TO-LOWER-CASE.
           SET CONVERT-INDEX TO 1.
           SEARCH CONVERT-CASE-LETTER
               WHEN WORK-LETTER (X) = CONVERT-UPPER (CONVERT-INDEX)
               MOVE CONVERT-LOWER (CONVERT-INDEX) TO WORK-LETTER (X).

       EOJ-ROUTINE.
           CLOSE INPUT-FILE.
           CLOSE PRINT-FILE.

Cobol Home