Wednesday, May 2, 2012

Printing 1099’s in Cobol, circa 1991

20 years ago, this is how we printed 1099’s…Many liked to call Cobol “wordy” but it was more accurate to say “self documenting”:

MOVE YTD-FED-GROSS-FINAL TO DATA-2 IN LINE-1.
WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 6.

“Look Mom, no need for comments”:

IDENTIFICATION DIVISION.

       PROGRAM-ID.  PRR1099.

      *    PRINT PAYROLL 1099 FORMS
      * 11/25/91  JOHN WATSON - CREATED.

           COPY HEADER OF CBLCPYSRC SUPPRESS.

       SPECIAL-NAMES.  LOCAL-DATA IS WS.

       INPUT-OUTPUT SECTION.

       FILE-CONTROL.

           COPY ADM1SL OF CBLCPYSRC SUPPRESS.

           SELECT EMPLFILE ASSIGN TO DATABASE-PRCYTDPF
               ORGANIZATION IS SEQUENTIAL
               ACCESS MODE IS SEQUENTIAL
               FILE STATUS IS IO-STATUS.

           SELECT SCRNFILE ASSIGN TO WORKSTATION-PRRPTSSC-SI
               ORGANIZATION IS TRANSACTION.

           SELECT PRNTFILE ASSIGN TO PRINTER-TRCSPRTF.

       DATA DIVISION.

       FILE SECTION.

           COPY SCRNFD OF CBLCPYSRC SUPPRESS.

           COPY PRNTFD OF CBLCPYSRC SUPPRESS.

       FD  ADM1FILE.
       01  ADM1-REC.
               COPY DD-ADM1DATA OF ADM1FILE.

       FD  EMPLFILE.
       01  EMPL-REC.
               COPY DD-EMPLDATA OF PRCYTDPF.
                                                             EJECT.
       WORKING-STORAGE SECTION.

       77  X                           PIC 999.
       77  LIMITER                     PIC X  VALUE "*".

       01  FILE-STATUS.
           03  ADM1FILE-STATUS         PIC XX.
           03  IO-STATUS               PIC XX.

       01  PROGRAM-FLAGS.
           03  END-FILE-FLAG           PIC 9.

       01  PROGRAM-COUNTERS.
           03  1099-COUNT              PIC 9(5).
           03  FORM-COUNT              PIC 9.

       01  FINAL-TOTAL-FIELDS.
           03  STATE-GROSS-FINAL       PIC S9(8)V99   COMP-3.
           03  FED-GROSS-FINAL         PIC S9(8)V99   COMP-3.
           03  YTD-STATE-TAX-FINAL     PIC S9(8)V99   COMP-3.
           03  YTD-FED-TAX-FINAL       PIC S9(8)V99   COMP-3.

       01  ERROR-MESSAGE-LINES.
           03  CONFIRM-SCREEN-MESSAGE.
               05  CONFIRM-SCREEN-MESSAGE-1      PIC X(49) VALUE SPACES.
               05  CONFIRM-SCREEN-MESSAGE-2      PIC X(21) VALUE
                   "CONFIRM DATA ENTERED.".

           COPY ZBEGINDD OF CBLCPYSRC SUPPRESS.

       01  SCREEN-RECORD-IN.
           03  PAGE1-IN.
               COPY DD-W2S01 OF PRRPTSSC.

       01  ERROR-SCREEN-IN.
           03  PAGEERROR-IN.
               COPY DD-ERRORSCR OF PRRPTSSC SUPPRESS.

           COPY XPRNTDD OF CBLCPYSRC.

       01  LINE-1.
           03                          PIC X(6).
           03  DATA-1                  PIC X(32).
           03                          PIC X(3).
           03  DATA-2                  PIC -------9.99.
           03                          PIC X(3).
           03  DATA-3                  PIC -------9.99.

       01  LINE-2.
           03                          PIC X(6).
           03  DATA-1                  PIC X(32).
           03                          PIC X(12).
           03  DATA-2                  PIC X.
           03                          PIC X(13).
           03  DATA-3                  PIC X.

       01  LINE-3.
           03                          PIC X(6).
           03  DATA-1                  PIC X(15).
           03                          PIC X(2).
           03  DATA-2                  PIC X(15).
           03                          PIC X(3).
           03  DATA-3                  PIC -------9.99.
           03                          PIC X(3).
           03  DATA-4                  PIC -------9.99.

       01  LINE-4.
           03                          PIC X(6).
           03  DATA-1                  PIC X(32).
           03                          PIC X(2).
           03  DATA-2                  PIC X.
           03                          PIC X(9).
           03  DATA-3                  PIC X.

       01  LINE-5.
           03                          PIC X(6).
           03  DATA-1                  PIC X(32).
           03                          PIC X(3).
           03  DATA-2                  PIC -------9.99.
           03                          PIC X(2).
           03  DATA-3                  PIC X(13).
                                                             EJECT.
       PROCEDURE DIVISION.
       DECLARATIVES.
           COPY ADM1ERR OF CBLCPYSRC SUPPRESS.

       EMPLFILE-ERROR SECTION.
           USE AFTER ERROR PROCEDURE ON EMPLFILE.
       EMPLFILE-DECL.
               MOVE "EMPL" TO ERROR-FILE
               MOVE IO-STATUS TO ERROR-CODE
               MOVE FILE-ERROR-MESSAGE TO ERROR-LINE-1 OF ERRORSCR-O
               WRITE SCREEN-RECORD FROM PAGEERROR-IN FORMAT "ERRORSCR"
                   INDICATORS ARE SCREEN-INDICATORS
               READ SCRNFILE RECORD INTO PAGEERROR-IN FORMAT "ERRORSCR"
                   INDICATORS ARE SCREEN-INDICATORS
               STOP RUN.
       END DECLARATIVES.
                                                             EJECT.
       MAIN SECTION.

       CLEAR-SCREEN.
           MOVE "PRR1099 - 1099 FORMS" TO PROGRAM-NAME OF ERRORSCR-O.
           OPEN I-O    SCRNFILE
                INPUT  ADM1FILE, EMPLFILE
                OUTPUT PRNTFILE.

           COPY ZBEGIN OF CBLCPYSRC.

           INITIALIZE PROGRAM-FLAGS, PROGRAM-COUNTERS, 
                      FINAL-TOTAL-FIELDS.

           READ ADM1FILE RECORD.

       SET-UP.
           MOVE SPACES TO SCREEN-RECORD-IN.
           INITIALIZE W2S01-O.
           MOVE 1 TO START-W2-NO OF W2S01-I.

       ACCEPT-1.
           WRITE SCREEN-RECORD FROM PAGE1-IN FORMAT "W2S01"
               INDICATORS ARE SCREEN-INDICATORS.
           READ SCRNFILE RECORD INTO PAGE1-IN FORMAT "W2S01"
               INDICATORS ARE SCREEN-INDICATORS.
           IF SCR-IND(93) = B"1"
               GO TO END-PROGRAM.

           IF START-W2-NO OF W2S01-I = ZERO
               MOVE "INVALID CONTROL NUMBER.  RE-ENTER."
                   TO ERRLINE OF W2S01-I
               GO TO ACCEPT-1.
                                                             EJECT.
       READ-EMPLFILE.
           READ EMPLFILE NEXT RECORD
               AT END MOVE 1 TO END-FILE-FLAG
               GO TO CHECK-SUBTOT-FLAG.

       CHECK-START-1099-NO.
           MOVE 0 TO SUBTOT-FLAG.
           ADD 1 TO 1099-COUNT.
           IF START-W2-NO OF W2S01-I GREATER THAN 1099-COUNT
               GO TO ACCUM-1.

       CHECK-FIRST-PRINTING.
           IF FIRST-PRINTING = 1
               GO TO MOVE-DATA.
           WRITE PRINT-RECORD FROM BLANK-LINE BEFORE ADVANCING 5.
           MOVE 1 TO FIRST-PRINTING.

           INITIALIZE LINE-1.
           MOVE SCHOOL-NAME TO DATA-1 IN LINE-1.
           MOVE EMP-YTD-FED-GROSS TO DATA-2 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-2 BEFORE ADVANCING 1.

           INITIALIZE LINE-1.
           MOVE SCHOOL-ADDR-1 TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-2 BEFORE ADVANCING 1.

           MOVE SCHOOL-ADDR-2 TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-3 BEFORE ADVANCING 1.

           MOVE SCHOOL-ADDR-3 TO DATA-1 IN LINE-1.
           MOVE EMP-YTD-FED-GROSS TO DATA-2 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-3 BEFORE ADVANCING 6.

           INITIALIZE LINE-2.
           MOVE FEDERAL-ID TO DATA-1 IN LINE-2.
           MOVE SOC-SEC-NO TO DATA-2 IN LINE-2.
           MOVE EMP-YTD-FED-TAX TO DATA-4 IN LINE-2.
           WRITE PRINT-RECORD FROM LINE-2 BEFORE ADVANCING 3.

           INITIALIZE LINE-1.
           MOVE EMP-FULL-NAME TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 3.

           INITIALIZE LINE-1.
           MOVE ADDR-LINE-1 TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 1.

           MOVE ADDR-LINE-2 TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 2.

           INITIALIZE LINE-1.
           INSPECT CITY REPLACING ALL "  " BY "**".
           STRING CITY DELIMITED BY LIMITER SPACE SPACE
               STATE-CODE DELIMITED BY LIMITER SPACE
               ZIP-CODE DELIMITED BY LIMITER
               INTO DATA-1 OF LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 3.

           INITIALIZE LINE-5.
           MOVE EMP-YTD-STATE-TAX TO DATA-2 IN LINE-5.
           MOVE STATE-ID TO DATA-3 IN LINE-5.
           WRITE PRINT-RECORD FROM LINE-5 BEFORE ADVANCING PAGE.

       ACCUM-TOTALS.
           ADD EMP-YTD-FED-TAX TO YTD-FED-TAX-FINAL.
           ADD EMP-YTD-FED-GROSS TO FED-GROSS-FINAL.
           ADD EMP-YTD-STATE-TAX TO YTD-STATE-TAX-FINAL.
           ADD EMP-YTD-STATE-GROSS TO STATE-GROSS-FINAL.

       CHECK-END-FILE-FLAG.
           IF END-FILE-FLAG = 1
               GO TO PRINT-FINAL-TOTALS.
           IF START-W2-NO OF W2S01-I GREATER THAN 1099-COUNT
               GO TO READ-EMPLFILE.
           GO TO READ-EMPLFILE.

      * * * * *      FINAL SUBTOTALS     * * * * *

       PRINT-FINAL-TOTALS.
           WRITE PRINT-RECORD FROM BLANK-LINE BEFORE ADVANCING 5.
           INITIALIZE LINE-1.
           MOVE "   FINAL TOTALS" TO DATA-1 IN LINE-1.
           MOVE YTD-FED-GROSS-FINAL TO DATA-2 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 3.

           INITIALIZE LINE-1.
           MOVE YTD-FED-GROSS-FINAL TO DATA-2 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 6.

           INITIALIZE LINE-2.
           MOVE YTD-FED-TAX-FINAL TO DATA-4 IN LINE-2.
           WRITE PRINT-RECORD FROM LINE-2 BEFORE ADVANCING 12.

           INITIALIZE LINE-1.
           MOVE YTD-STATE-TAX-FINAL TO DATA-3 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 1.

       END-PROGRAM.
           CLOSE ADM1FILE, EMPLFILE, PRNTFILE, SCRNFILE.
           STOP RUN.

      *********************** R O U T I N E S ************************

           COPY XDATE OF CBLCPYSRC SUPPRESS.

No comments:

Post a Comment