Step 6 Mutate a VSAM record

In this blog post we take a look at mutate a record via KICKS.

See previous steps for a better understanding.

Adding data to a VSAM file is easy. Just write the data to the dataset and your are done. But, there often will be a time that the record data needs to be modified, or maybe deleted. For those actions it is in a multi user environment a bit more complex. Especially in KICKS, or CICS.

For writing new data to the database nobody else on the system has to be taken in account. There is no need to check anything, other then the data itself, and the response from KICKS after writing it.

Modify data in a multi user environment however needs you to look carefully if another user is also trying to mutate (or update) the record data at the same time !

In such circumstances you normally would do a record lock, so nobody can access the record while we are updating the data and rewrite it to VSAM.

Above example program let you modify a record in KICKS.

There is a small problem in KICKS/CICS when we want to do a record lock. (Enqueue in IBM language). Remember that the COBOL program will terminate, and thus release all locks on records, thus dequeues the records ? So the locks are not persistant, just because the KICKS programs just fall thru the code and terminate.

Now we have a problem. 

There are some possible solutions I can think of. One is an easy solution, the other is more complicated.

First the complicated solution. We can do the lock administration by ourself. Create a VSAM database, store the locked record key's, user-id and a date-time stamp. This is the lock-table. Then in all your programs where a VSAM action is been done, check the lock table for a locked key, if not in there proceed, otherwise offer a message to the user that the action cannot be performed. You can see to the time stamp, and lets say its older then 60 minuts the user must have been looged out, so the lock can be removed. Rather complicated stuff, and all your programs need to do this in COBOL. But its doable.



Then there is the lock while in the program. During a loop in our COBOL program we might try to get a lock temporary when we are updating a lot of records. This can be done with the KICKS command:

       EXEC KICKS READ DATASET(name) | FILE(name)

            INTO(data-area) LENGTH(data-area)

            RIDFLD(data-area) KEYLENGTH(data-area)

            UPDATE

                 END-EXEC

Whenever UPDATE is been provided during a READ, then the record is automatically locked if found. To unlock the record on purpose (otherwise when the transaction is terminated or another record has been locked) you can do this:

           EXEC KICKS UNLOCK DATASET(name) | FILE(name)  END-EXEC

But this lock is only when the COBOL program is still running!

The easy method is to copy the record in the comunication area at the moment we retrieve it. Because after retrieval we show it to the user, let him do the mutations on the fields. Then when the program is started again the user pressed save or store the record.

Just before we save it back, we retrieve it again, compare to the record data with the copy in the communications area (remember we stored it before all actions) and if it is the same it was not changed during our transaction time. We can safely REWRITE the record. If not, then we offer the user a message saying so,

           EXEC CICS REWRITE FILE('LOCAT')
                FROM(LOCATION-RECORD)
           END-EXEC.

Below is a full example of how such solution will work. Of course there is much clutter in the example, but if you look at the bold sections, it might be much more clear.

First I setup the COMM-AREA variable with a place to store the record key, and a FILLER for the record data. Be sure to have the correct record length.

Next, be sure to have the linkage section, and in the procedure section to copy the communications area to the COMM-AREA variable.

Then you can see that we check if the record has been retrieved, by the LOOKUP-FLAG, and if so then the check is done if the record is the same as in the communication area,  

LOCATION-RECORD = CA-LOCREC.

Further on you see where I copied the record to the comm-area variable in the LOOKUP-MAP subroutine, and then the REWRITE in the PROC-MAP subroutine.

Just take a relaxed look and follow the program flow to see what is happening.




//AL14PGM JOB  CLASS=C,MSGCLASS=H,MSGLEVEL=(1,1),REGION=7000K
//JOBPROC DD   DSN=BIS.KICKSSYS.V1R5M0.PROCLIB,DISP=SHR
//AL14PGM EXEC  PROC=K2KCOBCL
//COPY.SYSUT1 DD *
       IDENTIFICATION DIVISION.
       PROGRAM-ID.    AL14PGM.
       AUTHOR.        BPTNZ
       DATE-WRITTEN.  NOV 2018.
       DATE-COMPILED. TODAY.

       REMARKS.       AL14,UPDATE LOCATION

       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

      * NOTE THAT THIS COMM-AREA NEED TO BE SET UP PROPERLY
      * BECAUSE WE STORE TEMPORARY RECORD CHECK RECORD LENGTH
      * IN FILLER


       01  COMM-AREA.
           05  CA-LOCREC.
               10  CA-LOCNUM PIC 999.
               10  FILLER    PIC X(86).
           05  LOOKUP-FLAG   PIC 9     VALUE 0.


       01  PGM-ID           PIC X(8)  VALUE 'AL14PGM'.
       01  END-MESSAGE      PIC X(20) VALUE 'END OF TRANSACTION'.

       01  MESSAGE.
           05  FILLER PIC X(9) VALUE 'LOCATION '.
           05  LOCNUM PIC 9(3).
           05  FILLER PIC X(30) VALUE ' UPDATED WITH DOCUMENT NUMBER '.
           05  DOCNUM PIC X(6).

       COPY LOCREC.
       COPY AL14MAP.
      * ]----- DO NOT CHANGE BELOW]
       COPY BISVARS.
       COPY BISREC.
       COPY BISLOG.
       COPY DFHBMSCA.
       COPY KIKAID.

       LINKAGE SECTION.
       01  DFHCOMMAREA      PIC X(200).

       PROCEDURE DIVISION.
           MOVE DFHCOMMAREA TO COMM-AREA.
           MOVE EIBTRNID    TO PGM-ID.
           EXEC CICS ASSIGN USERID(USERID) END-EXEC.
           PERFORM HANDLE-SETUP THRU HANDLE-SETUP-EXIT.
           PERFORM GET-TIME THRU GET-TIME-EXIT.

           IF EIBCALEN = 0
      *        --FIRST TIME IN, DO NEVER CHANGE
               MOVE 1 TO COMM-AREA
               PERFORM INIT-MAP THRU INIT-MAP-EXIT
               PERFORM SEND-MAP THRU SEND-MAP-EXIT
               GO TO RETURN-HERE.

      *    --RETURN AFTER FIRST TIME HERE AFTER PRESSING ANY ATT-KEY
      *    --YOU MAY CHANGE KIKPF KEY (SEE ALSO HANDLE KEYS)

           IF EIBAID = KIKPF4   GO TO LOOKUP-INPUT.
           IF EIBAID = KIKPF5   GO TO PROC-INPUT.
           PERFORM RECV-MAP THRU RECV-MAP-EXIT.
           PERFORM CHEK-MAP THRU CHEK-MAP-EXIT.
           MOVE 'CHECK DONE' TO CA-ERR-MSG.
           PERFORM SEND-MAP THRU SEND-MAP-EXIT.
           GO TO RETURN-HERE.

       PROC-INPUT.
      * ---- PROCESS DATA AFTER PRESSING ATT-KEY, DO NOT CHANGE
               PERFORM RECV-MAP THRU RECV-MAP-EXIT.
      *        PERFORM CHEK-MAP THRU CHEK-MAP-EXIT.
      * ---- IF ERROR-FLAG IS SET SKIP PROC-MAP

               IF LOOKUP-FLAG = 1 THEN
      * ---- GET RECORD READ AGAIN AND COMPARE TO COMM-AREA
                  EXEC CICS READ FILE('LOCAT')
                            INTO(LOCATION-RECORD)
                            RIDFLD (CA-LOCNUM)
                            UPDATE
                  END-EXEC
                  IF LOCATION-RECORD = CA-LOCREC THEN
                     PERFORM PROC-MAP THRU PROC-MAP-EXIT
                  ELSE
                     MOVE 'OTHER USER CHANGED' TO CA-ERR-MSG.
 
               PERFORM SEND-MAP THRU SEND-MAP-EXIT.
               GO TO RETURN-HERE.

       LOOKUP-INPUT.
      *       --LOOKUP THE GIVEN DATA
              PERFORM RECV-MAP THRU RECV-MAP-EXIT.
              PERFORM CHEK-MAP THRU CHEK-MAP-EXIT.
      *       IF ERROR-FLAG = 0 THEN
                 PERFORM LOOKUP-MAP THRU LOOKUP-MAP-EXIT.
              PERFORM SEND-MAP THRU SEND-MAP-EXIT.
              GO TO RETURN-HERE.

      * ------ PERFORM INIT THE MAP
       INIT-MAP.
           MOVE LOW-VALUES TO AL14O.
           MOVE SPACES TO CA-ERR-MSG.
           MOVE TODAY  TO F00DATO.
           MOVE ZERO    TO F03NUMO, F08NUMO.
           MOVE ALL '*' TO F04ALFO, F05ALFO,
                           F06ALFO, F07ALFO.
       INIT-MAP-EXIT.

      * ------ PERFORM SEND THE MAP
       SEND-MAP.
           MOVE CA-ERR-MSG TO F24ALFO.
           MOVE PGM-ID     TO F01ALFO.
           MOVE USERID     TO F02ALFO.
           EXEC CICS SEND MAP('AL14')
                       MAPSET('AL14MAP')
                             FREEKB
           END-EXEC.
       SEND-MAP-EXIT.

      * ------ PERFORM RECEIVE THE MAP
       RECV-MAP.
           EXEC CICS RECEIVE MAP('AL14')
                          MAPSET('AL14MAP')
           END-EXEC.
           EXAMINE F04ALFI REPLACING ALL '*' BY ' '.
           EXAMINE F05ALFI REPLACING ALL '*' BY ' '.
           EXAMINE F06ALFI REPLACING ALL '*' BY ' '.
           EXAMINE F07ALFI REPLACING ALL '*' BY ' '.
           MOVE SPACES TO CA-ERR-MSG.
       RECV-MAP-EXIT.


      * ------ PERFORM LOOKUP MAP, THUS DISPLAY THE GIVEN RECORD
       LOOKUP-MAP.
           EXEC CICS READ FILE('LOCAT')
                INTO (LOCATION-RECORD)
                RIDFLD(F03NUMI)
           END-EXEC.
           MOVE LOC-NAME    TO F04ALFO.
           MOVE LOC-ADDRESS TO F05ALFO.
           MOVE LOC-CITY    TO F06ALFO.
           MOVE LOC-COUNTRY TO F07ALFO.
           MOVE LOC-MASTER  TO F08NUMO.

           MOVE 'LOOKUP DONE' TO CA-ERR-MSG.
           MOVE 1 TO LOOKUP-FLAG.

      * A COPY OF THE RECORD MUST BE PLACED IN COMM-AREA TO CHECK
      * FOR CHANGES WHEN UPDATING HAPPENS

           MOVE F03NUMI TO CA-LOCNUM.
           MOVE LOCATION-RECORD TO CA-LOCREC.
       LOOKUP-MAP-EXIT.

      * ------ PERFORM PROCESS THE MAP, YOU CAN DO RECORD I/O HERE

       PROC-MAP.
      *    -PROCESS THE DATA
      * --HERE WE ASSUME RECORD CHECK IS DONE, AND WE JUST UPDATE
           MOVE F04ALFI TO LOC-NAME.
           MOVE F05ALFI TO LOC-ADDRESS.
           MOVE F06ALFI TO LOC-CITY.
           MOVE F07ALFI TO LOC-COUNTRY.
           MOVE F08NUMI TO LOC-MASTER.

           EXEC CICS REWRITE FILE('LOCAT')
                FROM(LOCATION-RECORD)
           END-EXEC.

      * --NOTE THAT ERROR PROCESSING IS DONE BY THE HANDLE CONDITION
      * --AND IT JUST DUMPS AN SHORT MESSAGE AND STOP
      * --FUTURE WILL REMOVE SOME OF THEM, DUPREC,DUPKEY AND REPLACE
      * --WITH SENSIBLE ERROR MESSAGES

      * NOW WE LOG A MESSAGE TO LOGFILE WITH LOG NUMBER

           MOVE ZERO TO BISNUM-RECORD-KEY.
           EXEC CICS READ FILE('BISNUM')
                INTO (BISNUM-RECORD)
                RIDFLD(BISNUM-RECORD-KEY)
                UPDATE
           END-EXEC.
           ADD 1 TO BISNUM-NEXT-NUMBER.
           EXEC CICS REWRITE FILE('BISNUM')
                FROM(BISNUM-RECORD)
           END-EXEC.

           MOVE BISNUM-NEXT-NUMBER TO DOCNUM.
           MOVE LOC-NUMBER         TO LOCNUM.

           MOVE BISNUM-NEXT-NUMBER TO LOG-NUMBER.
           MOVE USERID             TO LOG-USER-ID.
           MOVE TODAY              TO LOG-DATE.
           MOVE EIBTRNID           TO LOG-TRANID.
           MOVE MESSAGE            TO LOG-MESSAGE.
           EXEC CICS WRITE FILE('BISLOG')
                     FROM(BISLOG-RECORD)
                     RIDFLD(LOG-NUMBER)
           END-EXEC.
      * END OF LOG CODE
        MOVE MESSAGE TO CA-ERR-MSG.
        MOVE ZEROES TO F03NUMI.
       PROC-MAP-EXIT.

      * ------ PERFORM CHECK THE MAP, YOU NEED TO CHECK FIELDS HERE
       CHEK-MAP.
      *    --ON ERROR SET ERROR FLAG
           IF F03NUMI NOT NUMERIC THEN
              MOVE 'LOCATION CODE NOT NUMERIC' TO CA-ERR-MSG
              MOVE 1 TO ERROR-FLAG
              GO TO CHEK-MAP-EXIT.
           IF (F04ALFI EQUAL SPACES) OR
              (F05ALFI EQUAL SPACES) OR
              (F06ALFI EQUAL SPACES) OR
              (F07ALFI EQUAL SPACES) THEN
              MOVE 'NAME NOT COMPLETELY FILLED IN' TO CA-ERR-MSG
              MOVE 1 TO ERROR-FLAG
              GO TO CHEK-MAP-EXIT.
           IF (F08NUMI EQUAL SPACES) THEN
              MOVE 'MASTER LOCATION NOT FILLED IN' TO CA-ERR-MSG
              MOVE 1 TO ERROR-FLAG
              GO TO CHEK-MAP-EXIT.
           IF F08NUMI NOT NUMERIC THEN
              MOVE 'MASTER CODE NOT NUMERIC' TO CA-ERR-MSG
              MOVE 1 TO ERROR-FLAG
              GO TO CHEK-MAP-EXIT.
       CHEK-MAP-EXIT.


      * ########### BELOW IS NOTHING TO CHANGE #####################
      * ########### EXCEPT FOR PF KEYS SETUP #######################

      * ------ GO TO QUIT TO CALLER
       RETURN-ABOVE.
           EXEC CICS SEND CONTROL
                     ERASE FREEKB
           END-EXEC.
      *    EXEC CICS SEND TEXT FROM(END-MESSAGE)
      *              ERASE FREEKBT
      *    END-EXEC.
           EXEC CICS RETURN END-EXEC.

      * ------ GO TO RESTART THIS TRANSACTION
       RETURN-HERE.
      *    --IF NEEDED FILL IN THE COMMAREA HERE
           EXEC CICS RETURN TRANSID(EIBTRNID) COMMAREA(COMM-AREA)
                            LENGTH(200) END-EXEC.

       GET-TIME.
      * ------ GET SYSTEM DATE
           EXEC CICS ASKTIME ABSTIME(WS-ABSTIME) END-EXEC.
           EXEC CICS FORMATTIME ABSTIME(WS-ABSTIME)
                     MMDDYY(TODAY) DATESEP('/')  END-EXEC.
           EXEC CICS FORMATTIME ABSTIME(WS-ABSTIME)
                     TIME(TIJD) TIMESEP(':')     END-EXEC.
       GET-TIME-EXIT.
       HANDLE-SETUP.
      * ------ NEXT SETUP HANDLE AIDS FOR ATTENTION KEYS.
      * ------ REMOVE KEYS YOU WANT TO USE]]]]]]
           EXEC CICS HANDLE AID CLEAR(RETURN-ABOVE) PA1(INV-ATT)
                                PF12(RETURN-ABOVE)  PA2(INV-ATT)
                                PF24(RETURN-ABOVE)  PA3(INV-ATT)
                                END-EXEC.

           EXEC CICS HANDLE AID PF1(INV-ATT)    PF13(INV-ATT)
                                PF2(INV-ATT)    PF14(INV-ATT)
                                PF3(INV-ATT)    PF15(INV-ATT)
                                                PF16(INV-ATT)
                                                PF17(INV-ATT)
                                PF6(INV-ATT)    PF18(INV-ATT)
                                END-EXEC.

           EXEC CICS HANDLE AID PF7(INV-ATT)   PF19(INV-ATT)
                                PF8(INV-ATT)   PF20(INV-ATT)
                                PF9(INV-ATT)   PF21(INV-ATT)
                                PF10(INV-ATT)  PF22(INV-ATT)
                                PF11(INV-ATT)  PF23(INV-ATT)
                                END-EXEC.

      * -- NOTHING MORE TO SEE BELOW EXCEPT THIS PROGRAM NAME BOTTOM
      * ------ NEXT SETUP HANDLE CONDITIONS FOR POSSIBLE ERRORS
           EXEC CICS HANDLE CONDITION DSIDERR(ERR-01)
                                      DSSTAT(ERR-02)
                                      DUPKEY(ERR-03)
                                      DUPREC(ERR-04)
                                      ENDDATA(ERR-05)
                                      ENDFILE(ERR-06)
                                      ENDINPT(ERR-07)
                                      EOC(ERR-08)
                                      EODS(ERR-09)         END-EXEC.
           EXEC CICS HANDLE CONDITION EOF(ERR-10)
                                      EXPIRED(ERR-11)
                                      FUNCERR(ERR-12)
                                      IGREQID(ERR-13)
                                      ILLOGIC(ERR-14)
                                      INBFMH(ERR-15)
                                      INVERRTERM(ERR-16)
                                      INVLDC(ERR-17)       END-EXEC.
           EXEC CICS HANDLE CONDITION INVMPSZ(ERR-18)
                                      INVREQ(ERR-19)
                                      INVTSREQ(ERR-20)
                                      IOERR(ERR-21)
                                      ITEMERR(ERR-22)
                                      JIDERR(ERR-23)
                                      LENGERR(ERR-24)
                                      MAPFAIL(ERR-25)      END-EXEC.
           EXEC CICS HANDLE CONDITION NOJBUFSP(ERR-26)
                                      NONVAL(ERR-27)
                                      NOPASSBKRD(ERR-28)
                                      NOPASSBKWR(ERR-29)
                                      NOSPACE(ERR-30)
                                      NOSTART(ERR-31)
                                      NOSTG(ERR-32)
                                      NOTFND(ERR-33)       END-EXEC.
           EXEC CICS HANDLE CONDITION NOTOPEN(ERR-34)
                                      OVERFLOW(ERR-35)
                                      PGMIDERR(ERR-36)
                                      QBUSY(ERR-37)
                                      QIDERR(ERR-38)
                                      QZERO(ERR-39)
                                      RDATT(ERR-40)        END-EXEC.
           EXEC CICS HANDLE CONDITION RETPAGE(ERR-41)
                                      RTEFAIL(ERR-42)
                                      RTESOME(ERR-43)
                                      SELNERR(ERR-44)
                                      SIGNAL(ERR-45)
                                      TERMIDERR(ERR-46)
                                      TRANSIDERR(ERR-47)
                                      TSIOERR(ERR-48)
                                      UNEXPIN(ERR-49)
                                      WRBRK(ERR-50)
                                      ERROR(ERR-51)        END-EXEC.

       HANDLE-SETUP-EXIT.
      * ------ ERROR HANDLING ROUTINES ------
       ERR-01. MOVE 'DSIDERR          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-02. MOVE 'DSSTAT           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-03. MOVE 'DUPKEY           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-04. MOVE 'DUPREC           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-05. MOVE 'ENDDATA          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-06. MOVE 'ENDFILE          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-07. MOVE 'ENDINPT          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-08. MOVE 'EOC              ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-09. MOVE 'EODS             ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-10. MOVE 'EOF              ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-11. MOVE 'EXPIRED          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-12. MOVE 'FUNCERR          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-13. MOVE 'IGREQID          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-14. MOVE 'ILLOGIC          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-15. MOVE 'INBFMH           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-16. MOVE 'INVERRTERM       ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-17. MOVE 'INVLDC           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-18. MOVE 'INVMPSZ          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-19. MOVE 'INVREQ           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-20. MOVE 'INVTSREQ         ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-21. MOVE 'IOERR            ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-22. MOVE 'ITEMERR          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-23. MOVE 'JIDERR           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-24. MOVE 'LENGERR          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-25. MOVE 'MAPFAIL          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-26. MOVE 'NOJBUFSP         ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-27. MOVE 'NOVAL            ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-28. MOVE 'NOPASSBKRD       ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-29. MOVE 'NOPASSBKWR       ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-30. MOVE 'NOSPACE          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-31. MOVE 'NOSTART          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-32. MOVE 'NOSTG            ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-33. MOVE 'NOTFND           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-34. MOVE 'NOTOPEN          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-35. MOVE 'OVERFLOW         ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-36. MOVE 'PGMIDERR         ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-37. MOVE 'QBUSY            ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-38. MOVE 'QIDERR           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-39. MOVE 'QZERO            ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-40. MOVE 'RDATT            ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-41. MOVE 'RETPAGE          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-42. MOVE 'RTEFAIL          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-43. MOVE 'RTESOME          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-44. MOVE 'SELNERR          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-45. MOVE 'SIGNAL           ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-46. MOVE 'TERMIDERR        ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-47. MOVE 'TRANSIDERR       ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-48. MOVE 'TSIOERR          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-49. MOVE 'UNEXPIN          ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-50. MOVE 'WRBRK            ' TO CA-EM2. GO TO SEND-ERR-MSG.
       ERR-51. MOVE 'UNIDENT ERROR    ' TO CA-EM2. GO TO SEND-ERR-MSG.
 
       INV-ATT.
               MOVE 'INVALID ATTENTION' TO CA-EM2.

       SEND-ERR-MSG.
           MOVE CA-EM2 TO CA-ERR-MSG.
           PERFORM SEND-MAP   THRU SEND-MAP-EXIT.
           GO TO RETURN-HERE.

       END-OF-PROGRAM.
           EXEC CICS ABEND ABCODE('BARF') CANCEL END-EXEC.
           STOP RUN.
/*
//LKED.SYSLMOD DD DSN=BIS.KICKSSYS.V1R5M0.KIKRPL,DISP=SHR
//LKED.SYSIN DD *
 INCLUDE SKIKLOAD(KIKCOBGL)
 ENTRY AL14PGM
 NAME  AL14PGM(R)
/*
//

Step 3 - Create A VSAM database

In this blog-post we going to take a look on permanent datastorage with KICKS.

See previous steps for a better understanding.

In order to be able to store data what we enter via KICKS to a DASD (harddisk) we need to create a so called VSAM cluster. This is an allocation on the disk where we are able to store our records.

The following is for TK4

The record storing is almost hassle free in KICKS, because we can easily approach our records with a record key. It is very fast that way to get a certain record out of the VSAM cluster, or sometimes just called the database.

Simple COBOL/KICKS/CICS instruction to read a record:

        EXEC CICS READ FILE ('VSAM-CLUSTER-DATABASE')
                  INTO (RECORD-DEFINITION)
                  RIDFLD (RECORD-KEY)
        END-EXEC.

It is however nothing like a SQL database!. You can compare it to a random access database as was in implemented in for example, GWBasic long time ago under MS-DOS. We are only able to store, update or delete a record by its record key. You will see in next blog post that this is very handy, because KICKS/CICS has some easy to use features what takes advantage of those record keys.

Before we create the database we need to determine very carefully the record layout. Think deeply about the record fields, there are obviously often more fields then on the BMS map defined, (see post about creating a BMS map), because changing afterwards involves a database copy to a different layout (structure) what brings extra (complex) work. 

The record layout must be created, or defined, as a COBOL variable as shown below, and the member must be placed in your copybook dataset. A simple copy record-layout-member command in COBOL will include it during compilation. This is not a must. You can include the record data in your COBOL program, but maintaining is more difficult. When using a copybook member for this a simple record update and recompile of the COBOL sources and all are updated. (The VSAM cluster of course needs to be copied to the new layout (or structure if you will) also. But thats for another blog post, one where we also go into other pitfalls like VSAM PATH files.

Sum all field lengths together, wich give you the byte size of the record. This must be correct, so check it again!. Wrong length will give hard to find errors and bugs later on. (pitfall)

After determining the record size we can execute a JCL job that creates the VSAM cluster like below:

This has a different record size, to keep you sharp, and BIS is the HLQ.

//VSAMCREA JOB (1),'CREATE VSAM',CLASS=A,MSGCLASS=H,
//          MSGLEVEL(1,1),REGION=4M,NOTIFY=HERC01
//DELDEF EXEC PGM=IDCAMS,REGION=1024K                             
//SYSPRINT DD SYSOUT=*                                            
//SYSIN DD *                                                      
 DELETE BIS.VSAM.TEST                                             
 SET MAXCC = 0                                                    
 DEFINE CLUSTER                                     -           
     (NAME(BIS.VSAM.TEST) INDEXED                   -             
      VOLUMES(PUB020)                               -           
      TRACKS(15 15)                                 -           
      SHAREOPTIONS(1 3) UNIQUE                      -           
      RECORDSIZE(934 934) NONSPANNED                -             
      KEYS(6 0)                                     -           
     )                                              -           
    DATA ( NAME(BIS.VSAM.TEST.DATA))                -             
   INDEX ( NAME(BIS.VSAM.TEST.INDEX))                             
/*                                                                
//                                                                 

The JCL procedure has a few interesting points you need to address:

• The location of the cluster. If you going to add a lot of records then you can run out of space. Best is to create and add an decicated DASD for the cluster(s). Calculate the record length times the assumed total of records to expect to store, and use those bytes to determine the size. If enough space, be generous, you will not regret it later on.
• The key length in bytes is of high importance, and this field must be in the JCL definition, as you defined in the record. The key field is also stored in the record definition.
• The record size as discussed above.
• And, note that this JCL first attempts to delete the old one, thus removing all your old data, and then creates a new one. Four references to the same members are to be changed.

This concludes the creation of the VSAM cluster, file, member or dataset, whatever you want to call this member.

To use it in KICKS under MVS 3.8J TK4 it must be declared in the FCT table in KICKS, AND equally important, also in the CLIST member where KICKS is been started with. The CLIST is needed to allocate the VSAM cluster, wich in CICS isnt needed, but in TK4 it is mandatory. 

We will take a deeper look in the CLIST and the FCT in upcomming blog posts but for now you can add it to the FCT like this:

And adding it at three (3) places in the CLIST, one to FREE it if allocated, one to ALLOCate it properly and one mention of FREE again after KICKS quits execution.