BCS MVS Dynamic File Allocation COBOL

It would be nice to dynamically allocate and free the files need for applications via COBOL. This article describes how a subroutine may be used to accomplish such a feat.

First we will examine the sub program that allow us to accomplish dynamic allocation. The BPXWDYN routine allows a text interface access to the allocate process.  The string command may be used but I found it did not exactly give me the result I desired so I used a couple existing programs to fill the bill.  The sub program ABS00004 that detects the end of the string performs most of the heavy lifting.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    ABS00018.
000300 AUTHOR.        ARCH BROOKS.
000400 INSTALLATION   BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN.  10/24/2014.
000600 DATE-COMPILED. 10/24/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01  PGM PIC X(8) VALUE 'BPXWDYN'.
001700 01  BUF-500 PIC X(500).
001800 01  CMD-BUF PIC X(250).
001900 01  RLEN PIC S9(9) COMP.
002000 01  RCOB PIC S9(9) COMP.
002100 LINKAGE SECTION.
002200 01  DDNAME PIC X(9).
002300 01  DSN PIC X(100).
002400 01  DISP PIC X(50).
002500 01  DCB PIC X(100).
002600 01  FREE-CMD PIC X(100).
002700 01  RC PIC S9(9) COMP.
002800 PROCEDURE DIVISION USING DDNAME DSN DISP DCB RC.
002900     MOVE 'ALLOC FI(' TO CMD-BUF.
003000     PERFORM 0010-DET-RCOB-LEN.
003100     MOVE DDNAME TO BUF-500.
003200     PERFORM 0020-GET-500-LEN.
003300     MOVE DDNAME TO CMD-BUF(RCOB:).
003400     PERFORM 0010-DET-RCOB-LEN.
003500     MOVE DSN TO BUF-500.
003600     PERFORM 0020-GET-500-LEN.
003700     MOVE ') DSN(' TO CMD-BUF(RCOB:).
003800     PERFORM 0010-DET-RCOB-LEN.
003900     MOVE DSN TO CMD-BUF(RCOB:).
004000     PERFORM 0010-DET-RCOB-LEN.
004100     MOVE ')' TO CMD-BUF(RCOB:).
004200     PERFORM 0010-DET-RCOB-LEN.
004300     MOVE DISP TO BUF-500.
004400     PERFORM 0020-GET-500-LEN.
004500     ADD 1 TO RCOB.
004600     PERFORM 0010-DET-RCOB-LEN.
004700     ADD 1 TO RCOB.
004800     MOVE DISP TO CMD-BUF(RCOB:).
004900     PERFORM 0010-DET-RCOB-LEN.
005000     PERFORM 0040-XQT-ALLOC.
005100     PERFORM 0030-LEAVE-PROGRAM.
005200     ENTRY 'ABS0018A' USING FREE-CMD RC.
005300     MOVE FREE-CMD TO CMD-BUF.
005400     PERFORM 0040-XQT-ALLOC.
005500     PERFORM 0030-LEAVE-PROGRAM.
005600 0010-DET-RCOB-LEN.
005700     MOVE CMD-BUF TO BUF-500.
005800     CALL 'ABS00004' USING BUF-500 RCOB.
005900     ADD 1 TO RCOB.
006000 0020-GET-500-LEN.
006100     CALL 'ABS00004' USING BUF-500 RLEN.
006200 0030-LEAVE-PROGRAM.
006300     GOBACK.
006400 0040-XQT-ALLOC.
006500     CALL PGM USING CMD-BUF.
006600     MOVE RETURN-CODE TO RC.

I have added the subroutine that actually performs the IO write to verify that the allocation was successful.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    ABS00003.
000300 AUTHOR.        ARCH BROOKS.
000400 INSTALLATION   BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN.  09/15/2014.
000600 DATE-COMPILED. 09/15/2014.
000700*
000800*
000900*  THIS PROGRAM IS DESIGNED TO WRITE RECORDS TO THE FILE.
001000*
001100*
001200*
001300*
001400 ENVIRONMENT DIVISION.
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700     SELECT F-FILE ASSIGN TO UT-S-FSOUT
001800     ORGANIZATION IS SEQUENTIAL.
001900 DATA DIVISION.
002000 FILE SECTION.
002100 FD  F-FILE
002200     DATA RECORD IS F-RECORD
002300     BLOCK CONTAINS 0 RECORDS
002400     RECORDING MODE IS F.
002500 01  F-RECORD PIC X(80).
002600 WORKING-STORAGE SECTION.
002700 LINKAGE SECTION.
002800 01  LSBUF PIC X(80).
002900 PROCEDURE DIVISION.
003000*  OPEN THE OUTPUT FILE
003100     OPEN OUTPUT F-FILE.
003200     PERFORM 0010-RETURN.
003300*  WRITE A RECORD
003400     ENTRY 'ABS0003A' USING LSBUF.
003500     WRITE F-RECORD FROM LSBUF.
003600     PERFORM 0010-RETURN.
003700*  CLOSE THE FILE
003800     ENTRY 'ABS0003B'.
003900     CLOSE F-FILE.
004000     PERFORM 0010-RETURN.
004100*  LETS GET OUT OF HERE
004200 0010-RETURN.
004300     GOBACK.

Next we will review our driver or calling program.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABM00026.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 10/24/2014.
000600 DATE-COMPILED. 10/24/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01 DDNAME PIC X(9).
001700 01 DSN PIC X(100).
001800 01 DISP PIC X(50).
001900 01 DCB PIC X(100).
002000 01 RC PIC S9(9) COMP.
002100 01 OBUF PIC X(80).
002200 01 FREE-CMD PIC X(100).
002300 PROCEDURE DIVISION.
002400*
002500* PREPARE ALLOCATE STATEMENT
002600*
002700 MOVE 'FSOUT' TO DDNAME.
002800 MOVE 'AMBMVS.PDS.JCL(XXXALC)' TO DSN.
002900 MOVE 'SHR' TO DISP.
003000 MOVE ' ' TO DCB.
003100*
003200* INVOKE ALLOCATE STATEMENT
003300*
003400 CALL 'ABS00018' USING DDNAME DSN DISP DCB RC.
003500*
003600* OPEN OUTPUT FILE
003700*
003800 CALL 'ABS00003'.
003900 MOVE 'CCCC' TO OBUF.
004000*
004100* WRITE A RECORD TO OTPUT FILE
004200*
004300 CALL 'ABS0003A' USING OBUF.
004400 MOVE 'DDDD' TO OBUF.
004500*
004600* WRITE A RECORD TO OTPUT FILE
004700*
004800 CALL 'ABS0003A' USING OBUF.
004900*
005000* CLOSE OUTPUT FILE
005100*
005200 CALL 'ABS0003B'.
005300*
005400* PREPARE FREE COMMAND
005500*
005600 MOVE 'FREE FI(FSOUT)' TO FREE-CMD.
005700*
005800* INVOKE FREE COMMAND
005900*
006000 CALL 'ABS0018B' USING FREE-CMD RC.
006100 GOBACK.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.

BCS MVS KSDS VSAM COBOL

There are those time when a KSDS (key sequenced data set) using the VSAM (virtual sequential access method) fits the users requirements. The following example explains how such a feat is accomplished. First we need to create the KSDS and the JCL listed below defines how we will create our cluster.

//AMBMVS   JOB (SYS), 'BROOKS COMPUTING SYSTEMS, LLC',CLASS=A,
// MSGCLASS=A,MSGLEVEL=(1,1)
//*
//*
//DEFKSDS  EXEC PGM=IDCAMS
//SYSPRINT DD   DSN=AMBMVS.PDS.SPRT(KSDS),DISP=SHR
//SYSIN    DD   *
 DELETE (AMBMVS.VSAMKSDS.EMPSORTD) CLUSTER
 DEFINE CLUSTER ( -
  NAME (AMBMVS.VSAMKSDS.EMPSORTD) -
  CYLINDERS(1,1) -
  KEYS(20,0) -
  VOLUME(USR003) -
  RECORDSIZE(80,80) -
  INDEXED )
 REPRO INFILE(INFILE) OUTDATASET(AMBMVS.VSAMKSDS.EMPSORTD)
/*
//INFILE DD   DSN=AMBMVS.PDS.CNTL(INPKSDS),DISP=SHR
//*

The input data is listed below.

BUD WHYZER          05000  9  0001  0000001  000000
RALPH CRAMDEN       03000  1  0040  0000055  000022
MIKE KEE            06000  1  0200  0000020  000020
L. A. VATOR         07000  5  0020  0000033  000033
PAUL LONGA          04000  0  0002  0000022  000011
PEARLE E. GATES     01000  2  0010  0000020  000300
MIKE MENZA          02000  3  0030  0000050  000020

Next we will review the COBOL sub program that will perform the VSAM IO.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    ABS00017.
000300 AUTHOR.        ARCH BROOKS.
000400 INSTALLATION   BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN.  10/21/2014.
000600 DATE-COMPILED. 10/21/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300     SELECT VSAM-KSDS-FILE ASSIGN VSAMKSDS
001400        ORGANIZATION IS INDEXED
001500        ACCESS MODE IS RANDOM
001600        RECORD KEY IS VSAM-KSDS-RECORD-KEY
001700        FILE STATUS  IS VSAM-STATUS-CODE.
001800 DATA DIVISION.
001900 FILE SECTION.
002000 FD  VSAM-KSDS-FILE.
002100 01  VSAM-KSDS-RECORD.
002200     05  VSAM-KSDS-RECORD-KEY    PIC X(20).
002300     05  VSAM-KSDS-EMP-INFO      PIC X(60).
002400 WORKING-STORAGE SECTION.
002500 LINKAGE SECTION.
002600 01  VSAM-STATUS-CODE.
002700     05 VSAM-STATUS-CODE-BYTE1   PIC X.
002800     05 VSAM-STATUS-CODE-BYTE2   PIC X.
002900 01  REC-KEY PIC X(20).
003000 01  REC-BUF PIC X(80).
003100 PROCEDURE DIVISION USING VSAM-STATUS-CODE.
003200     PERFORM 0010-INIT.
003300 0010-INIT.
003400     OPEN INPUT VSAM-KSDS-FILE
003500     IF VSAM-STATUS-CODE IS NOT EQUAL TO '00' THEN
003600         PERFORM 0050-ERROR-EXIT.
003700     PERFORM 0060-LEAVE-PROGRAM.
003800     ENTRY 'ABS0017A' USING VSAM-STATUS-CODE REC-KEY REC-BUF.
003900 0030-RANDOM-READ.
004000     MOVE REC-KEY TO VSAM-KSDS-RECORD-KEY.
004100     READ VSAM-KSDS-FILE.
004200     MOVE VSAM-KSDS-RECORD TO REC-BUF.
004300     PERFORM 0060-LEAVE-PROGRAM.
004400     ENTRY 'ABS0017B' USING VSAM-STATUS-CODE.
004500 0040-TERMINATION.
004600     CLOSE VSAM-KSDS-FILE.
004700     PERFORM 0060-LEAVE-PROGRAM.
004800 0050-ERROR-EXIT.
004900     DISPLAY 'ERROR DETECTED '.
005000     PERFORM 0060-LEAVE-PROGRAM.
005100 0060-LEAVE-PROGRAM.
005200     GOBACK.

Now we will review the calling COBOL program.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    ABM00025.
000300 AUTHOR.        ARCH BROOKS.
000400 INSTALLATION   BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN.  10/23/2014.
000600 DATE-COMPILED. 10/23/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01  REC-KEY PIC X(20).
001700 01  S-CODE PIC XX.
001800 01  REC-BUF PIC X(80).
001900 PROCEDURE DIVISION.
002000     MOVE ' ' TO S-CODE.
002100     CALL 'ABS00017' USING S-CODE.
002200     DISPLAY 'OPEN STATUS IS ' S-CODE.
002300     MOVE 'BUD WHYZER' TO REC-KEY
002400     CALL 'ABS0017A' USING S-CODE REC-KEY REC-BUF.
002500     IF S-CODE =       '00'
002600     THEN DISPLAY 'RECORD READ ' REC-KEY
002700     DISPLAY REC-BUF
002800     ELSE IF S-CODE =       '23'
002900     THEN DISPLAY 'RECORD NOT FOUND ' REC-KEY.
003000     CALL 'ABS0017B' USING S-CODE.
003100     GOBACK.

Now we will review the command procedure that invokes the calling program.

PROC 0
CONTROL NOLIST NOMSG
FREE FI(SYSPRINT SYSOUT FSFIN VSAMKSDS))
ALLOC F(VSAMKSDS) DA(VSAMKSDS.EMPSORTD) SHR
ALLOC FI(SYSPRINT) DA(*)
ALLOC FI(FSFIN) DA(*)
ALLOC FI(SYSOUT) DA(*)
CALL 'AMBMVS.PDS.LOAD(ABM00025)'
FREE FI(SYSPRINT SYSOUT FSFIN VSAMKSDS)

Upon successful execution of the command procedure you will notice the return code and well as the fetched record will be displayed.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.

BCS Eclipse Mars M2

I am absolutely elated that the Eclipse Foundation has just released Milestone 2 of Mars Eclipse IDE. In milestone 2 I am able to program C, C++, FORTRAN, PHP, Grails, Rails, Python and MATLIB from the Mars IDE. This is great! I just change the workspace and perspective to code in a different language.

Please try the Mars Eclipse IDE today. I recommend the J2EE version and all the other aforementioned languages can be added by using the Add New Software feature of by loading features from the Eclipse Marketplace.

Eclipse is my IDE of choice.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.