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

No comments:

Post a Comment