Chapter 8
Section 17 - Passed
Area Processing
Areas passed to a program have
a starting point and a length. Both must be validated before the area
is used. How are they validated?
-
The length is compared
against a known value, not greater than zero.
-
The starting point is
validated by check against a known value such as the terminal identification
or transaction identification or other eye catcher.
-
The only exceptions to
these rules are:
-
Command Level Execute
Interface Block (EIB) and
-
the CICS CWA (Common
Work Area). The BIT Data Center will insure that the CWA is at least
1 byte long.
COBOL refers
to passed areas as LINKAGE SECTION areas and assembler refers
to them as DSECTs. Below are some examples of common situations the
programmer will experience.
8.17.1 Execute
Interface Block (EIB):
The EIB is automatically
generated at program start up for COBOL programs and generated by DFHEIENT macro
for assembler programs.
8.17.2 CICS
Common Work Area (CWA):
BIT Data Center is responsible
for supplying the byte to be tested to see if there is a requirement to link to
CICOMMEX. That is the first program of a transaction does not
have to issue EXEC CICS ASSIGN CWALEN(xxxx) command to
validate that the one byte field exists.
8.17.3 Common
Area:
The common area is a single
area that may be passed between programs and even from the last program of a
transaction to the first program of the next transaction. CICS supports
this feature with two fields:
-
EIBCALEN (Execution Interface Block Common Area Length)
contains the length of the field. Programmers must check the length
before using the field.
-
DFHEICAP (Execution Interface Common Area Pointer) is used
by assembler programs to address the common area. CICS provides
addressing to COBOL programs that have the first 01 level in the LINKAGE
SECTION named DFHCOMMAREA. After addressing the
area remember to test the area with known data.
8.17.4 Transaction
Work Area (TWA):
At transaction start
up CICS needs to get an area to anchor a
transaction (Task Control Area, TCA) and to
communicate with other IBM CICS programs (i.e. file control, storage control,
program control, terminal control . . .). One of the fields in the
processing control table (PCT - transaction table) entry is the option to add a
work area for the client applications programs to use. By specifying this
area, CICS will increase the storage it gets for the
TCA reducing the number of getmains required. Any of the programs
of the current transaction can pass information to the next program or to
CICS in this area and the client program doesn't
have to get additional storage. The first program of a transaction
needs to check the length of the TWA. All programs that need the TWA will
need to address this area only once, it doesn't move. See the sample
programs below for examples.
8.17.5 Terminal
Control Table Terminal Entry User Area (TCTTEUA):
When
a terminal is installed in CICS there is an option to associate storage with the
definition. This storage remains in CICS as long as the terminal
definition remains in CICS. BIT Data Center attempts to associate 56 bytes
of storage to all terminals and printer definitions. See the "Section
8 - Scratch Pad Area (TCTTEUA)" for details. Note
that the first 30 bytes are reserved for the BIT Data Center.
8.17.6 CICS
Getmained Storage:
Many CICS
command level commands use the SET option to instruct CICS to get storage.
In these cases you are also required to specify a LENGTH field so that CICS can
tell the program how long the storage is. It
is your responsibility to FREEMAIN these storage areas when they are no
longer needed. The only exception is that CICS frees the terminal input
area with the first RECEIVE or RECEIVE MAP command. Therefore,
you aren't allowed to RECEIVE MAP for the
command line and then RECEIVE MAP using the
desired map without causing CICS to issue an I-O request back to the terminal. Consider storing the mapset name and map name in
the common area passed between transactions so the correct
map is used.
8.17.7 User
GetMained Storage:
When
areas in working-storage section aren't initialized (no value clauses or values
of space or low-values) move these descriptions
to the linkage section and get the storage at program start up. This makes
your program smaller and allows CICS to keep more programs in memory. If
the program is already in storage, then the file I-O to locate and load the
program and address resolution aren't required. Good examples of these
types of storage are mapset and file work areas. It
is your responsibility to FREEMAIN these storage areas when they are no
longer needed.
8.17.8 SAMPLE
Mapset:
This mapset is defined simply as a reference for the following program
samples.
*---+---10----+---20----+---30----+---40----+---50----+---60----+---70--
PRINT NOGEN
C
aa00801 DFHMSD TYPE=MAP,
C
LANG=ASM,
C
MODE=INOUT,TERM=ALL,TI0APFX=YES,CTRL=(FREEKB)
map01 DFHMDI SIZE=(24,80),JUSTIFY=(LEFT,FIRST)
maptran DFHMDF POS=(01,01),LENGTH=04,ATTRIB=(PROT,NORM)
mapcmd DFHMDF POS=(01,06),LENGTH=03,ATTRIB=(UNPROT,NORM,IC,FRSET),
C
INITIAL='HLP'
...
mapmsg DFHMDF POS=(24,01),LENGTH=79,ATTRIB=PROT
...
scrn1 DFHMDI SIZE=(24,80),JUSTIFY=(LEFT,FIRST)
sc1tran DFHMDF ...
...
scrn2 DFHMDI SIZE=(24,80),JUSTIFY=(LEFT,FIRST)
sc2tran DFHMDF ...
...
hlpscrn DFHMDI SIZE=(24,80),JUSTIFY=(LEFT,FIRST)
hlptran DFHMDF ...
...
DFHMSD TYPE=FINAL
END
8.17.9 SAMPLE
First COBOL Program in a Transaction:
The
function of the first program of a transaction is to
determine if Technical Services requires a
link to the CICOMMEX, to validate the TWA size if
used in the system, and to then perform initial
operations such as mapping in the response from the last screen, initial I-O, or
even additional security checking. It is possible that initial program
might even complete the transaction.
*-10----+---20----+---30----+---40----+---50----+---60----+---70--
IDENTIFICATION DIVISION.
PROGRAM-ID. aa009010.
AUTHOR. john j jones.
******************************************************************
* aa009010 initializes processing on an inventory system.
*
* XCTLs to aa009020 to do file updates and adds.
*
* XCTLs to aa009030 to do alternate key access.
*
******************************************************************
*10/18/00 * updated by eugene collett
*
* * changed to cobol/mvs.
*
******************************************************************
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*-10----+---20----+---30----+---40----+---50----+---60----+---70--
77 my-len
PIC S9(4) COMP SYNC.
01 xctl-program.
05 FILLER
PIC X(5) VALUE 'aa009'.
05 xct1-pgmid
PIC XX
VALUE '02'.
05 FILLER
PIC X VALUE '0'.
01 my-error-save.
05 my-eibfn
PIC XX.
05 my-eibrcode
PIC XX.
COPY DFHAID
LINKAGE SECTION.
01 DFHCOMMAREA.
05 ca-id
PIC X(4).
05 ca-map-area
POINTER.
05 ca-map-area2 redefines ca-map-area PIC S9(8) COMP SYNC.
05 ca-mapset
PIC X(8).
05 ca-map
PIC X(8).
05 ca-rec-key
PIC X(16).
01 cwa-byte
PIC X.
01 my-twa
PIC X(8).
COPY aa00801 SUPRESS.
PROCEDURE DIVISION.
* Note: Common area and
MAP area are required by error routines.
EXEC CICS ADDRESS CWA(ADDRESS OF cwa-byte) END-EXEC.
IF cwa-byte = HIGH-VALUE
EXEC CICS LINK PROGRAM('CICOMMEX') NOHANDLE END-EXEC.
* DFHCLEAR and DFHNULL are found in copy book DFHAID.
* Short reads are used here as exits because data is not sent and
* mapin will fail.
IF EIBAID = DFHCLEAR OR DFHPA1 OR DFHPA2 OR DFHPA3
GO TO do-return.
EXEC CICS GETMAIN SET(ADDRESS OF aa00801)
LENGTH(1000) INITIMG(DFHNULL) END-EXEC.
* Just because the common area is present doesn't mean it is
* large enough or the common area is for this program.
IF EIBCALEN NOT = 40 OR ca-id NOT = EIBTRMID
EXEC CICS GETMAIN SET(ADDRESS OF DFHCOMMAREA)
LENGTH(40) END-EXEC
MOVE EIBTRMID TO ca-id
MOVE EIBTRNID TO maptrano
MOVE 'aa00801' TO ca-mapset
MOVE 'map01' TO ca-map
MOVE SPACES TO ca-rec-key
* You could process unformatted screen here.
GO TO send-map.
SET ca-map-area TO ADDRESS OF aa00801.
* Note: Now error routines
will work.
* If TWA is needed, check it before required.
EXEC CICS ASSIGN TWA(my-len) NOHANDLE END-EXEC.
IF EIBRESP NOT = DFHRESP(NORMAL)
GO TO TS017000.
IF my-len NOT = 8
GO TO send-twa-msg.
* If TWA is needed in this program, address it.
EXEC CICS ADDRESS TWA(ADDRESS OF my-twa) NOHANDLE END-EXEC.
IF EIBRESP NOT = DFHRESP(NORMAL)
GO TO TS017000.
MOVE 1000 to my-len.
EXEC CICS RECEIVE MAP(ca-map) MAPSET(ca-mapset)
INTO(aa00801) LENGTH(my-len) NOHANDLE END-EXEC.
IF EIBRESP = DFHRESP(NORMAL) OR EIBRESP = DFHRESP(EOC)
CONTINUE
ELSE
GO TO TS017000.
IF mapcmdi = 'QUE' OR 'DIS' OR 'DSP'
GO TO display.
IF mapcmdi = 'ADD' OR 'UPD'
'CHG'
IF mapkeyi = ca-rec-key and
(ca-map = 'SCRN1' or ca-map = 'SCRN2')
GO TO do-xctl
ELSE
GO TO display.
IF mapcmdi = 'ALT'
MOVE '10' TO xctl-pgmid
GO TO do-xctl.
IF mapcmdi = 'HLP'
MOVE 'HLPSCRN' TO camap
GO TO send-map.
MOVE 'Invalid command given.
DISplay assumed.' TO mapmsgo.
MOVE 'DIS' TO mapcmdi.
display.
* Validate key, read the record, and move fields to map.
* (you might want to freemain current map and getmain a new mapset)
MOVE 'SCRN1' to ca-map.
send-map.
EXEC CICS SEND MAP(ca-map) MAPSET(ca-mapset)
ERASE FREEKB NOHANDLE END-EXEC.
IF EIBRESP = DFHRESP(NORMAL)
MOVE ZERO TO ca-map-area2
EXEC CICS RETURN TRANSID(EIBTRNID)
COMMAREA(DFHCOMMAREA) END-EXEC.
*****************************************************************
* Since the MAPSET and MAP are used in error processing done by *
* TS017000 we can not pass control to TS017000 or we create a
*
* loop.
*
*****************************************************************
EXEC CICS SEND
FROM('Error using mapset aa00801.
Contact…')
LENGTH(??) ERASE END-EXEC.
do-return.
* This command is shared with CLEAR and the above message.
EXEC CICS RETURN END-EXEC.
do-xctl.
* Sample of XCTLing to a subsequent program.
EXEC CICS XCTL PROGRAM(xctl-program)
COMMAREA(DFHCOMMAREA) NOHANDLE END-EXEC.
* Optional message:
* IF EIBRESP = DFHRESP(PGMIDERR)
* MOVE 'PGMIDERR transferring control to' mapmsgo
* MOVE xctl-pgmid TO mapmsgo(33:8)
* GO TO send-map.
do-ts017000.
* Sample of linking to a subsequent program for standardized processing.
MOVE EIBFN TO my-eibfn.
MOVE EIBRCODE TO my-eibrcode.
MOVE my-error-save TO mapmsgo.
EXEC CICS LINK PROGRAM('TS017000')
COMMAREA(mapmsgo) LENGTH(64) NOHANDLE END-EXEC.
IF EIBRESP = DFHRESP(NORMAL)
GO TO send-map.
MOVE 'ERROR LINKING TO TS017000.
CONTACT …' TO mapmsgo.
GO TO send-map.
8.17.10 SAMPLE
Subsequent COBOL Program:
When
the first program can not complete a transaction because of program size
restrictions or needs to perform a common routine, then the
first program may XCTL or LINK to a subsequent program. XCTL is commonly
used to perform functions for a transaction. LINK is commonly used to
perform a common routine. It is the responsibility of the subsequent
program to validate any passed areas and act on them. Below is a sample of
subsequent COBOL program.
*-10----+---20----+---30----+---40----+---50----+---60----+---70--
IDENTIFICATION DIVISION.
PROGRAM-ID. aa009020.
AUTHOR. john j jones.
*****************************************************************
* aa009010 adds and updates records on the inventory file.
*
*****************************************************************
*10/18/00 * updated by eugene collett
*
* * changed to cobol/mvs.
*
*****************************************************************
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*-10----+---20----+---30----+---40----+---50----+---60----+---70--
77 my-len
PIC S9(4) COMP SYNC.
01 my-error-save.
05 my-eibfn
PIC XX.
05 my-eibrcode
PIC XX.
LINKAGE SECTION.
01 DFHCOMMAREA.
05 ca-id
PIC X(4).
05 ca-map-area
POINTER.
05 ca-map-area2 redefines ca-map-area PIC S9(8) COMP SYNC.
05 ca-mapset
PIC X(8).
05 ca-map
PIC X(8).
05 ca-rec-key
PIC X(16).
COPY aa00801 SUPRESS.
PROCEDURE DIVISION.
* Note: Common area and
MAP area are required by error routines.
* Just because the common area is present doesn't mean it is
* large enough or the common area is for this program.
IF EIBCALEN NOT = 40 OR ca-id NOT = EIBTRMID or
ca-map-area2 = ZERO
EXEC CICS SEND
FROM('Invalid common area passed to aa009020')
LENGTH(38) ERASE END-EXEC
GO TO do-return.
SET ADDRESS OF aa00801 TO ca-map-area.
* Note: Now error routines
will work.
* If TWA is needed in this program, address it.
EXEC CICS ADDRESS TWA(ADDRESS OF my-twa) NOHANDLE END-EXEC.
IF EIBRESP NOT = DFHRESP(NORMAL)
GO TO TS017000.
* Edit the screen and update the record.
* (you might want to freemain current map area and getmain a new
* one)
MOVE 'SCRN1' to ca-map.
MOVE 'Update completed normally.' TO mapmsgo.
send-map.
EXEC CICS SEND MAP(ca-map) MAPSET(ca-mapset)
ERASE FREEKB NOHANDLE END-EXEC.
IF EIBRESP = DFHRESP(NORMAL)
MOVE ZERO TO ca-map-area2
EXEC CICS RETURN TRANSID(EIBTRNID)
COMMAREA(DFHCOMMAREA) END-EXEC.
*****************************************************************
* Since the MAPSET and MAP are used in error processing done by *
* TS017000 we can not pass control to TS017000 or we create a
*
* loop.
*
*****************************************************************
EXEC CICS SEND
FROM('Error using mapset aa00801.
Contact…')
LENGTH(…) ERASE END-EXEC.
do-return.
EXEC CICS RETURN END-EXEC.
do-ts017000.
* Sample of linking to a subsequent program for standardized
* processing.
MOVE EIBFN TO my-eibfn.
MOVE EIBRCODE TO my-eibrcode.
MOVE my-error-save TO mapmsgo.
EXEC CICS LINK PROGRAM('TS017000')
COMMAREA(mapsmgo) LENGTH(64) NOHANDLE END-EXEC.
IF EIBRESP = DFHRESP(NORMAL)
GO TO send-map.
MOVE 'ERROR LINKING TO TS017000.
CONTACT …' TO mapmsgo.
GO TO send-map.
8.17.11 SAMPLE
First Assembler Program in a Transaction:
See "Sample First COBOL Program" for tasks that need to be
performed. Below is a sample of a first assembler program.
*************************************************************************
* PROGRAM-ID. aa009010.
*
* COMPILED-BY. john j jones.
*
* DATE-WRITTEN. Aug 7, 1997.
*
* DATE-COMPILED. (See code following CSECT).
*
* REMARKS.
*
*
aa009010 initializes processing on an inventory system.
*
* XCTLs to aa009020 to do file updates and adds.
*
* XCTLs to aa009030 to do alternate key access.
*
***********************************************************************
*10/18/00 * updated by eugene collett
*
* *
changed to 31 bit addressing mode.
*
***********************************************************************
TITLE 'aa009010CI - Inventory System primary program'
PRINT NOGEN
COPY
EQUREG
* REGISTER ASIGNMENTS
*---+---10----+---20----+---30----+---40----+---50----+---60----+---70--
databar EQU R13
DATA AREA REGISTER.
pgmbar1 EQU R12
PROGRAM BASE REGISTER #1.
pgmbar2 EQU R11
PROGRAM BASE REGISTER #2.
pgmbar3 EQU R10
PROGRAM BASE REGISTER #3.
linkreg EQU R9
ROUTINE LINKAGE REGISTER.
mapbar EQU R8
ADDRESS OF MAPS.
eibbar EQU R7
EXECUTE INTERFACE BASE REGISTER.
commbar EQU R6
COMMON AREA BASE REGISTER.
SPACE 3
commarea DSECT ,
SAME AS DFHCOMMAREA –
caid DS CL4
COMMON AREA IDENTIFICATION
camapa DS F
MAP ADDRESS
camapset DS CL8
MAPSET NAME
camap DS CL8
MAP NAME
careckey DS CL16
RECORD KEY
calen EQU *-commarea
LENGTH OF COMMON AREA
SPACE 3
mapstrg DSECT ,
MAP STORAGE AREA -
PRINT OFF
COPY aa00801
COPY
aa00801 INVENTORY SCREENS.
PRINT ON
SPACE 3
DFHEISTG
DFHEISTG DSECT ,
CICS DATA STORAGE –
mylen DS H
MY LENGTH FIELD
myxctl DS CL8
MY XCTL PROGRAM
EJECT
*---+---10----+---20----+---30----+---40----+---50----+---60----+---70--
aa009010 DFHEIENT CODEREG=(pgmbar1,pgmbar2,pgmbar3),
*
DATAREG=databar,EIBREG=eibbar
aa009010 RMODE ANY
aa009010 AMODE 31
B
START
DC
C' aa009010 WAS ASSEMBLED ON &SYSDATE AT &SYSTIME'
START DS 0H
* Note: Common area
and MAP area are required by error routines.
EXEC
CICS ADDRESS CWA(R2)
CLI
0(R2),X'FF'
LINK TO CICOMMEX?
BNE
testaid
NO...GO TEST EIBAID.
EXEC
CICS LINK PROGRAM('CICOMMEX') NOHANDLE
* DFHCLEAR, DFHPA1… are known by the CICS preprocessor.
* Short reads are used here as exits because data is not sent and
* mapin will fail.
testaid CLI EIBAID,DFHCLEAR WAS CLEAR KEY PRESSED?
BE
return
YES..GO RETURN TO CICS.
CLI
EIBAID,DFHPA1 WAS PA1 KEY PRESSED?
BE
return
YES..GO RETURN TO CICS.
CLI
EIBAID,DFHPA2 WAS PA2 KEY PRESSED?
BE
return
YES..GO RETURN TO CICS.
CLI
EIBAID,DFHPA3 WAS PA3 KEY PRESSED?
BE
return
YES..GO RETURN TO CICS.
L
commbar,DFHEICAP ADDRESS COMMON AREA.
USING commarea,combar
EXEC CICS GETMAIN SET(mapbar), *
LENGTH(1000) INITIMG(=X'00')
USING mapstrg,mapbar
* Just because the common area is present doesn't mean it is
* large enough or the common area is for this program.
* Note: Common area is required by error routines.
CLC
EIBCALEN,=AL2(calen) IS COMMAREA LENGTH CORRECT?
BNE
getcomm
NO...GO GET COMMAREA.
CLC
caid,EIBTRMID IS COMMAREA FOR THIS TERM-ID?
BE
savemap
YES...GO TO MAP SCREEN.
getcomm EXEC CICS GETMAIN SET(commbar),LENGTH(calen)
MVC
caid,EIBTRMID INITIALIZE COMMAREA.
MVC
camapset,=CL8'aa00801'
MVC
camap,=CL8'map01'
MVI
careckey,x'40'
MVC
careckey+1(L'careckey-1),careckey
MVC
maptrano,EIBTRNID INITIALIZE MAP.
* You could process unformatted screen here.
B
sendmap
GO SEND THE MAP.
savemap ST mapbar,camapa
PASS MAP ADDRESS.
* Note: Now error routines
will work.
* If TWA is needed, check it before required.
EXEC
CICS ASSIGN TWA(mylen) NOHANDLE
CLC
EIBRESP,DFHRESP(NORMAL)
BNE
ts017000
ERROR..GO TO ERROR ROUTINE.
CLC
mylen,=H'8'
IS TWA LENGTH 8?
BNE
send-twa-msg NO...GO SEND TWA ERROR MESSAGE.
* If TWA is needed in this program, address it.
EXEC
CICS ADDRESS TWA(twabar) NOHANDLE
CLC
EIBRESP,DFHRESP(NORMAL)
BNE
ts017000
ERROR..GO TO ERROR ROUTINE.
mapscrn MVC mylen,=H'1000'
SET MAP AREA LENGTH.
EXEC
CICS RECEIVE MAP(camap) MAPSET(camapset), *
LENGTH(mylen) NOHANDLE
CLC
EIBRESP,DFHRESP(EOC) END OF CHAIN?
BE
editcmd
YES..GO EDIT THE COMMAND.
CLC
EIBRESP,DFHRESP(NORMAL)
BNE
ts017000
NO...GO PROCESS ERROR.
editcmd MVC myxctl,=CL8'aa009020' SET UP XCTL PROGRAM
CLC
mapcmdi,=C'QUE' IS IT A DISPLAY COMMAND?
BE
display
YES..GO DISPLAY RECORD.
CLC
mapcmdi,=C'DIS'
BE
display
CLC
mapcmdi,=C'DSP'
BE
display
CLC
mapcmdi,=C'ADD' IS IT AN ADD COMMAND?
BE
ckkey
YES..GO CHECK THE KEY.
CLC
mapcmdi,=C'UPD' IS IT AN UPDATE COMMAND?
BE
dokey
CLC
mapcmdi,=C'CHG'
BNE
ckalt
NO...GO CHECK ALTERNATE KEY.
ckkey CLC mapkeyi,careckey
WAS THE KEY CHANGED?
BNE
display
NO...GO DISPLAY RECORD.
CLC
camap,=CL8'SCRN1' IS IT SCRN1 or SCRN2?
BE
doxctl
CLC
camap,=CL8'SCRN2'
BE
doxctl
YES..GO XCTL TO aa009020.
B
display
NO...GO DISPLAY RECORD.
ckalt CLC mapcmdi,=C'ALT'
IS IT AN ALTERNATE COMMAND?
BNE
ckhelp
NO...GO CHECK HELP.
MVC
myxctl+5(2),=C'10' CHANGE TO aa009100.
B
doxctl
GO XCTL TO aa009100.
ckhelp CLC mapcmdi,=C'HLP'
IS HELP SCREEN REQUESTED?
BNE
invcmd
NO...GO TO INVALID COMMAND.
MVC
camap,=CL8'HLPSCRN' DISPLAY HELP SCREEN.
B
sendmap
invcmd MVC mapmsgo(40),=C'Invalid command given.
DISplay assumed.'
MVC
mapcmdi,=C'DIS'
display DS 0H
Process display request -
* Validate key, read the record, and move fields to map.
* (you might want to freemain current map and getmain a new mapset)
MVC
camap,=CL8'SCRN1' USE SCRN1 MAP.
sendmap DS 0H
SEND MAP -
EXEC
CICS SEND MAP(camap) MAPSET(camapset),
*
ERASE FREEKB NOHANDLE
CLC
EIBRESP,DFHRESP(NORMAL)
BNE
maperror
XC
camapa,camapa LOW-VALUE MAP AREA ADDRESS.
EXEC
CICS RETURN TRANSID(EIBTRNID),
*
COMMAREA(commarea) LENGTH(calen)
maperror DS 0H
SEND MAP ERROR ROUTINE -
***********************************************************************
* Since the MAPSET and MAP are used in error processing done by *
* TS017000 we can not pass control to TS017000 or we create a loop. *
***********************************************************************
EXEC
CICS SEND,
SEND ERROR MESSAGE *
FROM(=CL60'Error using mapset aa00801. Contact...'), *
LENGTH(60) ERASE
return DS 0H
RETURN CONTROL TO CICS -
* This command is shared with CLEAR and the above message.
EXEC
CICS RETURN
doxctl DS 0H
TRANSFER CONTROL -
* Sample of XCTLing to a subsequent program.
EXEC
CICS XCTL PROGRAM(myxctl),
*
COMMAREA(commarea) LENGTH(calen) NOHANDLE
* Optional message:
CLC
EIBRESP,DFHRESP(PGMIDERR)
BNE
ts017000
NO...GO PROCESS ERROR.
MVC
mapmsgo,=CL79'PGMIDERR transferring control to'
MVC
mapmsgo+33(8),myxctl
B
sendmap
ts017000 DS 0H
PROCESS ERROR -
MVI
mapmsgo,X'40' BLANK OUT MESSAGE LINE.
MVC
mapmsgo+1(L'mapmsgo-1),mapmsgo
MVC
mapmsgo(2),EIBFN MOVE FUNCTION CODE TO MSG AREA.
MVC
mapmsgo+2(2),EIBRCODE
EXEC
CICS LINK PROGRAM('TS017000'),
*
COMMAREA(mapmsgo) LENGTH(64) NOHANDLE
CLC
EIBRESP,DFHRESP(NORMAL)
BE
sendmap
GO SEND ERROR MESSAGE.
MVC
mapmsgo,=CL79'ERROR LINKING TO TS017000. CONTACT...'
B
sendmap
GO SEND ERROR MESSAGE.
END
aa009010
8.17.12 SAMPLE
Subsequent Assembler Program:>
See
"Sample Subsequent COBOL Program" for reasons they are created and
tasks that need to be performed.
*---+---10----+---20----+---30----+---40----+---50----+---60----+---70--
************************************************************************
* PROGRAM-ID. aa009020. *
* COMPILED-BY. john j jones. *
* DATE-WRITTEN. Aug 7, 1997.
*
* DATE-COMPILED. (See code following CSECT). *
* REMARKS.
*
* aa00902 adds and updates records on the inventory file. *
************************************************************************
*10/18/00 * updated by eugene collett *
* *
changed to 31 bit addressing mode.
*
************************************************************************
TITLE 'aa009020 - Inventory System update program'
PRINT NOGEN
COPY
EQUREG
* REGISTER ASIGNMENTS
databar EQU R13
DATA AREA REGISTER.
pgmbar1 EQU R12
PROGRAM BASE REGISTER #1.
pgmbar2 EQU R11
PROGRAM BASE REGISTER #2.
pgmbar3 EQU R10
PROGRAM BASE REGISTER #3.
linkreg EQU R9
ROUTINE LINKAGE REGISTER.
mapbar EQU R8
ADDRESS OF MAPS.
eibbar EQU R7
EXECUTE INTERFACE BASE REG
commbar EQU R6
COMMON AREA BASE REGISTER
SPACE 3
commarea DSECT ,
SAME AS DFHCOMMAREA -
caid DS
CL4
COMMAREA IDENTIFICATION
camapa DS
F
MAP ADDRESS
camapset DS CL8
MAPSET NAME
camap DS
CL8
MAP NAME
careckey DS CL16
RECORD KEY
calen EQU
*-commarea LENGTH OF COMMON AREA
SPACE 3
mapstrg DSECT ,
MAP STORAGE AREA -
PRINT OFF
COPY aa00801
COPY
aa00801
INVENTORY SCREENS.
PRINT ON
SPACE 3
DFHEISTG
DFHEISTG DSECT ,
CICS DATA STORAGE –
mylen DS H
MY LENGTH FIELD
EJECT
*---+---10----+---20----+---30----+---40----+---50----+---60----+---70--
aa009020 DFHEIENT CODEREG=(pgmbar1,pgmbar2,pgmbar3), *
DATAREG=databar,EIBREG=eibbar
aa009020 RMODE ANY
aa009020 AMODE 31
B
START
DC
C' aa009020 WAS ASSEMBLED ON &SYSDATE AT &SYSTIME'
START DS 0H
* Note: Common area
and MAP area are required by error routines.
L
commbar,DFHEICAP ADDRESS COMMON AREA.
USING commarea,combar
* Just because the common area is present doesn't mean it is
* large enough or the common area is for this program.
CLC
EIBCALEN,=AL2(calen) IS COMMAREA LENGTH CORRECT?
BNE
commerr NO...COMMAREA ERROR.
CLC
caid,EIBTRMID IS COMMAREA FOR THIS TERM-ID?
BNE
commerr NO...COMMAREA ERROR.
OC
camapa,camapa IS MAP AREA ADDRESS ZERO?
BNZ
gettwa NO...GO TO MAP SCREEN.
commerr EXEC CICS SEND,
SEND ERROR MESSAGE *
FROM(=CL38'Invalid common area passed to aa009020'), *
LENGTH(38) ERASE
B
return RETURN CONTROL TO CICS.
gettwa DS
0H
ADDRESS TWA -
L
mapbar,camapa
ADDRESS MAP AREA.
USING mapstrg,mapbar
* Note: Now error routines
will work.
* If TWA needed in this program, address it.
EXEC
CICS ADDRESS TWA(twabar) NOHANDLE
CLC
EIBRESP,DFHRESP(NORMAL)
BNE
ts017000
ERROR..GO TO ERROR ROUTINE.
* Edit the screen, update the record.
* (you might want to freemain current map and getmain a new mapset)
MVC
camap,=CL8'SCRN1' USE SCRN1 MAP.
MVC
mapmsgo(27),=C27'Update completed normally.'
sendmap DS
0H
SEND MAP -
EXEC
CICS SEND MAP(camap) MAPSET(camapset),
*
ERASE FREEKB NOHANDLE
CLC
EIBRESP,DFHRESP(NORMAL)
BNE
maperror
XC
camapa,camapa LOW-VALUE MAP AREA ADDRESS.
EXEC
CICS RETURN TRANSID(EIBTRNID),
*
COMMAREA(commarea) LENGTH(calen)
maperror DS 0H
SEND MAP ERROR ROUTINE -
***********************************************************************
* Since the MAPSET and MAP are used in error processing done by *
* TS017000 we can not pass control to TS017000 or we create a loop. *
***********************************************************************
EXEC
CICS SEND, SEND ERROR MESSAGE *
FROM(=CL60'Error using mapset aa00801. Contact...'), *
LENGTH(60) ERASE
return EXEC CICS RETURN
ts017000 DS 0H
PROCESS ERROR -
MVI
mapmsgo,X'40' BLANK OUT MESSAGE LINE.
MVC
mapmsgo+1(L'mapmsgo-1),mapmsgo
MVC
mapmsgo(2),EIBFN MOVE FUNCTION CODE TO MESSAGE AREA.
MVC
mapmsgo+2(2),EIBRCODE
EXEC
CICS LINK PROGRAM('TS017000'),
*
COMMAREA(mapmsgo) LENGTH(64) NOHANDLE
CLC
EIBRESP,DFHRESP(NORMAL)
BE
sendmap GO SEND ERROR MESSAGE.
MVC
mapmsgo,=CL79'ERROR LINKING TO TS017000. CONTACT...'
B
sendmap GO SEND ERROR MESSAGE.
END
aa009020
