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)
/*
//

KICKS good morning screen

The screen you see when you start KICKS is the KSGM transaction. Did you know you can replace the KSGM transaction with another one ?

The above screen is the default KICKS screen, or better say map ? It doesnt matter, as long as you understand what I am trying to tell you.

Now, the KSGM transaction, of wich you have the source code available in hlq.KICKSSYS.V1M5R0.COBOL dataset, and the MAPSET dataset, can be altered and recompiled if you like to have a different screen.

Above you can see my KICKS screen. The reason for change is that I also want to see some figures on my login screen. In my case I created a user to user message system, (will be covered in another blog post) and like to see if I have a new message waiting for reading. Also I like to see if there are new helpdesk tickets are been created. What would be a better place than the KSGM screen ?

It is possible to change the default one, or create a new one, what I did, and use that as the startup transaction is to create new one, BSGM. Of course I added it to the PPT and PCT tables, and changed the SIT table to start the new good morning screen.

              PLTPI=KSGM, first transaction 

If you change the PLTPI to read your desired transaction code, it will start that after logging on to KICKS. You can find the SIT table in HLQ.KICKSSYS.V1M5R0.INSTLIB. Or, a better practice is to copy the member to another dataset, and use that to make modifications.

How you change the program ?

Well, its not different from other transactions. In the blog you can already find a COBOL sample, and a BMS mapping instruction. The COBOL sample shown here, can be modified to display your new map, and do additional tasks.

Step 5 - The Cobol Program

In this blog-post we are going to take a look in the COBOL program needed for a simple transaction in KICKS.

See previous steps for a better understanding.

KICKS in TK4 uses COBOL programs to show the mapset's and do the program logic. KICKS calls are used to do the data management, like VSAM interaction, limited TSO interaction, and spool writes.

Before we continue lets take a look at our COBOL available in MVS 3.8J, a.k.a TK4.  The version is an ancient one, I believe it is an MVT ANSI compiler from the beginning of the '70ths. You can see a date of 1972 in the job output, and gives an idea how old. It does not have functions for example, it was not implemented in those days, what is cumbersome, but we can program around that. This means a lot of extra work if you want to do some normal simple things. EXAMINE in stead of INSPECT, what was then unknown or not invented yet.

Thus, while programming in COBOL in TL4 remember that.

As with the BMS maps in step 2, we can either compile a program from a JCL what compiles another member with the COBOL source, or include the source between the JCL top and bottom, what makes the process easier and faster.

 Note that you need to change the bold names in the JCL if you use it for a new program:

//AL12PGM JOB  CLASS=C,MSGCLASS=H,MSGLEVEL=(1,1),REGION=7000K   
//JOBPROC DD   DSN=BIS.KICKSSYS.V1R5M0.PROCLIB,DISP=SHR         
//AL12PGM EXEC  PROC=K2KCOBCL                                   
//* IF YOU COPY THIS AND USE AS TEMPLATE THEN FIRST CHANGE      
//* ALL 8 FILENAMES BEFORE SUBMITTING THIS JOB                  
//* 2 ON TOP, 2 PROGRAM-IDS. 1 COPYBOOK, 1 INIT-MAP AND 2 AT BOTTOM
//COPY.SYSUT1 DD *


            Your COBOL program goes in between

/*                                                      
//LKED.SYSLMOD DD DSN=BIS.KICKSSYS.V1R5M0.KIKRPL,DISP=SHR
//LKED.SYSIN DD *                                       
 INCLUDE SKIKLOAD(KIKCOBGL)                             
 ENTRY AL12PGM                                          
 NAME  AL12PGM(R)                                       
/*                                                      
//                                                      

Pseudo conversational

What is this you ask ? Well, in a few words, its give the user the idea that the program is waiting for his input, process it, and wait for the next input. All the time the program is running during the conversation with the user.

Pseudo conversational is that the program starts, shows a conversation en stops. Exits, quits.
The user is entering data, press an action key (like ENTER, or a PF key) and KICKS loads the program back in memory (if it wasnt there already) and starts it again. The user is not aware of this process, and thinks the conversation is still going on. Of course this can only with TN3270 terminals, and cannot be done with for example Linux, what no screen mapping has.

The implications for us as programmer are huge. We need to make a program that does not work in a loop to catch user input, but starts, fall thru it, and stops. During the stop of the program we can store some variables in memory (yeah I know, storage in IBM terminology) and during the next start we can read those variables back in from memory. So we can save and restore te program state a bit. The area where we store the variables is called the communication-area, or the DFHCOMMAREA.

KICKS will take care of the reload of the program, en re-execute it after the user presses an action key, and KICKS takes care of the safety of our communications area so it survives between program loads.

Once you have programmed a few programs this way in COBOL it gets easier.

But why do you ask ? Why on earth should we terminate a program and wait until a user reactivates it by an action key press ? In our KICKS environment, with TK4 it is not an issue but in a real life IBM  mainframe it is possible that 10.000 users are working with the system, and imagine that 10.000 programs are running, and waiting for user conversations. It will bring any system to a crawl. IBM cheated by making them pseudo conversational, and of the 10.000 users maybe only 500 are at any given moment really active. The second one stops, another starts maybe, so on average it will be much less. And responsive!

If you program it pseudo conversational, you already doing it the CICS way. And thats the only method we use in this blog.

The Cobol Program

When we look at the program we can roughly put it in a few sections. It is not mandatory to do it this way, but for me it works well, and is easily modular this way. You can take a look to the KICKS included samples, the MURACH and the TAC samples. In the beginning I went for the Murach examples and method, but I found it to cumbersome. The TAC example was more elegant, and more modular to change or expand. You are free of course to do what you like.

You can see that we declare the communications-area where we set up variables we use. Then we insert mandatory copybook statements, one for loading the MAP copybook, and one for the RECORD copybook. A KICKS program without database interaction is not really a KICKS program.

       COPY AL12MAP.


       COPY LOCREC.
       COPY BISVARS.
       COPY BISREC.
       COPY BISLOG.
 
       COPY DFHBMSCA.
       COPY KIKAID.

I always start with the copy (thus include the file when compiling) of the BMS map variables. These are mandatory for processing screen data fields.
After that I include my applications copybook files, like record definitions, variables I created and are been used for every transaction in the region.
Finally, DFHBMSCA is needed for mapinterraction if you want to change colors for example from the COBOL program, and KIKAID is a list of easy to remember names for action key presses in stead of codes. Like KIKPF3 for example.

Then, the main procedure comes in where we test if this was the first time we are in the program, thus an empty communications area, if so display the map, set a flag in the communications area that next time in we expect a action key press.

          IF EIBCALEN = 0
               MOVE 1 TO COMM-AREA
               PERFORM INIT-MAP THRU INIT-MAP-EXIT
               PERFORM SEND-MAP THRU SEND-MAP-EXIT
               GO TO RETURN-HERE.

Here we check the length of the comm-area, and should be 0 (zero) at the first time the transaction is started. If so, then we put a value in it, like 1 for example, and send the map to the terminal and stop the program. Transfer controll back to KICKS.

Second time in we process the action key, put a map on the terminal, and exit again, and let the whole process start again for a next time.

           IF EIBAID = KIKPF5   GO TO PROC-INPUT.
           PERFORM RECV-MAP THRU RECV-MAP-EXIT.
           PERFORM CHEK-MAP THRU CHEK-MAP-EXIT.
           PERFORM SEND-MAP THRU SEND-MAP-EXIT.
           GO TO RETURN-HERE.

If EIBCALEN is greater then 0, then we know the map is already been sent to the terminal, possible data enteren and the user pressed an action-key. If that key was PF5, then we do the routines at PROC-INPUT,  or else we read the map, check it, and send it back and leave the transaction.

At the bottom we have some helping sub-routines, for error handling, exiting properly, and input testing.

EXEC KICKS .. END-EXEC.

All actions you want KICKS (or CICS, most of it is identical) to perform are to put between the EXEC KICKS and the END-EXEC. statements. There are a lot of them, and I recommend that you study the KICKS manual rather than a CICS book, because its easier to do, and you only learn what is possible in MVS 3.8J at the moment.

Sending a map to the terminal

       SEND-MAP.
           MOVE CA-ERR-MSG TO F24ALFO.
           MOVE PGM-ID     TO F01ALFO.
           MOVE USERID     TO F02ALFO.
           EXEC CICS SEND MAP('AL12')
                       MAPSET('AL12MAP')
                       ERASE FREEKB
           END-EXEC.
       SEND-MAP-EXIT.

You can see that we quickly put some variables to the BMS screen fields, like F24ALFO, and then use SEND MAP exec to send it to the terminal. ERASE clears the screen beforehand, and FREEKB makes sure the user isn't locked out.

Recieve a map from the terminal

       RECV-MAP.
           EXEC CICS RECEIVE MAP('AL12')
                          MAPSET('AL12MAP')
           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.

During a recieve map action, we can check fields and replace masking data, or not. Depends on your way of presenting fields. You can even use UNDERLINE in the BMS map to show the field length on the terminal. I prefer to use asterix to fill the fields beforehand.

Store data entered from the terminal

           EXEC CICS WRITE FILE('LOCAT')
                FROM(LOCATION-RECORD)
                RIDFLD(F03NUMI)
           END-EXEC.

Here we actually write a record to the VSAM file with the name LOCAT. The copybook LOCREC contains the record layout, and is been used as record to put to VSAM. The key we include, RIDFLD is a COBOL variable we created earlier, or just anything we want. Please not, if the key must be unique, then make sure it is one. I often use another VSAM dataset with a sequence number in it to generate an unique key.

Exit the transaction

       RETURN-HERE.
           EXEC CICS RETURN TRANSID(EIBTRNID)
                            COMMAREA(COMM-AREA)
                            LENGTH(200) 
           END-EXEC.

Here is the part where we return control to KICKS. You can see that we give control to ourself when after stopping the transaction, an action key is been pressed. Ourself is the transaction code in EIBTRNID. So no need to enter for example 'AL12'.

          EXEC CICS RETURN END-EXEC.

Of course, we can also really terminate the transaction by just doing a RETURN.
 

Full example

In below example you can see a working transaction, AL12. We first do some setup of variables, get the copybook members, and setup the LINKAGE section. This is what really is been communicated.

Then the procedure division let you see the tests of first in or not, and in the latter I jump to PROC INPUT. This is done for future use. This way I can always do something extra before I go to the actual processing. The more you break it in smaller pieces, the easier it is maintainable.

When using HANDLE, you can free yourself of writing all kinds of error trap routines. Often I only do that for NOTFND and leave the rest to the generic message.

       IDENTIFICATION DIVISION.
       PROGRAM-ID.    AL12PGM.
       AUTHOR.        BPTNZ.
       DATE-WRITTEN.  NOV 2018.
       DATE-COMPILED. TODAY.

       REMARKS.       AL12,ADD NEW LOCATION IS ALSO TEMPLATE.

       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  COMM-AREA        PIC X(200).
       01  PGM-ID           PIC X(8)  VALUE 'AL12PGM'.

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

       COPY LOCREC.
       COPY AL12MAP.
       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
               MOVE 1 TO COMM-AREA
               PERFORM INIT-MAP THRU INIT-MAP-EXIT
               PERFORM SEND-MAP THRU SEND-MAP-EXIT
               GO TO RETURN-HERE.

           IF EIBAID = KIKPF5   GO TO PROC-INPUT.
           PERFORM RECV-MAP THRU RECV-MAP-EXIT.
           PERFORM CHEK-MAP THRU CHEK-MAP-EXIT.
           PERFORM SEND-MAP THRU SEND-MAP-EXIT.
           GO TO RETURN-HERE.

       PROC-INPUT.
      *       --PROCESS DATA AFTER PRESSING ATT-KEY
               PERFORM RECV-MAP THRU RECV-MAP-EXIT.
               PERFORM CHEK-MAP THRU CHEK-MAP-EXIT.
               IF ERROR-FLAG = 0 THEN
                  PERFORM PROC-MAP THRU PROC-MAP-EXIT.
               PERFORM SEND-MAP THRU SEND-MAP-EXIT.
               GO TO RETURN-HERE.

      * ------ PERFORM INIT THE MAP
       INIT-MAP.
           MOVE LOW-VALUES TO AL12O.
           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('AL12')
                       MAPSET('AL12MAP')
                       ERASE FREEKB
           END-EXEC.
       SEND-MAP-EXIT.

      * ------ PERFORM RECEIVE THE MAP
       RECV-MAP.
           EXEC CICS RECEIVE MAP('AL12')
                          MAPSET('AL12MAP')
           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 PROCESS THE MAP.
       PROC-MAP.
      *    -PROCESS THE DATA
           MOVE F03NUMI TO LOC-NUMBER.
           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 WRITE FILE('LOCAT')
                FROM(LOCATION-RECORD)
                RIDFLD(F03NUMI)
           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.

       PROC-MAP-EXIT.

      * ------ PERFORM CHECK THE MAP

       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 RETURN END-EXEC.

      * ------ GO TO RESTART THIS TRANSACTION

       RETURN-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)
                                PF4(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.