IDENTIFICATION DIVISION.
       PROGRAM-ID. TABLESCR.
       AUTHOR. GROCER.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       SELECT PRINT-FILE ASSIGN TO PRINTER.
       DATA DIVISION.
       FILE SECTION.
       FD  PRINT-FILE
           DATA RECORD IS PRINTZ.
       01  PRINTZ.
           05  FILLER          PIC X.
           05  DIV-NAME-PR     PIC X(7).
           05  FILLER          PIC XX.
           05  BRANCH-NAME-PR  PIC X(8).
           05  FILLER          PIC X.
           05  DEPT-NAME-PR    PIC X(10).
           05  FILLER          PIC XX.
           05  ITEM-NO-PR      PIC 99.
           05  FILLER          PIC X.
           05  ITEM-NAME-PR    PIC X(20).
           05  FILLER          PIC X.
           05  ON-HAND-PR      PIC ZZ9.
           05  FILLER          PIC X.
           05  PRICE-PR        PIC $ZZ9.99.
           05  FILLER          PIC X.
           05  INV-VALUE-PR    PIC $ZZZ,ZZ9.99.
           05  FILLER          PIC X.
       WORKING-STORAGE SECTION.
       01  RESPONSEZ.
           05   SCREEN-RESPONSE      PIC X       VALUE "C".
       01  DATA-FROM-SCREEN.
           05  DIV                   PIC 9       VALUE 0.
           05  BRANCH                PIC 9       VALUE 0.
           05  DEPT                  PIC 9       VALUE 0.
           05  ITEM-NO               PIC 9       VALUE 0.
           05  ON-HAND               PIC 9(3)    VALUE 0.
       01  WORK-AREAS.
           05  INV-VALUE-WS          PIC 9(6)V99 VALUE 0.
       01  TABLE-DIVISION.
           05  FILLER PIC X(7) VALUE "EAST   ".
           05  FILLER PIC X(7) VALUE "CENTRAL".
           05  FILLER PIC X(7) VALUE "WEST   ".
       01  RDF-TABLE-DIVISION REDEFINES TABLE-DIVISION.
           05  DIV-NAME PIC X(7) OCCURS 3 TIMES.
       01  TABLE-BRANCH.
           05  FILLER PIC X(8) VALUE "DELAWARE".
           05  FILLER PIC X(8) VALUE "VIRGINIA".
           05  FILLER PIC X(8) VALUE "VERMONT ".
           05  FILLER PIC X(8) VALUE "ILLINOIS".
           05  FILLER PIC X(8) VALUE "TEXAS   ".
           05  FILLER PIC X(8) VALUE "OREGON  ".
           05  FILLER PIC X(8) VALUE "MONTANA ".
       01  RDF-TABLE-BRANCH REDEFINES TABLE-BRANCH.
           05  BR-NAME PIC X(8) OCCURS 7 TIMES.
       01  TABLE-DEPT.
           05  FILLER PIC X(10) VALUE "FURNITURE ".
           05  FILLER PIC X(10) VALUE "FABRIC    ".
           05  FILLER PIC X(10) VALUE "HARDWARE  ".
           05  FILLER PIC X(10) VALUE "PATIO FURN".
       01  RDF-TABLE-DEPT REDEFINES TABLE-DEPT.
           05  DEPT-NAME PIC X(10) OCCURS 4 TIMES.
       01  TABLE-ITEM.
           05  FILLER PIC X(25) VALUE "LOUNGE CHAIR        42999".
           05  FILLER PIC X(25) VALUE "BEDROOM SET         69998".
           05  FILLER PIC X(25) VALUE "WINDOW SEAT KIT     39595".
           05  FILLER PIC X(25) VALUE "GREENHOUSE ROOM KIT 89500".
           05  FILLER PIC X(25) VALUE "VELVET (BY THE YARD)02500".
           05  FILLER PIC X(25) VALUE "LINEN (BY THE YEARD)01900".
       01  RDF-TABLE-ITEM REDEFINES TABLE-ITEM.
           05  ITEMZ OCCURS 6 TIMES.
               10  ITEM-NAME PIC X(20).
               10  PRICE     PIC 9(3)V99.
       01  PAGE-CONTROL.
           05  PAGE-NO         PIC 99    VALUE 1.
           05  LINE-CT         PIC 99    VALUE 0.
       01  DATE-WS.
           05  YR-WS           PIC 99    VALUE 0.
           05  MO-WS           PIC 99    VALUE 0.
           05  DA-WS           PIC 99    VALUE 0.
       01  PAGE-HDR.
           05  FILLER          PIC XX    VALUE SPACES.
           05  DATE-HDR.
               10  MO-HDR      PIC 99.
               10  FILLER      PIC X     VALUE "/".
               10  DA-HDR      PIC 99.
               10  FILLER      PIC X     VALUE "/".
               10  YR-HDR      PIC 99.
           05  FILLER          PIC X(22) VALUE SPACES.
           05  FILLER          PIC X(16) VALUE "INVENTORY REPORT".
           05  FILLER          PIC X(20) VALUE SPACES.
           05  FILLER          PIC X(5)  VALUE "PAGE ".
           05  PAGE-NO-HDR     PIC Z9.
           05  FILLER          PIC X(5)  VALUE SPACES.
       01  COLUMN-HDR.
           05  FILLER          PIC X     VALUE SPACES.
           05  FILLER          PIC X(8)  VALUE "DIVISION".
           05  FILLER          PIC X     VALUE SPACES.
           05  FILLER          PIC X(8)  VALUE "BRANCH  ".
           05  FILLER          PIC X     VALUE SPACES.
           05  FILLER          PIC X(10) VALUE "DEPARTMENT".
           05  FILLER          PIC X     VALUE SPACES.
           05  FILLER          PIC X(4)  VALUE "IT# ".
           05  FILLER          PIC X(9)  VALUE "ITEM NAME".
           05  FILLER          PIC X(8)  VALUE SPACES.
           05  FILLER          PIC X(7)  VALUE "ON HAND".
           05  FILLER          PIC X     VALUE SPACES.
           05  FILLER          PIC X(5)  VALUE "PRICE".
           05  FILLER          PIC X(3)  VALUE SPACES.
           05  FILLER          PIC X(5)  VALUE "VALUE".
           05  FILLER          PIC X(8)  VALUE SPACES.
       SCREEN SECTION.
       01  DATA-ENTRY-SCREEN.
           05  VALUE "DATA ENTRY SCREEN"   BLANK SCREEN
                                           LINE 1 COL 30.
           05  VALUE "DIVISION (VALID 1 - 3)"
                                           LINE 3 COL 10.
           05  DIV-INPUT                   LINE 3 COL 40
                         PIC 9   TO DIV.
           05  VALUE "BRANCH (VALID 1 - 7)"
                                           LINE 5 COL 10.
           05  BRANCH-INPUT                LINE 5 COL 40
                         PIC 9   TO BRANCH.
           05  VALUE "DEPARTMENT (VALID 1- 4)"
                                           LINE 7 COL 10.
           05  DEPT-INPUT                  LINE 7 COL 40
                         PIC 9   TO DEPT.
           05  VALUE "ITEM NUMBER VALID (1 - 6)"
                                           LINE 9 COL 10.
           05  ITEM-NO-INPUT               LINE 9 COL 40
                         PIC 9  TO ITEM-NO.
           05  VALUE "ON HAND (VALID 1 - 999)"
                                           LINE 11 COL 10.
           05  ON-HAND-INPUT               LINE 11 COL 40
                         PIC 999  TO ON-HAND.
           05  VALUE "C - TO CONTINUE"     LINE 14 COL 30.
           05  VALUE "Q - TO QUIT"         LINE 15 COL 30.
           05  VALUE "ENTER CHOICE:"       LINE 16 COL 30.
           05  RESPONSE-FROM-SCR           LINE 16 COL 45
                         PIC X   TO SCREEN-RESPONSE.

       PROCEDURE DIVISION.
       MAINLINE.
           PERFORM A-100-STARTUP.
           PERFORM B-100-PROCESS.
           PERFORM C-100-WRAPUP.
           STOP RUN.
       A-100-STARTUP.
           OPEN OUTPUT PRINT-FILE.
           PERFORM U-010-DATE-ROUT.
       B-100-PROCESS.
           DISPLAY DATA-ENTRY-SCREEN.
           ACCEPT DATA-ENTRY-SCREEN.
           PERFORM B-200-LOOP
               UNTIL SCREEN-RESPONSE = "Q".
       B-200-LOOP.
           PERFORM B-300-DETAIL.
           DISPLAY DATA-ENTRY-SCREEN.
           ACCEPT DATA-ENTRY-SCREEN.
       B-300-DETAIL.
           IF LINE-CT > 55 OR PAGE-NO = 1
               PERFORM B-400-HDR-ROUT.
           MOVE SPACES TO PRINTZ.
           IF DIV > 0 AND DIV < 4
               MOVE DIV-NAME(DIV) TO DIV-NAME-PR
           ELSE
               MOVE "INVALID" TO DIV-NAME-PR.
           IF BRANCH > 0 AND BRANCH < 8
               MOVE BR-NAME (BRANCH) TO BRANCH-NAME-PR
           ELSE
               MOVE "INVALID" TO BRANCH-NAME-PR.
           IF DEPT > 0 AND DEPT < 5
               MOVE DEPT-NAME (DEPT) TO DEPT-NAME-PR
           ELSE
               MOVE "INVALID" TO DEPT-NAME-PR.
           IF ITEM-NO > 0 AND ITEM-NO < 6
               MOVE ITEM-NO TO ITEM-NO-PR
               MOVE ITEM-NAME (ITEM-NO) TO ITEM-NAME-PR
               MOVE ON-HAND TO ON-HAND-PR
               MOVE PRICE (ITEM-NO) TO PRICE-PR
               MULTIPLY ON-HAND BY PRICE (ITEM-NO)
                   GIVING INV-VALUE-WS
               MOVE INV-VALUE-WS TO INV-VALUE-PR
           ELSE
               MOVE "INVALID" TO ITEM-NAME-PR.
           WRITE PRINTZ
               AFTER ADVANCING 1 LINES.
           ADD 1 TO LINE-CT.
       B-400-HDR-ROUT.
           MOVE PAGE-NO TO PAGE-NO-HDR.
           WRITE PRINTZ FROM PAGE-HDR
               AFTER ADVANCING PAGE.
           WRITE PRINTZ FROM COLUMN-HDR
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO PRINTZ.
           WRITE PRINTZ
               AFTER ADVANCING 1 LINES.
           ADD 1 TO PAGE-NO.
           MOVE 4 TO LINE-CT.
       U-010-DATE-ROUT.
           ACCEPT DATE-WS FROM DATE.
           MOVE MO-WS TO MO-HDR.
           MOVE DA-WS TO DA-HDR.
           MOVE YR-WS TO YR-HDR.
       C-100-WRAPUP.
           CLOSE PRINT-FILE.