Wednesday, May 2, 2012
20 years ago, this is how we printed 1099s. 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.
See? There's no need for comments if you write your code well.
Notice the EJECT keywords hanging out on the right side of the source code lines below. That's how we told the compiler to print a page feed and start the next code on a new page! This is because most programs were printed out on greenbar paper for review and desk checking the code.
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.