/INFO MVS
//WILBUR      JOB     'FIRSTCOBOLRUN       ',CLASS=Q,
//  MSGLEVEL=(0,0)
//ST1  EXEC CICSCOBC,NAME=CISPG52,
//  PARM.COB='NODYNAM,LIB,SIZE=256K,BUF=&BUF'
//TRN.SYSIN DD *
       IDENTIFICATION DIVISION.

       PROGRAM-ID.       CISPG51.
       AUTHOR.           WILBUR LONGWISCH.
       INSTALLATION.     MURRAY STATE UNIVERSITY.
       DATE-WRITTEN.     2000/04/29.
       DATE-COMPILED.
       SECURITY.         N/A.

      *=================================================================
       ENVIRONMENT DIVISION.
      *-----------------------------------------------------------------
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.         IBM-MAINFRAME.
       OBJECT-COMPUTER.         IBM-MAINFRAME.

      *INPUT-OUTPUT SECTION.
      *FILE CONTROL.

      *=================================================================
       DATA DIVISION.
      *-----------------------------------------------------------------
       WORKING-STORAGE SECTION.
        01 BOOK-INFO.
           05 ISBN      PIC X(12).
           05 TITLE     PIC X(30).
           05 AUTHOR1   PIC X(30).
           05 EDITION   PIC X(04).
           05 PUB-DATE  PIC X(08).
           05 COURSE    PIC X(06).

      *-----------------------------------------------------------------

           COPY DFHBMSCA.
           COPY ACCM010.
           COPY ACCM002.

      *=================================================================
       PROCEDURE DIVISION.
      *-----------------------------------------------------------------
       0000-MAIN-CONTROL.
           EXEC CICS HANDLE CONDITION MAPFAIL(9000-END) END-EXEC.
           EXEC CICS SEND MAPSET('ACCM010') MAP('LOGNSCR') ERASE
                FREEKB MAPONLY END-EXEC.
           EXEC CICS RECEIVE MAPSET('ACCM010') MAP('LOGNSCR') END-EXEC.

           EXEC CICS SEND MAPSET('ACCM010') MAP('SELSCR') ERASE
                FREEKB MAPONLY END-EXEC.
           EXEC CICS RECEIVE MAPSET('ACCM010') MAP('SELSCR') END-EXEC.

           IF PROGSELI = 2
               PERFORM 3001-BOOK-SELECTION
           ELSE
               IF PROGSELI = 1
                   PERFORM 3000-ACCOUNT-RECEIVABLE
               ELSE
                   PERFORM 9000-END.
           PERFORM 9000-END.

      *-----------------------------------------------------------------
      *1000-INITIALIZE.

      *-----------------------------------------------------------------
      *2000-READ.

      *-----------------------------------------------------------------
       3000-ACCOUNT-RECEIVABLE.
           EXEC CICS SEND MAPSET('ACCM002') MAP('BKINFO3') ERASE
                FREEKB MAPONLY END-EXEC.
           EXEC CICS RECEIVE MAPSET('ACCM002') MAP('BKINFO3') END-EXEC.

           EXEC CICS SEND MAPSET('ACCM002') MAP('BKINFO5') ERASE
                FREEKB MAPONLY END-EXEC.
           EXEC CICS RECEIVE MAPSET('ACCM002') MAP('BKINFO5') END-EXEC.

      *    EXEC CICS SEND MAPSET('ACCM002') MAP('BKINF06') ERASE
      *         FREEKB MAPONLY END-EXEC.
      *    EXEC CICS RECEIVE MAPSET('ACCM002') MAP('BKINF06') END-EXEC.

           EXEC CICS SEND MAPSET('ACCM002') MAP('TRKINF') ERASE
                FREEKB MAPONLY END-EXEC.
           EXEC CICS RECEIVE MAPSET('ACCM002') MAP('TRKINF') END-EXEC.

           EXEC CICS SEND MAPSET('ACCM002') MAP('TRKINF2') ERASE
                FREEKB MAPONLY END-EXEC.
           EXEC CICS RECEIVE MAPSET('ACCM002') MAP('TRKINF2') END-EXEC.


      *-----------------------------------------------------------------
       3001-BOOK-SELECTION.
           EXEC CICS SEND MAPSET('ACCM010') MAP('CORSENT') ERASE
                FREEKB MAPONLY END-EXEC.
           EXEC CICS RECEIVE MAPSET('ACCM010') MAP('CORSENT') END-EXEC.

           MOVE '1' TO SEL001O.
           MOVE TITLE TO TIT001O.
           MOVE AUTHOR1 TO AUT001O.
           MOVE COURSE TO COR001O.

           EXEC CICS SEND MAPSET('ACCM010') MAP('BOOKFIL') FREEKB ERASE
                MAPONLY END-EXEC.
           EXEC CICS RECEIVE MAPSET('ACCM010') MAP('BOOKFIL') END-EXEC.

      *-----------------------------------------------------------------
      *4000-PROCESS-DATA.

      *-----------------------------------------------------------------
       9000-END.
           EXEC CICS SEND CONTROL ERASE FREEKB END-EXEC.
           EXEC CICS RETURN END-EXEC.
//