G2C Example COBOL

 logo                                                          logoslog

 

G2C - Gener/OL to COBOL CICS 
   

Gener/OL Program Code


 PROG: E06A     SUBLIB: PROD       DESC: TARIFF MAINTENANCE MENU
    SEQ  EF         STATEMENT
  ----- ---- --------------------------------------------------------------------------------------------------------------------
   0001      PROGRAM  E06A      DESCRIPTION 'TARIFF MAINTENANCE MENU        '
   0002        HANDLE CLEAR=CLRKEY,                   NOTOPEN=NOTOPEN
   0003      RECORD PROD:TRFMNT FILE=TRFMNT PREFIX=TH
   0004      WORK PROD:COMMX1  PREFIX=X1
   0005      WORK PROD:E06AN1  PREFIX=N1
   0006      * ********************************
   0009      * NOTE -
   0010      * TO ADD MORE MENU SELECTIONS TO
   0011      * THE MENU, THE AUTOMATIC EDITING
   0012      * MUST BE CHANGED TO INCLUDE THE
   0013      * NEW SELECTIONS IN THE RANGE
   0014      * ********************************
   0015      * SETUP PROGRAM/EXEC SPECIFICS
   0016
   0017        MOVE 'E06A' TO X1PROGID
   0018        IF RWLOGON <> 'COMMON99'
   0019          MOVE RWCLEAR TO X1DESTID
   0020          MOVE 'T' TO X1TRANSTAT
   0021        ENDIF
   0022      * ********************************
   0023      * DATA INPUT
   0024
   0025      SENDMAP. * ** SEND ORIGINAL MAP **
   0026        MAP PROD:E06AM1
   0027        MOVE RWCLEAR TO RWNOTICE
   0028      * ********************************
   0029      * -- MAP1 AID TESTING --
   0030
   0031        CASE RWAID
   0032      * ENTER KEY PRESSED
   0033        VALUE '7D'
   0034          GOTO ENTER
   0035      * PF1 PRESSED
   0036        VALUE 'F1'
   0037          GOTO SIGNOFF
   0038      * ALL OTHERS ARE INVALID
   0039        OTHERWISE
   0040          GOSUB EOFCHK
   0041          GOSUB RESTORE
   0042          GOSUB ERR1001
   0043          GOTO SENDMAP
   0044        ENDCASE
   0045      * ********************************
   0046      * EDIT FOR EXISTING, VALIDITY IS
   0047      * CHECKED BY AUTOMATIC EDITTING
   0048
   0049      ENTER. *
   0050        GOSUB EOFCHK
   0051        GOSUB RESTORE
   0052        IF N1SELECT = 0
   0053          GOSUB ERR1019
   0054          GOTO SENDMAP
   0055        ENDIF
   0056      * ********************************
   0057      * TRANSFER BASED ON SELECTION.
   0058      * TARIFF MAINT IS READ.  IF NOT
   0059      * OPEN BECAUSE FM07000 IS RUNNING,
   0060      * AN ERROR MESSAGE IS DISPLAYED
   0061      * (NOTOPEN IS A HANDLE CONDITION).
   0062      *
   0063      * BATCH CONTROL
   0064        CASE N1SELECT
   0065        VALUE 1
   0066          READ TRFMNT
   0067          MOVE 'E07A' TO RWPROG
   0068      * RECORD MAINTENANCE
   0069        VALUE 2
   0070          READ TRFMNT
   0071          MOVE 'E08A' TO RWPROG
   0072      * MAINTENANCE BROWSE
   0073        VALUE 3
   0074          READ TRFMNT
   0075          MOVE 'E09A' TO RWPROG
   0076        ENDCASE
   0077        NEWPROG
   0078      * ********************************
   0079
   0080      EOFCHK. * ** EOF KEY CHECK&CLEAR ROUTINE *
   0081        GETMAP PROD:E06AM1,TABLE
   0082        .MDT FIELD='N1SELECT',               LENGTH=X1LENCHK,                MODIFIED=X1MODCHK
   0083        IF X1LENCHK=0 & X1MODCHK='YES'
   0084          MOVE RWCLEAR TO N1SELECT
   0085        ENDIF
   0086        RETURN
   0087      * ********************************
   0088
   0089      RESTORE.
   0090        .MAPATTR 'N1SELECT',,,RESTORE
   0091        RETURN
   0092      * ********************************
   0093
   0094        * ** ERROR MESSAGE LITERALS **
   0095      ERR1001. MOVE '* * ERROR 1001           WRONG KEY PRESSED                     * *' TO RWNOTICE
   0096        RETURN
   0097      ERR1015. MOVE '* * ERROR 1015           COMPUTER PROBLEM - PLEASE SIGN OFF    * *' TO RWNOTICE
   0098        RETURN
   0099      ERR1019. MOVE '* * ERROR 1019           NO SELECTION MADE                     * *' TO RWNOTICE
   0100        RETURN
   0101      ERR1025. MOVE '* * ERROR 1025           APPLICATION NOT AVAILABLE             * *' TO RWNOTICE
   0102        RETURN
   0103      * ********************************
   0104      * OTHER BRANCH ROUTINES BEGIN HERE
   0105
   0106      SIGNOFF. * ** SIGN OFF ROUTINE **
   0107        MOVE RWBLANK TO RWABEND
   0108        ENDJOB
   0109      * ********************************
   0110
   0111      CLRKEY. * ** CLEAR KEY DETECTED **
   0112        *
   0113        IF X1TRANSTAT <> 'T'
   0114          XCTL (S03B    )
   0115        ENDIF
   0116        ENDJOB
   0117      * ********************************
   0118
   0119      RTERTN. * ** RUN TIME ERROR DETECTED **
   0120        PRINT (01)D=X1DESTID,                 ' COMPUTER PROBLEM AT TERMINAL=',RWTERM,                        ' PROGRAM=',
             ROGID,           ' ABEND=',RWABEND
   0121        PRINT D=X1DESTID,                     ' MAP=',RWCURMAP,               ' EIBFN=',RWEIBFN,              ' EIBRCODE='
             EIBRCODE
   0122        IF X1TRANSTAT = 'T'
   0123          PRINT ' '
   0124          PRINT ' SET OFF HANDLE RTE IN PROGRAM FOR FULL DIAGNOSTICS'
   0125          MOVE RWBLANK TO RWABEND
   0126          ENDJOB
   0127        ELSE
   0128          GOSUB ERR1015
   0129          GOTO MAPABEND
   0130        ENDIF
   0131      * ********************************
   0132
   0133      MAPABEND. * ** SEND COMPUTER PROBLEM ERROR *
   0134        MAP PROD:E06AM1
   0135        IF RWAID<>'F1'
   0136          GOTO MAPABEND
   0137        ENDIF
   0138        MOVE RWBLANK TO RWABEND
   0139        ENDJOB
   0140      * ********************************
   0141
   0142      NOTOPEN. GOSUB ERR1025
   0143        MOVE RWCLEAR TO RWABEND
   0144        GOTO SENDMAP
                    END OF PROGRAM LISTING

 

COBOL CICS Program Generated


      *PROGRAM E05 CONVERTED BY G2C ON 19 Feb 2020.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. E05.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  ABSOLUTE-TIME    PIC S9(15) COMP-3.
       01  RWPROG           PIC X(8)   VALUE 'E05'.
       01  HOLD-MESSAGE     PIC X(50)  VALUE SPACES.
       01  HOLD-MESSAGE-LEN PIC S9(08) VALUE 50.
       COPY DFHBMSCA.
       COPY DFHAID.
      *COPY DFHEIBLK.
       COPY RESERVED.
       COPY TRECON.
       COPY TARIF2.
       COPY COMMX1.
       COPY E05AR1.
       COPY E05AR2.
       COPY E05AM1.
       COPY E05AM2.

       LINKAGE SECTION.

       01  DFHCOMMAREA.
           10 FILLER PIC X OCCURS 0 TO 4096 TIMES
              DEPENDING ON EIBCALEN.

       PROCEDURE DIVISION.

       E05-BEGIN.

               EXEC CICS ASSIGN
                    USERID(RWLOGON)
               END-EXEC.

               EXEC CICS ASSIGN
                    USERID(RWUSERID)
               END-EXEC.

               MOVE LOW-VALUES TO E05AM1.
               MOVE LOW-VALUES TO E05AM2.
               PERFORM DATE-ROUTINE
                  THRU DATE-ROUTINE-EXIT
                MOVE RWIROME TO R2SYDTEYMD
                IF R2SYDTEYY  IS GREATER THAN  75
                  MOVE 19 TO R2SYDTECC
              ELSE
                  MOVE 20 TO R2SYDTECC
                END-IF
                MOVE 'E05A' TO X1PROGID
                IF RWLOGON  IS NOT EQUAL TO  'COMMON99'
                  MOVE NULLS TO X1DESTID
                  MOVE 'T' TO X1TRANSTAT
                END-IF
                .
        SENDMAP1.
      *  ** SEND CONTROL MAP **
                EXEC CICS
                  SEND MAP(E05AM1)
                  FROM(E05AM1O)
                  MAPSET(E05AM11)
                  FREEKB
                  FRSET
                END-EXEC
                MOVE NULLS TO RWNOTICE
                EVALUATE  EIBAID
                WHEN EIBAID = DFHENTER
                  GO TO ENTER1
                WHEN EIBAID = DFHPF1
                  GO TO SIGNOFF
                WHEN EIBAID = DFHPF4
                  GO TO MODSTS
                WHEN EIBAID = DFHPF2
                  GO TO ADDUSR
                WHEN EIBAID = DFHPF6
                  GO TO DELUSR
                WHEN EIBAID = DFHPF9
                  GO TO DELSPL
                WHEN OTHER
               EXEC CICS
                 RECEIVE MAP(E05AM1)
                   INTO(E05AM1I)
                   MAPSET(E05AM11)
                   NOHANDLE
               END-EXEC
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1001 THRU ERR1001-EXIT
                  GO TO SENDMAP1
                END-EVALUATE
               .
        SENDMAP1-EXIT.
               EXIT.
        ENTER1.
      *
               EXEC CICS
                 RECEIVE MAP(E05AM1)
                   INTO(E05AM1I)
                   MAPSET(E05AM11)
                   NOHANDLE
               END-EXEC
                PERFORM RESTOR1 THRU RESTOR1-EXIT
                MOVE SPACES TO R1DELUSER
                MOVE SPACES TO R1DELSPEC
                IF R1SELECT  IS EQUAL TO  0
                    MOVE -1 TO R1SELECTL
                    MOVE DFHBMBRY TO R1SELECTA
                  PERFORM ERR1002 THRU ERR1002-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1SELECT  IS GREATER THAN  4
                    MOVE -1 TO R1SELECTL
                    MOVE DFHBMBRY TO R1SELECTA
                  PERFORM ERR1018 THRU ERR1018-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1INITIAL  IS EQUAL TO  SPACES
                  OR  R1INITIAL  IS EQUAL TO  NULLS
                    MOVE -1 TO R1INITIALL
                    MOVE DFHBMBRY TO R1INITIALA
                  PERFORM ERR1002 THRU ERR1002-EXIT
                  GO TO SENDMAP1
                END-IF
                PERFORM READFC THRU READFC-EXIT
                IF R1SELECT  IS EQUAL TO  1
                  MOVE TCPRVMID TO R1BATCHID
                  MOVE 'PREVIOUS MONTH ' TO R2BDESC
                END-IF
                IF R1SELECT  IS EQUAL TO  2
                  MOVE TCCURMID TO R1BATCHID
                  MOVE 'CURRENT MONTH ' TO R2BDESC
                END-IF
                IF R1SELECT  IS EQUAL TO  3
                  MOVE TCSPECID TO R1BATCHID
                  MOVE 'SPECIAL ' TO R2BDESC
                END-IF
                IF R1SELECT  IS EQUAL TO  4
                  MOVE TCUSERID TO R1BATCHID
                  MOVE 'USER ' TO R2BDESC
                END-IF
                IF R1BATCHID  IS EQUAL TO  0
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM NOBATCH THRU NOBATCH-EXIT
                END-IF
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOBATCH)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                IF TCBSTATUS  IS EQUAL TO  'D'
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1046 THRU ERR1046-EXIT
                  GO TO SENDMAP1
                END-IF
                MOVE TCBATCHID TO R2BATCHID
                MOVE TCBATCHCC TO R2BCC
                MOVE TCBATCHYY TO R2BYY
                MOVE TCBATCHMD TO R2BMMDD
                IF TCCPROCESS  IS EQUAL TO  'U'
                  MOVE 'UPDATE, NO PRINT' TO R2BCSDESC
                END-IF
                IF TCCPROCESS  IS EQUAL TO  'P'
                  MOVE 'PRINT ONLY' TO R2BCSDESC
                END-IF
                IF TCCPROCESS  IS EQUAL TO  'B'
                  MOVE 'PRINT & UPDATE' TO R2BCSDESC
                END-IF
                IF TCCPROCESS  IS EQUAL TO  SPACES
                  MOVE 'NO ACTION' TO R2BCSDESC
                END-IF
                IF TCDPROCESS  IS EQUAL TO  'U'
                  MOVE 'PRINT & UPDATE' TO R2BDSDESC
                END-IF
                IF TCDPROCESS  IS EQUAL TO  'P'
                  MOVE 'PRINT ONLY' TO R2BDSDESC
                END-IF
                IF TCDPROCESS  IS EQUAL TO  SPACES
                  MOVE 'NO ACTION' TO R2BDSDESC
                END-IF
                MOVE SPACES TO R2KEY
                MOVE SPACES TO R2NEWTARIF
               EXEC CICS
                 HANDLE CONDITION
                   ERROR (SENDMAP2)
               END-EXEC
               EXEC CICS
                 READNEXT DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                IF R1BATCHID  IS NOT EQUAL TO  TCBATCHID
                  GO TO SENDMAP2
                END-IF
                MOVE TCOLDTARIF TO R2KEY
                MOVE TCNEWTARIF TO R2NEWTARIF
                GO TO SENDMAP2
               .
        ENTER1-EXIT.
               EXIT.
        ADDUSR.
               EXEC CICS
                 RECEIVE MAP(E05AM1)
                   INTO(E05AM1I)
                   MAPSET(E05AM11)
                   NOHANDLE
               END-EXEC
                MOVE SPACES TO R1DELUSER
                MOVE SPACES TO R1DELSPEC
                IF R1SELECT  IS NOT EQUAL TO  4
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1018 THRU ERR1018-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1INITIAL  IS EQUAL TO  SPACES
                  OR  R1INITIAL  IS EQUAL TO  NULLS
                    MOVE -1 TO R1INITIALL
                    MOVE DFHBMBRY TO R1INITIALA
                  PERFORM ERR1002 THRU ERR1002-EXIT
                  GO TO SENDMAP1
                END-IF
                PERFORM READFC THRU READFC-EXIT
                MOVE TCNEXTID TO R1NEXTID
                IF TCUSERID  IS GREATER THAN  00
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1052 THRU ERR1052-EXIT
                  GO TO SENDMAP1
                END-IF
                MOVE 1  TO  X1TALLY1
               .
        ADDUSR-EXIT.
               EXIT.
        TRYAGAIN.
                COMPUTE X1TALLY1 = (X1TALLY1 + 1)
                IF X1TALLY1  IS GREATER THAN  99
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1048 THRU ERR1048-EXIT
                  GO TO SENDMAP1
                END-IF
                MOVE SPACES TO TCREC
                MOVE R1NEXTID TO R1BATCHID
                MOVE R1HCKEY TO R1RECKEY
                MOVE R1KEY TO TCKEY
                MOVE 'U' TO TCBTYPE
                MOVE R2SYDTE TO TCBATCHDT
                MOVE ' ' TO TCBSTATUS
                MOVE ' ' TO TCCPROCESS
                MOVE ' ' TO TCDPROCESS
               EXEC CICS
                 HANDLE CONDITION
                   DUPREC(RUTINE)
               END-EXEC
               EXEC CICS
                 WRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   RIDFLD(TCKEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
                PERFORM READFC THRU READFC-EXIT
                MOVE R1NEXTID TO TCUSERID
                COMPUTE TCNEXTID = (R1NEXTID + 1)
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
                   UPDATE
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
               EXEC CICS
                 REWRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   LENGTH(TRECON-LEN)
               END-EXEC
                PERFORM RESTOR1 THRU RESTOR1-EXIT
                PERFORM MSG1009 THRU MSG1009-EXIT
                GO TO SENDMAP1
               .
        TRYAGAIN-EXIT.
               EXIT.
        DELUSR.
               EXEC CICS
                 RECEIVE MAP(E05AM1)
                   INTO(E05AM1I)
                   MAPSET(E05AM11)
                   NOHANDLE
               END-EXEC
                MOVE SPACES TO R1DELSPEC
                IF R1SELECT  IS NOT EQUAL TO  4
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1018 THRU ERR1018-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1DELUSER  IS EQUAL TO  '1'
                  GO TO DELUSROK
                END-IF
                IF R1INITIAL  IS EQUAL TO  SPACES
                  OR  R1INITIAL  IS EQUAL TO  NULLS
                    MOVE -1 TO R1INITIALL
                    MOVE DFHBMBRY TO R1INITIALA
                  PERFORM ERR1002 THRU ERR1002-EXIT
                  GO TO SENDMAP1
                END-IF
                PERFORM READFC THRU READFC-EXIT
                IF TCUSERID  IS EQUAL TO  00
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1046 THRU ERR1046-EXIT
                  GO TO SENDMAP1
                END-IF
                MOVE TCUSERID TO R1BATCHID
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOTFOUND)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                IF TCBSTATUS  IS EQUAL TO  'D'
                  PERFORM ERR1046 THRU ERR1046-EXIT
                  GO TO SENDMAP1
                END-IF
                MOVE '1' TO R1DELUSER
                PERFORM RESTOR1 THRU RESTOR1-EXIT
                PERFORM MSG1003 THRU MSG1003-EXIT
                GO TO SENDMAP1
               .
        DELUSR-EXIT.
               EXIT.
        DELUSROK.
                PERFORM READFC THRU READFC-EXIT
                MOVE TCUSERID TO R1BATCHID
                MOVE 00 TO TCUSERID
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
                   UPDATE
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
               EXEC CICS
                 REWRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   LENGTH(TRECON-LEN)
               END-EXEC
                MOVE R1HCKEY TO R1RECKEY
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
                   UPDATE
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                MOVE 'D' TO TCBSTATUS
               EXEC CICS
                 REWRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   LENGTH(TRECON-LEN)
               END-EXEC
                PERFORM RESTOR1 THRU RESTOR1-EXIT
                PERFORM MSG1010 THRU MSG1010-EXIT
                MOVE SPACES TO R1DELUSER
                GO TO SENDMAP1
               .
        DELUSROK-EXIT.
               EXIT.
        DELSPL.
               EXEC CICS
                 RECEIVE MAP(E05AM1)
                   INTO(E05AM1I)
                   MAPSET(E05AM11)
                   NOHANDLE
               END-EXEC
                MOVE SPACES TO R1DELUSER
                IF R1SELECT  IS NOT EQUAL TO  3
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1018 THRU ERR1018-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1DELSPEC  IS EQUAL TO  '1'
                  GO TO DELSPLOK
                END-IF
                IF R1INITIAL  IS EQUAL TO  SPACES
                  OR  R1INITIAL  IS EQUAL TO  NULLS
                    MOVE -1 TO R1INITIALL
                    MOVE DFHBMBRY TO R1INITIALA
                  PERFORM ERR1002 THRU ERR1002-EXIT
                  GO TO SENDMAP1
                END-IF
                PERFORM READFC THRU READFC-EXIT
                IF TCSPECID  IS EQUAL TO  00
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1046 THRU ERR1046-EXIT
                  GO TO SENDMAP1
                END-IF
                MOVE TCSPECID TO R1BATCHID
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                IF TCBSTATUS  IS EQUAL TO  'D'
                  PERFORM ERR1046 THRU ERR1046-EXIT
                  GO TO SENDMAP1
                END-IF
                MOVE '1' TO R1DELSPEC
                PERFORM RESTOR1 THRU RESTOR1-EXIT
                PERFORM MSG1032 THRU MSG1032-EXIT
                GO TO SENDMAP1
               .
        DELSPL-EXIT.
               EXIT.
        DELSPLOK.
                PERFORM READFC THRU READFC-EXIT
                MOVE TCSPECID TO R1BATCHID
                MOVE 00 TO TCSPECID
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
                   UPDATE
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
               EXEC CICS
                 REWRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   LENGTH(TRECON-LEN)
               END-EXEC
                MOVE R1HCKEY TO R1RECKEY
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
                   UPDATE
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                MOVE 'D' TO TCBSTATUS
               EXEC CICS
                 REWRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   LENGTH(TRECON-LEN)
               END-EXEC
                PERFORM RESTOR1 THRU RESTOR1-EXIT
                PERFORM MSG1010 THRU MSG1010-EXIT
                MOVE SPACES TO R1DELSPEC
                GO TO SENDMAP1
               .
        DELSPLOK-EXIT.
               EXIT.
        MODSTS.
               EXEC CICS
                 RECEIVE MAP(E05AM1)
                   INTO(E05AM1I)
                   MAPSET(E05AM11)
                   NOHANDLE
               END-EXEC
                MOVE SPACES TO R1DELUSER
                MOVE SPACES TO R1DELSPEC
                PERFORM RESTOR1 THRU RESTOR1-EXIT
                IF R1SELECT  IS LESS THAN  1
                  OR  R1SELECT  IS GREATER THAN  4
                    MOVE -1 TO R1SELECTL
                    MOVE DFHBMBRY TO R1SELECTA
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1018 THRU ERR1018-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1INITIAL  IS EQUAL TO  SPACES
                  OR  R1INITIAL  IS EQUAL TO  NULLS
                    MOVE -1 TO R1INITIALL
                    MOVE DFHBMBRY TO R1INITIALA
                  PERFORM ERR1002 THRU ERR1002-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1INITIAL  IS NOT EQUAL TO  'TSD'
                  AND  C  AND  ALL
                 'U'  OR  R1INITIAL  IS NOT EQUAL TO
                 'TSD'  AND  R1CPROCESS  IS EQUAL TO
                 'B'
                    MOVE -1 TO R1INITIALL
                    MOVE DFHBMBRY TO R1INITIALA
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1030 THRU ERR1030-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1INITIAL  IS NOT EQUAL TO  'TSD'
                  AND  R1DPROCESS  IS EQUAL TO  'U'
                    MOVE -1 TO R1INITIALL
                    MOVE DFHBMBRY TO R1INITIALA
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1030 THRU ERR1030-EXIT
                  GO TO SENDMAP1
                END-IF
                PERFORM READFC THRU READFC-EXIT
                MOVE 2  TO  RWROW
                COMPUTE RWI1 = (R1SELECT - 1) * RWROW
                MOVE TCBID TO R1BATCHID
                IF R1BATCHID  IS EQUAL TO  00
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1046 THRU ERR1046-EXIT
                  GO TO SENDMAP1
                END-IF
                IF R1SELECT  IS EQUAL TO  1
                  MOVE TCPRVMID TO R1BATCHID
                END-IF
                IF R1SELECT  IS EQUAL TO  2
                  MOVE TCCURMID TO R1BATCHID
                END-IF
                IF R1SELECT  IS EQUAL TO  3
                  MOVE TCSPECID TO R1BATCHID
                END-IF
                IF R1SELECT  IS EQUAL TO  4
                  MOVE TCUSERID TO R1BATCHID
                END-IF
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOBATCH)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                IF TCBSTATUS  IS EQUAL TO  'D'
                  PERFORM NOBATCH THRU NOBATCH-EXIT
                END-IF
                IF TCBTYPE  IS EQUAL TO  'U'
                  IF TCINT9  IS NOT EQUAL TO  SPACES
                    PERFORM ERR2020 THRU ERR2020-EXIT
                    GO TO SENDMAP1
                  END-IF
                  MOVE TCINITIALS TO R1USERINIT
                  PERFORM VARYING R1OCCURS
                    FROM 1 BY 1 UNTIL R1OCCURS = 9
                    COMPUTE RWI2 = (R1OCCURS - 1) * 3
                    IF R1INIT  IS NOT EQUAL TO  R1INITIAL
                      OR  R1INIT  IS NOT EQUAL TO  SPACES
                    MOVE R1INITIAL TO R1INIT
                    GO TO XSEARCH
                    END-IF
                    END-IF
                 END-IF
               .
        MODSTS-EXIT.
               EXIT.
        XSEARCH.
                    MOVE R1USERINIT TO TCINITIALS
                  IF R1CPROCESS  IS NOT EQUAL TO  SPACES
                    AND  R1CPROCESS  IS NOT EQUAL TO  NULLS
                    AND  R1CPROCESS  IS NOT EQUAL TO  'B'
                    AND  R1DPROCESS  IS NOT EQUAL TO  'U'
                      MOVE -1 TO R1CPROCESSL
                      MOVE DFHBMBRY TO R1CPROCESSA
                    PERFORM ERR1002 THRU ERR1002-EXIT
                    GO TO SENDMAP1
                  END-IF
                  IF R1DPROCESS  IS NOT EQUAL TO  SPACES
                    AND  R1DPROCESS  IS NOT EQUAL TO  NULLS
                    AND  R1DPROCESS  IS NOT EQUAL TO  'P'
                    AND  R1DPROCESS  IS NOT EQUAL TO  'U'
                      MOVE -1 TO R1DPROCESSL
                      MOVE DFHBMBRY TO R1DPROCESSA
                    PERFORM ERR1002 THRU ERR1002-EXIT
                    GO TO SENDMAP1
                  END-IF
                  MOVE 'J' TO R1CPROCESS
                  IF X1MODCHK  IS EQUAL TO  'YES'
                    COMPUTE R1CHGSWTCH  = R1CHGSWTCH+ 1
                  END-IF
                  IF X1LENCHK<> 0
                    MOVE R1CPROCESS TO TCCPROCESS
                  END-IF
                  MOVE 'J' TO R1DPROCESS
                  IF X1MODCHK  IS EQUAL TO  'YES'
                    COMPUTE R1CHGSWTCH  = R1CHGSWTCH+ 1
                  END-IF
                  IF X1LENCHK<> 0
                    MOVE R1DPROCESS TO TCDPROCESS
                  END-IF
                  IF R1CHGSWTCH  IS EQUAL TO  0
                    PERFORM ERR1009 THRU ERR1009-EXIT
                    GO TO SENDMAP1
                  END-IF
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
                   UPDATE
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
               EXEC CICS
                 REWRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   LENGTH(TRECON-LEN)
               END-EXEC
                  PERFORM MSG1002 THRU MSG1002-EXIT
                  MOVE 0  TO  R1CHGSWTCH
                  GO TO SENDMAP1
               .
        XSEARCH-EXIT.
               EXIT.
        SENDMAP2.
      *  ** SEND DETAIL MAP **
                  EXEC CICS
                    SEND MAP(E05AM2)
                    FROM(E05AM2O)
                    MAPSET(E05AM22)
                    FREEKB
                    FRSET
                  END-EXEC
                  MOVE NULLS TO RWNOTICE
                  EVALUATE  EIBAID
                  WHEN EIBAID = DFHENTER
                    GO TO ENTER2
                  WHEN EIBAID = DFHPF1
                    GO TO SIGNOFF
                  WHEN EIBAID = DFHPF3
                    GO TO RETURN$
                  WHEN EIBAID = DFHPF8
                    GO TO BRFWD
                  WHEN EIBAID = DFHPF7
                    GO TO BRBWD
                  WHEN EIBAID = DFHPF2
                    GO TO ADDREC
                  WHEN EIBAID = DFHPF6
                    GO TO DELREC
                  WHEN EIBAID = DFHPF4
                    GO TO UPDREC
                  WHEN OTHER
               EXEC CICS
                 RECEIVE MAP(E05AM2)
                   INTO(E05AM2I)
                   MAPSET(E05AM22)
                   NOHANDLE
               END-EXEC
                    PERFORM RESTOR2 THRU RESTOR2-EXIT
                    PERFORM ERR1001 THRU ERR1001-EXIT
                    GO TO SENDMAP2
                  END-EVALUATE
               .
        SENDMAP2-EXIT.
               EXIT.
        ENTER2.
      *
               EXEC CICS
                 RECEIVE MAP(E05AM2)
                   INTO(E05AM2I)
                   MAPSET(E05AM22)
                   NOHANDLE
               END-EXEC
                  PERFORM RESTOR2 THRU RESTOR2-EXIT
                  MOVE SPACES TO R1DEL
                  MOVE R2KEY TO R1RECKEY
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOTFOUND)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  MOVE TCOLDTARIF TO R2KEY
                  MOVE TCNEWTARIF TO R2NEWTARIF
                  GO TO SENDMAP2
               .
        ENTER2-EXIT.
               EXIT.
        BRFWD.
               EXEC CICS
                 RECEIVE MAP(E05AM2)
                   INTO(E05AM2I)
                   MAPSET(E05AM22)
                   NOHANDLE
               END-EXEC
                  PERFORM RESTOR2 THRU RESTOR2-EXIT
                  MOVE NULLS TO R1NOBRBWD
                  IF R1NOBRFWD  IS EQUAL TO  '1'
                    PERFORM ERR1079 THRU ERR1079-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF R1DEL  IS NOT EQUAL TO  '1'
                    GO TO BRFTAG1
                  END-IF
                  MOVE NULLS TO R1DEL
               EXEC CICS
                 HANDLE CONDITION
                   ERROR (NOMORE)
               END-EXEC
               EXEC CICS
                 READNEXT DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  IF TCBATCHCT  IS EQUAL TO  'CT'
                    MOVE '1' TO R1NOBRFWD
                    MOVE SPACES TO R2KEY
                    MOVE SPACES TO R2NEWTARIF
                    PERFORM ERR1079 THRU ERR1079-EXIT
                    GO TO SENDMAP2
                  END-IF
                  MOVE TCKEY TO R1KEY
                  GO TO BRFTAG2
               .
        BRFWD-EXIT.
               EXIT.
        BRFTAG1.
                  MOVE NULLS TO R1NOBRFWD
                  MOVE TCKEY TO R1KEY
               EXEC CICS
                 HANDLE CONDITION
                   ERROR (NOMORE)
               END-EXEC
               EXEC CICS
                 READNEXT DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
               .
        BRFTAG1-EXIT.
               EXIT.
        BRFTAG2.
                  IF TCBATCHID  IS NOT EQUAL TO  R1BATCHID
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                    PERFORM ERR1079 THRU ERR1079-EXIT
                    GO TO SENDMAP2
                  END-IF
                  MOVE TCOLDTARIF TO R2KEY
                  MOVE TCNEWTARIF TO R2NEWTARIF
                  GO TO SENDMAP2
               .
        BRFTAG2-EXIT.
               EXIT.
        BRBWD.
               EXEC CICS
                 RECEIVE MAP(E05AM2)
                   INTO(E05AM2I)
                   MAPSET(E05AM22)
                   NOHANDLE
               END-EXEC
                  PERFORM RESTOR2 THRU RESTOR2-EXIT
                  MOVE NULLS TO R1NOBRFWD
                  IF R1NOBRBWD  IS EQUAL TO  '1'
                    PERFORM ERR1078 THRU ERR1078-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF R1DEL  IS NOT EQUAL TO  '1'
                    GO TO BRBTAG1
                  END-IF
                  MOVE NULLS TO R1DEL
               EXEC CICS
                 HANDLE CONDITION
                   ERROR (BEGIN)
               END-EXEC
               EXEC CICS
                   READPREV DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  IF TCBATCHCT  IS EQUAL TO  'CT'
                    MOVE '1' TO R1NOBRBWD
                    MOVE SPACES TO R2KEY
                    MOVE SPACES TO R2NEWTARIF
                    PERFORM ERR1078 THRU ERR1078-EXIT
                    GO TO SENDMAP2
                  END-IF
                  MOVE TCKEY TO R1KEY
                  GO TO BRBTAG2
               .
        BRBWD-EXIT.
               EXIT.
        BRBTAG1.
                  MOVE NULLS TO R1NOBRBWD
                  MOVE TCKEY TO R1KEY
               EXEC CICS
                 HANDLE CONDITION
                   ERROR (BEGIN)
               END-EXEC
               EXEC CICS
                   READPREV DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
               .
        BRBTAG1-EXIT.
               EXIT.
        BRBTAG2.
                  IF TCBATCHID  IS NOT EQUAL TO  R1BATCHID
                    OR  TCBATCHCT  IS EQUAL TO  'CT'
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                    PERFORM ERR1078 THRU ERR1078-EXIT
                    GO TO SENDMAP2
                  END-IF
                  MOVE TCOLDTARIF TO R2KEY
                  MOVE TCNEWTARIF TO R2NEWTARIF
                  GO TO SENDMAP2
               .
        BRBTAG2-EXIT.
               EXIT.
        ADDREC.
               EXEC CICS
                 RECEIVE MAP(E05AM2)
                   INTO(E05AM2I)
                   MAPSET(E05AM22)
                   NOHANDLE
               END-EXEC
                  PERFORM RESTOR2 THRU RESTOR2-EXIT
                  MOVE SPACES TO R1DEL
                  MOVE R1HCKEY TO R1RECKEY
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOBATCH)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  MOVE TCBTYPE TO R2RECTYPE
                  IF TCCPROCESS  IS EQUAL TO  'B'
                    OR  TCCPROCESS  IS EQUAL TO  'U'
                    PERFORM ERR1031 THRU ERR1031-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF TCDPROCESS  IS EQUAL TO  'U'
                    PERFORM ERR1031 THRU ERR1031-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF R2KEY  IS EQUAL TO  NULLS
                    OR  R2KEY  IS EQUAL TO  SPACES
                    PERFORM MAPATTR1 THRU MAPATTR1-EXIT
                    PERFORM ERR1056 THRU ERR1056-EXIT
                    GO TO SENDMAP2
                  END-IF
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NRFOLD)
               END-EXEC
               EXEC CICS
                 READ DATASET('TARIF2')
                   INTO(TARIF2-RECORD)
                   RIDFLD(R2KEY)
                   KEYLENGTH(16)
                   LENGTH(TARIF2-LEN)
               END-EXEC
               MOVE TARIF2-LEN TO RWLENGTH
               MOVE TARIF2 TO RWRECORD
               MOVE R2KEY TO RWRID
                  IF R2NEWTARIF  IS EQUAL TO  NULLS
                    MOVE SPACES TO R2NEWTARIF
                  END-IF
                  IF R2NEWTARIF  IS NOT EQUAL TO  SPACES
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NRFNEW)
               END-EXEC
               EXEC CICS
                 READ DATASET('TARIF2')
                   INTO(TARIF2-RECORD)
                   RIDFLD(R2NEWTARIF)
                   KEYLENGTH(16)
                   LENGTH(TARIF2-LEN)
               END-EXEC
               MOVE TARIF2-LEN TO RWLENGTH
               MOVE TARIF2 TO RWRECORD
               MOVE R2NEWTARIF TO RWRID
                  END-IF
                  MOVE SPACES TO TCREC
                  MOVE R2KEY TO R1RECKEY
                  MOVE R1KEY TO TCKEY
                  MOVE R2RECTYPE TO TCRTYPE
                  MOVE R2NEWTARIF TO TCNEWTARIF
                  MOVE ' ' TO TCRSTATUS
                  MOVE R1INITIAL TO TCINITCHG
               EXEC CICS
                 HANDLE CONDITION
                   DUPREC(RUTINE)
               END-EXEC
               EXEC CICS
                 WRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   RIDFLD(TCKEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
                  PERFORM MSG1001 THRU MSG1001-EXIT
                  GO TO SENDMAP2
               .
        ADDREC-EXIT.
               EXIT.
        DELREC.
               EXEC CICS
                 RECEIVE MAP(E05AM2)
                   INTO(E05AM2I)
                   MAPSET(E05AM22)
                   NOHANDLE
               END-EXEC
                  PERFORM RESTOR2 THRU RESTOR2-EXIT
                  IF R1DEL  IS EQUAL TO  '1'
                    IF R2KEY  IS EQUAL TO  TCOLDTARIF
                    GO TO DELETEOK
                    END-IF
                  END-IF
                  MOVE R1HCKEY TO R1RECKEY
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOBATCH)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  IF TCCPROCESS  IS EQUAL TO  'B'
                    OR  TCCPROCESS  IS EQUAL TO  'U'
                    PERFORM ERR1031 THRU ERR1031-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF TCDPROCESS  IS EQUAL TO  'U'
                    PERFORM ERR1031 THRU ERR1031-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF R2KEY  IS EQUAL TO  NULLS
                    OR  R2KEY  IS EQUAL TO  SPACES
                    PERFORM ERR1002 THRU ERR1002-EXIT
                    GO TO SENDMAP2
                  END-IF
                  MOVE R2KEY TO R1RECKEY
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOTFOUND)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  PERFORM MSG1003 THRU MSG1003-EXIT
                  MOVE '1' TO R1DEL
                  GO TO SENDMAP2
               .
        DELREC-EXIT.
               EXIT.
        DELETEOK.
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
                   UPDATE
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
              EXEC CICS
                DELETE FILE(||PROD||)
                   RIDFLD(R1KEY)
              END-EXEC.
                  PERFORM MSG1004 THRU MSG1004-EXIT
                  MOVE SPACES TO TCOLDTARIF
                  GO TO SENDMAP2
               .
        DELETEOK-EXIT.
               EXIT.
        UPDREC.
               EXEC CICS
                 RECEIVE MAP(E05AM2)
                   INTO(E05AM2I)
                   MAPSET(E05AM22)
                   NOHANDLE
               END-EXEC
                  PERFORM RESTOR2 THRU RESTOR2-EXIT
                  MOVE NULLS TO R1DEL
                  MOVE R1HCKEY TO R1RECKEY
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOBATCH)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  IF TCCPROCESS  IS EQUAL TO  'B'
                    OR  TCCPROCESS  IS EQUAL TO  'U'
                    PERFORM ERR1031 THRU ERR1031-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF TCDPROCESS  IS EQUAL TO  'U'
                    PERFORM ERR1031 THRU ERR1031-EXIT
                    GO TO SENDMAP2
                  END-IF
                  MOVE R2KEY TO R1RECKEY
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOTFOUND)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  IF TCOLDTARIF  IS EQUAL TO  SPACES
                    OR  TCOLDTARIF  IS EQUAL TO  NULLS
                    PERFORM ERR1021 THRU ERR1021-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF R2KEY  IS NOT EQUAL TO  TCOLDTARIF
                    PERFORM ERR1023 THRU ERR1023-EXIT
                    MOVE TCOLDTARIF TO R2KEY
                    PERFORM MAPATTR1 THRU MAPATTR1-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF TCOLDTARIF  IS EQUAL TO  SPACES
                    PERFORM NOTFOUND THRU NOTFOUND-EXIT
                  END-IF
                  IF R2NEWTARIF  IS EQUAL TO  NULLS
                    MOVE SPACES TO R2NEWTARIF
                  END-IF
                  IF R2NEWTARIF  IS EQUAL TO  TCNEWTARIF
                    PERFORM ERR1009 THRU ERR1009-EXIT
                    PERFORM MAPATTR2 THRU MAPATTR2-EXIT
                    GO TO SENDMAP2
                  END-IF
                  IF R2NEWTARIF  IS NOT EQUAL TO  SPACES
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NRFNEW)
               END-EXEC
               EXEC CICS
                 READ DATASET('TARIF2')
                   INTO(TARIF2-RECORD)
                   RIDFLD(R2NEWTARIF)
                   KEYLENGTH(16)
                   LENGTH(TARIF2-LEN)
               END-EXEC
               MOVE TARIF2-LEN TO RWLENGTH
               MOVE TARIF2 TO RWRECORD
               MOVE R2NEWTARIF TO RWRID
                  END-IF
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R2NEWTARIF)
                   KEYLENGTH(16)
                   LENGTH(TRECON-LEN)
                   UPDATE
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R2NEWTARIF TO RWRID
                  MOVE R2NEWTARIF TO TCNEWTARIF
               EXEC CICS
                 REWRITE DATASET('TRECON')
                   FROM(TRECON-RECORD)
                   LENGTH(TRECON-LEN)
               END-EXEC
                  PERFORM MSG1002 THRU MSG1002-EXIT
                  GO TO SENDMAP2
               .
        UPDREC-EXIT.
               EXIT.
        SUBRTN.
      *  ********************************
               .
        SUBRTN-EXIT.
               EXIT.
        RESTOR1.
                  MOVE DFHALL TO R1SELECTA
                  MOVE DFHALL TO R1INITIALA
                  MOVE DFHALL TO R1CPROCESSA
                  MOVE DFHALL TO R1DPROCESSA
                  EXIT PERFORM
               .
        RESTOR1-EXIT.
               EXIT.
        RESTOR2.
                  MOVE DFHALL TO R2KEYA
                  MOVE DFHALL TO R2NEWTARIFA
                  CONTINUE
               .
        RESTOR2-EXIT.
               EXIT.
        SIGNOFF.
      *  ** SIGN OFF ROUTINE **
                  MOVE SPACES TO RWABEND
                  GO TO CLEAR-ENDJOB
               .
        SIGNOFF-EXIT.
               EXIT.
        RETURN$.
      *  ** RETURN TO MAP1 FROM MAP2 **
               EXEC CICS
                 RECEIVE MAP(E05AM2)
                   INTO(E05AM2I)
                   MAPSET(E05AM22)
                   NOHANDLE
               END-EXEC
                  MOVE SPACES TO R1DEL
                  MOVE SPACES TO R1CPROCESS
                  MOVE SPACES TO R1DPROCESS
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM READFC THRU READFC-EXIT
                  GO TO SENDMAP1
               .
        RETURN$-EXIT.
               EXIT.
        READFC.
      *  ** GET THE FILE CONTROL REC **
                  MOVE 00 TO R1BATCHID
                  MOVE R1HCKEY TO R1RECKEY
               EXEC CICS
                 HANDLE CONDITION
                   NOTFND (NOHEADER)
               END-EXEC
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  CONTINUE
               .
        READFC-EXIT.
               EXIT.
        CLRKEY.
      *  ** CLEAR KEY DETECTED **
      *
                  IF X1TRANSTAT  IS NOT EQUAL TO  'T'
                    EXEC CICS
                      XCTL
                      PROGRAM(V2)
                    END-EXEC
                  END-IF
                  GO TO CLEAR-ENDJOB
               .
        CLRKEY-EXIT.
               EXIT.
        MAPATTR1.
                    MOVE -1 TO R2KEYL
                    MOVE DFHBMBRY TO R2KEYA
                  CONTINUE
               .
        MAPATTR1-EXIT.
               EXIT.
        MAPATTR2.
                    MOVE -1 TO R2NEWTARIFL
                    MOVE DFHBMBRY TO R2NEWTARIFA
                  CONTINUE
               .
        MAPATTR2-EXIT.
               EXIT.
        RTERTN.
      *  ** RUN TIME ERROR DETECTED **
                  IF EIBRCODE  IS EQUAL TO  '0C0000000000'
                    GO TO NOTOPEN
                  END-IF
                  IF EIBRCODE  IS EQUAL TO  '080000000000'
                    GO TO BROWSE
                  END-IF
               MOVE
                 'COMPUTER PROBLEM AT TERMINAL = ' EIBTRMID
               TO HOLD-MESSAGE
                  EXEC CICS
                    WRITEQ TD QUEUE('PRT1')
                    FROM(HOLD-MESSAGE)
                    LENGTH(HOLD-MESSAGE-LEN)
                  END-EXEC
               MOVE
               'PROGRAM  =  ' 1PROGID 'ABEND =  ' RWABEND
                    TO HOLD-MESSAGE
                  EXEC CICS
                    WRITEQ TD QUEUE('PRT1')
                    FROM(HOLD-MESSAGE)
                    LENGTH(HOLD-MESSAGE-LEN)
                  END-EXEC
               EXEC CICS
                 INQUIRE TERMINAL(EIBTRMID)
                   MAPNAME(RWCURMAP)
               END-EXEC
               MOVE
                 'MAP= ',RWCURMAP, 'EIBFN =  ',EIBFN  ,
               TO HOLD-MESSAGE
                  EXEC CICS
                    WRITEQ TD QUEUE('PRT1')
                    FROM(HOLD-MESSAGE)
                    LENGTH(HOLD-MESSAGE-LEN)
                  END-EXEC
               MOVE
               'EIBRCODE  =  ' EIBRCODE
                    TO HOLD-MESSAGE
                  EXEC CICS
                    WRITEQ TD QUEUE('PRT1')
                    FROM(HOLD-MESSAGE)
                    LENGTH(HOLD-MESSAGE-LEN)
                  END-EXEC
                  IF X1TRANSTAT  IS EQUAL TO  'T'
               MOVE
               ' '
                      TO HOLD-MESSAGE
                    EXEC CICS
                      WRITEQ TD QUEUE('PRT1')
                      FROM(HOLD-MESSAGE)
                      LENGTH(HOLD-MESSAGE-LEN)
                    END-EXEC
               MOVE
               ' SET OFF HANDLE RTE IN PROGRAM FOR FULL DIAGNOSTICS'
                      TO HOLD-MESSAGE
                    EXEC CICS
                      WRITEQ TD QUEUE('PRT1')
                      FROM(HOLD-MESSAGE)
                      LENGTH(HOLD-MESSAGE-LEN)
                    END-EXEC
                    MOVE SPACES TO RWABEND
                    GO TO CLEAR-ENDJOB
                ELSE
                    PERFORM ERR1015 THRU ERR1015-EXIT
                    GO TO MAPABEND
                  END-IF
               .
        RTERTN-EXIT.
               EXIT.
        MAPABEND.
      *  ** SEND COMPUTER PROBLEM ERROR *
                  EXEC CICS
                    SEND MAP(E05AM1)
                    FROM(E05AM1O)
                    MAPSET(E05AM11)
                    FREEKB
                    FRSET
                  END-EXEC
                  IF EIBAID<> 'F1'
                    GO TO MAPABEND
                  END-IF
                  MOVE SPACES TO RWABEND
                  GO TO CLEAR-ENDJOB
               .
        MAPABEND-EXIT.
               EXIT.
        NOHEADER.
      *  NO FILE CONTROL RECORD
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR2019 THRU ERR2019-EXIT
                  GO TO SENDMAP1
               .
        NOHEADER-EXIT.
               EXIT.
        NOBATCH.
      *  NO BATCH HEADER RECORD
                  PERFORM RESTOR1 THRU RESTOR1-EXIT
                  PERFORM ERR1046 THRU ERR1046-EXIT
                  GO TO SENDMAP1
               .
        NOBATCH-EXIT.
               EXIT.
        NRFNEW.
      *  NO NEW TARIFF NUMBER EXISTS
                  PERFORM ERR1056 THRU ERR1056-EXIT
                  PERFORM MAPATTR2 THRU MAPATTR2-EXIT
                  GO TO SENDMAP2
               .
        NRFNEW-EXIT.
               EXIT.
        NRFOLD.
      *  NO OLD TARIFF NUMBER EXISTS
                  PERFORM ERR1056 THRU ERR1056-EXIT
                  PERFORM MAPATTR1 THRU MAPATTR1-EXIT
                  GO TO SENDMAP2
               .
        NRFOLD-EXIT.
               EXIT.
        NOTFOUND.
      *  NO TRECON RECORD FOUND
                  PERFORM ERR1064 THRU ERR1064-EXIT
                  PERFORM RESTOR2 THRU RESTOR2-EXIT
                  GO TO SENDMAP2
               .
        NOTFOUND-EXIT.
               EXIT.
        DUPLIC.
      *  ** DUPLICATE RECORD IN FILE *
                  PERFORM ERR1022 THRU ERR1022-EXIT
                  GO TO SENDMAP2
               .
        DUPLIC-EXIT.
               EXIT.
        BEGIN.
      *  ** FIRST RECORD IN BATCH **
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  PERFORM ERR1078 THRU ERR1078-EXIT
                  MOVE NULLS TO RWABEND
                  GO TO SENDMAP2
               .
        BEGIN-EXIT.
               EXIT.
        NOMORE.
      *  ** LAST RECORD IN BATCH **
               EXEC CICS
                 READ DATASET('TRECON')
                   INTO(TRECON-RECORD)
                   RIDFLD(R1KEY)
                   KEYLENGTH(12)
                   LENGTH(TRECON-LEN)
               END-EXEC
               MOVE TRECON-LEN TO RWLENGTH
               MOVE TRECON TO RWRECORD
               MOVE R1KEY TO RWRID
                  PERFORM ERR1079 THRU ERR1079-EXIT
                  GO TO SENDMAP2
               .
        NOMORE-EXIT.
               EXIT.
        NOTOPEN.
              PERFORM ERR1025 THRU ERR1025-EXIT
                  MOVE NULLS TO RWABEND
                  GO TO SENDMAP1
               .
        NOTOPEN-EXIT.
               EXIT.
        BROWSE.
                  PERFORM ERR1031 THRU ERR1031-EXIT
                  MOVE NULLS TO RWABEND
               EXEC CICS
                 INQUIRE TERMINAL(EIBTRMID)
                   MAPNAME(RWCURMAP)
               END-EXEC
                  IF RWCURMAP  IS EQUAL TO  'E05AM1'
                    PERFORM RESTOR1 THRU RESTOR1-EXIT
                    GO TO SENDMAP1
                  END-IF
               EXEC CICS
                 INQUIRE TERMINAL(EIBTRMID)
                   MAPNAME(RWCURMAP)
               END-EXEC
                  IF RWCURMAP  IS EQUAL TO  'E05AM2'
                    PERFORM RESTOR2 THRU RESTOR2-EXIT
                    GO TO SENDMAP2
                  END-IF
               .
        BROWSE-EXIT.
               EXIT.
        ERRMSG.
      *  ** ERROR MESSAGE LITERALS **
        ERRMSG-EXIT.
               EXIT.
        ERR1001.
               MOVE
               '* * ERROR 1001 WRONG KEY PRESSED * *    '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1001-EXIT.
               EXIT.
        ERR1002.
               MOVE
               '* * ERROR 1002 REQUIRED DATA IS MISSING * *   '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1002-EXIT.
               EXIT.
        ERR1003.
               MOVE
               '* * ERROR 1003 FIRST RECORD IN FILE * *   '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1003-EXIT.
               EXIT.
        ERR1009.
               MOVE
               '* * ERROR 1009 NO FIELDS UPDATED * *    '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1009-EXIT.
               EXIT.
        ERR1011.
               MOVE
               '* * ERROR 1011 INVALID TARIFF NUMBER * *    '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1011-EXIT.
               EXIT.
        ERR1015.
               MOVE
               '* * ERROR 1015 COMPUTER PROBLEM - PLEASE SIGN OFF * * '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1015-EXIT.
               EXIT.
        ERR1018.
               MOVE
               '* * ERROR 1018 INVALID SELECTION * *     '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1018-EXIT.
               EXIT.
        ERR1021.
               MOVE
               '* * ERROR 1021 START BROWSE FIRST * *    '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1021-EXIT.
               EXIT.
        ERR1022.
               MOVE
               '* * ERROR 1022 RECORD ALREADY ON FILE * *   '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1022-EXIT.
               EXIT.
        ERR1023.
               MOVE
               '* * ERROR 1023 NO UPDATE ALLOWED FOR THIS RECORD * * '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1023-EXIT.
               EXIT.
        ERR1025.
               MOVE
               '* * ERROR 1025 APPLICATION NOT AVAILABLE * *    '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1025-EXIT.
               EXIT.
        ERR1030.
               MOVE
               '* * ERROR 1030 INITIALS NOT AUTHORIZED * *    '
               TO RWNOTICE
                  MOVE SPACES TO R1CPROCESS
                  MOVE SPACES TO R1DPROCESS
                  CONTINUE
               .
        ERR1030-EXIT.
               EXIT.
        ERR1031.
               MOVE
               '* * ERROR 1031 BROWSE ONLY ACTIVE * *    '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1031-EXIT.
               EXIT.
        ERR1046.
               MOVE
               '* * ERROR 1046 BATCH NOT ON FILE * *   '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1046-EXIT.
               EXIT.
        ERR1048.
               MOVE
               '* * ERROR 1048 NO ROOM FOR A NEW BATCH - CALL PROGRAMMI'
               TO RWNOTICE
                  CONTINUE
               .
        ERR1048-EXIT.
               EXIT.
        ERR1052.
               MOVE
               '* * ERROR 1052 DUPLICATE BATCH ENTERED * *    '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1052-EXIT.
               EXIT.
        ERR1056.
               MOVE
               '* * ERROR 1056 NOT IN TARIFF FILE * *   '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1056-EXIT.
               EXIT.
        ERR1064.
               MOVE
               '* * ERROR 1064 TARIFF # NOT IN RECONCILIATION FILE * * '
               TO RWNOTICE
                  CONTINUE
               .
 ***       ERR1064-EXIT.
               EXIT.
        ERR1078.
               MOVE
               '* * ERROR 1078 FIRST RECORD IN BATCH * *   '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1078-EXIT.
               EXIT.
        ERR1079.
               MOVE
               '* * ERROR 1079 LAST RECORD IN BATCH * *   '
               TO RWNOTICE
                  CONTINUE
               .
        ERR1079-EXIT.
               EXIT.
        ERR2019.
               MOVE
               '* * ERROR 2019 NO FILE CONTROL FOUND - CALL PROGRAMMING'
               TO RWNOTICE
                  CONTINUE
               .
        ERR2019-EXIT.
               EXIT.
        ERR2020.
               MOVE
               '* * ERROR 2020 NO MORE USER COPIES AVAILABLE * *  '
               TO RWNOTICE
                  CONTINUE
               .
        ERR2020-EXIT.
               EXIT.
        MSG1001.
               MOVE
               '* * MSG 1001 RECORD ADDED AS SHOWN * *   '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1001-EXIT.
               EXIT.
        MSG1002.
               MOVE
               '* * MSG 1002 RECORD UPDATED AS SHOWN * *   '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1002-EXIT.
               EXIT.
        MSG1003.
               MOVE
               '* * MSG 1003 PRESS PF6 AGAIN TO DELETE * *  '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1003-EXIT.
               EXIT.
        MSG1004.
               MOVE
               '* * MSG 1004 RECORD DELETED * *     '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1004-EXIT.
               EXIT.
        MSG1005.
               MOVE
               '* * MSG 1005 FILE UPDATED AS SHOWN * *   '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1005-EXIT.
               EXIT.
        MSG1009.
               MOVE
               '* * MSG 1009 BATCH ADDED AS SHOWN * *   '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1009-EXIT.
               EXIT.
        MSG1010.
               MOVE
               '* * MSG 1010 BATCH DELETED * *     '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1010-EXIT.
               EXIT.
        MSG1027.
               MOVE
               '* * MSG 1027 BATCH SHEDULED FOR UPDATE * *   '
               TO RWNOTICE
                  CONTINUE
               .+++++
        MSG1027-EXIT.
               EXIT.
        MSG1028.
               MOVE
               '* * MSG 1028 UPDATE STATUS HAS BEEN CANCELLED * *  '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1028-EXIT.
               EXIT.
        MSG1029.
               MOVE
               '* * MSG 1029 BATCH SCHEDULED FOR PRINTING * *   '
               TO RWNOTICE
                  CONTINUE
               .
        MSG1029-EXIT.
               EXIT.
        MSG1032.
               MOVE
               '* * MSG 1032 PRESS PF9 AGAIN TO DELETE * *  '
               TO RWNOTICE
                  CONTINUE
       DATE-ROUTINE.
              EXEC CICS ASKTIME
                  ABSTIME(ABSOLUTE-TIME)
              END-EXEC

              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  MMDDYY(RWLDATE) DATESEP('/')
              END-EXEC.
********************
              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  MMDDYYYY(RWLDATEY) DATESEP('/')
              END-EXEC.

              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  MMDDYYYY(RWDATE) DATESEP('/')
              END-EXEC.

              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  MMDDYY(RWDATEY) DATESEP('/')
              END-EXEC.

              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  YYMMDD(RWIROME)
              END-EXEC.

              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  YYYYDDD(RWJULC)
              END-EXEC.

              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  YYYYDDD(RWJULCD)
              END-EXEC.

              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  TIME(RWTIME)   TIMESEP('-')
              END-EXEC.

              EXEC CICS FORMATTIME
                  ABSTIME(ABSOLUTE-TIME)
                  TIME(RWTIMER)
              END-EXEC.

       DATE-ROUTINE-EXIT.
               EXIT.
       CLEAR-ENDJOB.
               EXEC CICS
                 SEND CONTROL ERASE FREEKB
               END-EXEC
               EXEC CICS
                 RETURN
               END-EXEC.
       CLEAR-ENDJOB-EXIT.
               EXIT.