I, unEnlighteneD

Sunday, March 27, 2011

COBOL: Update a KSDS record / Read it back

000100*UPDATES A RECORD TO THE KSDS
000200*READS THE RECORD IF PRESENT
000300 IDENTIFICATION DIVISION.
000400 PROGRAM-ID. CBLKSDS4.
000500 ENVIRONMENT DIVISION.
000600 INPUT-OUTPUT SECTION.
000700 FILE-CONTROL.
000800 SELECT INPUT-FILE ASSIGN TO READER
000900 ORGANIZATION IS INDEXED
001000 ACCESS MODE IS DYNAMIC
001100 RECORD KEY IS EMP-ID
001200 FILE STATUS IS FS.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 FD INPUT-FILE.
001600 01 INPUT-REC.
001700 02 EMP-ID PIC X(06).
001800 02 FIRST-NAME PIC X(20).
001900 02 MIDDLE-NAME PIC X(20).
002000 02 LAST-NAME PIC X(20).
002100 02 FILLER PIC X(14).
002200 WORKING-STORAGE SECTION.
002300 01 FS PIC X(2).
002400 88 RECORDFOUND VALUE '00'.
002500 01 WS-INPUT-REC.
002600 02 WS-EMP-ID PIC X(06).
002700 02 WS-FIRST-NAME PIC X(20).
002800 02 WS-MIDDLE-NAME PIC X(20).
002900 02 WS-LAST-NAME PIC X(20).
003000 02 FILLER PIC X(14).
003100 PROCEDURE DIVISION.
003200 MAINLINE SECTION.
003300 OPEN I-O INPUT-FILE.
003400 DISPLAY 'ENTER ENTIRE RECORD' WITH NO ADVANCING.
003500 ACCEPT INPUT-REC.
003600 DISPLAY 'TRYING TO UPDATE WITH RECORD: ' INPUT-REC.
003700 REWRITE INPUT-REC
003800 END-REWRITE.
003900 READ INPUT-FILE
004000 KEY IS EMP-ID
004100 INVALID KEY DISPLAY 'BAD EMPID GIVEN, FILE STATUS ' FS
004200 END-READ.
004300 IF RECORDFOUND THEN
004400 MOVE EMP-ID TO WS-EMP-ID
004500 MOVE FIRST-NAME TO WS-FIRST-NAME
004600 MOVE MIDDLE-NAME TO WS-MIDDLE-NAME
004700 MOVE LAST-NAME TO WS-LAST-NAME
004800 DISPLAY 'DISPLAYING CURRENT RECORD'
004900 DISPLAY ' '
005000 DISPLAY 'EMP_ID ' WS-EMP-ID
005100 DISPLAY 'FIRST_NAME ' WS-FIRST-NAME
005200 DISPLAY 'MIDDLE_NAME ' WS-MIDDLE-NAME
005300 DISPLAY 'LAST_NAME ' WS-LAST-NAME
005400 END-IF.
005500 CLOSE INPUT-FILE.
005600 STOP RUN.

COBOL: Write a KSDS record / verify for duplicates / READ it back

000100*WRITES A RECORD TO THE KSDS AND VERIFIES FOR DUPLICATES
000200*READS THE RECORD IF PRESENT
000300 IDENTIFICATION DIVISION.
000400 PROGRAM-ID. CBLKSDS3.
000500 ENVIRONMENT DIVISION.
000600 INPUT-OUTPUT SECTION.
000700 FILE-CONTROL.
000800 SELECT INPUT-FILE ASSIGN TO READER
000900 ORGANIZATION IS INDEXED
001000 ACCESS MODE IS DYNAMIC
001100 RECORD KEY IS EMP-ID
001200 FILE STATUS IS FS.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 FD INPUT-FILE.
001600 01 INPUT-REC.
001700 02 EMP-ID PIC X(06).
001800 02 FIRST-NAME PIC X(20).
001900 02 MIDDLE-NAME PIC X(20).
002000 02 LAST-NAME PIC X(20).
002100 02 FILLER PIC X(14).
002200 WORKING-STORAGE SECTION.
002300 01 FS PIC X(2).
002400 88 RECORDFOUND VALUE '00'.
002500 01 WS-INPUT-REC.
002600 02 WS-EMP-ID PIC X(06).
002700 02 WS-FIRST-NAME PIC X(20).
002800 02 WS-MIDDLE-NAME PIC X(20).
002900 02 WS-LAST-NAME PIC X(20).
003000 02 FILLER PIC X(14).
003100 PROCEDURE DIVISION.
003200 MAINLINE SECTION.
003300 OPEN I-O INPUT-FILE.
003400 DISPLAY 'ENTER ENTIRE RECORD' WITH NO ADVANCING.
003500 ACCEPT INPUT-REC.
003600 DISPLAY 'TRYING TO INSERT:' INPUT-REC.
003700 WRITE INPUT-REC
003800 INVALID KEY DISPLAY 'DUPLICATE ENCOUNTERED, STATUS ' FS
003900 END-WRITE.
004000 READ INPUT-FILE
004100 KEY IS EMP-ID
004200 INVALID KEY DISPLAY 'BAD EMPID GIVEN, FILE STATUS ' FS
004300 END-READ.
004400 IF RECORDFOUND THEN
004500 MOVE EMP-ID TO WS-EMP-ID
004600 MOVE FIRST-NAME TO WS-FIRST-NAME
004700 MOVE MIDDLE-NAME TO WS-MIDDLE-NAME
004800 MOVE LAST-NAME TO WS-LAST-NAME
004900 DISPLAY 'DISPLAYING CURRENT RECORD'
005000 DISPLAY ' '
005100 DISPLAY 'EMP_ID ' WS-EMP-ID
005200 DISPLAY 'FIRST_NAME ' WS-FIRST-NAME
005300 DISPLAY 'MIDDLE_NAME ' WS-MIDDLE-NAME
005400 DISPLAY 'LAST_NAME ' WS-LAST-NAME
005500 END-IF.
005600 CLOSE INPUT-FILE.
005700 STOP RUN.

COBOL: Key based search on a KSDS

000100*SEARCHES FOR A SPECIFIC KSDS RECORD BASED ON AN INPUT KEY
000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. CBLKSDS2.
000400 ENVIRONMENT DIVISION.
000500 INPUT-OUTPUT SECTION.
000600 FILE-CONTROL.
000700 SELECT INPUT-FILE ASSIGN TO READER
000800 ORGANIZATION IS INDEXED
000900 ACCESS MODE IS DYNAMIC
001000 RECORD KEY IS EMP-ID
001100 FILE STATUS IS FS.
001200 DATA DIVISION.
001300 FILE SECTION.
001400 FD INPUT-FILE.
001500 01 INPUT-REC.
001600 02 EMP-ID PIC X(06).
001700 02 FIRST-NAME PIC X(20).
001800 02 MIDDLE-NAME PIC X(20).
001900 02 LAST-NAME PIC X(20).
002000 02 FILLER PIC X(14).
002100 WORKING-STORAGE SECTION.
002200 01 FS PIC X(2).
002300 88 RECORDFOUND VALUE '00'.
002400 01 WS-INPUT-REC.
002500 02 WS-EMP-ID PIC X(06).
002600 02 WS-FIRST-NAME PIC X(20).
002700 02 WS-MIDDLE-NAME PIC X(20).
002800 02 WS-LAST-NAME PIC X(20).
002900 02 FILLER PIC X(14).
003000 PROCEDURE DIVISION.
003100 MAINLINE SECTION.
003200 OPEN INPUT INPUT-FILE.
003300 DISPLAY 'ENTER EMPLOYEE ID: ' WITH NO ADVANCING.
003400 ACCEPT EMP-ID.
003410 DISPLAY 'SEARCHING FOR EMPID= ' EMP-ID.
003500 READ INPUT-FILE
003600 KEY IS EMP-ID
003700 INVALID KEY DISPLAY 'BAD EMPID GIVEN, FILE STATUS ' FS
003800 END-READ.
003900 IF RECORDFOUND THEN
004000 MOVE EMP-ID TO WS-EMP-ID
004100 MOVE FIRST-NAME TO WS-FIRST-NAME
004200 MOVE MIDDLE-NAME TO WS-MIDDLE-NAME
004300 MOVE LAST-NAME TO WS-LAST-NAME
004310 DISPLAY ' '
004400 DISPLAY 'EMP_ID ' WS-EMP-ID
004500 DISPLAY 'FIRST_NAME ' WS-FIRST-NAME
004600 DISPLAY 'MIDDLE_NAME ' WS-MIDDLE-NAME
004700 DISPLAY 'LAST_NAME ' WS-LAST-NAME
004900 END-IF.
005000 CLOSE INPUT-FILE.
005100 STOP RUN.

JCL for program preparation and execution.

//COBOLCOM JOB (0000),'COMPILE COBOL PGM',
// CLASS=A,MSGCLASS=0,MSGLEVEL=(1,1),NOTIFY=R01029
//PROCLIB JCLLIB ORDER='SYS1.ADMIN.PROCLIB'
//COB##COM EXEC IGYWCL,MEMBER=CBLKSDS2,
// SRCELIB=R01029.COBOL.PGM,
// LOADLIB=R01029.COBOL.LOADLIB,
// COPYLIB1=R01029.COBOL.DCLGEN,
// PARM.COBOL='LIB,CODEPAGE(37)'
//RUN##PGM EXEC PGM=CBLKSDS2
//READER DD DSN=R01029.KSDS.CLUS,DISP=SHR
//STEPLIB DD DSN=R01029.COBOL.LOADLIB,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSIN DD *
051029
/*

COBOL: Displaying all records in a KSDS by iterating thru the key.

000100*DISPLAYS ALL KSDS RECORDS BY ITERATING THRU THE KEY
000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. CBLKSDS1.
000400 ENVIRONMENT DIVISION.
000500 INPUT-OUTPUT SECTION.
000600 FILE-CONTROL.
000700 SELECT INPUT-FILE ASSIGN TO READER
000800 ORGANIZATION IS INDEXED
000900 ACCESS MODE IS DYNAMIC
001000 RECORD KEY IS EMP-ID
001100 FILE STATUS IS FILE-STATUS.
001200 DATA DIVISION.
001300 FILE SECTION.
001400 FD INPUT-FILE.
001500 01 INPUT-REC.
001600 88 END-OF-FILE VALUE HIGH-VALUES.
001700 02 EMP-ID PIC X(06).
001800 02 FIRST-NAME PIC X(20).
001900 02 MIDDLE-NAME PIC X(20).
002000 02 LAST-NAME PIC X(20).
002100 02 FILLER PIC X(14).
002200 WORKING-STORAGE SECTION.
002300 01 FILE-STATUS PIC X(2).
002400 88 RECORDFOUND VALUE '00'.
002500 01 WS-INPUT-REC.
002600 02 WS-EMP-ID PIC X(06).
002700 02 WS-FIRST-NAME PIC X(20).
002800 02 WS-MIDDLE-NAME PIC X(20).
002900 02 WS-LAST-NAME PIC X(20).
003000 02 FILLER PIC X(14).
003100 PROCEDURE DIVISION.
003200 DECLARATIVES.
003300 USE-PROCEDURE SECTION.
003400 USE AFTER EXCEPTION PROCEDURE ON INPUT-FILE.
003500 COPY-PROCEDURE.
003600 COPY FILESTAT.
003700 END DECLARATIVES.
003800 MAINLINE SECTION.
003900 100-MAIN-PARA.
004000 OPEN INPUT INPUT-FILE.
004100 READ INPUT-FILE NEXT RECORD
004200 AT END SET END-OF-FILE TO TRUE
004300 END-READ.
004400 PERFORM UNTIL END-OF-FILE
004500 MOVE EMP-ID TO WS-EMP-ID
004600 MOVE FIRST-NAME TO WS-FIRST-NAME
004700 MOVE MIDDLE-NAME TO WS-MIDDLE-NAME
004800 MOVE LAST-NAME TO WS-LAST-NAME
004900 DISPLAY 'EMP_ID ' WS-EMP-ID
005000 DISPLAY 'FIRST_NAME ' WS-FIRST-NAME
005100 IF WS-MIDDLE-NAME EQUAL TO SPACES THEN
005200 MOVE '******' TO WS-MIDDLE-NAME
005300 END-IF
005400 DISPLAY 'MIDDLE_NAME ' WS-MIDDLE-NAME
005500 DISPLAY 'LAST_NAME ' WS-LAST-NAME
005600 DISPLAY ' '
005700 READ INPUT-FILE NEXT RECORD
005800 AT END SET END-OF-FILE TO TRUE
005900 END-READ
006000 END-PERFORM.
006100 CLOSE INPUT-FILE.
006200 STOP RUN.

KSDS Declare:

//VSAMDECL JOB (1111),'VSAMDECL',CLASS=A,NOTIFY=&SYSUID

//DECLARE EXEC PGM=IDCAMS

//SYSPRINT DD SYSOUT=*

//SYSOUT DD SYSOUT=*

//SYSIN DD *

DEFINE CLUSTER -

( -

NAME('R01029.KSDS.CLUS') -

CYLINDERS(1,1) -

CONTROLINTERVALSIZE(4096) -

FREESPACE(10,20) -

KEYS(6,0) -

RECORDSIZE(80,80) -

) -

DATA -

( -

NAME('R01029.KSDS.DATA') -

) -

INDEX -

( -

NAME('R01029.KSDS.INDEX') -

CONTROLINTERVALSIZE(2048) -

)

JCL for PROGRAM preparation and execution

//COBOLCOM JOB (0000),'COMPILE COBOL PGM',

// CLASS=A,MSGCLASS=0,MSGLEVEL=(1,1),NOTIFY=R01029

//PROCLIB JCLLIB ORDER='SYS1.ADMIN.PROCLIB'

//COB##COM EXEC IGYWCL,MEMBER=CBLKSDS1,

// SRCELIB=R01029.COBOL.PGM,

// LOADLIB=R01029.COBOL.LOADLIB,

// COPYLIB1=R01029.COBOL.DCLGEN,

// PARM.COBOL='LIB,CODEPAGE(37)'

//RUN##PGM EXEC PGM=CBLKSDS1

//READER DD DSN=R01029.KSDS.CLUS,DISP=SHR

//STEPLIB DD DSN=R01029.COBOL.LOADLIB,DISP=SHR

//SYSPRINT DD SYSOUT=*

//SYSOUT DD SYSOUT=*

COBOL: Decision based ARITHMETIC operation.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ARITHPRF.
000300 DATA DIVISION.
000400 WORKING-STORAGE SECTION.
000500 01 NUM1 PIC 9 VALUE ZEROS.
000600 01 NUM2 PIC 9 VALUE ZEROS.
000700 01 RESULT PIC 99 VALUE ZEROS.
000800 01 OPERATOR PIC X VALUE SPACE.
000900 PROCEDURE DIVISION.
001000 CALCULATOR.
001100 PERFORM 3 TIMES
001200 DISPLAY "ENTER FIRST NUMBER : " WITH NO ADVANCING
001300 ACCEPT NUM1
001400 DISPLAY "ENTER SECOND NUMBER : " WITH NO ADVANCING
001500 ACCEPT NUM2
001600 DISPLAY "ENTER OPERATOR (+ OR *) : " WITH NO ADVANCING
001700 ACCEPT OPERATOR
001800 IF OPERATOR = "+" THEN
001900 ADD NUM1, NUM2 GIVING RESULT
002000 END-IF
002100 IF OPERATOR = "*" THEN
002200 MULTIPLY NUM1 BY NUM2 GIVING RESULT
002300 END-IF
002400 DISPLAY "RESULT IS = ", RESULT
002500 END-PERFORM.
002600 STOP RUN.

COBOL: Multiplication

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. MULTIPLICATION.
000300* EXAMPLE PROGRAM USING ACCEPT, DISPLAY AND MULTIPLY TO
000400* GET TWO SINGLE DIGIT NUMBERS FROM THE USER AND MULTIPLY THEM TOGETHER
000500 DATA DIVISION.
000600 WORKING-STORAGE SECTION.
000700 01 NUM1 PIC 9 VALUE ZEROS.
000800 01 NUM2 PIC 9 VALUE ZEROS.
000900 01 RESULT PIC 99 VALUE ZEROS.
001000 PROCEDURE DIVISION.
001100 DISPLAY "ENTER FIRST NUMBER (1 DIGIT) : " WITH NO ADVANCING.
001200 ACCEPT NUM1.
001300 DISPLAY "ENTER SECOND NUMBER (1 DIGIT) : " WITH NO ADVANCING.
001400 ACCEPT NUM2.
001500 MULTIPLY NUM1 BY NUM2 GIVING RESULT.
001600 DISPLAY "RESULT IS = ", RESULT.
001700 STOP RUN.

COBOL: Read Variable Block data from a file and sum them.

I have a file as VB 300 with the following records:

EDIT R01029.COBOL.INPUT.VB Columns 00001 00072
Command ===> Scroll ===> CSR
****** ***************************** Top of Data ******************************
000001 10
000002 1020
000003 102030
000004 10203040
000005 1020304050
000006 10203040
000007 102030
000008 1020
000009 10
****** **************************** Bottom of Data ****************************

And I need the sum of all the fields for every row read.

This is how i managed to accomplish this

000100*READS VARIABLE SIZE DATA FROM A FILE AND CALCULATES SUM
000200 ID DIVISION.
000300 PROGRAM-ID.
000400 ADDFIELD.
000500 DATE-COMPILED.
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800*I-O-CONTROL.
000900* RERUN ON RESCUE EVERY 100 RECORDS OF INPUT-FILE.
001000 FILE-CONTROL.
001100 SELECT INPUT-FILE ASSIGN TO READER
001200 ORGANIZATION IS SEQUENTIAL
001300 ACCESS MODE IS SEQUENTIAL
001400 FILE STATUS IS FILE-STATUS.
001500 DATA DIVISION.
001600 FILE SECTION.
001700 FD INPUT-FILE
001800 BLOCK CONTAINS 27703 TO 27998 CHARACTERS
001900 RECORD IS VARYING IN SIZE FROM 2 TO 296 CHARACTERS
002000 DEPENDING ON SIZE-VAR
002100 LABEL RECORDS ARE STANDARD
002200 DATA RECORD IS INPUT-REC
002300 RECORDING MODE IS V.
002400 01 INPUT-REC.
002500 88 END-OF-FILE VALUE HIGH-VALUES.
002600 05 STRING-IN OCCURS 1 TO 148 TIMES DEPENDING ON DSIZE-VAR.
002700 10 NUM-IN PIC 9(2).
002800 WORKING-STORAGE SECTION.
002900 01 FILE-STATUS PIC X(2).
003000 01 SIZE-VAR PIC 9(3).
003100 01 DSIZE-VAR PIC 9(3).
003200 01 COUNTER PIC 9(3).
003300 01 OUTPUT-SUM PIC 9(3).
003400 01 OUTPUT-SUM-MOD PIC Z(3).
003500 PROCEDURE DIVISION.
003600 DECLARATIVES.
003700 USE-PROCEDURE SECTION.
003800 USE AFTER EXCEPTION PROCEDURE ON INPUT-FILE.
003900 COPY-PROCEDURE.
004000 COPY FILESTAT.
004100 END DECLARATIVES.
004200 MAINLINE SECTION.
004300 100-MAIN-PARA.
004400 INITIALIZE SIZE-VAR
004500 OPEN INPUT INPUT-FILE
004600 PERFORM UNTIL END-OF-FILE
004700 READ INPUT-FILE
004800 AT END
004900 SET END-OF-FILE TO TRUE
005000 NOT AT END
005100 PERFORM 200-DISPLAY-PARA
005200 END-READ
005300 END-PERFORM
005400 CLOSE INPUT-FILE
005500 STOP RUN.
005600 200-DISPLAY-PARA.
005700 DISPLAY ' '
005800 DISPLAY 'DATA SIZE: ' SIZE-VAR
005900 DISPLAY 'DATA TEXT: ' INPUT-REC(1:SIZE-VAR)
006000 INITIALIZE OUTPUT-SUM
006100 DIVIDE 2 INTO SIZE-VAR GIVING DSIZE-VAR
006200 PERFORM VARYING COUNTER FROM 1 BY 1 UNTIL COUNTER > DSIZE-VAR
006300 ADD NUM-IN(COUNTER) TO OUTPUT-SUM
006400 END-PERFORM
006500 MOVE OUTPUT-SUM TO OUTPUT-SUM-MOD
006600 DISPLAY 'OUTPUT: ' OUTPUT-SUM-MOD
006700 DISPLAY ' '.

My FILESTAT member that I use for the DECLARATIVES section in all my FILE handling programs is as below:

   DISPLAY 'FILE-STATUS: ' FILE-STATUS
   EVALUATE FILE-STATUS
   WHEN '02' DISPLAY 'DUPLICATE KEY DETECTED'
   WHEN '04' DISPLAY 'READ, WRONG LENGTH RECORD'
   WHEN '05' DISPLAY 'OPEN, OPTIONAL FILE NOT PRESENT'
   WHEN '07' DISPLAY 'CLOSE INCOMPATIBLE TAPE FILE'
   WHEN '10' DISPLAY 'END OF FILE DETECTED'
   WHEN '14' DISPLAY 'RRN > RELATIVE KEY DATA'
   WHEN '20' DISPLAY 'INVALID KEY VSAM KSDS OR RRDS'
   WHEN '21' DISPLAY 'RECORD OUT OF SEQUENCE'
   WHEN '22' DISPLAY 'DUPLICATE KEY'
   WHEN '23' DISPLAY 'RECORD OR FILE NOT FOUND'
   WHEN '24' DISPLAY 'FILE BOUNDARY VIOLATION.'
   DISPLAY 'COBOL 370: REL: REC# TOO BIG'
   DISPLAY 'OUT OF SPACE ON KSDS/RRDS FILE'
   WHEN '30' DISPLAY 'PERMANENT DATA ERROR'
   DISPLAY 'DATA CHECK, PARITY CHK'
   WHEN '34' DISPLAY 'BOUNDARY VIOLATION'
   DISPLAY 'WRITE PAST END OF ESDS RECORD'
   DISPLAY 'OR NO SPACE TO ADD KSDS/RRDS RECORD'
   DISPLAY 'OUT OF SPACE ON SEQUENTIAL FILE'
   WHEN '35' DISPLAY 'OPEN, FILE NOT PRESENT'
   WHEN '37' DISPLAY 'OPEN MODE INCOMPAT WITH DEVICE'
   WHEN '38' DISPLAY 'OPENING FILE CLOSED WITH LOCK'
   WHEN '39' DISPLAY 'OPEN, FILE ATTRIB CONFLICTING'
   WHEN '41' DISPLAY 'OPEN, FILE IS OPEN'
   WHEN '42' DISPLAY 'CLOSE, FILE IS CLOSED'
   WHEN '43' DISPLAY 'DELETE OR REWRITE & NO GOOD READ FIRST'
   WHEN '44' DISPLAY 'BOUNDARY VIOLATION/REWRITE REC TOO BIG'
   WHEN '46' DISPLAY 'SEQUENTIAL READ WITHOUT POSITIONING'
   WHEN '47' DISPLAY 'READING FILE NOT OPEN AS INPUT/IO/EXTEND'
   WHEN '48' DISPLAY 'WRITE WITHOUT OPEN IO'
   WHEN '49' DISPLAY 'DELETE OR REWRITE WITHOUT OPEN IO'
   WHEN '90' DISPLAY 'UNKNOWN'
   WHEN '91' DISPLAY 'VSAM - PASSWORD FAILURE'
   WHEN '92' DISPLAY 'LOGIC ERROR/WRONG MODE OPERATION'
   WHEN '93' DISPLAY 'VSAM - RESOURCE NOT AVAILABLE'
   WHEN '94' DISPLAY 'VSAM - SEQUENTIAL READ AFTER END OF FILE'
   DISPLAY 'OR NO CURRENT REC POINTER FOR SEQ'
   WHEN '95' DISPLAY 'VSAM - INVALID FILE INFORMATION'
   WHEN '96' DISPLAY 'VSAM - MISSING DD STATEMENT IN JCL'
   WHEN '97' DISPLAY 'VSAM - OPEN OK, FILE INTEGRITY VERIFIED'
   WHEN OTHER DISPLAY 'UNKNOWN REASON:' FILE-STATUS
   END-EVALUATE
   MOVE 12 TO RETURN-CODE
   STOP RUN.

(Adapted from ibmmainframes.com)

JCL:

//COBOLCOM JOB (0000),'COMPILE COBOL PGM',
// CLASS=A,MSGCLASS=0,MSGLEVEL=(1,1),NOTIFY=R01029
//PROCLIB JCLLIB ORDER='SYS1.ADMIN.PROCLIB'
//COB##COM EXEC IGYWCL,MEMBER=ADDFIELD,
// SRCELIB=R01029.COBOL.PGM,
// LOADLIB=R01029.COBOL.LOADLIB,
// PARM.COBOL='LIB,CODEPAGE(37),LIST',
// COPYLIB1=R01029.COBOL.DCLGEN
//RUN##PGM EXEC PGM=ADDFIELD,COND=(4,LE)
//READER DD DSN=R01029.COBOL.INPUT.VB,DISP=SHR
//STEPLIB DD DSN=R01029.COBOL.LOADLIB,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//PRINT EXEC PGM=IDCAMS,COND=(4,LE)
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//INDD DD DSN=R01029.COBOL.INPUT.VB,
// DISP=SHR,DCB=RECFM=U
//SYSIN DD *
  PRINT -
  INFILE(INDD) -
  DUMP

I use the PRINT step to verify the RDW(whether the file data is indeed VB or not)