APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

1/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

2/256

REFERENCES
1.MURACHs CICS for the COBOL programmer.
2.IBM manuals from the Book Manager CICS bookshelf.
3.The sample application used in the LAB exercises
is from the above MURACH book.
4.Some additional programs have been written to
illustrate advanced concepts.
5.Students are requested to refer to the MURACH
book as well as IBM manuals on the CICS product
for more details.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

CONTENTS
Start
1. Introduction
2. Introduction to CICS Programming
3. How to create a BMS mapset
4. How to code a CICS program
5. How to use Temporary Storage
6. Additional Programming Techniques
7. Introduction to debug a ASRA abend
8. How to process files sequentially
9. How to use vsam alternate indexes
10. Other file processing feature
11. Advanced Program control
12. Manipulating Dynamic Storage
13. Advanced BMS
14. Advanced File Control
15. Temporary Storage Control
16. Transient Data Control
17. Interval Control
18. Task Control

A model CICS application

1.
2.
3.
4.
5.

Miscellaneous sub programs and utilities

The MENU program
The CUSTMNT1 program
The ORDRENT1 program
The CUSTINQ1 program

3/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

4/256

INTRODUCTION

back

The CICS interface

CICS provides an interface between application programs and operating
system services, such as data access and communication access.

D is k s t o r a g e

O p e r a tin g s y s te m
A p p lic a t io n
p ro g ra m s

D a ta a c c e s s
(V S A M ,D B 2 ,IM S )

C IC S

C o m m u n ic a t io n
access
(V T A M , S N A ,
T C P /IP )
U s e r in te r f a c e

CICS in an OS/390 address space

More than one CICS system (or region) can run on the same computer at
the same time.

O S /3 9 0
A d d re s s s p a c e 1

A d d re s s s p a c e 2

A d d re s s s p a c e 3

A d d re s s s p a c e 4

C IC S p r o d u c tio n
r e g io n

B a tc h
Job

C IC S
te s t
r e g io n

TSO
user

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

5/256

CICS transaction server platforms

Hardware
IBM S/390
IBM AS/400
IBM RS/6000
PC server

Operating system
OS/390, MVS, VSE
OS/400
AIX (UNIX)
Windows NT, OS/2

CICS programming languages

Language
COBOL
Assembler language

Description
The most used programming language for both batch and online
applications in a mainframe environment.
Assembler language is used mostly for special-purpose devices
like ATM machines.

PL/I

You probably wont find any new program development being

done in PL/I.

C and C++

Traditionally used in engineering and math environments. With

C++, an object-oriented language, you can develop objectoriented classes that access CICS services.

Java

The newest language for writing CICS applications, Java can

also be used for developing object-oriented classes that access
CICS services.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

6/256

The 3270 Information Display System

3 2 7 0 d is p la y

IB M 3 x 7 4
c o n t r o lle r
3 2 7 0 d is p la y
S /3 9 0
m a in fr a m e

LAN/
W AN
In te r n e t/
In tr a n e t

3 2 7 0 d is p la y

PC 3270
e m u la tio n

PC 3270
e m u la tio n

PC 3270
e m u la tio n

PC 3270
e m u la t io n

PC 3270
e m u la t io n

PC 3270
e m u la t io n

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

7/256

Alternate User Interfaces

O S /3 9 0
C IC S a d d re s s s p a c e

3270

P r e s e n t a t io n lo g ic

B u s in e s s lo g ic

P C
3 2 7 0 e m u la t io n

H TTP

W e b a p p lic a t io n

M Q S e r ie s

F ro n t-e n d
a p p lic a t io n

E C I

V is u a l B a s ic
a p p lic a t io n

When CICS is used with alternate user interfaces, the front-end program
provides the presentation logic, but the CICS application is still the
back-end program that provides the business logic.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

8/256

How Mutitasking Works

C IC S a d d r e s s s p a c e
Task 1

Task 2

Task 3

Task 4

Task 5

O rd e r e n try
p ro g ra m
(u s e r 1 )

C u s to m e r
in q u ir y
p ro g ra m
(u s e r 2 )

M a s te r m e n u
p ro g ra m
(u s e r 3 )

C u s to m e r
m a in te n a n c e
p ro g ra m
(u s e r 4 )

O rd e r e n try
p ro g ra m
(u s e r 5 )

A task is the execution of an application program for a specific

user.

Within CICS, two or more tasks can execute at the same time using a
CICS feature called multitasking.

CICS handles multitasking internally, within its own address space.

How MultiThreading Works

CICS address space
User 1
Working
storage

Order entry program

User 5
User 1

User 5
Working
storage

With multithreading, two or more users can access the same copy of a
program at the same time. CICS accomplishes this by providing a separate
copy of working storage for each user running the program.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

9/256

How CICS Invokes a Transaction

T h e u s e r e n te rs
t r a n s - id O R D 1

ORD1

PCT

C I C S lo c a t e s
t r a n s - id O R D 1
in th e P r o g r a m
C o n tr o l T a b le

T r a n s a c tio n

P ro g ra m

D
D
M
O
O

D
D
M
O
O

M 01
M 01
MA1
RD1
RD2

M PG M 01
M PG M 02
MAPGM1
RDPGM1
RDPGM2

PPT
C I C S lo c a t e s
p ro g ra m
O R D P G M 1 in t h e
P r o c e s s in g
P r o g r a m T a b le

P ro g ra m

L o c a tio n

D
D
M
O
O

In s to ra g e
O n d is k
In s to ra g e
O n d is k
O n d is k

M PG M 01
M PG M 02
MAPGM1
RDPGM1
RDPGM2

C IC S a d d re s s s p a c e

DM PG M 01

C I C S lo c a t e s lo a d
m o d u le O R D P G M 1
o n d is k , lo a d s it
in to m e m o r y , a n d
s ta rts th e ta s k

L ib r a r y

L o a d m o d u le

DMPROG

D
D
M
O
O

MMAPROG
ORDPROG

M PG M 01
M PG M 02
MAPGM1
RDPGM1
RDPGM2

MMAPGM1

ORDPGM1

Note that earlier versions of CICS programs and transactions needed to

be defined via assembler macros in the PPT and PCT. Today systems have
RDO or Resource Definition Online, where CICS resources are defined
online using the CEDA transaction. In this training program we will be
extensively using CEDA. However, behind the scenes, CICS still maintains
data structures equivalent to the PPT and PCT above.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

10/256

How a Program Accesses CICS services

O S /3 9 0
C IC S

D a ta
m anagem ent
s e r v ic e s

C IC S
m anagem ent
s e r v ic e s

A p p lic a tio n
P r o g r a m m in g
In te rfa c e

A p p lic a t io n
p ro g ra m s

D a ta
c o m m u n ic a tio n
s e r v ic e s

CICS services are available to an application

Application Programming Interface, or API.

program

through

its

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

11/256

How a Program Communicates with a terminal

O S /3 9 0

C IC S

T e r m in a l
c o n tro l

A p p lic a tio n
P r o g r a m m in g
In te r fa c e

A p p lic a tio n
p ro g ra m s

B a s ic
m a p p in g
s u p p o rt

M aps

VTAM , SN A,
T C P /IP

T e r m in a l
user

Terminal control provides the interface between

operating systems telecommunication access method.

Basic
mapping
support
(BMS)
provides
application programs and terminal control.

the

CICS

interface

and

the

between

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Three ways an application can access disk data

D is k s to r a g e

O S /3 9 0
VSAM

D B2

IM S

SQ L

D L /I

C IC S
F ile c o n t r o l

A p p lic a tio n
P r o g r a m m in g
In te rfa c e

A p p lic a tio n
p ro g ra m s

12/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

13/256

CICS Services for application programs

Management service

Description

Program control

Provides for calling or transferring control

to other programs.

Temporary storage
control

Provides for storing data outside working

storage in simple files called temporary
storage queues.

Interval control

Provides time-related services, including

services for getting the current date and
time and scheduling tasks for execution.

Storage control

Provides for allocating main storage space

outside of working storage.

Task control

Provides for temporarily suspending a task

that is monopolizing CICS resources or
gaining exclusive control of a CICS resource.
Produces a transaction dump when a fatal
error is encountered during the execution of
an application program.
Maintains a trace table that indicates the
sequence of CICS operations performed.
Creates a record or journal that can be used
to restore files in the event of a task or
system failure.
Provides a convenient way to use sequential
files called destinations to store data.

Dump control
Trace control
Journal control
Transient data control

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Introduction To CICS Programming

14/256

back

How a Conversational Program Works

S ta r t

S e n d
fir s t
m a p

W a it
fo r
in p u t

E n d ?

Ye s

E n d

N o
R e c e ive
m a p

P ro c e s s
d a ta

S e n d
m a p

A conversational program is an online program that sits idle while it

waits for user input.

While a conversational program waits for user input,

associated with that program must remain in storage.

Conversational programs are often the cause of a CICS condition known

as Short on Storage, or SOS.

the

task

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

15/256

How a Pseudo Conversational Program works

S ta r t

Send
fir s t
m ap

W a it
fo r
in p u t

S ta r t

End?

Yes

End

N o

End

R e c e ive
m ap

P ro c e s s
d a ta

Send
m ap

End

A pseudo-conversational program ends after it sends data to a

terminal, and some of the resources used by the program are released.

CICS restarts the program when the user completes an entry

presses one of the terminals attention identifier (AID) keys.

A pseudo-conversational program requires a different type of design

and logic than a conversational program.

and

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

16/256

The general syntax of a CICS command

EXEC CICS
command option(value)...
END-EXEC.

A CICS command that receives data from the terminal

EXEC CICS
RECEIVE MAP('INQMAP1')
MAPSET('INQSET1')
INTO(INQMAP1I)
END-EXEC.
CICS commands for doing BMS-controlled screen interactions
RECEIVE MAP Retrieves input data from the terminal.
SEND MAP
Sends information to the terminal for display.
CICS commands for passing control from one program to another
ABEND
Transfers control to an abend routine or returns control
to CICS.
LINK
Invokes a program at a lower level.
RETURN
Returns control to CICS or the invoking program.
XCTL
Transfers control to another program.
CICS commands for processing VSAM files
DELETE
Deletes a record from a file.
READ
Retrieves a specified record from a file.
REWRITE
Updates a record in a file.
WRITE
Adds a record to a file.
CICS commands for transaction control
SYNCPOINT
Commits or reverses updates made to one or more
recoverable resources (files, Data Base, MQ gets and
puts ).
SYNCPOINT
Backs out changes to recoverable resources
ROLLBACK
COBOL statements not allowed in CICS programs
1. Operator communication statements
Accept
Display
2. File I/O statements
Open
Close
Read
Write
Rewrite
Delete
Start
3. Other statements

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

17/256

Accept Date/Day/Day-Of-Week/Time
Sort / Merge
Sign is separate
Current-date
Date
Stop run
Day
Time
Exhibit
Unstring
Inspect

An eight-step procedure for developing a CICS program

Analysis and design

1. Develop a complete set of program specifications.
2. Design the program using an event/response chart and a structure
chart.
Implementation
1. Prepare the BMS mapset.
2. Code the program.
3. Prepare the program for execution.
4. Make the necessary CICS resource definitions.
5. Test the program under CICS.
Documentation
1. Document the program.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

18/256

CICS program Preparation

S o u rc e p ro g ra m

C I C S tr a n s la t o r

T r a n s la t e d p r o g r a m

C o p y lib r a r ie s

C O B O L c o m p ile r

C o m p ile r o u tp u t

O b je c t m o d u le

O b je c t lib r a r ie s

L in k a g e e d ito r

L in k a g e e d it o r
o u tp u t

L o a d m o d u le

1. Before you compile a CICS program, you must translate it.

2. The CICS translator converts the CICS commands to Move and Call
statements that can be compiled by the COBOL compiler.
3. The translator also inserts code into your program that it needs to
operate under CICS.
4. After you translate the program, you compile and link-edit it just as
you would any other COBOL program.
5. Translated code for a CICS READ command
*
EXEC CICS
*
RECEIVE MAP('INQMAP1')
*
MAPSET('INQSET1')
*
INTO(INQMAP1I)
*
END-EXEC.
MOVE '..}............00109
' TO DFHEIV0
MOVE 'INQMAP1' TO DFHC0070
MOVE 'INQSET1' TO DFHC0071
CALL 'DFHEI1' USING DFHEIV0 DFHC0070
INQMAP1I DFHDUMMY DFHC0071.
JCL
//USER0101 JOB NOTIFY=&SYSUID
//
JCLLIB ORDER=(USER01.PROCLIB)
//COMPILE EXEC DFHEITVL
//TRN.SYSIN
DD DSN=USER01.COBOL.SOURCE(memname),DISP=SHR
//LKED.SYSIN DD *

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

19/256

NAME memname(R)
/*
//* THIS FOR USER LOADLIB FOR C0A2
//LKED.SYSLMOD DD DSN=<-loadlib->(memname),DISP=SHR
//

PROC

//DFHEITVL PROC SUFFIX=1$,

Suffix for translator module
//
INDEX='CICSTS13.CICS',
qualifier(s) for CICS libs
//
COMPHLQ='CICSTS13.CICS', QUALIFIER(S) FOR COBOL COMPILER
//
OUTC=*,
Class for print output
//
REG=2M,
Region size for all steps
//
LNKPARM='LIST,XREF',
Link edit parameters
//
STUB='DFHEILIC',
Link edit INCLUDE for DFHECI
//
LIB='SDFHCOB',
Library
//
WORK=SYSDA
Unit for work datasets
//*
This procedure contains 4 steps
//*
1.
Exec the COBOL translator
//*
(using the supplied suffix 1$)
//*
2.
Exec the vs COBOL II compiler
//*
3.
Reblock &LIB(&STUB) for use by the linkedit step
//*
4.
Linkedit the output into dataset &PROGLIB
//*
//*
The following JCL should be used
//*
to execute this procedure
//*
//*
//APPLPROG EXEC DFHEITVL
//*
//TRN.SYSIN DD *
//*
.
//*
. Application program
//*
.
//*
/*
//*
//LKED.SYSIN DD *
//*
NAME anyname(R)
//*
/*
//*
//TRN
EXEC PGM=DFHECP&SUFFIX,
//
PARM='COBOL2',
//
REGION=&REG
//STEPLIB DD DSN=&INDEX..SDFHLOAD,DISP=SHR
//SYSPRINT DD SYSOUT=&OUTC
//SYSPUNCH DD DSN=&&SYSCIN,
//
DISP=(,PASS),UNIT=&WORK,
//
DCB=BLKSIZE=400,
//
SPACE=(400,(400,100))
//*
//COB
EXEC PGM=IGYCRCTL,REGION=&REG,
//
PARM='NODYNAM,LIB,OBJECT,RENT,RES,APOST,MAP,XREF'
//STEPLIB DD DSN=IGY.V2R1M0.SIGYCOMP,DISP=SHR
//SYSLIB
DD DSN=&INDEX..SDFHCOB,DISP=SHR
//
DD DSN=&INDEX..SDFHMAC,DISP=SHR
//
DD DSN=&INDEX..SDFHSAMP,DISP=SHR
//SYSPRINT DD SYSOUT=&OUTC
//SYSIN
DD DSN=&&SYSCIN,DISP=(OLD,DELETE)
//SYSLIN
DD DSN=&&LOADSET,DISP=(MOD,PASS),

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

20/256

//
UNIT=&WORK,SPACE=(80,(250,100))
//SYSUT1
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT2
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT3
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT4
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT5
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT6
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT7
DD UNIT=&WORK,SPACE=(460,(350,100))
//*
//COPYLINK EXEC PGM=IEBGENER,COND=(7,LT,COB)
//SYSUT1
DD DSN=&INDEX..&LIB(&STUB),DISP=SHR
//SYSUT2
DD DSN=&&COPYLINK,DISP=(NEW,PASS),
//
DCB=(LRECL=80,BLKSIZE=400,RECFM=FB),
//
UNIT=&WORK,SPACE=(400,(20,20))
//SYSPRINT DD SYSOUT=&OUTC
//SYSIN
DD DUMMY
//*
//LKED
EXEC PGM=IEWL,REGION=&REG,
//
PARM='&LNKPARM',COND=(5,LT,COB)
//SYSLIB
DD DSN=&INDEX..SDFHLOAD,DISP=SHR
//
DD DSN=&COMPHLQ..SDFHLINK,DISP=SHR
//
DD DSN=CEE.SCEELKED,DISP=SHR
//
DD DSN=CEE.SCEERUN,DISP=SHR
//SYSUT1
DD UNIT=&WORK,DCB=BLKSIZE=1024,
//
SPACE=(1024,(200,20))
//SYSPRINT DD SYSOUT=&OUTC
//SYSLIN
DD DSN=&&COPYLINK,DISP=(OLD,DELETE)
//
DD DSN=&&LOADSET,DISP=(OLD,DELETE)
//
DD DDNAME=SYSIN
The CICS-supplied procedures to install your online application programs
in a CICS library specify the CICS library member that contains the
INCLUDE statement for the appropriate language EXEC interface module.
These library members are named DFHEILIx, where x is A for assembler, C
for COBOL, D for C, or P for PL/I.
In this VS COBOL II example, the symbolic parameters STUB and LIB
default to DFHEILIC and SDFHCOB. The DFHEILIC member contains the
statement INCLUDE SYSLIB(DFHECI). The COPYLINK step ensures that DFHECI
is the first CSECT in the load module.
Language
Assembler
C
COBOL
PL/I

Interface module name

DFHEAI and DFHEAI0
DFHELII
DFHECI
DFHPL1OI supplied by PL/I (and DFHEPI, which is part of the
PL/I DFHPL1OI module)

Other stubs that may be required are

Notes:1. DSNCLI is the stub you use if you have DB2 calls
2. EZACICAL is the stub you use if you have socket calls from CICS
3. CSQCSTUB for MQSeries calls
If you do use the additional stubs make sure you concatenate appropriate
libraries from the product to the LKED.SYSLIB ddname. For example for
DB2 V5.1 and Sockets concatenate the libraries

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

21/256

DSN510.SDSNLOAD and TCPIP.SEZATCP. Note that the HLQ DSN510 for the DB2
dataset will change with the DB2 version. DSN510 is for V5.1.

How to create and use a BMS mapset

1. A BMS mapset is an assembler language program that defines the format

of the maps that are used by a program.
2. After you code a mapset, you assemble twice, once to produce a
physical mapset after subsequent link edit step and a second time to
produce a symbolic mapset. Usually the mapset preparation PROC
(DFHMAPT) includes both the operations.
3. The physical mapset is used by CICS to determine the location,
appearance, and operation of data thats displayed on a screen. It
also contains the literals that represent the constant information on
the screen.
4. The symbolic mapset is a COBOL copy member that allows
manipulate the variable screen data in your COBOL program.

you

to

5. To code a BMS mapset, you use two assembler commands (PRINT NOGEN and
END) and three macros (DFHMSD, DFHMDI, and DFHMDF).
6. A DFHMSD macro marks the start and end of each mapset.
7. A DFHMDI macro marks the beginning of each map.
8. A DFHMDF macro defines each field.
Sample

PRINT NOGEN
DFHMSD TYPE=&SYSPARM,
X
LANG=COBOL,
X
MODE=INOUT,
X
TERM=3270-2,
X
CTRL=FREEKB,
X
STORAGE=AUTO,
X
TIOAPFX=YES
***********************************************************************
INQMAP1 DFHMDI SIZE=(24,80),
X
LINE=1,
X
COLUMN=1
***********************************************************************
DFHMDF POS=(1,1),
X
LENGTH=7,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='INQMAP1'
DFHMDF POS=(1,20),
X
LENGTH=16,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='Customer Inquiry'
TRANID
DFHMDF POS=(1,76),
X
LENGTH=4,
X
ATTRB=(NORM,PROT),
X
INQSET1

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

22/256

COLOR=BLUE,
X
INITIAL='XXXX'
***********************************************************************
DFHMDF POS=(3,1),
X
LENGTH=42,
X
ATTRB=(NORM,PROT),
X
COLOR=NEUTRAL,
X
INITIAL='Type a customer number. Then press Enter.'
DFHMDF POS=(5,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='Customer number. . . . .'
CUSTNO
DFHMDF POS=(5,26),
X
LENGTH=6,
X
ATTRB=(NORM,UNPROT,IC),
X
COLOR=TURQUOISE,
X
INITIAL='______'
DFHMDF POS=(5,33),
X
LENGTH=1,
X
ATTRB=ASKIP
***********************************************************************
DFHMDF POS=(7,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='Name and address . . . :'
LNAME
DFHMDF POS=(7,26),
X
LENGTH=30,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
FNAME
DFHMDF POS=(8,26),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
ADDR
DFHMDF POS=(9,26),
X
LENGTH=30,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
CITY
DFHMDF POS=(10,26),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
STATE
DFHMDF POS=(10,47),
X
LENGTH=2,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
ZIPCODE DFHMDF POS=(10,50),
X
LENGTH=10,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
***********************************************************************
MESSAGE DFHMDF POS=(23,1),
X
LENGTH=79,
X
ATTRB=(BRT,PROT),
X
COLOR=YELLOW
DFHMDF POS=(24,1),
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

23/256

LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='F3=Exit
F12=Cancel'
DUMMY
DFHMDF POS=(24,79),
X
LENGTH=1,
X
ATTRB=(DRK,PROT,FSET),
X
INITIAL=' '
***********************************************************************
DFHMSD TYPE=FINAL
END
The symbolic map definition
The fields in a symbolic map represent the data thats sent to and
received from a terminal by a COBOL program.

You use a COPY statement to copy the symbolic map into the WorkingStorage Section of your program.

A symbolic map includes two 01-level items that occupy the same
storage space: one for input and one for output.

For each input field in the mapset (I), the symbolic map contains a
length field (L), a flag field (F), and an attribute field (A).

For each output field (O), the symbolic map contains a Picture for
the output data, which can be different from the picture for the
input field.
01 INQMAP1I.
03 FILLER
03 TRANIDL
03 TRANIDF
03 FILLER REDEFINES
05 TRANIDA
03 TRANIDI
03 CUSTNOL
03 CUSTNOF
03 FILLER REDEFINES
05 CUSTNOA
03 CUSTNOI
03 LNAMEL
03 LNAMEF
03 FILLER REDEFINES
05 LNAMEA
03 LNAMEI
03 FNAMEL
03 FNAMEF
03 FILLER REDEFINES
05 FNAMEA
03 FNAMEI
03 ADDRL
03 ADDRF
03 FILLER REDEFINES
05 ADDRA
03 ADDRI

PIC X(12).
PIC S9(4) COMP.
PIC X.
TRANIDF.

CUSTNOF.

PIC X.
PIC X(4).
PIC S9(4) COMP.
PIC X.
PIC X.
PIC X(6).
PIC S9(4) COMP.
PIC X.

LNAMEF.

FNAMEF.

PIC X.
PIC X(30).
PIC S9(4) COMP.
PIC X.
PIC X.
PIC X(20).
PIC S9(4) COMP.
PIC X.

ADDRF.

PIC X.
PIC X(30).

APPLICATION PROGRAMMING IN CICS BASIC

03 CITYL
03 CITYF
03 FILLER REDEFINES
05 CITYA
03 CITYI
03 STATEL
03 STATEF
03 FILLER REDEFINES
05 STATEA
03 STATEI
03 ZIPCODEL
03 ZIPCODEF
03 FILLER REDEFINES
05 ZIPCODEA
03 ZIPCODEI
03 MESSAGEL
03 MESSAGEF
03 FILLER REDEFINES
05 MESSAGEA
03 MESSAGEI
03 DUMMYL
03 DUMMYF
03 FILLER REDEFINES
05 DUMMYA
03 DUMMYI
*

24/08/2003

24/256

PIC S9(4) COMP.

PIC X.
CITYF.

STATEF.

PIC X.
PIC X(20).
PIC S9(4) COMP.
PIC X.
PIC X.
PIC X(2).
PIC S9(4) COMP.
PIC X.

ZIPCODEF.

MESSAGEF.

PIC X.
PIC X(10).
PIC S9(4) COMP.
PIC X.
PIC X.
PIC X(79).
PIC S9(4) COMP.
PIC X.

DUMMYF.

Output Data For Map INQMAP1

01 INQMAP1O REDEFINES INQMAP1I.
03 FILLER
03 FILLER
03 TRANIDO
03 FILLER
03 CUSTNOO
03 FILLER
03 LNAMEO
03 FILLER
03 FNAMEO
03 FILLER
03 ADDRO
03 FILLER
03 CITYO
03 FILLER
03 STATEO
03 FILLER
03 ZIPCODEO
03 FILLER
03 MESSAGEO
03 FILLER
03 DUMMYO

PIC X.
PIC X(1).

PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X(12).
X(3).
X(4).
X(3).
X(6).
X(3).
X(30).
X(3).
X(20).
X(3).
X(30).
X(3).
X(20).
X(3).
X(2).
X(3).
X(10).
X(3).
X(79).
X(3).
X(1).

JCL for Mapset

Copy this procedure into your USER01.PROCLIB
//DFHMAPT PROC INDEX='CICSTS13.CICS', FOR SDFHMAC
//
DSCTLIB='USER01.COBOL.COPYBOOK', TARGET FOR DSECT
//
MAPNAME=,
NAME OF MAPSET - REQUIRED
//
RMODE=24,
24/ANY
//
ASMBLR=ASMA90,
ASSEMBLER PROGRAM NAME

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

25/256

//
REG=2048K,
REGION FOR ASSEMBLY
//
OUTC=A,
PRINT SYSOUT CLASS
//
WORK=SYSDA
WORK FILE UNIT
//ASMMAP
EXEC PGM=&ASMBLR,REGION=&REG,
// PARM='SYSPARM(MAP),DECK,NOOBJECT'
//SYSPRINT DD SYSOUT=&OUTC
//SYSLIB
DD DSN=&INDEX..SDFHMAC,DISP=SHR
//
DD DSN=SYS1.MACLIB,DISP=SHR
//SYSUT1
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSUT2
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSUT3
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSPUNCH DD DSN=&&MAP,DISP=(,PASS),UNIT=&WORK,
//
DCB=(RECFM=FB,LRECL=80,BLKSIZE=400),
//
SPACE=(400,(50,50))
//SYSIN
DD DSN=USER01.MAPSET.SOURCE(&MAPNAME),DISP=SHR
//LINKMAP EXEC PGM=IEWL,PARM='LIST,LET,XREF,RMODE(&RMODE)'
//SYSPRINT DD SYSOUT=&OUTC
//SYSLMOD DD DSN=,<----cics mapset library --->(&MAPNAME),DISP=SHR
//SYSUT1
DD UNIT=&WORK,SPACE=(1024,(20,20))
//SYSLIN
DD DSN=&&MAP,DISP=(OLD,DELETE)
//ASMDSECT EXEC PGM=&ASMBLR,REGION=&REG,
// PARM='SYSPARM(DSECT),DECK,NOOBJECT'
//SYSPRINT DD SYSOUT=&OUTC
//SYSLIB
DD DSN=&INDEX..SDFHMAC,DISP=SHR
//
DD DSN=SYS1.MACLIB,DISP=SHR
//SYSUT1
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSUT2
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSUT3
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSPUNCH DD DSN=&DSCTLIB(&MAPNAME),DISP=OLD
//SYSIN
DD DSN=USER01.MAPSET.SOURCE(&MAPNAME),DISP=SHR
JOB
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//
JCLLIB ORDER=(USER01.PROCLIB)
//STEP1 EXEC DFHMAPT,MAPNAME=memname
//

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

How to create a BMS mapset

How to code a CICS program
How to use Temporary Storage
Additional Programming Techniques
How to process files sequentially
How to use vsam alternate indexes
How to use other file processing features
How to debug an ASRA abend

26/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

27/256

ADVANCED PROGRAM CONTROL

back

Inputmsg Command

EXEC CICS
LINK PROGRAM(name)
[COMMAREA(data_area)[ LENGTH(data_value)][DATALENGTH(data_value)]]
[ INPUTMSG (data_area) [ INPUTMSGLEN(data_value)]]
[ SYSID(name)]
[ SYNCONRETURN ]
END-EXEC
Options
PROGRAM

one to eight character program name defined using CEDA

DEFINE PROGRAM(name) GROUP(group-name)

COMMAREA

Specifies a data area that is passed by reference to the

called program and accessed in the called program through a
01 level item DFHCOMMAREA in the linkage section.

LENGTH

Specifies a binary half word (PIC S9(4) COMP) field or

literal value that is the length of the COMMAREA passed.

DATALENGTH

Use this when the called program returns more data than is
passed. This length specifies the passed data. This is
useful in DPL where less data needs to be transmitted across
the link to the called program.

INPUTMSG

specifies data that can be passed to the called program

where the called program expects command line arguments that
it will fetch using the RECEIVE command. This is useful to
insert a front end menu program between many different
programs designed to be invoked stand alone using command
line arguments.

INPUTMSGLEN Specifies a binary half word (PIC S9(4) COMP) field or

literal value that is the length of the INPUTMSG passed.
SYSID

specifies the name of a remote system (a 4 character name of

a CONNECTION resource that points to the remote system)
Where the program is to be run. In the absence of this
parameter the program is run in the same address space as
the LINK call.

SYNCONRETURN Relevant only for a DPL to ask CICS to take a SYNCPOINT on

return from the LINK.
conditions
LENGERR

A length error occurred

NOTAUTH

Insufficient authority to run the program

PGMIDERR

The target program is not defined to CICS

ROLLEDBACK

For a DPL the Linked to program could not take a syncpoint.

The calling program gets an opportunity to roll back any UOW
which it has in an uncommitted state.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

SYSIDERR

The remote system could not be located

TERMERR

For DPL a conversation error(APPC) occurred.

28/256

RECEIVE Command
Use the RECEIVE command to access the data passed via INPUTMSG. The
syntax of the RECEIVE command is below:EXEC

CICS

END-EXEC
Options
INTO

RECEIVE {INTO(data_area) | SET(ptr_ref)

{LENGTH(data_area) | FLENGTH(data_area)}
[ NOTRUNCATE ]
[ ASIS ]
[ BUFFER ]

The data area into which the received data is put

SET

A pointer reference, usually the address special register of

a 01 level LINKAGE SECTION item.

LENGTH

A half word binary PIC S9(4) COMP which on return from the
call has the length of the actual data received.

FLENGTH

Same as LENGTH, but is a full word field , PIC S9(8) COMP.

NOTRUNCATE

CICS is not to truncate the data if the buffer is

inadequate. CICS is to retain the excess data and the user
can access it by reissuing the RECEIVE command. If you omit
this CICS truncates the excess data and signals it via a
LENGERR condition. Use the LENGTH field to check for the
actual length of the data including any excess.

conditions
LENGERR

The data length exceeds the buffer and the excess has been
discarded.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

29/256

FRONT END PROGRAM

.
.
MOVE INQ4 400001 TO INPUT-MESSAGE.
EXEC CICS
LINK PROGRAM(CUSTINQ4)
INPUTMSG(INPUT-MESSAGE)
END-EXEC.

EXISTING APPLICATION PROGRAM CUSTINQ4

.
.
EXEC CICS
RECEIVE INTO(COMMAND-AREA)
LENGTH(COMMAND-LENGTH)
RESP(RESPONSE-CODE)
END-EXEC.

LOAD COMMAND
This command fetches a Load module from a Load Library into storage and
returns the address and length to the issuing program. Such loaded
programs are usually modules which represent tables created by coding DS
and DC instructions in an assembler source file. The loaded program does
not have executable code. The loaded program code (table data) is mapped
into a LINKAGE SECTION 01 level data item. The loaded program is read
only and any changes made to its data is not reflected back to the load
module in the PDS.
EXEC CICS
LOAD PROGRAM(name)
[ SET(pointer-ref)]
[LENGTH(data-area) | FLENGTH(data-area)]
[ ENTRY(pointer-ref) ]
[ HOLD ]
Options
PROGRAM
SET

One to eight character program name defined to CICS using

CEDA.
Points to a field that is of type POINTER or a PIC S9(8)
COMP or a internal COBOL register of a 01 level LINKAGE
SECTION item using ADDRESS OF COBOL keywords. This item is
the address at which the module is loaded.

LENGTH | FLENGTH

is set by CICS to the length of the loaded module.

ENTRY

is a PIC S9(8) COMP field that is set by CICS to the entry

point of the loaded module. Note that for tables this
corresponds to the load address returned via SET keyword.

HOLD

Instructs CICS to hold the loaded module in storage even

beyond the lifetime of the invoking program.

APPLICATION PROGRAMMING IN CICS BASIC

Conditions
LENGERR

24/08/2003

30/256

set when the size of the loaded module is more than 32K and
LENGTH was specified in the call instead of FLENGTH.

NOTAUTH

insufficient authority for the invoking program to load the

specified module

PGMIDERR

The specified program is not defined to CICS

Notes
LOAD is used to remove embedded constants from mainline programs and put
these into a table created using assembler. That way the table entries
can be changed by recompiling the assembler code and avoiding changes to
much larger complex COBOL program. Typical examples could be a fare
table, which can undergo frequent change.
Example OS/VS COBOL.
LINKAGE SECTION
*
01 BLL-CELLS.
05
FILLER
PIC S9(8) COMP.
05
BLL-STATE-TABLE
PIC S9(8) COMP.
*
1
STATE-TABLE.
*
05
STATE-CODE
OCCURS 52 PIC XX.
*
PROCEDURE DIVISION.
*
0000-ACCEPT-CUSTOMER-ORDERS.
*
EXEC CICS
LOAD PROGRAM(STATABL)
SET(BLL-STATE-TABLE)
HOLD
END-EXEC.
SERVICE RELOAD STATE-TABLE.
Example COBOL II example
LINKAGE SECTION
*
1
STATE-TABLE.
*
05
STATE-CODE
OCCURS 52
*
PROCEDURE DIVISION.
*
0000-ACCEPT-CUSTOMER-ORDERS.
*
EXEC CICS
LOAD PROGRAM(STATABL)
SET(ADDRESS OF STATE-TABLE)
HOLD
END-EXEC.
*

PIC X(10).

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

31/256

Sample Assembler Code

STATABL
CSECT
DC CL10AKALARAZCA
DC CL10COCTDCDEFL
.
.
.
.
.
.
DC CL10UTVAVTWAWV
DC CL10WIWY
END
You can compile and link edit the module using this sample JCL and the
IBM supplied procedure ASMACL shown below:Sample JCL to create the assembler module
//ASMACL
PROC
//*
//***
ASMACL
//*
//* THIS PROCEDURE RUNS THE HIGH LEVEL ASSEMBLER AND LINKS
//* THE NEWLY ASSEMBLED PROGRAM
//*
//C
EXEC PROG=ASMA90,PARM=(OBJECT,NODECK)
//SYSLIB
DD
DSN=SYS1.MACLIB,DISP=SHR
//SYSUTI
DD
DSN=&&SYSUT1,SPACE=(4096,(120,120),,,ROUND),UNIT=VIO,
//
DCB=BUFNO=1
//SYSPRINT DD
SYSOUT=*
//SYSPUNCH DD
SYSOUT=B
//SYSLIN
DD
DSN=&&OBJ,SPACE=(3040,(40,40),,,ROUND),UNIT=VIO,
//
DISP=(MOD,PASS),
//
DCB=(BLKSIZE=3040,LRECL=80,RECFM=FBS,BUFNO=1)
//L
EXEC PGM=HEWL,PARM='MAP,LET,NCAL',COND=(8,LT,C)
//SYSLIN
DD
DSN=&&OBJ,DISP=(OLD,DELETE)
//
DD
DDNAME=SYSIN
//SYSLMOD
DD
DISP=(,PASS),UNIT=SYSDA,SPACE=(CYL,(1,1,1)),
//
DSN=&&GOSET(GO)
//SYSUT1
DD
DSN=&SYSUT1,SPACE=(1024,(120,120),,,ROUND),
//
DCB=BUFNO=1,UNIT=VIO
//SYSPRINT DD
SYSOUT=*
Invoking JCL
//... . . JOB card
//STEP1
EXEC ASMACL
//C.SYSIN DD DSN=myuserid.ASM.SOURCE(member-name),DISP=SHR
//L.SYSLMOD DD DSN=cics-load-library-for-user-programs-and-mapsets,DISP=SHR
//
RELEASE Command
Use this command to release modules loaded using LOAD with the HOLD option.
EXEC CICS
RELEASE PROGRAM(program-name)
END-EXEC.

APPLICATION PROGRAMMING IN CICS BASIC

conditions
INVREQ

24/08/2003

32/256

The program cannot be released.

NOTAUTH

Insufficient access authority to use / release the specified

program.

PGMIDERR

Program name is not recognized by CICS.

USAGE
0500-RELEASE-STATE-TABLE.
*
EXEC CICS
RELEASE PROGRAM(STATATBL)
END-EXEC.

DISTRIBUTED PROGRAM LINK

CICS distributed program link (DPL) enables CICS application programs
to run programs residing in other CICS regions by shipping programcontrol LINK requests.

An application can be written without regard for the location of the

requested programs; it simply uses program-control LINK commands in
the usual way. Entries in the CICS program definition tables allow
the system programmer to specify that the named program is not in the
local region (known as the client region) but in a remote region
(known as the server region).

An illustration of a DPL request is given below. In this figure, a

program (known as a client program) running in CICA issues a programcontrol LINK command for a program called PGA (the server program).
From the installed program definitions, CICS discovers that this
program is owned by a remote CICS system called CICB. CICS changes
the LINK request into a suitable transmission format, and then ships
it to CICB for execution.

APPLICATION PROGRAMMING IN CICS BASIC

+---------------------------+
CICA +-------------------+
DEFINE
PROGRAM('PGA')
REMOTESYSTEM(CICB)
+-------------------+

24/08/2003

33/256

+---------------------------+
CICB +-----------------+
DEFINE
PROGRAM('PGA')
+-----------------+

+---------------+
+--------------+
.
EXEC CICS LINK
CICS mirror
PROGRAM('PGA') +--+
ISC or MRO
transaction +-+
COMMAREA(...) +----------<---->------ (issues LINK
.
session
command and
.
passes back
.
commarea)
+---------------+
+--------------+
+---------------------------+
+---------------------------+
Client programs can run in a CICS intercommunication environment and use
DPL without being aware of the location of the server program.
DEFINE PROGRAM(PG1) REMOTESYSTEM(CICB) ...
DEFINE PROGRAM(PG99) REMOTENAME(PG1) REMOTESYSTEM(CICC) ...
In the second definition above the requested program is known by a
different name on the remote system.
A transformer program DFHXFP is used to transform the call request to a
form suitable for sending across the link. At the remote system a mirror
transaction (represented by program DFHMIRS) is used to link to the
target user program. If a user transaction identifier points to DFHMIRS
then that must be specified by the TRANID of the link call. Else by
default CSMI or CVMI is used. The definitions for all these system level
Objects are defined in group DFHISC.
Examples of DPL
This section gives some examples to illustrate the lifetime of the
mirror transaction and the information flowing between the client
program and its mirror transaction.

APPLICATION PROGRAMMING IN CICS BASIC

System A
Application Transaction
.
.
EXEC CICS LINK
PROGRAM('PGA')
COMMAREA(...) ...
.
.

Transmitted
Information

24/08/2003

34/256

System B

Attach mirror,
'LINK' request
------------------>

Attach
mirror transaction.
Mirror performs LINK
to PGA.
PGA runs, issues RETURN.

Reply passed to
client program.
.
.
EXEC CICS SYNCPOINT

Syncpoint completed.
Client program
continues.

Commarea data
<-----------------'SYNCPOINT'
request, last
------------------>
Positive response
<------------------

Mirror ships the

commarea back to
system A.
Mirror takes syncpoint,
frees the session,
and terminates.

ASYNCHRONOUS PROCESSING METHODS

In CICS, asynchronous processing can be done in either of two ways:
By using the interval control commands START and RETRIEVE. You can use
the START command to schedule a transaction in a remote system in much
the same way as you would in a single CICS system. This type of
asynchronous processing is in effect a form of CICS function shipping,
and as such, it is transparent to the application. The systems
programmer determines whether the attached transaction is local or
remote. A CICS transaction that is initiated by a remotely-issued start
request can use the RETRIEVE command to retrieve any data associated
with the request.
Data transfer is restricted to a single record
passing from the initiating transaction to the transaction initiated.
System A
+----------+

System B
+----------+
Synchronous Processing (DTP)

+------+-------+
TRAN1 +--<---->-- TRAN2
+------+-------+
+------+-------+
TRAN3 +---->----- TRAN4
+------+------TRAN5 +----<----+------+-------+
+----------+

+----------+

TRAN1 and TRAN2 hold synchronous

conversation on session.
Asynchronous Processing
TRAN3 initiates TRAN4
request.
Later TRAN4 initiates
and sends reply.
No direct correlation
between executions of
TRAN5.

and sends
TRAN5
exists
TRAN3 and

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

35/256

The asynchronous Processing is illustrated below using three programs.

SAMP12 is invoked by the user using transaction id SM12. It invokes
SAMP13 via a start command on its transaction id SM13, passing the
RTRANSID (SM14) and RTERMID (EIBTRMID) as well as input data. SAMP13
processes the data and returns the response by invoking RTRANSID on
RTERMID.
SAMP12
tranid SM12
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP12.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-RESP
PIC S9(08) COMP VALUE
01 WS-LINK.
03 WS-LINK-DATA
PIC X(30)
VALUE "START DATA FROM SAMP12".
03 WS-SERVER-DATA
PIC X(8) VALUE " ".
03 WS-CLIENT-DATA
PIC X(8) VALUE " ".
01 WS-LINK-DATA-LEN
PIC S9(04) COMP VALUE 46.
PROCEDURE DIVISION.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
START
TRANSID("SM13")
FROM(WS-LINK-DATA)
LENGTH(WS-LINK-DATA-LEN)
RTRANSID("SM14")
RTERMID(EIBTRMID)
RESP(WS-RESP)
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
SAMP13
tranid SM13
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP13.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-RESP
PIC S9(08) COMP VALUE
03 WS-RTRANSID
PIC X(4).
03 WS-RTERMID
PIC X(8).
01 WS-LINK.
03 WS-LINK-DATA
PIC X(30).
03 WS-SERVER-DATA
PIC X(8) VALUE " ".
03 WS-CLIENT-DATA
PIC X(8) VALUE " ".
01 WS-LINK-DATA-LEN
PIC S9(04) COMP VALUE 46.
PROCEDURE DIVISION.
PERFORM MAIN-PARA

0.

0.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

36/256

PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
RETRIEVE
INTO(WS-LINK)
LENGTH(WS-LINK-DATA-LEN)
RTRANSID(WS-RTRANSID)
RTERMID(WS-RTERMID)
RESP(WS-RESP)
END-EXEC
MOVE "SAMP13" TO WS-SERVER-DATA
EXEC CICS
START
TRANSID(WS-RTRANSID)
TERMID(WS-RTERMID)
FROM(WS-LINK-DATA)
LENGTH(WS-LINK-DATA-LEN)
RESP(WS-RESP)
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
SAMP14
tranid SM14
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP14.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-RESP
PIC S9(08) COMP VALUE
01 WS-LINK.
03 WS-LINK-DATA
PIC X(30).
03 WS-SERVER-DATA
PIC X(8) VALUE " ".
03 WS-CLIENT-DATA
PIC X(8) VALUE " ".
01 WS-LINK-DATA-LEN
PIC S9(04) COMP VALUE 46.
PROCEDURE DIVISION.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
RETRIEVE
INTO(WS-LINK)
LENGTH(WS-LINK-DATA-LEN)
RESP(WS-RESP)
END-EXEC
MOVE "SAMP14" TO WS-CLIENT-DATA
EXEC CICS
SEND TEXT
FROM(WS-LINK-DATA)
LENGTH(WS-LINK-DATA-LEN)
RESP(WS-RESP)
END-EXEC.
END-PARA.
EXEC CICS
RETURN

0.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

37/256

END-EXEC.

Starting and cancelling remote transactions

The interval control START command is used to schedule transactions
asynchronously in remote CICS. The command is function shipped. If
the remote system is CICS, the mirror transaction is invoked in the
remote system to issue the START command on that system.

You can include time-control information on the shipped START command

in the normal way, by means of the INTERVAL or TIME options. A TIME
specification is converted by CICS to a time interval, relative to
the local clock, before the command is shipped. Because the ends of
an intersystem link may be in different time zones, it is usually
better to think in terms of time intervals, rather than absolute
times, for intersystem communication.

A START command shipped to a remote CICS system can be canceled at

any time up to its expiration time by shipping a CANCEL command to
the same system.
The particular START command has a unique
identifier (REQID), which you can specify on the START command and on
the associated CANCEL command. The CANCEL command can be issued by
any task that "knows" the identifier.

Passing information with the START command

The START command has a number of options that enable information to
be made available to the remote transaction when it is started. If
the remote transaction is in a CICS system, it obtains the
information by issuing a RETRIEVE command. The information that can
be specified is summarized in the following list:

User data--specified in the FROM option. This is the principal way in

which data can be passed to the remote transaction.

For CICS-to-CICS communication, additional data can be made available

in a transient data or temporary storage queue named in the QUEUE
option. The queue can be on any CICS system that is accessible to
the system on which the remote transaction is executed.

The transaction and terminal names to be used for replies--specified

in the RTRANSID and RTERMID options. These options, whose values are
set by the local transaction, provide the means for the remote
transaction to pass a reply to the local system.
(That is, the
TRANSID and TERMID specified by the remote transaction on its reply
are the RTRANID and RTERMID specified by the local system on the
initial request.)

A terminal name--specified in the TERMID option. For CICS-to-CICS

communication, this is the name of a terminal that is to be
associated with the remote transaction when it is initiated.

A CICS transaction that is started by a start request can get the

user data and other information associated with the request by using
the RETRIEVE command.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

38/256

In accordance with the normal rules for CICS interval control, a

start request for a particular transaction that carries both user
data and a terminal identifier is queued if the transaction is
already active and associated with the same terminal.
During the
waiting period, the data associated with the queued request can be
accessed by the active transaction by using a further RETRIEVE
command. This has the effect of canceling the queued start request.

Thus, it is possible to design transactions that can handle the data

associated with multiple start requests. Typically, a long-running
local transaction could be designed to accept multiple inquiries from
a terminal and ship start requests to a remote system. From time to
time, the transaction would issue RETRIEVE commands to receive the
replies, the absence of further replies being indicated by the
ENDDATA condition.

The WAIT option of the RETRIEVE command can be used to put the
transaction into a wait state pending the arrival of the next start
request from the remote system.

APPLICATION PROGRAMMING IN CICS BASIC

MANIPULATING DYNAMIC STORAGE

24/08/2003

39/256

back

Fundamentals of Storage Protection

The format of the PSW of the system is as below Program-Status-Word
Format
+------------------------------------------------------------+

IE

Prog

0R0 0 0TOX Key 1MWPA SC C Mask 0 0 0 0 0 0 0 0

+------------------------------------------------------------+
0
5
8
12
16 18 20
24
31
+------------------------------------------------------------+

A
Instruction Address

+------------------------------------------------------------+
The fields are described in the ESA/390 principles of operation. However
Note the 4 bit storage protection key field. Whenever a program runs on
the S/390, the storage that the program can access is determined by the
Key field in the PSW. The system sets a key for every 4k page of virtual
storage in the address space in which the program is running. The key of
the 4k page that the program is accessing and the key field in the PSW
must match for the program to access the storage.
User programs run under PSW key 8. Historically CICS has always run as a
user program from the perspective of the operating system and used user
key storage. So did user programs running under CICS. This made CICS
vulnerable to badly written programs. Current releases of CICS have an
option of defining one of two keys under which a user program is to run.
You can specify (its the default) user key. In this case a bad program
cannot affect CICS but it could affect other programs, perhaps unrelated
ones. You specify CICS KEY when you want to access and perhaps modify
CICS owned storage. Typical are applications that use the CICS system
programming interface.
You specify this option when you use CEDA to define a program resource
to CICS.
In addition, for critical transactions, you can specify transaction
isolation when you define the transaction. In the CEDA define
transaction screen,
ISOLATE({YES|NO})
specifies whether CICS is to isolate the transaction's user-key tasklifetime storage to provide transaction-to-transaction protection.
Isolation means that the user-key task-lifetime storage is protected
from both reading and writing by the user-key programs of other
transactions--that is, from programs defined with EXECKEY(USER).

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

40/256

+------------------------------------------------------------------------+

Transactions with

Transactions with ISOLATE(YES)

ISOLATE(NO)

+---+
+---+
+---+
+---+
+-----------------
User-key
TRN
TRN
TRN
TRN
TRN TRN TRN
task-lifetime
A
B
C
D
E F G
storage
+---+
+---+
+---+
+---+
+-----------------

+----------------------------------------------------

Read-only to all programs

CICS-key storage
Write access for all EXECKEY(CICS) programs

+----------------------------------------------------

+------------------------------------------------------------------------+
Conceptual view of key protection and transaction isolation.
SIT Parameters that affect Storage access
CMDPROT={YES|NO}
specifies that you want to allow, or inhibit, CICS validation of start
addresses of storage referenced as output parameters on EXEC CICS
commands.
YES

If CICS detects that an application program has asked CICS to

write into an area to which the application does not have
addressability, CICS abends the task with an AEYD abend.

NO

CICS does not perform any validation of addresses of the storage

referenced by EXEC CICS commands. This means that an application
program could cause CICS to overwrite storage to which the
application program itself does not have write access.

CWAKEY={USER|CICS}
specifies the storage key for the common work area (CWA) if you are
operating CICS with storage protection (STGPROT=YES). (You specify how
much storage you want for the CWA on the WRKAREA parameter.)
The
permitted values are USER (the default), or CICS:
STGPROT={NO|YES}
specifies whether you want storage protection in the CICS region.
permitted values are NO (the default), or YES:

The

NO

If you specify NO, or allow this parameter to default, CICS does

not operate any storage protection, and runs in a single storage
key as in earlier releases.

YES

If you specify YES, and if you have the required hardware and
software, CICS operates with storage protection, and observes the
storage keys and execution keys that you specify in various system
and resource definitions.

GETMAIN COMMAND
Get main storage.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

41/256

EXEC CICS
GETMAIN SET(ptr-ref)
FLENGTH(data-value)
BELOW
LENGTH(data value)
INITIMG(data value)
SHARED
NOSUSPEND
USERDATAKEY | CICSDATAKEY
END-EXEC
Options
SET

Establishes addressability to the storage that is acquired.

For the OS/VS compiler, this should be a BLL cell thats
associated with the linkage section description of the
storage. For the VS COBOL compiler, use the ADDRESS OF
special
register
for
the
Linkage
Section
storage
description.

LENGTH

Specifies a half word binary , PIC S9(4) COMP field or

literal value that indicates the length of the storage to be
acquired.

FLENGTH

Specifies a full word binary , PIC S9(8) COMP field or

literal value that indicates the length of the storage to be
acquired.

BELOW

Specifies that the storage is to be acquired from below the

16 MB line.

INITMG

Specifies a one byte field or literal value used to

initialize the storage acquired. If omitted the storage is
not initialized. Can cause performance issues!!!

NOSUSPEND

Indicates that if storage is not available, control is

returned immediately to your program at the point following
the GETMAIN command.

SHARED

Specifies that the storage will not be automatically freed

when the task ends. Instead , it must be explicitly freed by
a FREEMAIN command.

USERKEY

Specifies that the storage is to be allocated from one of

the user key storage areas.

CICSKEY

Specifies that the storage is to be allocated from one of

the CICS key storage areas.

Conditions
LENGERR
NOSTG

You requested too much storage with the FLENGTH option or

the LENGTH is 0.
The amount
available.

of

requested

storage

is

not

immediately

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

42/256

Notes
1. BELOW gets storage below 16MB line, typically for AMODE(24) programs.
Be aware that the amount of storage below the line is severely
limited.
2. INITMG initializes the storage with the data value. Be aware that
this can cause excessive paging activity for large storage blocks.
3. SHARED The acquires storage will not be freed on task termination. It
needs an explicit FREEMAIN from this or any other task. Be aware that
if the storage is not explicitly freed, and repeated calls are made
to acquire shared storage, you will eventually get a CICS Short on
Storage condition.
4. NOSUSPEND will make CICS return immediately with the NOSTG response
code when adequate storage is not available, else the task is
suspended until enough storage is available.
5. CICSDATAKEY causes CICS to acquire storage with CICS key. A task
running in USER key will not be able to use storage acquired in
CICSDATAKEY. Use this when the task is running in CICSKEY and you
want to protect the storage from errant tasks running in USERKEY
Example
OS/VS COBOL

LINKAGE SECTION
*
01 BLL-CELLS.
05
FILLER
PIC S9(8) COMP.
05
BLL-INVENTORY-RECORD
PIC S9(8) COMP.
*
1
INVENTORY-RECORD.
.
.
*
PROCEDURE DIVISION.
*
.
.
EXEC CICS
GETMAIN SET(BLL-INVENTORY-RECORD)
LENGTH(2048)
INITIMG(HEX-00)
END-EXEC.
SERVICE RELOAD INVENTORY-RECORD.
COBOL II example
LINKAGE SECTION
*
01
INVENTORY-RECORD.
.
.
PROCEDURE DIVISION.
.
.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

43/256

EXEC

CICS
GETMAIN SET(ADDRESS OF INVENTORY-RECORD)
LENGTH(2048)
INITMG(HEX-00)
END-EXEC.

BLL CELLS (only OS/VS COBOL)

BLL is Base locator for linkage
The base locator for linkage (BLL) mechanism is used to address storage
outside the working-storage section of an application program.
It
operates by addressing the storage as if it were a parameter to the
program.
The storage must be defined by means of an 01-level data
definition in the linkage section of the program.
The COBOL compiler
generates code to address the storage using the parameter list.
When
the program is invoked, CICS sets up the parameter list in such a way
that the parameter list is itself addressable by the application
program.
The parameter list must be defined as the first parameter to the
program, unless a communication area is being passed to the program, in
which case the DFHCOMMAREA definition must precede it.
In the following example, the first 02-level data name(that is, FILLER)
is set up by CICS to provide addressability to the other fields in the
parameter list.
The other data names are known as BLL cells, and
address the remaining parameters of the program. There is a one-to-one
correspondence between the 02-level data names of the parameter list
definition and the 01-level data definitions in the linkage section:
LINKAGE SECTION.
01 PARMLIST.
02 FILLER PIC S9(8) COMP.
02 A-POINTER PIC S9(8) COMP.
02 B-POINTER PIC S9(8) COMP.
02 C-POINTER PIC S9(8) COMP.
01 A-DATA.
02 PARTNO PIC 9(4).
02 QUANTITY PIC 9(4) .
02 DESCRIPTION PIC X(100).
01 B-DATA PIC X.
01 C-DATA PIC X.
BLL cells and areas greater than 4096 bytes
Special considerations apply for OS/VS COBOL when the LOADED program or
the GETMAINED storage exceeds 4096 bytes. Here is a snippet of the code
when the loaded program is more than 4096 bytes.
LINKAGE SECTION
*

01

BLL-CELLS.
05
FILLER
05
BLL-TABLE-ADDRESS-1
05
BLL-TABLE-ADDRESS-2

PIC S9(8) COMP.

PIC S9(8) COMP.
PIC S9(8) COMP.

APPLICATION PROGRAMMING IN CICS BASIC

05

*
1

BLL-TABLE-ADDRESS-3

TABLE

24/08/2003

44/256

PIC S9(8) COMP.

PIC X(9606).

PROCEDURE DIVISION.

0000-ACCEPT-CUSTOMER-ORDERS.

EXEC

CICS
LOAD PROGRAM(STATABL)
SET(BLL-TABLE-ADDRESS-1)
END-EXEC.
ADD 4096 BLL-TABLE-ADDRESS-1 GIVING BLL-TABLE-ADDRESS-2
ADD 4096 BLL-TABLE-ADDRESS-2 GIVING BLL-TABLE-ADDRESS-3
SERVICE RELOAD TABLE.
In general If an address is moved into a BLL cell, addressability must
be established in the same way, for example:
MOVE B-POINTER TO A-POINTER.
SERVICE RELOAD A-DATA.
CICS Allocation of storage
CICS always allocates on double-word boundaries and rounds the requested
length up to the nearest double-word multiple.
Because there is no
default initialization, you must use the INITIMG option if you require
the storage to be initialized to a specific bit configuration.
CICS allocates storage from one of six different dynamic storage areas
(DSAs):

The CICS dynamic storage area (CDSA), below the 16MB line

The user dynamic storage area (UDSA), below the 16MB line

The shared dynamic storage area (SDSA), below the 16MB line

The extended CICS dynamic storage area (ECDSA), above the 16MB line

The extended user dynamic storage area (EUDSA), above the 16MB line

The extended shared dynamic storage area (ESDSA), above the 16MB line

There are two other dynamic storage areas--the read-only DSA (RDSA)
and the extended read-only DSA (ERDSA)--but you cannot GETMAIN
storage from these DSAs.

CICS decides whether to allocate storage from a CICS-key or user-key

DSA, or from a shared DSA, according to the following options:

The USERDATAKEY option on the GETMAIN command.

The CICSDATAKEY option on the GETMAIN command.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

45/256

The TASKDATAKEY option on the transaction resource definition under

which the requesting program is running if the USERDATAKEY or
CICSDATAKEY option is omitted.

The SHARED option on the GETMAIN command.

The data-key option on the GETMAIN command overrides the TASKDATAKEY

option on the transaction resource definition.
+------------------------------------------------------------------------+

Without SHARED option

+------------------------------------------------------------------------
No data-key
USERDATAKEY specified

CICSDATAKEY specified

option

+--------------+----------------------------+----------------------------
Determined
User-key storage
CICS-key storage

by
(from UDSA or EUDSA)
(from CDSA or ECDSA)

TASKDATAKEY

on

transaction

definition

+------------------------------------------------------------------------+
+------------------------------------------------------------------------+

With SHARED option

+------------------------------------------------------------------------
No data-key
USERDATAKEY specified

CICSDATAKEY specified

option

+--------------+----------------------------+----------------------------
Determined
User-key storage
CICS-key storage

by
(from SDSA or ESDSA)
(from CDSA or ECDSA)

TASKDATAKEY

on

transaction

definition

+------------------------------------------------------------------------+
Note:-Shared DSA are for long life, shared Storage. SHARED storage is
available for all tasks, even those that run with Transaction isolation.
Example of GETMAIN OS/VS Cobol
LINKAGE SECTION.
*
01 BLL-CELLS.
*
05 FILLER
PIC S9(8)
COMP.
05 BLL-INVENTORY-RECORD
PIC S9(8)
COMP.
*
1
INVENTORY-RECORD.
.
.
.
PROCEDURE DIVISION.
.
.
EXEC CICS
GETMAIN
SET(BLL-INVENTORY-RECORD)

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

46/256

LENGTH(2048)
INITMG(HEX-00)
.

END-EXEC

Example of GETMAIN VS Cobol

LINKAGE SECTION.
*
1
INVENTORY-RECORD.
.
.
.
PROCEDURE DIVISION.
.
.
EXEC CICS
GETMAIN
SET(ADDRESS OF INVENTORY RECORD)
LENGTH(2048)
INITMG(HEX-00)
END-EXEC.
.
.
EXEC CICS
FREEMAIN DATA(INVENTORY RECORD)
END-EXEC.
The common work area
The common work area (CWA) is an area of storage within your CICS region
that any user application can access. You determine the size of this
work area by means of the WRKAREA system initialization parameter, which
allows you to specify sizes up to 3584 bytes. If you omit the WRKAREA
parameter, CICS allocates a 512 byte CWA by default. You specify the
storage key for the CWA on the CWAKEY parameter.
Because this work area is available to all transactions in a CICS
region, you should ensure that the storage key is appropriate to the use
of the CWA by all transactions. If there is only one transaction that
runs in user key, and which requires write access, you must specify user
key storage for the CWA, otherwise it will fail with a storage
protection exception (an ASRA abend). CICS obtains user key storage for
the CWA by default, and you must review the use of this storage by all
programs before you decide to change it to CICS key.
It is possible that you might want to protect the CWA from being
overwritten by applications that should not have write access. In this
case, provided all the transactions that legitimately require write
access to the CWA run in CICS key, you can specify CICS key storage for
the CWA.
To access CWA you need to tell the system the CWA is needed. This is a
system programmers job and is specified through SIT. SIT stands for
System Initialization Table that is a table written in assembler and
which is compiled and link edited and specified through the CICS startup
JCL (DFHSIT is the default). Overrides could be provided via JCL SYSIN
parameters, PARM= in the exec for the CICS system program or through
operator overrides. The two parms that affect the CWA are:-

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

47/256

CWAKEY={USER|CICS}
specifies the storage key for the common work area (CWA) if you are
operating CICS with storage protection (STGPROT=YES). The permitted
values are USER (the default), or CICS:
USER

CICS obtains storage for the CWA in user key. This allows a
user program executing in any key to modify the CWA.

CICS

CICS obtains storage for the CWA in CICS key.

This means
that only programs executing in CICS key can modify the CWA,
and user-key programs have read-only access.

If CICS is running without storage protection, the CWAKEY parameter is

ignored, and the CWA is always allocated from CICS-key storage.
WRKAREA={512|number}
specifies the number of bytes to be
(CWA).
This area, for use by your
binary zeros, and is available to all
The maximum size for the work area is

allocated to the common work area

installation, is initially set to
programs. It is not used by CICS.
3584 bytes.

TCTUAKEY={USER|CICS}
specifies the storage key for the terminal control table user areas
(TCTUAs)
if
you
are
operating
CICS
with
storage
protection
(STGPROT=YES).
USER

CICS obtains the amount of storage for TCTUAs in user key.

This allows a user program executing in any key to modify
the TCTUA.

CICS

The storage is obtained in CICS key

If CICS is running without storage protection, the TCTUAKEY parameter

only designates which DSA (User or CICS) the storage comes from. The
TCTUAs are accessed in CICS-key whether they are in the UDSA or CDSA.
TCTUALOC={BELOW|ANY}
specifies where terminal user areas (TCTUA) are to be stored.
BELOW

The TCTUAs are stored below the 16MB line.

ANY

The TCTUAs are stored anywhere in virtual storage.

CICS
stores TCTUAs above the 16MB line if possible. CICS obtains
the amount of storage in CICS key.
This means that only
programs executing in CICS key can modify the TCTUA, and
user-key programs have read-only access.

The system programmer defines the size of the area. The CWA could be
accessed by all CICS transactions. The TCTUA is an area shared by all
transactions run from the same terminal. This area is rarely used as
front ends have changed from 3270s to client systems that do not
communicate as a terminal to CICS.
TWA
All programs that run as a result of an instance of the transaction
execution share this work area. It is specified in the RDO for a
transaction via TWASIZE parameter and can be up to 32767 bytes.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

48/256

The ADDRESS Command

Obtain access to CICS storage areas.
EXEC CICS
ADDRESS
COMMAREA(ptr ref)
CWA(ptr ref)
EIB(ptr ref)
TCTUA(ptr ref)
TWA(ptr ref)
END-EXEC
Options
COMMAREA

Establishes addressability to the communication area. The

ADDRESS COMMAREA command is used only in C programs as COBOL
automatically
establishes
addressability
to
the
communication area.

CWA

Establishes addressability to the Common Work Area. This

area is a user defined area common to all tasks in a CICS
system.

EIB

Establishes addressability to the Execute Interface Block.

Usually only used by called subprogram to access the EIB.

TCTUA

Establishes addressability to the Terminal Control Table

User Area. This is defined by the user and is unique to a
terminal.

TWA

Establishes addressability to the Transaction Work Area.

This is a user defined area that is unique to the current
task. The TWA is deleted when the current task ends.

Condition
INVREQ

You attempted to address the TCTUA in a program that was

started by a DPL.

Notes
The ADDRESS command simply returns the address requested. You have to
provide the 01 level structure in the linkage section to map over the
addressed area.

The format and size of the CWA is installation dependent. The size is
specified in the SIT. The format is decided by the programs that
access this area.

The size and format of the TCTUA and TWA are also installation
dependent as in the case of the CWA.

Note that use of these area introduces transaction affinities. The

term means that later you cannot shift part of the application to a
different CICS region to distribute load / increase reliability.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Example for CWA

VS COBOL II
LINKAGE SECTION.
*
01 COMMON-WORK-AREA.
.
.
*
PROCEDURE DIVISION.
*
.
.
EXEC CICS
ADDRESS CWA(ADDRESS OF COMMON-WORK-AREA).
END-EXEC.
VS OS/VS COBOL
LINKAGE SECTION.
*
01 BLL-CELLS.
*
05
FILLER
PIC S9(8) COMP.
05
BLL-CWA
PIC S9(8) COMP.
01 COMMON-WORK-AREA.
.
.
*
PROCEDURE DIVISION.
*
.
.
EXEC CICS
ADDRESS CWA(BLL-CWA).
END-EXEC.
SERVICE RELOAD COMMON-WORK-AREA.

49/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

50/256

ADVANCED BMS

back
A logical message is a single unit of output thats created from one or
more SEND TEXT or SEND MAP commands. When you use SEND TEXT or SEND MAP
to build a logical message BMS collects the output from one or more such
commands and treats it as a single logical unit.
BMS provides a set of message retrieval commands to fetch pieces of the
logical message. Logical message building or just message building is
also known as terminal paging and page building. They all mean the same
thing and use a message building program to create a logical message.
The logical message building program uses SEND TEXT or SEND MAP commands
with special options to build the message.
Once a message is built it is delivered to the terminal. Three factors
affect the building and delivery process:1. Message disposition
2. Terminal status
3. Message routing
Message disposition
Two dispositions are possible, terminal or paging, which you specify as
an option in the SEND TEXT or SEND MAP command.
When you specify Terminal disposition, the message is sent directly to
the terminal as it is created.

BMS
User Task
SEND MAP
or
SEND TEXT

Page and text

build program

Terminal page
processor

Page buffer

The three BMS components build one page at a time and deliver the
completed page immediately to the output device.

Terminal

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

51/256

Paging Disposition
With this disposition the logical message is not sent directly to the
terminal. Instead the entire message is held in temporary storage until
the operator retrieves it. You use this disposition for a terminal as it
needs user interaction to fetch the pages.
Temporary storage
area for Logical
messages

BMS
User Task
SEND MAP
or
SEND TEXT

Page and text

build program

Terminal page
processor

Page buffer

Page 1

Page 2

Page n

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

52/256

Terminal Status
Each terminal in the CICS system has a terminal status that affects the
way messages with the paging disposition are delivered to it. Two
options are possible, paging and autopage.
For terminals with a paging status BMS delivers pages one at a time as
the operator requests them.
Temporary storage
area for Logical
messages
Terminal

BMS
Page 1
Page retrieval
program
Page 2

Page requests

Page n

Paging status indicates that operators can request pages one at a time
by issuing retrieval commands. In contrast paging disposition means a
logical message is written to temporary storage for later delivery.
Paging status is meaningful only for output with paging disposition.
Autopage status
For a terminal with autopage status, usually a printer, the entire
message is delivered automatically as soon as the terminal is ready.
That way no message retrieval commands are necessary from the device.
Sometimes a program can route a message to a terminal(usually a printer)
other than the one to which it is attached. This is called message
routing.
Message Retrieval
Two commands are used getpage and msgterm.
The getpage Command
P/n
Retrieve page n
P/+n Retrieve the page
P/-n Retrieve the page
P/L
Retrieve the last
P/N
Retrieve the next

thats n pages past the current page

thats n pages before the current page
page
page

APPLICATION PROGRAMMING IN CICS BASIC

P/P

24/08/2003

53/256

Retrieve the previous page

The Msgterm command

T/B

Terminate the page retrieval session and purge the message being
displayed.

Single Keystroke retrieval

Also known as SKR PF keys are associated with specific commands. For
example:PF5
PF6
PF7
PF8
PF3

P/1
P/L
P/P
P/N
T/B

The PF keys assume the above meaning only when page retrieval session is
active. If you use a 3270 display device under BTAM or VTAM, you can use
PA or PF keys, as defined in the SKRxxxx system initialization
parameter, to enter page retrieval commands, and greatly reduce the
number of keystrokes necessary in a page retrieval session.
System Considerations for Page Retrieval
The page retrieval command allows you to retrieve a specified page.
CSPG getpage B
getpage
This is the user-defined identification code for the retrieval
transaction, and is 1-7 characters long.
This code is defined by the
PGRET system initialization parameter. For convenience, make the code
as short as possible; for example, P/.
B
Defines the next operation to be performed on the logical message at the
current level, or at the level specified by the a option It can be one
of the following:
n
page n
+n
page n pages forward
-n
page n pages backward
P
previous page
C
redisplay current page (after clearing the screen)
N
next page
L
last page
Examples
In the following examples, P/ is the page retrieval transaction
identifier:
P/7
P/N

Retrieve page 7 of this message.

Retrieve next page (following the one being displayed) of this
message.

CSPG msgterm B
msgterm

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

54/256

Similarly the SIT parameter PGPURGE specifies the character string for
msgterm, usually set to T/.
A
Terminates all logical messages destined for and being displayed on that
terminal (including routed messages not yet displayed).
B
Terminates the logical message being displayed on that terminal and all
logical messages chained to it. This does not include routed messages.
Whenever you have finished with all the output from a transaction, you
should terminate the base message by entering a command of the form
msgtermB. If the message has been built using a SEND PAGE command with
the OPERPURGE option omitted, you can terminate the paging session by
entering data other than a paging command.
C
Terminates the current (level) logical message and any messages chained
below it.
The SEND TEXT command
EXEC CICS
SEND TEXT FROM(data-area)
[ LENGTH(data-area) ]
[ ACCUM ]
[ PAGING ]
[ ERASE ]
[ HEADER(data-area) ]
[ TRAILER(data-area) ]
[ REQID(name) ]
END-EXEC
Options
FROM

Specifies the data area containing the data to be sent.

LENGTH

Optional under new versions of COBOL (other than OS/VS

Cobol). If used it must be PIC S9(4) COMP field.

ACCUM

Specifies that this SEND TEXT command is used to build a

Logical message.

PAGING

Write the message to temporary storage for later retrieval.

ERASE

Clear the terminals buffer before each page of the message

is displayed during page retrieval.

HEADER

Name of the field which contains the header information to

be displayed.

TRAILER

Name of the field from where the trailer information is to

be displayed.

REQID

Specifies a two character name thats used for message

recovery. If omitted ** is assumed. All BMS commands for
the same logical message must specify the same REQID.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

55/256

Conditions
IGREQID

It means that you changed the REQID for a logical message.

INVREQ

It means that this request is not allowed.

LENGERR

The length specified in the length option is out of range.

TSIOERR

A Temporary Storage I/O error has occurred.

Notes
1. When you use send text data is broken into lines, the break taking
place between words, so words are not split across lines. You can
force a line break by introducing a new line character X15.
2. When you are building a message be sure to use the ACCUM and PAGING
options. The HEADER and TRAILER options let you specify data areas
that contain header and trailer information. This data is included in
the output if the text data overflows a page. The header and trailer
areas start with a 4 byte prefix. The first two bytes indicate the
length in binary form, excluding the 4 byte prefix. The third byte
indicates whether the page should be numbered. The fourth byte is
reserved by IBM.
3. The JUSTIFY, JUSFIRST and JUSLAST lets you alter the output datas
position. With JUSTIFY you specify the line number at which the data
is to be positioned. JUSFIRST and JUSLAST allows you to position data
at the top or bottom of the page after allowing for the header and
trailer areas. If you omit JUSTIFY, JUSFIRST and JUSLAST the data is
positioned at the next available line.
4. ACCUM means that output from one or more SEND TEXT commands is used
to build a logical message. PAGING indicates paging disposition which
means that the output is written to temporary storage. If you omit
PAGING it is written directly to the terminal buffer.
5. When you use the HEADER and TRAILER options BMS automatically inserts
the TRAILER before a page overflow and a HEADER at the start of a new
page. BMS counts the output lines written in between to determine
when it should insert the trailer. The header of course is written at
the start of a new page.
6. If you want page numbering, include a four byte prefix at the start
of both the header and trailer data blocks. The prefix is of the form

PIC S9(4) comp field which is set to the length of the header or
trailer area not counting the prefix.

A single character, which if non blank, tells BMS page numbering

is required. For example if it is * BMS scans the header (or
trailer) for occurrences of * and replaces it with the page
number. You can use up to five bytes for the page number.

The fourth byte is a filler used by BMS.

The SEND PAGE command

EXEC CICS

APPLICATION PROGRAMMING IN CICS BASIC

SEND PAGE

[
[
[
[

24/08/2003

56/256

RELEASE [TRANSID(name) | RETAIN ]]

AUTOPAGE | NOAUTOPAGE ]
OPERPURGE ]
TRAILER(data-area) ]

END-EXEC
Options
RELEASE

Specifies that the terminal paging transaction is to be

initiated immediately. After the message is delivered,
control is to return directly to CICS as if the program had
issued a RETURN command. The page retrieval command is
invoked via XCTL command.

TRANSID

Specifies the transaction identifier

associated with the next terminal input.

RETAIN

If you code the RETAIN command option, the page retrieval

command is automatically invoked via the LINK command. When
the operator has finished viewing the message, control
returns to your program following the SEND TEXT RETAIN
command.

OPERPURGE

The OPERPURGE command option tells BMS that the message has
to be explicitly purged by the operator by entering T/B.

TRAILER

Specifies a data area that contains data that is to be

displayed at the bottom of the last page. See SEND TEXT for
details of how to format this data. This is usually required
to display gross totals etc.

AUTOPAGE

Specifies that the pages should be sent to the terminal

automatically. NOAUTOPAGE specifies that the pages are to be
sent under operator control.

Conditions
INVREQ

The request is not allowed

TSIOERR

A temporary Storage error occurred

that

is

to

be

Notes
If you omit both RETAIN and RELEASE the page retrieval command is
attached as a separate task.
The DFHMDI macro revisited
Name DFHMDI
SIZE=(lines,columns),
[ LINE = {line-number | NEXT}, ]
[ COLUMN = column-number ]
[ JUSTIFY = {FIRST | LAST }, ]
[ { HEADER=YES | TRAILER=YES } ]
Options
SIZE
LINE

Specifies the size of the map in lines and columns.

Specifies the position of the first line of the map. If a
Number is coded then the map is positioned at that line. If
NEXT is coded the map is positioned at the next available
line.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

57/256

COLUMN

Specifies the starting column of the map.

JUSTIFY

If FIRST the map is positioned on a new page, the previous

page being Written to Temporary Storage. If LAST it is
positioned at the end of the current page.

HEADER

if YES the map is treated as a header map.

TRAILER

if YES the map is treated as a trailer map.

Notes
When you attempt to send a detail map, if there is enough room only
for the trailer, BMS signals this via OVERFLOW. The program has to
detect this condition and send first the trailer map followed by the
header. If either map contains fields like Date, Page number or Page
total, the application has to set these fields with the right values
before issuing the SEND MAP.
Overflow does not occur when you send a header or trailer map, so
that you can send these without having to deal with another overflow
condition.
The SEND MAP command revisited
EXEC CICS
SEND
MAP(name)
[ MAPSET(name) ]
[ FROM(data-area) ]
[ MAPONLY | DATAONLY
[ ACCUM ]
[ PAGING ]
[ ERASE ]
END-EXEC
Options
MAP

Specifies the 1 to 7 character map name

MAPSET

Specifies the 1 to 8 character mapset name. If omitted the

Map name is used.

FROM

The data area from which the data is to be mapped

MAPONLY

Only constants from the physical map are to be sent

DATAONLY

Only the variable data from the data area is to be sent

ACCUM

This SEND MAP command builds a logical message

PAGING

Specifies that the output pages should be written to

Temporary storage

ERASE

Specifies that the terminals buffer is to be erased before

Each page is sent during page retrieval.

Examples using different Techniques for building a Logical Message

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

58/256

1. Use SEND TEXT which does not need a mapset, EXAMPLE PROLST1
2. Use SEND MAP which needs a mapset, EXAMPLE PROLST2
The product listing Program(send text version)
Program
PROLST1
Overview

Produces a listing of records in the product file.

Input /
Output
Specs

PRODUCT

Subprogram

SYSERR

Product file

Processing Specifications
1. For each record in the product file, list the product code,
description, unit price, and quantity on hand. At the end of the
listing, list the number of products in the file.
2. Create the listing using BMS message building facility and the SEND
TEXT command.
Product Listing
Product
Code

Description

XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX

XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX

Continued on next page...

Page: ***
Unit
Price

Quantity
On Hand

Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99

Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Product Listing
Product
Code

Description

XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX

XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX

Page: ***
Unit
Price

Quantity
On Hand

Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99

Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9

ZZ,ZZ9 records in the product file.

59/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

60/256

Test Data
Create PRODUCT file with Test Data
JCL(member PRODC)
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE userid.PRODUCT CLUSTER
DEFINE CLUSTER (NAME(userid.PRODUCT) INDEXED KEYS(10,0) RECORDSIZE(39,39) TRACKS(1,1)) DATA(CONTROLINTERVALSIZE(1024))
//
Use this program to generate test data with which you can check out your
BMS programs that implement paging.
SAMP18
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP18.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-RESP
PIC S9(08) COMP VALUE 0.
01 PRODUCT-MASTER-RECORD.
*
05 PRM-PRODUCT-CODE
PIC 9(10) VALUE 10.
05 PRM-PRODUCT-DESCRIPTION.
10 PROD-KEY
PIC 9(10).
10 DESCRIPTION
PIC X(10) VALUE "ABCDEFGH".
05 PRM-UNIT-PRICE
PIC S9(7)V99 COMP-3 VALUE 10.00.
05 PRM-QUANTITY-ON-HAND
PIC S9(7)
COMP-3 VALUE 10.
*
01 WS-COUNT
PIC 9(10) VALUE 1.
PROCEDURE DIVISION.
PERFORM MAIN-PARA VARYING WS-COUNT FROM 0 BY 1
UNTIL WS-COUNT EQUAL 100
PERFORM END-PARA.
MAIN-PARA.
MOVE WS-COUNT TO PROD-KEY
MOVE WS-COUNT TO PRM-PRODUCT-CODE
ADD 1 TO PRM-UNIT-PRICE
ADD 1 TO PRM-QUANTITY-ON-HAND
EXEC CICS
WRITE FILE('PRODUCT')
FROM(PRODUCT-MASTER-RECORD)
RIDFLD(PRM-PRODUCT-CODE)
RESP(WS-RESP)
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

61/256

Structure chart for the product listing program (send text version)
0000
prepare
product
listing

1000
start
product
browse

2000
produce
product
line

3000
send
total
line

2200
send
product
line

2100
read
product
record

Copy books
01 PRODUCT-MASTER-RECORD.
05 PRM-PRODUCT-CODE
05 PRM-PRODUCT-DESCRIPTION
05 PRM-UNIT-PRICE
05 PRM-QUANTITY-ON-HAND
01

ERROR-PARAMETERS.
05 ERR-RESP
05 ERR-RESP2
05 ERR-TRNID
05 ERR-RSRCE

PIC
PIC
PIC
PIC

S9(8)
S9(8)
X(4).
X(8).

PIC
PIC
PIC
PIC

X(10).
X(20).
S9(7)V99
S9(7)

COMP-3.
COMP-3.

COMP.
COMP.

Notes
The source for the subprogram SYSERR is shown later in this material.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

62/256

This sample program (PROLST1) needs the following copybooks

The ERRPARM copy member
01 ERROR-PARAMETERS.
*
05 ERR-RESP
PIC S9(8)
COMP.
05 ERR-RESP2
PIC S9(8)
COMP.
05 ERR-TRNID
PIC X(4).
05 ERR-RSRCE
PIC X(8).
The PRODUCT copy member
01 PRODUCT-MASTER-RECORD.
*
05 PRM-PRODUCT-CODE
05 PRM-PRODUCT-DESCRIPTION
05 PRM-UNIT-PRICE
05 PRM-QUANTITY-ON-HAND
*

PIC
PIC
PIC
PIC

X(10).
X(20).
S9(7)V99
S9(7)

COMP-3.
COMP-3.

The PROLST1 program transaction-id PRO1

IDENTIFICATION DIVISION.
PROGRAM-ID. PROLST1.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SWITCHES.
05 PRODUCT-EOF-SW PIC X
VALUE 'N'.
88 PRODUCT-EOF
VALUE 'Y'.
01 WORK-FIELDS.
05 RECORD-COUNT
PIC S9(5)
VALUE ZERO COMP-3.
01 RESPONSE-CODE
PIC S9(8)
COMP.
01 HEADER-AREA.
05 HA-PREFIX.
10 HA-LENGTH
PIC S9(4)
VALUE 176
COMP.
10 HA-PAGE-CODE PIC X
VALUE '*'.
10 FILLER
PIC X
VALUE SPACE.
05 HEADER-LINE-1.
10 FILLER
PIC X(20) VALUE '
Produ'.
10 FILLER
PIC X(20) VALUE 'ct Listing
'.
10 FILLER
PIC X(15) VALUE '
Page: ***'.
10 HA1-NL
PIC XX
VALUE X'1515'.
05 HEADER-LINE-2.
10 FILLER
PIC X(20) VALUE 'Product
'.
10 FILLER
PIC X(20) VALUE SPACE.
10 FILLER
PIC X(19) VALUE ' Unit
Quantity'.
10 HA2-NL
PIC X
VALUE X'15'.
05 HEADER-LINE-3.
10 FILLER
PIC X(20) VALUE 'Code
Descript'.
10 FILLER
PIC X(20) VALUE 'ion
'.
10 FILLER
PIC X(17) VALUE ' Price
On Hand'.
10 HA3-NL
PIC XX
VALUE X'1515'.
01 PRODUCT-LINE.
05 PL-PRODUCT-CODE PIC X(10).
05 FILLER
PIC XX
VALUE SPACE.
05 PL-DESCRIPTION
PIC X(20).
05 FILLER
PIC XX
VALUE SPACE.
05 PL-UNIT-PRICE
PIC Z,ZZZ,ZZZ.99.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

63/256

05 FILLER
PIC XX
VALUE SPACE.
05 PL-QUANTITY
PIC Z,ZZZ,ZZ9.
05 PL-NL
PIC X
VALUE X'15'.
01 TOTAL-LINE.
05 TL-NL
PIC X
VALUE X'15'.
05 TL-RECORD-COUNT PIC ZZ,ZZ9.
05 FILLER
PIC X(15) VALUE ' records in the'.
05 FILLER
PIC X(15) VALUE ' product file. '.
01 TRAILER-AREA.
05 TA-PREFIX.
10 TA-LENGTH
PIC S9(4) VALUE 26 COMP.
10 FILLER
PIC XX
VALUE SPACE.
05 TRAILER-LINE.
10 TA-NL
PIC X
VALUE X'15'.
10 FILLER
PIC X(20) VALUE 'Continued on next pa'.
10 FILLER
PIC X(5)
VALUE 'ge...'.
COPY PRODUCT.
COPY ERRPARM.
PROCEDURE DIVISION.
0000-PRODUCE-PRODUCT-LISTING.
PERFORM 1000-START-PRODUCT-BROWSE.
PERFORM 2000-PRODUCE-PRODUCT-LINE
UNTIL PRODUCT-EOF.
PERFORM 3000-SEND-TOTAL-LINE.
EXEC CICS
SEND PAGE
OPERPURGE
END-EXEC.
EXEC CICS
RETURN
END-EXEC.
1000-START-PRODUCT-BROWSE.
MOVE LOW-VALUE TO PRM-PRODUCT-CODE.
EXEC CICS
STARTBR DATASET('PRODUCT')
RIDFLD(PRM-PRODUCT-CODE)
GTEQ
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'Y' TO PRODUCT-EOF-SW
ELSE IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
GO TO 9999-TERMINATE-PROGRAM.
2000-PRODUCE-PRODUCT-LINE.
PERFORM 2100-READ-PRODUCT-RECORD.
IF NOT PRODUCT-EOF
PERFORM 2200-SEND-PRODUCT-LINE.
2100-READ-PRODUCT-RECORD.
EXEC CICS
READNEXT DATASET('PRODUCT')
RIDFLD(PRM-PRODUCT-CODE)
INTO(PRODUCT-MASTER-RECORD)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NORMAL)
ADD 1 TO RECORD-COUNT
ELSE IF RESPONSE-CODE = DFHRESP(ENDFILE)

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

64/256

MOVE 'Y' TO PRODUCT-EOF-SW

ELSE

GO TO 9999-TERMINATE-PROGRAM.
2200-SEND-PRODUCT-LINE.
MOVE PRM-PRODUCT-CODE
TO PL-PRODUCT-CODE.
MOVE PRM-PRODUCT-DESCRIPTION TO PL-DESCRIPTION.
MOVE PRM-UNIT-PRICE
TO PL-UNIT-PRICE.
MOVE PRM-QUANTITY-ON-HAND
TO PL-QUANTITY.
EXEC CICS
SEND TEXT FROM(PRODUCT-LINE)
ACCUM
PAGING
ERASE
HEADER(HEADER-AREA)
TRAILER(TRAILER-AREA)
END-EXEC.
3000-SEND-TOTAL-LINE.
MOVE RECORD-COUNT TO TL-RECORD-COUNT.
EXEC CICS
SEND TEXT FROM(TOTAL-LINE)
ACCUM
PAGING
ERASE
END-EXEC.
9999-TERMINATE-PROGRAM.
MOVE EIBRESP TO ERR-RESP.
MOVE EIBTRNID TO ERR-TRNID.
MOVE EIBRSRCE TO ERR-RSRCE.
EXEC CICS
XCTL PROGRAM('SYSERR')
COMMAREA(ERROR-PARAMETERS)
END-EXEC.
When you use SEND TEXT command the field you specify in the FROM option
can contain one or more lines of text. Line endings are indicated by the
new line character X15.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

65/256

The product listing program(send map version)

Program
PROLST2
Overview

Produces a listing of records in the product file

Input /
Output
Specs

PRODUCT
LSTSET1

Product file
Mapset

Processing Specifications
1. For each record in the product file, list the product code,
description, unit price, and quantity on hand. At the end of the
listing, list the number of products in the file
2. Create the listing using BMS message building facility and the SEND
MAP command.
The LSTSET1 mapset
Study the following Mapset. It has four maps. One for the Header, one
for a detail line, one for the trailer and the last map for the total
line.
The LSTSET1 mapset
PRINT NOGEN
LSTSET1 DFHMSD TYPE=&SYSPARM,
X
LANG=COBOL,
X
MODE=INOUT,
X
TERM=3270-2,
X
CTRL=FREEKB,
X
STORAGE=AUTO,
X
TIOAPFX=YES
***********************************************************************
LSTMAP1 DFHMDI SIZE=(5,80),
X
JUSTIFY=FIRST,
X
HEADER=YES
***********************************************************************
DFHMDF POS=(1,16),
X
LENGTH=15,
X
ATTRB=(NORM,PROT),
X
INITIAL='Product Listing'
DFHMDF POS=(1,47),
X
LENGTH=5,
X
ATTRB=(NORM,PROT),
X
INITIAL='Page:'
PAGENO
DFHMDF POS=(1,53),
X
LENGTH=3,
X
ATTRB=(NORM,PROT),
X
PICOUT='ZZ9'
DFHMDF POS=(3,1),
X
LENGTH=7,
X
ATTRB=(NORM,PROT),
X
INITIAL='Product'
DFHMDF POS=(3,43),
X
LENGTH=17,
X
ATTRB=(NORM,PROT),
X
INITIAL='Unit
Quantity'
DFHMDF POS=(4,1),
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

66/256

LENGTH=23,
X
ATTRB=(NORM,PROT),
X
INITIAL='Code
Description'
DFHMDF POS=(4,42),
X
LENGTH=18,
X
ATTRB=(NORM,PROT),
X
INITIAL='Price
On Hand'
***********************************************************************
***********************************************************************
LSTMAP2 DFHMDI SIZE=(1,80),
X
LINE=NEXT,
X
COLUMN=1
***********************************************************************
PCODE
DFHMDF POS=(1,1),
X
LENGTH=10,
X
ATTRB=(NORM,PROT)
DESCR
DFHMDF POS=(1,13),
X
LENGTH=20,
X
ATTRB=(NORM,PROT)
UPRICE
DFHMDF POS=(1,35),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
PICOUT='Z,ZZZ,ZZ9.99'
ONHAND
DFHMDF POS=(1,49),
X
LENGTH=9,
X
ATTRB=(NORM,PROT),
X
PICOUT='Z,ZZZ,ZZ9'
***********************************************************************
***********************************************************************
LSTMAP3 DFHMDI SIZE=(2,80),
X
JUSTIFY=LAST,
X
TRAILER=YES
DFHMDF POS=(2,1),
X
LENGTH=25,
X
ATTRB=(NORM,PROT),
X
INITIAL='Continued on next page...'
***********************************************************************
***********************************************************************
LSTMAP4 DFHMDI SIZE=(2,80),
X
LINE=NEXT,
X
COLUMN=1,
X
TRAILER=YES
COUNT
DFHMDF POS=(2,1),
X
LENGTH=6,
X
ATTRB=(NORM,PROT),
X
PICOUT='ZZ,ZZ9'
DFHMDF POS=(2,8),
X
LENGTH=28,
X
ATTRB=(NORM,PROT),
X
INITIAL='records in the product file.'
***********************************************************************
DFHMSD TYPE=FINAL
END
Notes

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

67/256

1. The SIZE parameter tells BMS about the number of lines and columns in
the map. SIZE=(5,80) indicates that there are 5 rows and 80 columns
and that is the size of the header map.
2. You use the LINE, COLUMN and JUSTIFY to specify the starting position
of the map within the current page.
3. If you code LINE=NEXT the map is positioned in the next available
line in the current page. You usually code this for the detail line
map.
4. If you code JUSTIFY=FIRST the map is positioned at the beginning of
the next page. You usually code this for a header map. The effect of
JUSTIFY=FIRST is the similar as coding as LINE=1 and COLUMN=1. The
big difference is that when you code JUSTIFY=FIRST the existing
contents of the page buffer are written to Temporary Storage and the
map is written at the top of the new page buffer. LINE=1 and COLUMN=1
does not cause the page buffer to be written to the Temporary
Storage.
5. JUSTIFY=LAST causes the map to be positioned at the bottom of the
current page.
6. You use the HEADER and TRAILER parameters to indicate that the map is
a header or a trailer.
Product Listing
Product
Code

Description

XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX

XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX

Continued on next page...

Page: ***
Unit
Price

Quantity
On Hand

Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99

Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Product Listing
Product
Code

Description

XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX
XXXXXXXXXX

XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX

Page: ***
Unit
Price

Quantity
On Hand

Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99

Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9
Z,ZZZ,ZZ9

ZZ,ZZ9 records in the product file.

68/256

APPLICATION PROGRAMMING IN CICS BASIC

The Symbolic Map
01 LSTMAP1I.
05 FILLER
05 PAGENOL
05 PAGENOF
05 FILLER REDEFINES PAGENOF.
10 PAGENOA
05 PAGENOI
01 LSTMAP1O REDEFINES LSTMAP1I.
05 FILLER
05 FILLER
05 PAGENOO
01 LSTMAP2I.
05 FILLER
05 PCODEL
05 PCODEF
05 FILLER REDEFINES PCODEF.
10 PCODEA
05 PCODEI
05 DESCRL
05 DESCRF
05 FILLER REDEFINES DESCRF.
10 DESCRA
05 DESCRI
05 UPRICEL
05 UPRICEF
05 FILLER REDEFINES UPRICEF.
10 UPRICEA
05 UPRICEI
05 ONHANDL
05 ONHANDF
05 FILLER REDEFINES ONHANDF.
10 ONHANDA
05 ONHANDI
01 LSTMAP2O REDEFINES LSTMAP2I.
05 FILLER
05 FILLER
05 PCODEO
05 FILLER
05 DESCRO
05 FILLER
05 UPRICEO
05 FILLER
05 ONHANDO
01 LSTMAP3I.
05 FILLER
01 LSTMAP3O REDEFINES LSTMAP3I.
05 FILLER
01 LSTMAP4I.
05 FILLER
05 COUNTL
05 COUNTF
05 FILLER REDEFINES COUNTF.
10 COUNTA
05 COUNTI
01 LSTMAP4O REDEFINES LSTMAP4I.
05 FILLER

24/08/2003

69/256

PIC X(12).
PIC S9(4) COMP.
PIC X(01).
PIC X(01).
PIC X(003).
PIC X(12).
PIC X(03).
PIC ZZ9.
PIC X(12).
PIC S9(4) COMP.
PIC X(01).
PIC
PIC
PIC
PIC

X(01).
X(010).
S9(4) COMP.
X(01).

PIC
PIC
PIC
PIC

X(01).
X(020).
S9(4) COMP.
X(01).

PIC
PIC
PIC
PIC

X(01).
X(012).
S9(4) COMP.
X(01).

PIC X(01).
PIC X(009).
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X(12).
X(03).
X(010).
X(03).
X(020).
X(03).
Z,ZZZ,ZZ9.99.
X(03).
Z,ZZZ,ZZ9.

PIC X(12).
PIC X(12).
PIC X(12).
PIC S9(4) COMP.
PIC X(01).
PIC X(01).
PIC X(006).
PIC X(12).

APPLICATION PROGRAMMING IN CICS BASIC

01

01

01

01

01
01
01

01

05 FILLER
05 COUNTO
LSTMAP1I.
05 FILLER
05 PAGENOL
05 PAGENOF
05 FILLER REDEFINES PAGENOF.
10 PAGENOA
05 PAGENOI
LSTMAP1O REDEFINES LSTMAP1I.
05 FILLER
05 FILLER
05 PAGENOO
LSTMAP2I.
05 FILLER
05 PCODEL
05 PCODEF
05 FILLER REDEFINES PCODEF.
10 PCODEA
05 PCODEI
05 DESCRL
05 DESCRF
05 FILLER REDEFINES DESCRF.
10 DESCRA
05 DESCRI
05 UPRICEL
05 UPRICEF
05 FILLER REDEFINES UPRICEF.
10 UPRICEA
05 UPRICEI
05 ONHANDL
05 ONHANDF
05 FILLER REDEFINES ONHANDF.
10 ONHANDA
05 ONHANDI
LSTMAP2O REDEFINES LSTMAP2I.
05 FILLER
05 FILLER
05 PCODEO
05 FILLER
05 DESCRO
05 FILLER
05 UPRICEO
05 FILLER
05 ONHANDO
LSTMAP3I.
05 FILLER
LSTMAP3O REDEFINES LSTMAP3I.
05 FILLER
LSTMAP4I.
05 FILLER
05 COUNTL
05 COUNTF
05 FILLER REDEFINES COUNTF.
10 COUNTA
05 COUNTI
LSTMAP4O REDEFINES LSTMAP4I.

24/08/2003

70/256

PIC X(03).
PIC ZZ,ZZ9.
PIC X(12).
PIC S9(4) COMP.
PIC X(01).
PIC X(01).
PIC X(003).
PIC X(12).
PIC X(03).
PIC ZZ9.
PIC X(12).
PIC S9(4) COMP.
PIC X(01).
PIC
PIC
PIC
PIC

X(01).
X(010).
S9(4) COMP.
X(01).

PIC
PIC
PIC
PIC

X(01).
X(020).
S9(4) COMP.
X(01).

PIC
PIC
PIC
PIC

X(01).
X(012).
S9(4) COMP.
X(01).

PIC X(01).
PIC X(009).
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X(12).
X(03).
X(010).
X(03).
X(020).
X(03).
Z,ZZZ,ZZ9.99.
X(03).
Z,ZZZ,ZZ9.

PIC X(12).
PIC X(12).
PIC X(12).
PIC S9(4) COMP.
PIC X(01).
PIC X(01).
PIC X(006).

APPLICATION PROGRAMMING IN CICS BASIC

05
05
05

24/08/2003

FILLER
FILLER
COUNTO

71/256

PIC X(12).
PIC X(03).
PIC ZZ,ZZ9.

Structure map for the product listing map(send map version)

Prepare 0000
Product
Listing

Start 1000
Product
Browse

Send 2230
Header
map

Produce 2000
Product
line

Read 2100
Product
record

Send
3000
Total
line

Send
2200
Product
line

Send 2210
Detail
map

Send 2220
Trailer
map

The PROLST2 Program needs the following copy books

The PRODUCT copy member
01 PRODUCT-MASTER-RECORD.
*
05 PRM-PRODUCT-CODE
PIC X(10).
05 PRM-PRODUCT-DESCRIPTION
PIC X(20).
05 PRM-UNIT-PRICE
PIC S9(7)V99
05 PRM-QUANTITY-ON-HAND
PIC S9(7)
*
The ERRPARM copy member
01 ERROR-PARAMETERS.
*
05 ERR-RESP
05 ERR-RESP2
05 ERR-TRNID
05 ERR-RSRCE

PIC
PIC
PIC
PIC

S9(8)
S9(8)
X(4).
X(8).

COMP.
COMP.

Send
2230
Header
map

COMP-3.
COMP-3.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

The PROLST2 program

IDENTIFICATION DIVISION.
PROGRAM-ID. PROLST2.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SWITCHES.
05 PRODUCT-EOF-SW
PIC X
VALUE 'N'.
88 PRODUCT-EOF
VALUE 'Y'.
05 PAGE-OVERFLOW-SW
PIC X
VALUE 'N'.
88 PAGE-OVERFLOW
VALUE 'Y'.
01 WORK-FIELDS.
05 RECORD-COUNT
PIC S9(5) VALUE ZERO
05 PAGE-NO
PIC S9(3) VALUE 1
01 RESPONSE-CODE
PIC S9(8)
COMP.
COPY LSTSET1.
COPY PRODUCT.
Copy ERRPARM.
PROCEDURE DIVISION.
0000-PRODUCE-PRODUCT-LISTING.
MOVE LOW-VALUE TO LSTMAP1O
LSTMAP2O
LSTMAP4O.
PERFORM 1000-START-PRODUCT-BROWSE.
PERFORM 2230-SEND-HEADER-MAP.
PERFORM 2000-PRODUCE-PRODUCT-LINE
UNTIL PRODUCT-EOF.
PERFORM 3000-SEND-TOTAL-MAP.
EXEC CICS
SEND PAGE
OPERPURGE
END-EXEC.
EXEC CICS
RETURN
END-EXEC.
1000-START-PRODUCT-BROWSE.
MOVE LOW-VALUE TO PRM-PRODUCT-CODE.
EXEC CICS
STARTBR DATASET('PRODUCT')
RIDFLD(PRM-PRODUCT-CODE)
GTEQ
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'Y' TO PRODUCT-EOF-SW
ELSE IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
GO TO 9999-TERMINATE-PROGRAM.
2000-PRODUCE-PRODUCT-LINE.
PERFORM 2100-READ-PRODUCT-RECORD.
IF NOT PRODUCT-EOF
PERFORM 2200-SEND-PRODUCT-LINE.
2100-READ-PRODUCT-RECORD.
EXEC CICS
READNEXT DATASET('PRODUCT')
RIDFLD(PRM-PRODUCT-CODE)
INTO(PRODUCT-MASTER-RECORD)
RESP(RESPONSE-CODE)

72/256

COMP-3.
COMP-3.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

END-EXEC.
IF RESPONSE-CODE = DFHRESP(NORMAL)
ADD 1 TO RECORD-COUNT
ELSE IF RESPONSE-CODE = DFHRESP(ENDFILE)
MOVE 'Y' TO PRODUCT-EOF-SW
ELSE
GO TO 9999-TERMINATE-PROGRAM.
2200-SEND-PRODUCT-LINE.
MOVE PRM-PRODUCT-CODE
TO PCODEO.
MOVE PRM-PRODUCT-DESCRIPTION TO DESCRO.
MOVE PRM-UNIT-PRICE
TO UPRICEO.
MOVE PRM-QUANTITY-ON-HAND
TO ONHANDO.
PERFORM 2210-SEND-DETAIL-MAP.
IF PAGE-OVERFLOW
PERFORM 2220-SEND-TRAILER-MAP
PERFORM 2230-SEND-HEADER-MAP
PERFORM 2210-SEND-DETAIL-MAP
MOVE 'N' TO PAGE-OVERFLOW-SW.
2210-SEND-DETAIL-MAP.
EXEC CICS
SEND MAP('LSTMAP2')
MAPSET('LSTSET1')
FROM(LSTMAP2O)
ACCUM
PAGING
ERASE
NOFLUSH
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(OVERFLOW)
MOVE 'Y' TO PAGE-OVERFLOW-SW
ELSE IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
GO TO 9999-TERMINATE-PROGRAM.
2220-SEND-TRAILER-MAP.
EXEC CICS
SEND MAP('LSTMAP3')
MAPSET('LSTSET1')
MAPONLY
ACCUM
PAGING
ERASE
END-EXEC.
2230-SEND-HEADER-MAP.
MOVE PAGE-NO TO PAGENOO.
EXEC CICS
SEND MAP('LSTMAP1')
MAPSET('LSTSET1')
FROM(LSTMAP1O)
ACCUM
PAGING
ERASE
END-EXEC.
ADD 1 TO PAGE-NO.
3000-SEND-TOTAL-MAP.
MOVE RECORD-COUNT TO COUNTO.
EXEC CICS
SEND MAP('LSTMAP4')

73/256

APPLICATION PROGRAMMING IN CICS BASIC

MAPSET('LSTSET1')
FROM(LSTMAP4O)
ACCUM
PAGING
ERASE

END-EXEC.
9999-TERMINATE-PROGRAM.
MOVE EIBRESP TO ERR-RESP.
MOVE EIBTRNID TO ERR-TRNID.
MOVE EIBRSRCE TO ERR-RSRCE.
EXEC CICS
XCTL PROGRAM('SYSERR')
COMMAREA(ERROR-PARAMETERS)
END-EXEC.

24/08/2003

74/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Advanced File Control

75/256

back

Introduction to Data tables

A CICS file is a representation of a data set on DASD. If you specify
that the file is to use data table services, CICS copies the contents of
the data set into an MVS data space when the file is opened and uses
that copy whenever possible.
Because of the way that the data table services access the records, they
can be used only with a VSAM key-sequenced data set (KSDS). The KSDS is
called the source data set.
The copy in memory is called the data
table. The process of copying the records is called loading the data
table.
When the file is read by a CICS application, the record is normally
retrieved from the data table.
When the file is updated by a CICS
application, the effect depends on the type of data table that you have
defined for the file.
CICS data table services support two types of data table:

CICS-maintained data table (CMT)

User-maintained data table (UMT)

A CICS-maintained data table is a data table whose records are

automatically reflected in the source data set; when you update the
file, CICS changes both the source data set and the data table.
A CICS-maintained data table is easy to implement--you need to know
little about the data table services, you do not need to change your
existing application programs.
A user-maintained data table is a data table whose records are not
automatically reflected in the source data set; when you update the
file, CICS changes only the data table.
A user-maintained data table lets you optimize the benefits of using a
data table by allowing you to eliminate activity on the source data set,
for update requests as well as read requests.
A small number of file operations are not supported for user-maintained
data tables.
Thus, you might need to make minor changes to existing
application programs.
The source data set must be a base VSAM KSDS, not an alternate index.
However, updates made to the KSDS via an alternate index are reflected
in a CICS-maintained data table.
The VSAM definition of the KSDS supplies the values for maximum record
length and key length.
All CICS file control commands can be used in applications that access a
CICS-maintained data table. This means that the benefits of data tables
can
be
obtained
immediately
without
any
changes
to
existing
applications.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

76/256

If the source data set is allocated with DISP=SHR, there is a risk that
it could be updated by a region other than the FOR. If this happened,
the data table would no longer match the source data set. To minimize
this risk, the VSAM cross-region SHAREOPTION should be set to 1 or 2.
1. 1 means that either one region can have update access to the data set
or many regions can have read-only access.
2. 2 means that one region can have update access to the data set and,
at the same time, many regions can have read-only access.
A file that uses a CICS-maintained data table can be defined as a
recoverable resource.
The source data set is recovered in the normal
way after a system or transaction failure:

After a system failure, the data table is reloaded from the recovered
source data set when the file is reopened.

After a transaction failure, changes that are made to the source data
set by dynamic transaction backout are also made to the data table.

If a file is defined as a user-maintained data table (UMT), the source

data set and the data table are treated by CICS as separate entities.
After a user-maintained data table has been loaded, it is independent of
its source data set; the source data set is not updated when the data
table is updated. Thus, a user-maintained data table is particularly
suited to applications that make frequent updates to data that is of a
transitory nature.
If the data table and source data set are updated separately, by
defining them as different files, changes to one are not automatically
reflected in the other.
If a request cannot be satisfied from a user-maintained data table, CICS
does not access the source data set (as it would for a CICS-maintained
data table); instead it returns an exception condition response.
A user-maintained data table can be defined as a recoverable resource.
However, changes to the data table are not recorded in the system log.
Thus the data table can be recovered after a transaction failure (by
dynamic backout) but not after a system failure.
After a system failure, the data table is reloaded from the source data
set when the file is reopened. Remember that, at the time of failure,
the contents of the source data set and data table would not have been
the same unless you had ensured that either:

No change is made to either, or

Any change is made to both.

CICS handles a CICS-maintained data table and its source data set as a
single entity. After the data table has been loaded, CICS automatically
keeps the contents of the data table and the source data set consistent;
any changes that an application makes to the file are reflected in both.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

77/256

All file control commands and options can be used and the use of a data
table is transparent to the application programmer. The following
information is provided to allow you to get the maximum benefits from
your data tables.
Some commands are performed by access only to the data table (using
cross-memory services for shared files), some by access only to the
source data set (using function shipping for shared files), and some by
access to both.
The following commands usually access only the data table:

READ commands without the UPDATE or RBA options

STARTBR, RESETBR, READNEXT, and READPREV commands without the RBA
option
ENDBR command (unless the browse sequence has accessed the source
data set)

The following commands access only the source data set:

READ commands with the UPDATE or RBA options

STARTBR, RESETBR, READNEXT, and READPREV commands with the RBA option

ENDBR command for a browse sequence that has accessed the source data
set

The following commands might access both the data table and the source
data set:

READ and browse commands (which would usually access only the data
table) that find a gap in the sequence of records in the data table.
This gap might indicate that one or more records are missing from the
data table because:
-

Records have been suppressed by a user exit.

The maximum number of records has been reached.
Insufficient virtual storage is available for the data table.
Some abnormal event has occurred.

READ, READNEXT, and READPREV commands for records that are currently
being processed by a WRITE, REWRITE, or DELETE command.
These
commands need to first access the data table to determine that this
situation exists.

WRITE, REWRITE, and DELETE commands.

These commands are always
executed in the FOR, where they first update the source data set. If
this is successful, a corresponding change to the data table is
attempted, using local SDT services in the FOR.
In the case of a
WRITE command, the addition of the record to the data table might be
rejected or might fail because the data table is full or insufficient
virtual storage is available.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

78/256

CICS handles a user-maintained data table and its source data set as
separate entities. When loading is complete, all file control commands
that access the filename are performed only on the data table.
There are some restrictions on which commands and options can be used.
There are also some exceptional conditions that are unique to usermaintained data tables. These restrictions and conditions are described
below.
The following commands are not supported; they
condition and a value of 44 in the EIBRESP2 field:

return

the

INVREQ

Commands with the RBA option

WRITE commands with the MASSINSERT option

DELETE commands with the GENERIC option

READ commands with the UPDATE option plus either the GENERIC or GTEQ
options

The following commands are supported (using cross-memory services for

remote accesses):

READ commands with neither the RBA option nor the UPDATE option. If
the record does not exist in the data table, the NOTFND condition is
returned.

STARTBR, RESETBR, READNEXT, and READPREV commands without the RBA

option.

ENDBR commands.

The following commands are supported (using function shipping for remote
requests):

WRITE commands without the RBA or MASSINSERT options.

REWRITE commands without the RBA option.

DELETE commands without the GENERIC or RBA options.

The record is
deleted from the data table. The NOTFND condition is returned if the
record does not exist in the data table.

Example of a CICS-maintained data table definition

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

79/256

The following example shows the definition of a CICS-maintained data

table. Only the relevant parameters are shown.
+----------------------------------------------------------------------------------+

File
==> APPLE

Group
==> FRUIT

DEscription ==>

VSAM PARAMETERS

DSNAme
==> CIC01.CICOWN.APPLES

Password
==>
PASSWORD NOT SPECIFIED

RLSACCESS
==> NO
YES|NO

Lsrpoolid
==> 2
1-8 | None

READINTEG
==> UNCOMMITTED
UNCOMMITTED|CONSISTENT|REPEATABLE

DSNSharing
==> Allreqs
Allreqs | Modifyreqs

STRings
==> 005
1 - 255

Nsrgroup
==>

REMOTE ATTRIBUTES

REMOTESystem ==>

REMOTEName
==>

RECORDSize
==>
1 - 32767

Keylength
==>
1 - 255

INITIAL STATUS

STAtus
==> Enabled
Enabled | Disabled | Unenabled

Opentime
==> Startup
Firstref | Startup

DIsposition ==> Share

Share | Old

BUFFERS

DAtabuffers ==> 00002

2 - 32767

Indexbuffers ==> 00001

1 - 32767

DATATABLE PARAMETERS

Table
==> CICS
No | Cics | User

Maxnumrecs
==> 1000000
16 - 16777215

DATA FORMAT

RECORDFormat ==> F
V | F

OPERATIONS

Add
==> Yes
No | Yes

BRowse
==> No
No | Yes

DELete
==> Yes
No | Yes

REAd
==> Yes
Yes | No

Update
==> Yes
No | Yes

AUTO JOURNALING

JOurnal
==> No
No | 1 - 99

JNLRead
==> None
None | Updateonly | Readonly | All

JNLSYNCRead ==> No
No | Yes

JNLUpdate
==> No
No | Yes

JNLAdd
==> None
None | Before | AFter |ALl

JNLSYNCWrite ==> Yes

Yes | No

RECOVERY PARAMETERS

RECOVery
==> All
None | Backoutonly | All

Fwdrecovlog ==> 10
No | 1-99

BAckuptype
==> STAtic
STAtic | DYNamic

SECURITY

RESsecnum
: 00
0-24 | Public

+----------------------------------------------------------------------------------+

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

80/256

Example of a user-maintained data table definition

The following example shows the definition of a user-maintained data
table. Only the relevant parameters are shown.
+----------------------------------------------------------------------------------+

File
==> COURGETT

Group
==> VEGS

DEscription ==>

VSAM PARAMETERS

DSNAme
==> CIC02.CICOWN.COURGETT

Password
==>
PASSWORD NOT SPECIFIED

RLSACCESS
==> NO
YES|NO

Lsrpoolid
==> 5
1-8 | None

READINTEG
==> UNCOMMITTED
UNCOMMITTED|CONSISTENT|REPEATABLE

DSNSharing
==> Allreqs
Allreqs | Modifyreqs

STRings
==> 005
1 - 255

Nsrgroup
==>

REMOTE ATTRIBUTES

REMOTESystem ==>

REMOTEName
==>

RECORDSize
==>
1 - 32767

Keylength
==>
1 - 255

INITIAL STATUS

STAtus
==> Enabled
Enabled | Disabled | Unenabled

Opentime
==> Firstref
Firstref | Startup

DIsposition ==> Share

Share | Old

BUFFERS

DAtabuffers ==> 00002

2 - 32767

Indexbuffers ==> 00001

1 - 32767

DATATABLE PARAMETERS

Table
==> User
No | Cics | User

Maxnumrecs
==> 2000000
16 - 16777215

DATA FORMAT

RECORDFormat ==> V
V | F

OPERATIONS

Add
==> Yes
No | Yes

BRowse
==> Yes
No | Yes

DELete
==> No
No | Yes

REAd
==> Yes
Yes | No

Update
==> Yes
No | Yes

AUTO JOURNALING

JOurnal
==> No
No | 1 - 99

JNLRead
==> None
None | Updateonly | Readonly | All

JNLSYNCRead ==> No
No | Yes

JNLUpdate
==> No
No | Yes

JNLAdd
==> None
None | Before | AFter |ALl

JNLSYNCWrite ==> Yes

Yes | No

RECOVERY PARAMETERS

RECOVery
==> Backoutonly
None | Backoutonly | All

Fwdrecovlog ==> No
No | 1-99

BAckuptype
==> STAtic
STAtic | DYNamic

SECURITY

RESsecnum
: 00
0-24 | Public

+----------------------------------------------------------------------------------+

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

81/256

File Control Commands

The READ command
EXEC CICS
{ READ DATASET(filename) | FILE(name) }
{ INTO(data-area) | SET(pointer-ref) }
[ LENGTH(data-area) ]
RIDFLD(data-area)
[ KEYLENGTH(data-value) [ GENERIC ]]
[ SYSID(name) ]
[ RRN | RBA ]
[ GTEQ | EQUAL ]
[ UPDATE ]
END-EXEC
Options
DATASET or FILE

Specifies a 1 to 8 character name for the data set as

specified using CEDA DEFINE FILE(name)

INTO

The target data area

SET

Specifies a pointer data item (or register) to hold the

address of the data record

LENGTH

Specifies in a half word PIC S9(4) COMP field. This is an

input / output field. On input it specifies the length of
the data area. On return CICS sets into this field the
length of the data returned. Required if you are dealing
with variable length records.

RIDFLD

If RRN or RBA is specified refers to relative record number

of a RRDS or RBA of a ESDS file. If neither is specified
this field contains the key of the KSDS record. This field
must be as big as the full defined key length. After a
generic read, CICS always sets the field with the full key
of the record just read. For this reason the length of the
field should be the full key length.

KEYLENGTH

Specifies in a half word field ( PIC S9(4) COMP) or a

literal, the length of the generic key. The value specified
must be less than the files defined key length. Used only
with GENERIC or SYSID option. Valid only for a KSDS and
therefore invalid if the RRN or RBA keywords are specified.

GENERIC

Specifies that only a part of the key (left part, whose

length is indicated by KEYLENGTH) is supplied in the RIDFLD.
The first record with a key whose leftmost positions(as many
as specified by this field) match the RIDFLD is returned.

SYSID

Specifies a 1 to 4 character connection name that represents

a remote system.

RBA

Full word PIC S9(8) COMP field which specifies the relative
byte address of the record for a KSDS or ESDS file.

RRN

Full word PIC S9(8) COMP field which specifies the relative
record number of the record for a RRDS file.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

82/256

GTEQ

Specifies that the first record whose key equal to or higher

than what is specified in the RIDFLD will be returned to the
application.

EQUAL

Specifies that only a record whose key exactly matches the

value in the RIDFLD will be returned to the application.

UPDATE

Specifies that you Intend to update the record by rewriting

or deleting it. CICS locks the whole CI containing the
record and does not allow any other task access to this CI
until one of the following occurs:1) you issue a REWRITE,
DELETE or UNLOCK command or 2)additionally if the file is
defined as recoverable you have to issue a syncpoint or your
task must end (implied syncpoint).

Conditions
The RESP field can have the following values:DISABLED

file is disabled using CEMT SET

DSIDERR

File is not defined to CICS. In later systems also indicated

by FILENOTFOUND.

LENGERR

The buffer provided is too small to hold the record.

DUPKEY

Occurs when you READ via an alternate index and indicate

that at least one more record with the same key exists. The
read command fetches only the first record with the same
key.

ENDFILE

End of file condition.

ILLOGIC

A serious VSAM error occurred.

INVREQ

The read request is prohibited by the resource definition

for this resource.

IOERR

An IOERR occurred

NOTAUTH

The transactions definition specified resource Checking and

the operator is not authorized to Access the data set.

NOTFND

The specified record could not be located.

NOTOPEN

the data set is not open

SYSIDERR

The system identified by SYSID could not be found.

Notes
To read from an alternate index specify the PATH name instead of the
file name when you define the file using CEDA. Only the first of many
records with the same key can be read by the READ command. If you
want to read all records with the same key you must use READNEXT.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

83/256

If accessing via an alternate index DUPKEY is possible if the

alternate key is not unique. The other exception condition you can
get is NOTFND if you do not find a record with the same key.

The WRITE command

EXEC CICS
{ WRITE DATASET(filename)
FROM(data-area)
[ LENGTH(data-area) ]
RIDFLD(data-area)
[ KEYLENGTH(data-value) ]
[ SYSID(name) ]
[ RRN | RBA ]
[ MASSINSERT ]
END-EXEC
Options
DATASET or FILE

FILE(name)

Specifies a 1 to 8 character name for the datset as

specified using CEDA DEFINE FILE(name)

FROM

The source data area

LENGTH

Specifies in a half word PIC S9(4) COMP field. This

specifies the length of the record to be written. Not needed
for fixed length records.

RIDFLD

If RRN or RBA is specified refers to relative record number

of a RRDS or RBA of a ESDS file. If neither is specified
this field contains the key of the KSDS record.

KEYLENGTH

Specifies in a half word field ( PIC S9(8) COMP) field the

length of the key. It is used only if SYSID is specified and
RBA / RRN is not specified, in other words a remote KSDS
file.

SYSID

Specifies a 1 to 4 character connection name that represents

a remote system.

RBA

Full word PIC S9(8) COMP field which specifies the relative
byte address of the record for a KSDS or ESDS file.

RRN

Full word PIC S9(8) COMP field which specifies the relative
record number of the record for a RRDS file.

MASSINSERT

Specifies that the write is part of a VSAM mass insert

operation. A mass insert operation splits the CI at the key
of the record being inserted, which improves mass sequential
inserts.

Conditions
The RESP field can have the following values:DISABLED

file is disabled using CEMT SET

DSIDERR

File is not defined to CICS. In later systems also indicated

by FILENOTFOUND.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

84/256

LENGERR

The buffer provided is too small to hold the record.

DUPREC

A record with the specified key already exists in the

Can also occur if the record contains an alternate key
that already exists, the alternate index does not
duplicate keys and the alternate index is part of the
upgrade set or access is via the path.

ILLOGIC

A serious VSAM error occurred

INVREQ

The write operation is not enabled for this File when it was
defined using CEDA , or the key length specified is
incorrect, or a READ UPDATE has exclusive control of this
record.

IOERR

An IOERR occurred

NOTAUTH

The transactions definition specified resource Checking and

the operator is not authorized to Access the data set.

NOTOPEN

the data set is not open

SYSIDERR

The system identified by SYSID could not be found.

file.
value
allow
files

Notes
When you write to an ESDS the record is always added to the end of
the file. The input via RIDFLD is ignored. On return though, it has
the RBAS of the record that has just been added.

If you are inserting several records in key sequence, use massinsert.

It is more efficient. You need to take a SYNCPOINT or issue an UNLOCK
command before the records can be read by any task.

The only exception condition that you normally can expect to handle
in your program is DUPREC.

The REWRITE command

EXEC CICS
{ REWRITE DATASET(filename)|FILE(name) }
FROM(data-area)
[ LENGTH(data-area) ]
[ SYSID(name) ]
END-EXEC
Options
DATASET or FILE

Specifies a 1 to 8 character name for the dataset as

specified using CEDA DEFINE FILE(name)

FROM

The source data area

LENGTH

Specifies in a half word PIC S9(4) COMP field. This

specifies the length of the record to be written. Not needed
for fixed length records. Required if SYSID is specified.

APPLICATION PROGRAMMING IN CICS BASIC

SYSID

24/08/2003

85/256

Specifies a 1 to 4 character connection name that represents

a remote system.

Conditions
The RESP field can have the following values:DISABLED

file is disabled using CEMT SET

DSIDERR

File is not defined to CICS. In later systems also indicated

by FILENOTFOUND.

DUPREC

Occurs if the record contains an alternate key value that

already exists, the alternate index does not allow duplicate
keys and the alternate index is part of the files upgrade
set or access is via the path.

ILLOGIC

A serious VSAM error occurred

INVREQ

The record was not previously fetched by READ with UPDATE

option.

IOERR

An IOERR occurred

NOTAUTH

The transactions definition specified resource Checking and

the operator is not authorized to Access the data set.

NOTOPEN

the data set is not open

SYSIDERR

The system identified by SYSID could not be found.

Notes
To REWRITE a record you must first read it with UPDATE option. If the
file is recoverable, the lock on the CI is held until the task ends
or a syncpoint is taken. Else the lock is released when you issue a
REWRITE or UNLOCK command.

When you rewrite a record, you can change any field except the key
field, or change the length of the record.

The DELETE command

EXEC CICS
{ DELETE DATASET(filename) | FILE(name) }
[ RIDFLD(data-area)
[ KEYLENGTH(data-value)
[ GENERIC
[ NUMREC(data-area) ] ] ]
[ RBA | RRN ]
[ SYSID(name) ]
END-EXEC
Options
DATASET or FILE

Specifies a 1 to 8 character name for the datset as

specified using CEDA DEFINE FILE(name)

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

86/256

RIDFLD

Specifies a data area that has the key of the record to be

deleted. If omitted, the record must have been fetched using
a READ with the UPDATE option. If RRN or RBA is not
specified this field contains the key of the KSDS record to
be deleted.

KEYLENGTH

A binary half word (PIC S9(4) COMP) field used to specify

the length of a GENERIC key. Used for a generic delete along
with the GENERIC option. This field must be specified along
with SYSID option. Not valid if RBA or RRN is specified.

GENERIC

Specifies that the delete is a generic delete.

NUMREC

Is set by CICS to the number of records that have been

deleted for a generic delete.

RBA

Specifies that the RIDFLD contains a RBA for a VSAM KSDS

record. It is a binary full word field PIC S9(8) COMP.

RRN

Specifies that the RIDFLD contains a RRN for a VSAM RRDS

record. It is a binary full word field PIC S9(8) COMP. Note
that RRNs start from 1.

SYSID

Specifies a 1 to 4 character connection name that represents

a remote system.

Conditions
The RESP field can have the following values:DISABLED

file is disabled using CEMT SET

DSIDERR

File is not defined to CICS. In later systems also indicated

by FILENOTFOUND.

DUPKEY

Another record with the specified key also exists in the

file when the file access is via an alternate index. The
DELETE deletes only the first record.

ILLOGIC

A serious VSAM error occurred

INVREQ

The
was
not
the

IOERR

An IOERR occurred

NOTAUTH

The transactions definition specified resource Checking and

the operator is not authorized to Access the data set.

NOTOPEN

the data set is not open

NOTFND

The specified record could not be found.

SYSIDERR

The system identified by SYSID could not be found.

Notes

DELETE operation is not enabled for this File when it

defined using CEDA. It can also occur if the RIDFLD is
specified and the DELETE was not preceded by a READ with
UPDATE option.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

87/256

For recoverable files, the DELETE command causes your task to hold
the control interval that contains the record until you take a
syncpoint or your task ends.

To prevent deadlock situations, follow two rules:-(1)update files in

alphabetical order and (2) update records in ascending key sequence.

You can delete a record directly or subsequent to a READ with the

UPDATE option.

You can get an exception of NOTFND if you do a DELETE with RIDFLD and
the specified record does not exist. You can also get a DUPKEY if
deleting via a path and duplicate alternate keys are permitted and
exist.

Browsing
Accessing files sequentially is called browsing. The commands that are
needed for browsing are:STARTBR
READNEXT
READPREV
RESETBR
ENDBR
You can browse a KSDS, RRDS or ESDS. Browsing a KSDS is on key sequence.
For an RRDS it is based on relative record numbers. For an ESDS it is
based on RBA.
The STARTBR command
EXEC CICS
STARTBR
DATASET(file-name)
RIDFLD(data-area)
[ RRN | RBA ]
[ GTEQ | EQUAL ]
[ GENERIC ]
[ KEYLENGTH(data-value)
[ REQID(data-value) ]
[ SYSID(name) ]
END-EXEC
Options
DATASET

Specifies the file name as defined using CEDA DEFINE

FILE(file-name) GROUP(group-name)

RIDFLD

For a KSDS specifies the key of the record where the browse
Will start. For a RRDS it specifies the relative record
number and for an ESDS it specifies the RBA (PIC S9(8)
COMP).

RRN

Specifies that the file is a RRDS and the RIDFLD should be

interpreted as a relative record number.

RBA

Specifies that the file is an ESDS and the RIDFLD should be

interpreted as a Relative Byte Address.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

88/256

GTEQ

Specifies that the browse operation will start with a record

whose key is greater than or equal to the RIDFLD.

EQUAL

Specifies that the browse operation will start with a record

whose key is equal to the RIDFLD.

GENERIC

Specifies that only a part of the key (left part, whose

length is indicated by KEYLENGTH) is supplied in the RIDFLD.
The first record that matches this key is the point of start
of the browse.

KEYLENGTH

is a PIC S9(4) COMP field that specifies the length of the

generic key. The value must be less than the length of the
key defined for the file.

REQID

Specifies a binary half word or literal value that

identifies this browse operation. Useful when more than one
browse is started on same file. You can then explicitly
direct further browse operations to a specific browse
instance.

SYSID

Specifies a 1 to 4 character connection name that represents

a remote system.

Conditions
The RESP field can have the following values:DISABLED

file is disabled using CEMT SET

DSIDERR

File is not defined to CICS

ILLOGIC

A serious VSAM error occurred

INVREQ

The browse operation is not enabled for this File when it

was defined using CEDA, the REQID already exists, the
KEYLENGTH value is incorrect, or the file is a user
maintained table.

IOERR

An IOERR occurred

NOTAUTH

The transactions definition specified resource Checking and

the operator is not authorized to Access the data set.

NOTFND

The specified record could not be located.

NOTOPEN

the data set is not open

SYSIDERR

The system identified by SYSID could not be found.

Notes
You must issue a STARTBR command before you issue READNEXT or
READPREV.

To browse via a alternate index specify a path name for the data set
when you define the file.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

89/256

You need to define a string for each browse operation. A string is in

this case one index and one data buffer. The string is held right
from STARTBR to ENDBR.

You can skip records when browsing simply by changing the RIDFLD
value when you browse using READNEXT or READPREV on the file. This is
called skip sequential processing. You can also do this by RESETBR
but with this command the string resource is released and reacquired.
There is therefore a possibility of the transaction going into string
wait.

CICS sets the data area corresponding to the RIDFLD field with the
key of the record fetched using READNEXT or READPREV.

In the case of a KSDS you can start at the beginning of the file by
moving low values to the RIDFLD when you issue STARTBR. If you have
defined a numeric key field, move zeroes to the key field, as the
compiler wont allow you to move low values to the key field. In the
case of an ESDS move 0 to the RIDFLD. In the case of a RRDS move 1 to
the RIDFLD.

To start the browse at the end of a file, for a KSDS move high values
(XFF) to the RIDFLD. High values is a special case, it does not
cause a NOTFND condition. Unfortunately moving all 9s to a numeric
key field will cause a NOTFND condition if the record is not found.
In this case redefine the field as a alphanumeric field and move high
values to it to start the browse at the end of the file. For an ESDS
or a RRDS move HIGH VALUES to the RIDFLD.

To start a browse at a specific record that must exist in the file,

code the EQUAL keyword and move the key of the record to the RIDFLD.

The READNEXT command

EXEC CICS
READNEXT
{ DATASET(name) | FILE(name) }
{ INTO(data-area) | SET(pointer-ref)
[ LENGTH(data-area) ]
RIDFLD(data-area)
[ KEYLENGTH(data-value) ]
[ RBA | RRN ]
[ REQID(data-value) ]
[ SYSID(name) ]
END-EXEC
Options
DATASET or FILE

Specifies a 1 to 8 character name for the dataset as

specified using CEDA DEFINE FILE(name)

INTO

The target data area

SET

Specifies a pointer data item (or register) to hold

the address of the data record

LENGTH

Specifies in a half word PIC S9(4) COMP field. This is

an input / output field. On input it specifies the
length of the data area. On return CICS sets into this

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

90/256

field the length of the data returned. Required if you

are dealing with variable length records.
RIDFLD

If RRN or RBA is specified refers to relative record

number of a RRDS or RBA of a ESDS file. If neither is
specified this field contains the key of the KSDS
record. This field must be as big as the full key
length. It is an input / output field. If you set it
with a value CICS uses the value to fetch the right
record, skipping any records in the process while
moving from the current position (skip sequential
processing). Note that for skip sequential processing
the key you set for READNEXT must be higher than what
was returned in the previous call. If you specified
EQUAL in the start browse command and CICS cannot find
the record, it returns NOTFND. If GTEQ was specified
while starting the browse, CICS returns the first
record with a higher key than what you specified. CICS
always sets the field with the full key of the record
just read.

KEYLENGTH

Specifies in a half word field ( PIC S9(4) COMP) field

the length of the generic key. It has meaning if the
browse was started(STARTBR), or reset(RESETBR) with
the GENERIC keyword. Valid only for a KSDS and
therefore invalid if the RRN or RBA keywords are
specified. Also needed if SYSID is specified.

RBA

Full word PIC S9(8) COMP field which specifies the

relative byte address of the record for a KSDS or ESDS
file.

RRN

Full word PIC S9(8) COMP field which specifies the

relative record number of the record for a RRDS file.

REQID

Specifies a binary half word or literal value that

identifies the browse operation. Useful when more than
one browse is started on same file. You can then
explicitly direct further browse operations to a
specific operation.

SYSID

Specifies a 1 to 4 character connection name that

represents a remote system.

Conditions
The RESP field can have the following values:DISABLED

file is disabled using CEMT SET

DSIDERR

File is not defined to CICS. In later systems also indicated

by FILENOTFOUND.

LENGERR

The buffer provided is too small to hold the record.

DUPKEY

Occurs when you READNEXT via an alternate index to indicate

that at least one more record with the same key exists.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

91/256

Issue READNEXT calls repeatedly until you dont get the

DUPKEY condition to fetch all records with the same key.
ENDFILE

End of file condition.

ILLOGIC

A serious VSAM error occurred

INVREQ

The browse operation was not started by a STARTBR command,

the meaning of the RIDFLD (RBA, RRN, Key) was changed in
between the browse operation, or the KEYLENGTH is incorrect.

IOERR

An IOERR occurred

NOTAUTH

The transactions definition specified resource Checking and

the operator is not authorized to Access the data set.

NOTFND

The specified record could not be located.

NOTOPEN

the data set is not open

SYSIDERR

The system identified by SYSID could not be found.

Notes
You must issue STARTBR before issuing this command. Note that each
STARTBR holds a VSAM string.

You cannot update a file using a browse operation. (exception is if

the file is under RLS).

For browsing via an alternate index specify the PATH name in the data
set option when you define the file using CEDA. Check for the DUPKEY
condition if the file permits duplicate alternate keys. The order of
records are not assured to be in prime key sequence.

DUPKEY (if accessing via a PATH) or ENDFILE are the only conditions
you should expect to handle in your program.

The READPREV command

EXEC CICS
READPREV
{ DATASET(name) | FILE(name) }
{ INTO(data-area) | SET(pointer-ref)
[ LENGTH(data-area) ]
RIDFLD(data-area)
[ KEYLENGTH(data-value) ]
[ RBA | RRN ]
[ REQID(data-value) ]
[ SYSID(name) ]
END-EXEC
Options
DATASET or FILE
INTO

Specifies a 1 to 8 character name for the data set as

specified using CEDA DEFINE FILE(name)
The target data area

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

92/256

SET

Specifies a pointer data item (or register) to hold

the address of the data record

LENGTH

Specifies in a half word PIC S9(4) COMP field. This is

an input / output field. On input it specifies the
length of the data area. On return CICS sets into this
field the length of the data returned. Required if you
are dealing with variable length records.

RIDFLD

If RRN or RBA is specified refers to relative record

number of a RRDS or RBA of a ESDS file. If neither is
specified this field contains the key of the KSDS
record. This field must be as big as the full key
length. CICS always sets the field with the full key
of the record just read.

KEYLENGTH

Specifies in a half word field ( PIC S9(8) COMP) field

the length of the generic key. It has meaning if the
browse was started, or reset with the GENERIC keyword.
Valid only for a KSDS and therefore invalid if the RRN
or RBA keywords are specified. If RIDFLD and KEYLENGTH
is set by the application and the browse was started
with the GENERIC option, CICS repositions the browse
using the new generic key.

RBA

Full word PIC S9(8) COMP field which specifies the

relative byte address of the record for a KSDS or ESDS
file.

RRN

Full word PIC S9(8) COMP field which specifies the

relative record number of the record for a RRDS file.

REQID

Specifies a binary half word or literal value that

identifies this browse operation. Useful when more
than one browse is started on same file. You can then
explicitly direct further browse operations to a
specific operation.

SYSID

Specifies a 1 to 4 character connection name that

represents a remote system.

Conditions
The RESP field can have the following values:DISABLED

file is disabled using CEMT SET

DSIDERR

File is not defined to CICS. In later systems also indicated

by FILENOTFOUND.

LENGERR

The buffer provided is too small to hold the record.

DUPKEY

Occurs when you READPREV via an alternate index to indicate

that at least one more record with the same key exists. To
fetch all records with the same key, issue READPREV calls
repeatedly until you dont get the DUPKEY condition.

ENDFILE

End of file condition.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

93/256

ILLOGIC

A serious VSAM error occurred

INVREQ

A browse operation was not started by a STARTBR command, the

meaning of the RIDFLD (RBA, RRN, key) was changed during the
browse operation, or the KEYLENGTH is invalid.

IOERR

An IOERR occurred

NOTAUTH

The transactions definition specified resource Checking and

the operator is not authorized to Access the data set.

NOTFND

The specified record could not be located.

NOTOPEN

the data set is not open

SYSIDERR

The system identified by SYSID could not be found.

Notes
You must issue STARTBR before issuing this command. Note that each
STARTBR holds a VSAM string.

You cannot update a file using a browse operation.

For browsing via an alternate index specify the PATH name in the data
set option when you define the file using CEDA. Note that DUPKEY
conditions are possible when browsing via an alternate index.

DUPKEY (if accessing via a PATH) or ENDFILE are the only conditions
you should expect to handle in your program.

If you issue READPREV immediately after READNEXT the same record is

fetched again.

At STARTBR position at the end of the file (by moving high values
into the RIDFLD) before issuing this command if you want to read this
file backwards.

The RESETBR command

EXEC CICS
RESETBR
DATASET(file-name)
RIDFLD(data-area)
[ RRN | RBA ]
[ GTEQ | EQUAL ]
[ KEYLENGTH(data-value) [
[ REQID(data-value) ]
[ SYSID(name) ]
END-EXEC
Options
DATASET
RIDFLD

GENERIC

] ]

Specifies the file name as defined using CEDA DEFINE

FILE(file-name) GROUP(group-name)
For a KSDS specifies the key of the record where the browse

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

94/256

Will start. For a RRDS it specifies the relative record

number and for an ESDS it specifies the RBA (PIC S9(8)
COMP). If RRN or RBA is not specified, key is assumed.
RRN

Specifies that the file is a RRDS and the RIDFLD should be

interpreted as a relative record number.

RBA

Specifies that the file is an ESDS and the RIDFLD should be

interpreted as a Relative Byte Address.

GTEQ

Specifies that the browse operation will start with a record

whose key is greater than or equal to the RIDFLD.

EQUAL

Specifies that the browse operation will start with a record

whose key is equal to the RIDFLD.

GENERIC

Specifies that only a part of the key (left part, whose

length is indicated by KEYLENGTH) is supplied in the RIDFLD.
The first record that matches this key is the point of start
of the browse.

KEYLENGTH

is a PIC S9(4) COMP field that specifies the length of the

generic key. The value must be less than the length of the
key defined for the file. Also needed if SYSID is specified.
Not valid if RBA or RRN is specified.

REQID

Specifies a binary half word or literal value that

identifies this browse operation. Useful when more than one
browse is started on same file. You can then explicitly
direct further browse operations to a specific operation.

SYSID

Specifies a 1 to 4 character connection name that represents

a remote system.

Conditions
The RESP field can have the following values:DISABLED

file is disabled using CEMT SET

DSIDERR

File is not defined to CICS

ILLOGIC

A serious VSAM error occurred

INVREQ

The browse operation was not started on this file or the

KEYLENGTH is invalid.

IOERR

An IOERR occurred

NOTAUTH

The transactions definition specified resource Checking and

the operator is not authorized to Access the data set.

NOTFND

The specified record could not be located.

NOTOPEN

the data set is not open

SYSIDERR

The system identified by SYSID could not be found.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

95/256

Notes
You can issue RESETBR only after a STARTBR.

To browse via a alternate index specify a path name for the data set
when you define the file.

You can skip records when browsing simply by changing the RIDFLD
value when you browse using READNEXT or READPREV on the file. This is
called skip sequential processing. This is an alternative to using
RESETBR.

RESETBR has the same effect as issuing an ENDBR and a STARTBR.

However if you take this path, the VSAM resources (string) is
released and then reacquired when you issue STARTBR. For this reason
RESETBR is more efficient. However, your program could go into a
string wait!!.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

96/256

Defining Files to CICS

CEDA Define File
+----------------------------------------------------------------------------------+

File
==>

Group
==>

DEscription ==>

VSAM PARAMETERS

DSNAme
==>

Password
==>
PASSWORD NOT SPECIFIED

RLSACCESS
==> NO
YES|NO

Lsrpoolid
==> 1
1-8 | None

READINTEG
==> UNCOMMITTED
UNCOMMITTED|CONSISTENT|REPEATABLE

DSNSharing
==> Allreqs
Allreqs | Modifyreqs

STRings
==> 001
1 - 255

Nsrgroup
==>

REMOTE ATTRIBUTES

REMOTESystem ==>

REMOTEName
==>

RECORDSize
==>
1 - 32767

Keylength
==>
1 - 255

INITIAL STATUS

STAtus
==> Enabled
Enabled | Disabled | Unenabled

Opentime
==> Firstref
Firstref | Startup

DIsposition ==> Share

Share | Old

BUFFERS

DAtabuffers ==> 00002

2 - 32767

Indexbuffers ==> 00001

1 - 32767

DATATABLE PARAMETERS

Table
==> No
No | Cics | User

Maxnumrecs
==>
16 - 16777215

DATA FORMAT

RECORDFormat ==> V
V | F

OPERATIONS

Add
==> No
No | Yes

BRowse
==> No
No | Yes

DELete
==> No
No | Yes

REAd
==> Yes
Yes | No

Update
==> No
No | Yes

AUTO JOURNALING

JOurnal
==> No
No | 1 - 99

JNLRead
==> None
None | Updateonly | Readonly | All

JNLSYNCRead ==> No
No | Yes

JNLUpdate
==> No
No | Yes

JNLAdd
==> None
None | Before | AFter |ALl

JNLSYNCWrite ==> Yes

Yes | No

RECOVERY PARAMETERS

RECOVery
==> None
None | Backoutonly | All

Fwdrecovlog ==> No
No | 1-99

BAckuptype
==> STAtic
STAtic | DYNamic

SECURITY

RESsecnum
: 00
0-24 | Public

+----------------------------------------------------------------------------------+

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

97/256

Only those which are of interest to application programmer are described

in detail. See CICS resource definition guide for a detailed
explanation.

ADD(NO|YES)
specifies whether records can be added to the file.

BACKUPTYPE(STATIC|DYNAMIC)
CICS VSAM files can be defined as eligible for backup while open for
update.

BROWSE(NO|YES)
specifies whether records can be retrieved sequentially from the
file.

DATABUFFERS(2|value)
specifies the number of buffers to be used for data. Use a value in
the range 2 through 32767. The minimum value you may specify is one
more than the number of strings defined in the STRINGS attribute.

DELETE(NO|YES)
specifies whether records can be deleted from the file.

DESCRIPTION(text)
You can provide a description of the resource you are defining in
this field.

DISPOSITION(SHARE|OLD)
specifies the disposition of this file
1. OLD Equivalent to the DISP=OLD parameter in JCL.
2. SHARE Equivalent to the DISP=SHR parameter in JCL.

DSNAME(name)
specifies the data set name (as known to the operating system) to be
used for this file.

DSNSHARING(ALLREQS|MODIFYREQS)
specifies whether VSAM data set name sharing is used for the VSAM
file.

FILE(name)
specifies the name of
characters in length.

the

file.

The

name

can

be

up

to

eight

FWDRECOVLOG(NO |number)
specifies the journal name that corresponds to the MVS system logger
log stream that is to be used for forward recovery.

GROUP(groupname)
specifies the group name

INDEXBUFFERS(1|value)

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

98/256

specifies the number of buffers to be used for the index.

Use a
value in the range 1 through 32767.
The minimum value you may
specify is the number of strings defined in the STRINGS attribute.

KEYLENGTH(value)
specifies the length in bytes, in the range 1 through 255, of the
logical key for remote files. If not defined here, the length option
must be specified in the application program that refers to this
file.

LSRPOOLID(1-8|None)
specifies the identity of the local shared resource pool. For a data
table, the default value for LSRPOOLID is 1, unless a value has been
specified for the NSRGROUP attribute, in which case the default value
for LSRPOOLID is NONE.
None Specifies that the data set associated with this file uses VSAM
non shared resources (NSR).
1-8 The value, in the range 1 through 8, identifies the number of
the VSAM shared resource pool that is used by the VSAM data set
associated with this file.
The data set is defined as using VSAM
local shared resources (LSR).
You are recommended to define the
buffers, strings, and other resources explicitly in an LSRPOOL
resource definition that corresponds to this LSRPOOLID.
By default, if the file definition specifies RLSACCESS(YES), the
LSRPOOLID is ignored when CICS opens the file.

MAXNUMRECS(value)
specifies the maximum number of entries to be accommodated in the
data table, in the range 16 through 16777215, if you have specified
'CICS' or 'USER' for the TABLE attribute.

NSRGROUP(value)
specifies a symbolic name (up to eight characters) to group together
file definitions that refer to the same VSAM base data set. The
value is purely symbolic and need not refer to any particular file
definition.
It is merely necessary that all file definitions that
need to be grouped together have the same name. You do not have to
specify this attribute to ensure correct processing, but if you do
not provide it, performance of your system may be degraded.
The NSRGROUP attribute takes effect only for files referencing data
sets that use VSAM non shared resources. The NSRGROUP parameter must
not be coded for a data table.
It is associated with the VSAM
concept of data set name sharing which causes VSAM to create a single
control block structure for the strings and buffers required by all
the files that relate to the same base data set.
When the first member of such a group of files is opened, the total
number of strings to be allocated for all file entries in the group
must be specified to VSAM. CICS adds together the STRINGS values in
all the file definitions with the same NSRGROUP attribute. This
allows CICS to assess the requirements at one time of all files that
are in the same NSRGROUP.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

99/256

Data set name sharing is forced by CICS as the default for all VSAM
files. Data set name sharing is not in effect if a file is opened
for read-only processing with DSNSHARING=MODIFYREQS.
If a file is using VSAM non shared resources, and you do not provide
an NSRGROUP attribute, the VSAM control block structure may be built
with insufficient strings for later processing. When this happens,
VSAM invokes the dynamic string addition feature to provide the extra
control blocks for the strings as they are required. This mechanism
is, however, inefficient and the extra storage is not released until
the end of the CICS run.
For files specifying that VSAM local shared resources are to be used
(LSRPOOLID=n, where n is in the range 1 to 8), NSRGROUP has no
effect.
Figure below shows an example of how to specify the required file
control definition for a VSAM base data set and alternate index path.
+------------------------------------------------------------------------+

CEDA DEFINE FILE(VSAM10B) GROUP(xxxxxx)

DSNAME(DTGCAT.VSAM10B)

DISPOSITION(SHARE) ADD(YES)

BROWSE(YES) DELETE(YES) READ(YES)

UPDATE(NO) RECORDFORMAT(F)

STRINGS(8) LSRPOOLID(NONE)

RECOVERY(NONE) NSRGROUP(GROUP1)

INDEXBUFFERS(8) DATABUFFERS(9)

CEDA DEFINE FILE(VSAM10P) GROUP(xxxxxx)

DSNAME(DTGCAT.VSAM10P)

LSRPOOLID(NONE) DISPOSITION(SHARE)

STRINGS(5) NSRGROUP(GROUP1)

BROWSE(YES) DELETE(NO) READ(YES)

ADD(NO) UPDATE(NO) RECORDFORMAT(F)

RECOVERY(NONE) INDEXBUFFERS(5)

DATABUFFERS(6)

+------------------------------------------------------------------------+

VSAM base data set and alternate index path definition.

OPENTIME(FIRSTREF|STARTUP)
specifies when the file is opened.

PASSWORD(name)

READ(YES|NO)
specifies whether records on this file can be read.

READINTEG( UNCOMMITTED|CONSISTENT|REPEATABLE)
specifies the level of read integrity required for files defined with
RLSACCESS(YES). Read integrity does not apply to non-RLS access mode
files or to any form of data tables.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

100/256

You can use READINTEG to set a default level of read integrity for a
file. The default level of read integrity is used by programs that
do not specify one of the API read integrity options UNCOMMITTED,
CONSISTENT, or REPEATABLE on the READ, READNEXT, or READPREV
commands. However, if an application program uses one of these
explicitly to specify read integrity, the API option overrides any
value specified on this READINTEG attribute.
You can specify CONSISTENT or REPEATABLE in a file resource
definition, to make read integrity available to programs written
before these options were available on the API, and without having to
modify those programs.
However, if you do this, be aware that
enforcing consistent or repeatable reads can introduce unexpected
deadlocks. Programs may also encounter the LOCKED condition.
CONSISTENT The record is read with consistent read integrity. If the
record is being modified by another transaction, the READ request
waits until the update is complete, the timing of which depends on
whether the data set is recoverable or non recoverable:
1. For a recoverable data set, the READ request completes when the
updating transaction completes its next syncpoint or rollback.
2. For a non recoverable data set, the READ completes as soon as the
VSAM request performing the update completes.
CONSISTENT is valid only if you also specify RLSACCESS(YES)--the
resource definition is rejected with an error if you specify
CONSISTENT for a non-RLS file.
REPEATABLE The record is read with repeatable read integrity. If the
record is being modified by another transaction, the READ request
waits until the update is complete, the timing of which depends on
whether the data set is recoverable or non recoverable:
1. For a recoverable data set, the READ request completes when the
updating transaction completes its next syncpoint or rollback.
2. For a non recoverable data set, the READ completes as soon as the
VSAM request performing the update completes.
After the read completes, a shared lock remains held until syncpoint.
This guarantees that any record read within a unit-of-work cannot be
modified while the task makes further read requests.
REPEATABLE is valid only if you also specify RLSACCESS(YES)--the
resource definition is rejected with an error if you specify
REPEATABLE for a non-RLS file.
UNCOMMITTED The record is read without read integrity. CICS obtains
the current value of the record as known to VSAM.
No attempt is
made to serialize this read request with any concurrent update
activity for the same record. The record returned may be a version
updated by another transaction, but not yet committed, and this
record may change if the update is subsequently backed out.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

101/256

RECORDFORMAT(V|F)
specifies the format of the records on the file.
F

The records are fixed length. F is invalid for user-maintained

data tables.
All user-maintained data tables are variable
length.

The records are variable length.

RECORDSIZE(number)
specifies the maximum length in bytes, in the range 1 through 32767,
of the logical record. For a fixed-length remote file, this value is
the length of the records. Needed only for defining a remote file.

RECOVERY(NONE|BACKOUTONLY|ALL)
specifies the type of recovery required for the file.
This attribute is not used for files defined with RLSACCESS(YES), or
if the recovery options are defined in the ICF catalog and RLS=YES is
specified as a system initialization parameter. If RLS=YES, and LOG
is defined in the ICF catalog, CICS ignores the recovery setting and
takes the LOG value from the ICF catalog, even for files defined with
RLSACCESS(NO).
If LOG(ALL) is specified in the ICF catalog, CICS
also takes the LOGSTREAMID and BWO values from the ICF catalog.
For files that are accessed in RLS mode, you must specify the
recovery parameters with the data set definition in the ICF catalog.
ALL
Log before images to the system log, and after images to the
journal specified in the FWDRECOVLOG attribute.
RECOVERY=ALL together with FWDRECOVLOG provide a means of separating
the needs of a forward recovery utility from those of automatic
journaling.
Additional information, not available via automatic
journaling, is recorded on the FWDRECOVLOG. RECOVERY=ALL plus
FWDRECOVLOG is the recommended way to provide forward recovery
support.
For CICS-maintained data tables, the data table and its source data
set are logged, journaled, and recovered together.
For usermaintained tables, specifying ALL has the same effect as specifying
BACKOUTONLY: only dynamic backout is provided. There is no forward
recovery support for user-maintained tables.
BACKOUTONLY Log before images to the system log. For CICS-maintained
data tables, BACKOUTONLY specifies that the data table and its source
data set are recoverable.
They are both updated in step and, if
required, recovered in step. For user-maintained tables, this
specifies only dynamic backout. No log records are written and,
therefore, there is no recovery at emergency restart.
NONE No recovery logging for this file.

RLSACCESS(NO|YES)
specifies whether CICS is to open the file in RLS mode.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

102/256

NO
The file is not to be opened in RLS mode.
If you specify
RLSACCESS(NO) or allow it to default, CICS opens the file in LSR or
NSR access mode, depending on the LSRPOOLID attribute. If you also
specify
LSRPOOLID(NONE),
the
access
mode
is
NSR;
if
LSRPOOLID(number), the access mode is LSR.
YES
The file is to be opened in RLS mode.
If you specify
RLSACCESS(YES), it takes precedence over the LSRPOOLID attribute,
which is ignored when the FILE is opened.
Specifying RLSACCESS(YES) alters the effect of some other attributes
defined in the FILE definition (see manual).

REMOTENAME(name)
specifies the name by which this file is known in the system or
region in which it is resident.

REMOTESYSTEM(name)
If you are operating in an ISC or MRO environment, and the file is
held by a remote system, this specifies the name of the system or
region in which the file is resident.

STATUS({ ENABLED|DISABLED|UNENABLED})
specifies the initial status of the file
initialization with START=COLD or START=INITIAL.

following

CICS

STRINGS(1|value)
specifies the number, in the range 1 through 255, of concurrent
requests that can be processed against the file. When the number of
requests reaches this value, CICS queues any additional requests
until one of the active requests terminates.
This applies both to
files using shared resources, and to those not using shared
resources.
When coding STRINGS, be aware that a proportion (20%) of the
specified number of strings is reserved by CICS for use in read-only
requests.
For VSAM files using shared resources, this number is not used by
VSAM. It is used by CICS, not only as described above, but also to
calculate the default value in the buffer pool definition.

TABLE(NO|CICS|USER)
specifies the type of data table that you require.
CICS CICS-maintained data tables.
These automatically reflect all
modifications to their source data set.
If you specify CICS, you
must also specify LSRPOOLID with a value of 1 through 8, and
MAXNUMRECS with the value you require.
NO

Data table not required.

USER User-maintained tables. If you specify USER, you must also

specify LSRPOOLID with a value of 1 through 8, RECORDFORMAT as V (or
let this default to the value of V), and MAXNUMRECS with the value
you require.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

103/256

UPDATE(NO|YES)
specifies whether records on this file can be updated.

LSRPOOL
VSAM buffers play an important role in VSAM performance. CICS allows us
to define what are known as LSR or Local Shared Resource Pools for VSAM
buffers. The LSR pools are defined using CEDA and the resource name is
LSRPOOL. 1 to 8 LSRPOOLS can be defined. A sample CEDA screen is shown
below:+----------------------------------------------------------------------------------+

Lsrpool
==> ....

Group
==> ....

DEscription ==>

Lsrpoolid
==> 1
1 - 8

Maxkeylength ==>
0 - 255

SHarelimit
==>
1 - 100

STrings
==>
1 - 255

DATA BUFFERS

DATA512
==>
3 - 32767

DATA1K
==>
3 - 32767

DATA2K
==>
3 - 32767

DATA4k
==>
3 - 32767 increments of 4 up to 32

DATA32k
==>
3 - 32767

INDEX BUFFERS

INDEX512
==>
3 - 32767

INDEX1K
==>
3 - 32767

INDEX2K
==>
3 - 32767

INDEX4k
==>
3 - 32767 increments of 4 up to 32

INDEX32k
==>
3 - 32767

HIPERSPACE DATA BUFFERS

HSDATA4K
==>
0 - 16777215 increments of 4 up to 32

HSDATA32K
==>
0 - 16777215

HIPERSPACE INDEX BUFFERS

HSINDEX4K
==>
0 - 16777215 increments of 4 up to 32

HSINDEX32K ==>
0 - 16777215

+----------------------------------------------------------------------------------+

The local shared resources (LSR) pool is a reserve of data buffers,

strings, and Hiperspace buffers that VSAM uses when processing access
requests for certain files.
You use the LSRPOOL definition to define
the size and characteristics of the pool. Up to eight LSR pools can be
defined concurrently in the system, each identified by their LSRPOOLID.
This LSRPOOLID is used to associate a FILE with an LSR pool if that file
is to use shared resources.
When the LSRPOOL definition is installed in the active system, its
information is stored and used when the pool with the specified ID is
next built. A pool is built when the first file using a particular LSR
pool is opened, and is dynamically deallocated only when no files are
currently open against that pool.
This means that when an LSRPOOL

APPLICATION PROGRAMMING IN CICS BASIC

definition is
immediately.

installed

into

the

system

24/08/2003
it

may

not

104/256

take

effect

CICS sets default attributes if an LSRPOOL is not defined, but you are
advised to define the LSRPOOL anyway, for reasons of performance. In a
production system, for example, delay may be incurred while pool
requirements are being calculated by CICS. Another possible problem is
that if files in the FCT are not allocated at the time the pool is
built, the data set names will not be known to CICS. In this case, the
pool is built based on the information available, but the subsequent
performance of the system may suffer or files may fail to open.
See example below of SAMP10 and SAMP11 which illustrate a deadlock
caused by CI waits.
Define SAMP10 as transaction SM10 and SAMP11 as SM11. You need two KSDS
files defined as FILE61 and FILE62 with record size of 80 fixed and a
key in first 5 positions before you run SM10 transaction. SM10 starts
SM11 and creates a deadlock condition over the two files (FILE61 and
FILE62).
Defining the File61 data set
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE USER01.FILE61 CLUSTER
DEFINE CLUSTER (NAME(USER01.FILE61) INDEXED KEYS(5,0) RECORDSIZE(80,80) TRACKS(1,1)) DATA(CONTROLINTERVALSIZE(1024))
//
Defining the File61 data set
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE USER01.FILE62 CLUSTER
DEFINE CLUSTER (NAME(USER01.FILE62) INDEXED KEYS(5,0) RECORDSIZE(80,80) TRACKS(1,1)) DATA(CONTROLINTERVALSIZE(1024))
//
Loading the data sets
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
REPRO INDATASET(userid.FILE61.LOADDATA) OUTDATASET(userid.FILE61)
//
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
REPRO INDATASET(userid.FILE62.LOADDATA) OUTDATASET(userid.FILE62)
//

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

105/256

Printing the data sets

//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
PRINT INDATASET(userid.FILE61) CHAR
PRINT INDATASET(userid.FILE61) CHAR
//
Define the files to CICS and give RACF permissions from your TSO userid
SAMP10

transaction-id SM10
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP10.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-MSG-DATA
PIC X(30).
03 WS-MSG-DATA-LEN
PIC S9(4) COMP VALUE 30.
03 WS-RESP
PIC S9(08) COMP VALUE 0.
03 WS-QUEUE-RECORD-LEN
PIC S9(4) COMP VALUE 10.
03 WS-POST
PIC S9(8) COMP.
03 WS-POST-BIN REDEFINES WS-POST PIC X(4).
03 WS-CLEAR
PIC S9(8) COMP.
03 WS-CLEAR-BIN REDEFINES WS-CLEAR PIC X(4).
03 WS-SAMP8-PTR
USAGE IS POINTER.
03 WS-SAMP8-PTR-LEN
PIC S9(4) COMP VALUE 4.
01 WS-QUEUE-RECORD.
03 WS-QUEUE-DATA
PIC X(10) VALUE "SAMP10".
01 WS-DATA
PIC X(80).
01 WS-KEY-ONE
PIC X(5) VALUE '00001'.
01 WS-KEY-TWO
PIC X(5) VALUE '00001'.
LINKAGE SECTION.
01 WS-ECBS.
03 ECB-ONE
PIC S9(8) COMP.
03 ECB-ONE-PTR
POINTER.
03 ECB-ONE-PTR-PTR
POINTER.
PROCEDURE DIVISION.
PERFORM INIT-PARA.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
MOVE "SAMP10 STARTING ...." TO WS-MSG-DATA
EXEC CICS
SEND TEXT FROM(WS-MSG-DATA)
LENGTH(WS-MSG-DATA-LEN)
RESP(WS-RESP)
END-EXEC
PERFORM LOOP-PARA
MOVE "SAMP10 ENDING..." TO WS-MSG-DATA
EXEC CICS
SEND TEXT FROM(WS-MSG-DATA)
LENGTH(WS-MSG-DATA-LEN)
RESP(WS-RESP)
END-EXEC.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

106/256

LOOP-PARA.
EXEC CICS WAITCICS
ECBLIST(ECB-ONE-PTR-PTR)
NUMEVENTS(1)
RESP(WS-RESP)
END-EXEC
MOVE WS-CLEAR TO ECB-ONE
EXEC CICS
WRITEQ TS QUEUE("SAMP10")
FROM(WS-QUEUE-RECORD)
LENGTH(WS-QUEUE-RECORD-LEN)
RESP(WS-RESP)
END-EXEC
EXEC CICS
READ FILE('FILE62') INTO(WS-DATA) RIDFLD(WS-KEY-TWO)
UPDATE
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
INIT-PARA.
MOVE X'40008000' TO WS-POST-BIN
MOVE X'00000000' TO WS-CLEAR-BIN
EXEC CICS
GETMAIN SET(ADDRESS OF WS-ECBS)
FLENGTH(LENGTH OF WS-ECBS)
USERDATAKEY
END-EXEC
MOVE WS-CLEAR TO ECB-ONE
SET ECB-ONE-PTR TO ADDRESS OF ECB-ONE
SET ECB-ONE-PTR-PTR TO ADDRESS OF ECB-ONE-PTR
EXEC CICS
DELETEQ TS QUEUE("SAMP10")
RESP(WS-RESP)
END-EXEC
EXEC CICS
READ FILE('FILE61') RIDFLD(WS-KEY-ONE) INTO(WS-DATA)
UPDATE
END-EXEC
SET WS-SAMP8-PTR TO ADDRESS OF WS-ECBS
EXEC CICS
START TRANSID("SM11")
INTERVAL(0)
FROM(WS-SAMP8-PTR)
LENGTH(WS-SAMP8-PTR-LEN)
END-EXEC.
SAMP11

transaction-id SM11
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP11.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-RESP
03 WS-QUEUE-RECORD-LEN

PIC S9(08) COMP VALUE 0.

PIC S9(4) COMP VALUE 14.

APPLICATION PROGRAMMING IN CICS BASIC

01

24/08/2003

107/256

WS-QUEUE-RECORD.
03 WS-QUEUE-DATA
PIC X(10) VALUE "SAMP11".
03 WS-COUNT
PIC 9(4) VALUE 0.
03 WS-POST
PIC S9(8) COMP.
03 WS-POST-BIN REDEFINES WS-POST PIC X(4).
03 WS-CLEAR
PIC S9(8) COMP.
03 WS-CLEAR-BIN REDEFINES WS-CLEAR PIC X(4).
01 WS-ECBS-LEN
PIC S9(4) COMP VALUE 4.
01 WS-SAMP5-WS-PTR
USAGE IS POINTER.
01 WS-SAMP5-WS-PTR-LEN
PIC S9(4) COMP VALUE 4.
01 NUMEVENTS
PIC S9(8) COMP VALUE 1.
01 WS-DATA
PIC X(80).
01 WS-KEY-ONE
PIC X(5) VALUE '00001'.
01 WS-KEY-TWO
PIC X(5) VALUE '00001'.
LINKAGE SECTION.
01 WS-ECBS.
03 ECB-ONE
PIC S9(8) COMP.
03 ECB-ONE-PTR
POINTER.
03 ECB-ONE-PTR-PTR
POINTER.
PROCEDURE DIVISION.
PERFORM INIT-PARA.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
READ FILE('FILE62') RIDFLD(WS-KEY-TWO) INTO(WS-DATA)
UPDATE
END-EXEC
PERFORM LOOP-PARA.
LOOP-PARA.
EXEC CICS
WRITEQ TS QUEUE("SAMP10")
FROM(WS-QUEUE-RECORD)
LENGTH(WS-QUEUE-RECORD-LEN)
RESP(WS-RESP)
END-EXEC.
MOVE WS-POST TO ECB-ONE
EXEC CICS
READ FILE('FILE61') RIDFLD(WS-KEY-ONE) INTO(WS-DATA)
UPDATE
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
INIT-PARA.
MOVE X'40008000' TO WS-POST-BIN
MOVE X'00000000' TO WS-CLEAR-BIN
EXEC CICS
RETRIEVE INTO(WS-SAMP5-WS-PTR)
LENGTH(WS-SAMP5-WS-PTR-LEN)
END-EXEC
SET ADDRESS OF WS-ECBS TO WS-SAMP5-WS-PTR.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

108/256

How tasks can become deadlocked waiting for exclusive control

Tasks can become deadlocked waiting for exclusive control of a CI only
when they have shared control of the CI and then attempt to get
exclusive control without relinquishing shared control first. This can
only occur for VSAM shared resource data sets accessed in non-RLS mode.
For the deadlock to occur, a transaction must first issue a VSAM READ
SEQUENTIAL request via EXEC CICS STARTBR.
This is a VSAM "shared
control" operation.
It must then issue some VSAM request requiring
exclusive control of the CI without first ending the shared control
operation.
The requests that require exclusive control of the CI are:
VSAM READ UPDATE, via EXEC CICS READ UPDATE and, subsequently, EXEC
CICS REWRITE. Exclusive control of the CI is not acquired until after
the initial read is complete, but it happens automatically after that
and the CI is not released until the record has been rewritten.

VSAM WRITE DIRECT, via EXEC CICS WRITE.

VSAM WRITE SEQUENTIAL, via EXEC CICS WRITE MASSINSERT.

VSAM handles requests requiring exclusive control on a data set that is

already being used in shared control mode by queueing them internally.
VSAM returns control to CICS, but transactions waiting for exclusive
control remain suspended.
Example of code causing an exclusive control deadlock
The following sequence of EXEC commands would cause an exclusive control
deadlock to occur.
The first command causes shared control to be acquired:
EXEC CICS STARTBR
FILE(myfile)
RIDFLD(rid-area)
This causes no problems. The next command at first acquires shared
control while the record is read into "input-area". When an attempt is
subsequently made to get exclusive control, deadlock occurs because the
task that wants exclusive control is also the task that is preventing it
from being acquired.
EXEC CICS READ
FILE(myfile)
INTO(input-area)
RIDFLD(rid-area)
UPDATE
The following sequence of commands would not cause deadlock to occur,
because the transaction relinquishes its shared control of the CI by
ending the browse before attempting to get exclusive control of it.
The first command causes shared control to be acquired:
EXEC CICS STARTBR

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

109/256

FILE(myfile)
RIDFLD(rid-area)
The next command causes shared control to be relinquished:
EXEC CICS ENDBR
FILE(myfile)
The next command initially causes shared control to be acquired.
The
record is read into "input-area", and then exclusive control is acquired
in place of shared control.
EXEC CICS READ
FILE(myfile)
INTO(input-area)
RIDFLD(rid-area)
UPDATE
The transaction now resumes. Exclusive control is relinquished following
the next REWRITE or UNLOCK command on file "myfile".
Resolving deadlocks
You can diagnose deadlocks between tasks wanting an exclusive lock on
the same resource (such as a record in a non-RLS file, a recoverable
transient data queue, or any resource represented by an EXEC CICS
ENQUEUE).
Enqueue deadlocks between tasks occur when each of two transactions
(say, A and B) needs an exclusive lock on a resource that the other
holds already.
Transaction A waits for transaction B to release the
resource. However, if transaction B cannot release the resource because
it, in turn, is enqueued on a resource held by transaction A, the two
transactions are deadlocked. Further transactions may then queue,
enqueued on the resources held by transactions A and B.
You can use CEMT online to identify
identify the resources they hold.

deadlocked

transactions,

and

The CEMT INQUIRE UOWENQ command displays information about the owners of
all enqueues held. More importantly, for deadlock diagnosis purposes,
it displays information about the tasks waiting for the enqueues. Note
that CEMT INQUIRE UOWENQ can be used only for files accessed in non-RLS
mode, because files accessed in RLS mode have their locks managed by
VSAM, not by CICS. Deadlock and timeout detection for files accessed in
RLS mode is also performed by VSAM.
An example of deadlock diagnosis using CEMT INQUIRE UOWENQ
Consider the following example. The user of task 32 complains that his
terminal is locked:
he cannot enter data and his terminal does not
respond to any prompt. If you enter CEMT INQUIRE TASK at a different
terminal at this time, a display similar to the following might appear:
+------------------------------------------------------------------------------+

INQUIRE TASK

STATUS: RESULTS - OVERTYPE TO MODIFY

Tas(0000025) Tra(CEMT) Fac(T773) Run Ter Pri( 255 )

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Sta(TO) Use(CICSUSER) Uow(AA8E9505458D8C01)

Tas(0000028) Tra(TDUP) Fac(T774) Sus Ter Pri( 001 )
Sta(TO) Use(CICSUSER) Uow(AA8E9505458D8C01) Hty(ZCIOWAIT)
Tas(0000032) Tra(FUPD) Fac(T775) Sus Ter Pri( 001 )
Sta(TO) Use(CICSUSER) Uow(AA8E950545DAC004) Hty(ENQUEUE )
Tas(0000035) Tra(FUPD) Fac(T784) Sus Ter Pri( 001 )
Sta(TO) Use(CICSUSER) Uow(AA8E950545DBC357) Hty(ENQUEUE )
Tas(0000039) Tra(FUPD) Fac(T778) Sus Ter Pri( 001 )
Sta(TO) Use(CICSUSER) Uow(AA8E97FE9592F403) Hty(ENQUEUE )
Tas(0000042) Tra(FUP2) Fac(T783) Sus Ter Pri( 001 )
Sta(TO) Use(CICSUSER) Uow(AA8E97FE9592F403) Hty(ENQUEUE )

110/256

Hva(DFHZARQ1)

Hva(FCDSRECD)

Hva(FCDSRECD)

Hva(FCDSRECD)

Hva(FCDSRECD)

CEMT INQUIRE TASK shows task 32 waits on an enqueue

Task 32 is waiting on an enqueue (Hty = ENQUEUE). You can also see that
the task is waiting for a lock on a data set record (Hva = FCDSRECD).
But, at this stage, you cannot tell which (if any) task has control of
this resource.
If you now enter CEMT INQUIRE UOWENQ at the same terminal, you can see
the enqueues held in the system - you can see which tasks own which
resources and which tasks are waiting for those resources.
A screen similar to the following might be displayed:
+--------------------------------------------------------------------------+

INQUIRE UOWENQ

STATUS: RESULTS

Uow(AA8E9505458D8C01) Tra(CEMT) Tas(0000025) Act Exe Own

Uow(AA8E9505458D8C01) Tra(TDUP) Tas(0000028) Act Tdq Own

Uow(AA8E950545DAC004) Tra(FUPD) Tas(0000032) Act Dat Own

Uow(AA8E950545DBC357) Tra(FUPD) Tas(0000035) Act Dat Wai

Uow(AA8E97FE9592F403) Tra(FUP2) Tas(0000039) Act Dat Wai

Uow(AA8E9505458D8C01) Tra(TSUP) Tas(0000034) Ret Tsq Own

Uow(AA8E97FE9592F403) Tra(FUP2) Tas(0000039) Act Dat Own

Uow(AA8E950545DAC004) Tra(FUPD) Tas(0000032) Act Dat Wai

Uow(AA8E97FE9592F403) Tra(FUPD) Tas(0000042) Act Dat Own

CEMT INQUIRE UOWENQ shows the owners of and waiters on resources

You can see all the enqueue owners and waiters on this display. Tasks
waiting for an enqueue are displayed immediately after the task which
owns the enqueue.
You can clarify this display in a busy system by displaying only those
resources that the task you are interested in owns and waits for. This
is called filtering. You add a filter to the end of the INQUIRE UOWENQ
command: CEMT INQUIRE UOWENQ TASK(32).
+--------------------------------------------------------------------------+

INQUIRE UOWENQ TASK(32)

STATUS: RESULTS

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Uow(AA8E950545DAC004) Tra(FUPD) Tas(0000032) Act Dat Own

Uow(AA8E950545DAC004) Tra(FUPD) Tas(0000032) Act Dat Wai

111/256

Information pertinent to task 32

You can now see that task 32 owns one enqueue but is also waiting for
another.
This display shows one line of information per item, listing:

UOW identifier
Transaction identifier
Task identifier
Enqueue state (active, or retained)
Enqueue type
Relation (whether owner of the enqueue or waiter).

In order to see more information, press ENTER alongside the item that
interests you.
If you press ENTER alongside the first entry of the
output from CEMT INQUIRE UOWENQ TASK(32), a screen similar to the
following might be displayed:
+--------------------------------------------------------------------------+

INQUIRE UOWENQ TASK(32)

RESULT

Uowenq

Uow(AA8E950545DAC004)

Transid(FUPD)

Taskid(0000032)

State(Active)

Type(Dataset)

Relation(Owner)

Resource(ACCT.CICS520.ACCTFILE)

Qualifier(SMITH)

Netuowid(..GBIBMIYA.IYA2T774.n......)

Enqfails(00000000)

The enqueued owned by task 32

This shows you details of the enqueue that task 32 owns.
Expanding the second entry shows the enqueue that task 32 is waiting
for:
+--------------------------------------------------------------------------+

INQUIRE UOWENQ TASK(32)

RESULT

Uowenq

Uow(AA8E950545DAC004)

Transid(FUPD)

Taskid(0000032)

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

State(Active)
Type(Dataset)
Relation(Waiter)
Resource(INDX.CICS520.ACIXFILE)
Qualifier(SMITH)
Netuowid(..GBIBMIYA.IYA2T774.n......)
Enqfails(00000000)

112/256

The enqueue that task 32 is waiting for

Expanding the one-line display is useful because RESOURCE and QUALIFIER
fields are then revealed. These identify the physical resource that is
related to the enqueue.
You can see, from the first entry in this
example, that task 32 owns the enqueue on record identifier "SMITH" in
the ACCT.CICS520.ACCTFILE data set. You can also see, from the second
expanded entry, that task 32 is waiting on an enqueue - for record
identifier "SMITH" in the INDX.CICS520.ACIXFILE data set.
So now you need to investigate why task 32 is waiting on the enqueue
detailed in the second expanded entry. You need to find out which task
owns this enqueue and why it is holding it for such a long time. You
can do this by filtering the CEMT INQUIRE UOWENQ command with the
RESOURCE
and
QUALIFIER
options.
Enter
CEMT
INQUIRE
UOWENQ
RESOURCE(INDX.CICS520.ACIXFILE) QUALIFIER(SMITH) This shows the task
that owns the enqueue that is being waited on.
+--------------------------------------------------------------------------+

INQUIRE UOWENQ RESOURCE(INDX.CICS520.ACIXFILE) QUALIFIER(SMITH)

STATUS: RESULTS

Uow(AA8E97FE9592F403) Tra(FUP2) Tas(0000039) Act Dat Own

Uow(AA8E950545DAC004) Tra(FUPD) Tas(0000032) Act Dat Wai

Task 39 owns the enqueue that task 32 waits on

This shows you that another task, task 39, owns the enqueue that task 32
is waiting on.
In order to find out why task 39 is holding this
enqueue, filter the CEMT command again for task 39. Enter CEMT INQUIRE
UOWENQ TASK(39).
+--------------------------------------------------------------------------+

INQUIRE UOWENQ TASK(39)

STATUS: RESULTS

Uow(AA8E97FE9592F403) Tra(FUP2) Tas(0000039) Act Dat Wai

Uow(AA8E97FE9592F403) Tra(FUP2) Tas(0000039) Act Dat Own

Information pertinent to task 39

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

113/256

This shows you that task 39 is also waiting for an enqueue.

If you
expand the entry which indicates the waiting state, you may see a
display similar to the following:
+--------------------------------------------------------------------------+

INQUIRE UOWENQ TASK(39)

RESULT

Uowenq

Uow(AA8E97FE9592F403)

Transid(FUP2)

Taskid(0000039)

State(Active)

Type(Dataset)

Relation(Waiter)

Resource(ACCT.CICS520.ACCTFILE)

Qualifier(SMITH)

Netuowid(..GBIBMIYA.IYA2T776.p.nk4..)

Enqfails(00000000)

The enqueue that task 39 is waiting on

This shows you that task 39 is waiting for the enqueue on record "SMITH"
in the ACCT.CICS520.ACCTFILE data set. This is the enqueue that task 32
owns. You can now see that the deadlock is between tasks 32 and 39.
If you filter by the RESOURCE and QUALIFIER of this enqueue, you can
confirm that this is the case. This also shows that task 35
also waits on the enqueue owned by task 32.
+--------------------------------------------------------------------------+

INQUIRE UOWENQ RESOURCE(ACCT.CICS520.ACCTFILE) QUALIFIER(SMITH)

STATUS: RESULTS

Uow(AA8E950545DAC004) Tra(FUPD) Tas(0000032) Act Dat Own

Uow(AA8E950545DBC357) Tra(FUPD) Tas(0000035) Act Dat Wai

Uow(AA8E97FE9592F403) Tra(FUP2) Tas(0000039) Act Dat Wai

Task 32 owns the enqueue that task 39 waits on

You are now in a position of knowing which transaction(s) to cancel and
investigate further.
You can also use the EXEC CICS INQUIRE UOWENQ command in your
applications. This returns all the information that is available under
CEMT INQUIRE UOWENQ.
If you wish to automate deadlock detection and
resolution, this command is of great benefit.
Two Sample Programs that illustrate deadlock occurrence
SAMP8
transaction-id SM08
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP8.
ENVIRONMENT DIVISION.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-MSG-DATA
PIC X(30).
03 WS-MSG-DATA-LEN
PIC S9(4) COMP VALUE 30.
03 WS-RESP
PIC S9(08) COMP VALUE 0.
03 WS-QUEUE-RECORD-LEN
PIC S9(4) COMP VALUE 10.
03 WS-POST
PIC S9(8) COMP.
03 WS-POST-BIN REDEFINES WS-POST PIC X(4).
03 WS-CLEAR
PIC S9(8) COMP.
03 WS-CLEAR-BIN REDEFINES WS-CLEAR PIC X(4).
03 WS-SAMP8-PTR
USAGE IS POINTER.
03 WS-SAMP8-PTR-LEN
PIC S9(4) COMP VALUE 4.
01 WS-QUEUE-RECORD.
03 WS-QUEUE-DATA
PIC X(10) VALUE "SAMP8 ".
01 WS-RESOURCE-ONE
PIC X(8) VALUE 'ONE'.
01 WS-RESOURCE-TWO
PIC X(8) VALUE 'TWO'.
LINKAGE SECTION.
01 WS-ECBS.
03 ECB-ONE
PIC S9(8) COMP.
03 ECB-ONE-PTR
POINTER.
03 ECB-ONE-PTR-PTR
POINTER.
PROCEDURE DIVISION.
PERFORM INIT-PARA.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
MOVE "SAMP8 STARTING ...." TO WS-MSG-DATA
EXEC CICS
SEND TEXT FROM(WS-MSG-DATA)
LENGTH(WS-MSG-DATA-LEN)
RESP(WS-RESP)
END-EXEC
PERFORM LOOP-PARA
MOVE "SAMP8 ENDING..." TO WS-MSG-DATA
EXEC CICS
SEND TEXT FROM(WS-MSG-DATA)
LENGTH(WS-MSG-DATA-LEN)
RESP(WS-RESP)
END-EXEC.
LOOP-PARA.
EXEC CICS WAITCICS
ECBLIST(ECB-ONE-PTR-PTR)
NUMEVENTS(1)
RESP(WS-RESP)
END-EXEC
MOVE WS-CLEAR TO ECB-ONE
EXEC CICS
WRITEQ TS QUEUE("SAMP8")
FROM(WS-QUEUE-RECORD)
LENGTH(WS-QUEUE-RECORD-LEN)
RESP(WS-RESP)
END-EXEC
EXEC CICS
ENQ RESOURCE(WS-RESOURCE-TWO) LENGTH(8)
END-EXEC.
END-PARA.

114/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

EXEC CICS
RETURN
END-EXEC.
INIT-PARA.
MOVE X'40008000' TO WS-POST-BIN
MOVE X'00000000' TO WS-CLEAR-BIN
EXEC CICS
GETMAIN SET(ADDRESS OF WS-ECBS)
FLENGTH(LENGTH OF WS-ECBS)
USERDATAKEY
END-EXEC
MOVE WS-CLEAR TO ECB-ONE
SET ECB-ONE-PTR TO ADDRESS OF ECB-ONE
SET ECB-ONE-PTR-PTR TO ADDRESS OF ECB-ONE-PTR
EXEC CICS
DELETEQ TS QUEUE("SAMP8")
RESP(WS-RESP)
END-EXEC
EXEC CICS
ENQ RESOURCE(WS-RESOURCE-ONE) LENGTH(8)
END-EXEC
SET WS-SAMP8-PTR TO ADDRESS OF WS-ECBS
EXEC CICS
START TRANSID("SM09")
INTERVAL(0)
FROM(WS-SAMP8-PTR)
LENGTH(WS-SAMP8-PTR-LEN)
END-EXEC.
SAMP9

transaction-id SM09
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP9.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-RESP
PIC S9(08) COMP VALUE 0.
03 WS-QUEUE-RECORD-LEN
PIC S9(4) COMP VALUE 14.
01 WS-QUEUE-RECORD.
03 WS-QUEUE-DATA
PIC X(10) VALUE "SAMP9 ".
03 WS-COUNT
PIC 9(4) VALUE 0.
03 WS-POST
PIC S9(8) COMP.
03 WS-POST-BIN REDEFINES WS-POST PIC X(4).
03 WS-CLEAR
PIC S9(8) COMP.
03 WS-CLEAR-BIN REDEFINES WS-CLEAR PIC X(4).
01 WS-ECBS-LEN
PIC S9(4) COMP VALUE 4.
01 WS-SAMP5-WS-PTR
USAGE IS POINTER.
01 WS-SAMP5-WS-PTR-LEN
PIC S9(4) COMP VALUE 4.
01 WS-RESOURCE-ONE
PIC X(8) VALUE 'ONE'.
01 WS-RESOURCE-TWO
PIC X(8) VALUE 'TWO'.
01 NUMEVENTS
PIC S9(8) COMP VALUE 1.
LINKAGE SECTION.
01 WS-ECBS.
03 ECB-ONE
PIC S9(8) COMP.
03 ECB-ONE-PTR
POINTER.
03 ECB-ONE-PTR-PTR
POINTER.
PROCEDURE DIVISION.

115/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

PERFORM INIT-PARA.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
ENQ RESOURCE(WS-RESOURCE-TWO) LENGTH(8)
END-EXEC
PERFORM LOOP-PARA.
LOOP-PARA.
EXEC CICS
WRITEQ TS QUEUE("SAMP8")
FROM(WS-QUEUE-RECORD)
LENGTH(WS-QUEUE-RECORD-LEN)
RESP(WS-RESP)
END-EXEC.
MOVE WS-POST TO ECB-ONE
EXEC CICS
ENQ RESOURCE(WS-RESOURCE-ONE) LENGTH(8)
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
INIT-PARA.
MOVE X'40008000' TO WS-POST-BIN
MOVE X'00000000' TO WS-CLEAR-BIN
EXEC CICS
RETRIEVE INTO(WS-SAMP5-WS-PTR)
LENGTH(WS-SAMP5-WS-PTR-LEN)
END-EXEC
SET ADDRESS OF WS-ECBS TO WS-SAMP5-WS-PTR.

116/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

117/256

VSAM Performance Issues

LSR has significant advantages, by providing:

More efficient use of virtual storage because buffers and strings are
shared.

Better performance because of better buffer lookaside, which can

reduce I/O operations.

Self-tuning because more buffers are allocated to busy files and

frequently referenced index control intervals are kept in its
buffers.

Better read integrity because there is only one copy of a CI in

storage.

NSR, on the other hand:

Allows for specific tuning in favor of a particular data set

Can provide better performance for sequential operations.

The general recommendation is to use LSR for all VSAM data sets except
where you have one of the following situations:
1. A file is very active but there is no opportunity for lookaside
because, for instance, the file is very large.
2. High performance
buffers.

is

required

by

the

allocation

of

extra

index

3. Fast sequential browse or mass insert is required by the allocation

of extra data buffers.
4. Control area (CA) splits are expected for a file, and extra data
buffers are to be allocated to speed up the CA splits.
If you have only one LSR pool, a particular data set cannot be isolated
from others using the same pool when it is competing for strings, and it
can only be isolated when it is competing for buffers by specifying
unique CI sizes.
In general, you get more self-tuning effects by
running with one large pool, but it is possible to isolate busy files
from the remainder or give additional buffers to a group of high
performance files by using several pools. It is possible that a highly
active file has more successful buffer lookaside and less I/O if it is
set up as the only file in an LSR subpool rather than using NSR. Also
the use of multiple pools eases the restriction of 255 strings for each
pool.
Number of strings
The next decision to be made is the number of concurrent accesses to be
supported for each file and for each LSR pool.
This is achieved by specifying VSAM "strings". A string is a request to
a VSAM data set requiring "positioning" within the data set.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

118/256

VSAM requires one or more strings for each concurrent file operation.
For non update requests (for example, a READ or BROWSE), an access using
a base needs one string, and an access using an AIX needs two strings
(one to hold position on the AIX and one to hold position on the base
data set).
If access to a file is read only with no browsing, there is no need to
have a large number of strings; just one may be sufficient. Note that,
while a read operation only holds the VSAM string for the duration of
the request, it may have to wait for the completion of an update
operation on the same CI.
CICS manages string usage for both files and LSR pools. For each file,
whether it uses LSR or NSR, CICS limits the number of concurrent VSAM
requests to the STRNO= specified in the FCT file entry. For each LSR
pool, CICS also prevents more requests being concurrently made to VSAM
than can be handled by the strings in the pool.
When deciding the number of strings for a particular file, consider the
maximum number of concurrent tasks. Because CICS command level does not
allow more than one request to be outstanding against a particular data
set from a particular task, there is no point in allowing strings for
more concurrent requests.
If you want to distribute your strings across tasks of different types,
the transaction classes may also be useful.
You can use transaction
class limits to control the transactions issuing the separate types of
VSAM request, and for limiting the number of task types that can use
VSAM strings, thereby leaving a subset of strings available for other
uses.
Size of control intervals
The size of the data set control intervals is not an operand specified
to CICS; it is defined through VSAM AMS. However, it can have a
significant performance effect on a CICS system that provides access to
the control interval.
In general, direct I/O runs slightly more quickly when data CIs are
small, whereas sequential I/O is quicker when data CIs are large.
However, with NSR files, it is possible to get a good compromise by
using small data CIs but also assigning extra buffers, which leads to
chained and overlapped sequential I/O.
However, all the extra data
buffers get assigned to the first string doing sequential I/O.
VSAM functions most efficiently when its control areas are the maximum
size, and it is generally best to have data CIs larger than index CIs.
Thus, typical CI sizes for data are 4KB to 12KB and, for index, 1KB to
2KB.
In general, you should specify the size of the data CI for a file, but
allow VSAM to select the appropriate index CI to match.
Number of buffers (NSR)
The next decision is the number of buffers to be provided for each file.
Enough buffers must be provided to support the concurrent accesses
specified in the STRNO operand for the file.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

119/256

Specify the number of data and index buffers for NSR using the
DATABUFFER and INDEXBUFFER operands of the file definition (or
explicitly by coding the BUFND and BUFNI operands in the file
definition). It is important to specify sufficient index buffers. If a
KSDS consists of just one control area (and, therefore, just one index
CI), the minimum index buffers equal to STRNO is sufficient. But when a
KSDS is larger than this, at least one extra index buffer needs to be
specified so that at least the top level index buffer is shared by all
strings. Further index buffers reduces index I/O to some extent.
BUFND should generally be the minimum at STRNO + 1, unless the aim is to
enable overlapped and chained I/O in sequential operations or it is
necessary to provide the extra buffers to speed up CA splits.
Number of buffers (LSR)
The set of buffers of one size in an LSR pool is called a "subpool."
The number of buffers for each subpool is controlled by the DATA and
INDEX operands of the LSRPOOL definition.
Take care to include buffers of the right size. If no buffers of the
required size are present, VSAM uses the next larger buffer size.
VSAM resource usage (LSRPOOL)
The default for all VSAM data sets is LSR.
If multiple pools are
supported CICS provides for the use of pools 1 through 8.
The LSRPOOL operand specifies whether a file is to use LSR or NSR and,
if LSR, which pool. The LSRPOOL operand can be used in CICS systems with
VSAM data sets.
All files with the same base data set, except read-only files with
DSNSHR=UPDATE specified in the FCT file entry, must use either the same
LSR pool or all use NSR.
VSAM buffer allocations for NSR (BUFNI and BUFND)
For files using non shared resources (NSR), the BUFNI and BUFND operands
define VSAM index buffers and data buffers respectively.
BUFNI and BUFND specify the number of index and data buffers for an NSR
file.
The number of buffers can have a significant effect
use of many buffers can permit multiple concurrent
are the corresponding number of VSAM strings) and
operations and CA splits. Providing extra buffers
records can reduce physical I/O operations.

on performance. The
operations (if there
efficient sequential
for high-level index

The BUFND and BUFNI operands should be used in CICS systems that use
VSAM NSR files in CICS file control.
The BUFNI and BUFND operands are defined in the file definition on the
CSD. They correspond exactly to VSAM ACB operands: BUFNI is the number
of index buffers, BUFND is the number of data buffers. For LSR files,
they are ignored.
BUFND and BUFNI map to DATABUFFERS and INDEXBUFFERS in RDO.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

120/256

VSAM buffer allocations for LSR (BUFFERS)

For files using shared resources (LSR), the number of buffers to be used
is not specified explicitly by file. The files share the buffers of the
appropriate sizes in the LSR pool. The number of buffers in the pool
may either be specified explicitly using the BUFFERS operand in the file
definition on the CSD, or be left to CICS to calculate.
The BUFFERS operand allows for exact definition of specific buffers for
the LSR pool.
The number of buffers can have a significant effect on performance. The
use of many buffers can permit multiple concurrent operations (if there
are the corresponding number of VSAM strings). It can also increase the
chance of successful buffer lookaside with the resulting reduction in
physical I/O operations.
The number of buffers should achieve an optimum between increasing the
I/O saving due to lookaside and increasing the real storage requirement.
This optimum is different for buffers used for indexes and buffers used
for data. Note that the optimum buffer allocation for LSR is likely to
be significantly less than the buffer allocation for the same files
using NSR.
The BUFFERS operand should be used in CICS systems that use VSAM LSR
files in CICS file control.
VSAM string settings for NSR (STRNO)
STRNO is used to determine the number of concurrent operations possible
against the file and against the VSAM base cluster to which the file
relates.
The STRNO operand for files using NSR can limit the number of concurrent
asynchronous requests that can be made against that specific file.
The STRNO operand should be used in CICS systems that use VSAM NSR files
in CICS file control.
The number of strings is defined by the STRINGS operand in the CICS file
definition on the CSD.
VSAM string settings for LSR (STRNO)
STRNO is used to determine the number of strings and thereby the number
of concurrent operations possible against the LSR pool (assuming that
there are buffers available).
The STRNO operand relating to files using LSR can limit the number of
concurrent requests that can be made against that specific file.
The number of strings is defined by the STRNO operand in the file
definition on the CSD, which limits the concurrent activity for that
particular file.

APPLICATION PROGRAMMING IN CICS BASIC

Temporary Storage Control

24/08/2003

121/256

back

Introduction
Temporary Storage provides a scratchpad area for applications to store
data for short term use. One example of usage is passing data between
executions of a pseudo conversational program.
Temporary Storage, also called TS is divided into TS queues and records,
which are also known as items. It is incorrect to relate the term record
to a file based record. A TS record or item size can be different for
the record size of the underlying data set. The underlying data set over
which TS is implemented is pointed to by DFHTEMP dd name in the CICS
startup. This is a VSAM ESDS file, set up by the systems programmer. All
CICS instance wide TS queues use this one file and the application
programmer need not be bothered about setting this file up.
You do not need to define TS queues to CICS if you do not want them to
be recoverable, or under syncpoint control. Be aware though that if you
do need to define them, online CEDA does not support TS queue
definitions. You have to code assembler macros and assemble and Link
edit the definition into the CICS libraries. This is a system programmer
/ CICS administrators job.
System Considerations
The temporary storage table (TST) is a list of generic names (or
prefixes) used to identify sets of temporary storage queues.
Generic
names are formed from the leading characters of the appropriate queue
names, and can be up to seven characters long.
The generic names coded on a DFHTST TYPE=RECOVERY macro identify queues
for which CICS provides backout of changes in the event of transaction
failure or protection against system failure.
The generic name coded on a DFHTST TYPE=REMOTE macro identifies queues
for which CICS routes the temporary storage request to a remote CICS
region or TS server, unless the remote system name (SYSIDNT) is the same
as that of the local CICS.
If SYSIDNT is the same name as the local
CICS, the queues specified by the DATAID option are treated by CICS as
local queues.
The generic name coded on a DFHTST TYPE=LOCAL macro identifies queues as
local queues that reside in the CICS region in which the TST is
installed.
The generic name coded on a DFHTST TYPE=SECURITY macro identifies queues
for which resource security checking is required.
CICS searches the TST for the first prefix that satisfies the particular
search criteria.
For example, if CICS searches for temporary storage
queue ABCDEFGH, and the TST contains prefix A followed by prefix AB, A
is selected. To avoid this, define the less-generic entries to the TST
before any more-generic entries, so that the first to be found is the
least generic of all possible matches.
Note that when CICS is looking for DATAIDs to match against a TS queue
name, it searches only the types of entry in which it is interested for
that particular search. CICS searches:

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

122/256

Local and remote entries when determining whether a queue is remote.

Thus, local and remote entries are regarded as one search category
when CICS is matching a queue name against generic names.

Recovery and remote entries when determining whether a queue is

recoverable.
However, if the leading characters of a queue name
match both TYPE=RECOVERY and TYPE=REMOTE generic names, TYPE=REMOTE
takes precedence, and the recovery option must be redefined in the
local region in which the queue resides. (Queues in a shared TS pool
cannot be recoverable.)

Security entries only when determining whether a queue is subject to

security.
DFHTST TYPE=INITIAL,
SUFFIX=01

*
*
*
*
*
*
*
*
*
*
*

*
*
*
*

LIST OF GENERIC NAMES OF QUEUE

THAT ARE RECOVERABLE, REMOTE,
SHARED, LOCAL, OR REQUIRE
SECURITY CHECKING.
The following macro specifies that all LOCAL queues with
names beginning with the letter 'R' are RECOVERABLE:

DFHTST TYPE=RECOVERY,
DATAID=R
The following macro specifies that queues with names
beginning with C,D,E, and X are local queues:

DFHTST TYPE=LOCAL,
DATAID=(C,D,E,X)
The following macro specifies that queues with names
beginning with AB,L,M,N are remote queues on system RSYS:

DFHTST TYPE=REMOTE,
DATAID=(AB,L,M,N),
SYSIDNT=RSYS,
Queue names on remote system
RMTNAME=LC
begin with letters LC
The following macro specifies that queues with names
beginning with SAQ require security checking.
Note that the full TS queue name is passed to the ESM.

*
*
*

DFHTST TYPE=SECURITY,
DATAID=SAQ

*
DFHTST TYPE=FINAL
END

Sample Source For TS Queue Definitions.

Note that the link edited module will have the name DFHTST01. This must
be pointed to in DFHSIT, the System Initialization Table by TST=01. The
creation of the table and the DFHSIT change is the CICS administrator/
systems programmer work.
Application Programming Consideration
As mentioned earlier the items in the queue represent data records from
the application perspective. They are numbered 1 through n, although
most usage will typically have only one record.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

123/256

Applications can fetch the item either sequentially or randomly (by

specifying the item number).
TS control lets you choose between main storage and DFHTEMP ESDS for
hosting your queue. Long life temporary data, typically data between
pseudo conversational executions are better stored on disk to avoid
stress on main storage. Short life data, where operator interaction does
not determine the lifetime of the data, is better stored in main
storage. However CICS does not pose any restrictions. Depending on the
response times and other CICS conditions, an application programmer is
free to choose between the methods. Note though that main storage
implemented queues are not recoverable as they cannot be defined in the
TST.
The WRITEQ TS command
EXEC CICS
WRITEQ TS QUEUE(name)
FROM(data-area)
[ LENGTH(data-value) ]
[ ITEM(data-area) [ REWRITE
[ NUMITEMS(data-area) ]
[ SYSID(name) ]
[ MAIN | AUXILIARY ]
[ NOSUSPEND ]
END-EXEC
options
QUEUE

One to eight character queue name.

FROM

The data area from where the data is to be written to the

queue.

LENGTH

A binary half word PIC S9(4) COMP field that specifies the
length of the record to be written.

ITEM

A half word PIC S9(4) COMP field which specifies the item to
be rewritten when REWRITE is specified. If REWRITE is not
specified, CICS ignores this field on input and sets it with
the item number of the newly written item on return.

REWRITE

specifies that the item should be rewritten.

NUMITEMS

A binary half word field that CICS sets with the number of
items (including this one just written) in the queue. Not
valid if ITEM is coded.

SYSID

Connection name of the remote system where this queue is

defined.

MAIN

Specifies that the item should be held in main storage.

AUXILIARY

Specifies that the item should be held in auxiliary storage.

NOSUSPEND

If sufficient space does not exist for the record, dont

suspend the calling task. Return with the NOSPACE response.

APPLICATION PROGRAMMING IN CICS BASIC

Exceptions
INVREQ

24/08/2003

124/256

The queue name is invalid, or the queue was created for CICS
internal use and cant be written into by a user program.

IOERR

An IOERR occurred.

ITEMERR

No record exists for the item number specified.

NOSPACE

There is insufficient space to hold the TS record.

QIDERR

The specified queue does not exist.(conceivably possible

only when you attempt rewrite)

SYSIDERR

The system
accessed.

ISCINVREQ

An indeterminate error occurred on the remote system.

defined

by

SYSID

could

not

be

located

or

Notes
1. TS queues are automatically created when you write a record to a
queue that does not exist.
2. Main or auxiliary lets you choose between the queue being on main or
auxiliary storage.
3. If the data being passed between applications is
commarea. If more than say 4k use a queue instead.

small

use

the

4. If you want the queue name to be unique, use the terminal ID in the
EIBTRMID field as the queue name.
5. If you code NOSUSPEND, control is returned immediately to your
program if sufficient space does not exist for the record. You can
detect it by the NOSPACE condition.
The READQ TS command
EXEC CICS
READQ TS
QUEUE(name)
{ INTO(data-area) | SET(pointer-ref)
[ LENGTH(data-value) ]
[ NUMITEMS(data-value) ]
[ ITEM(data-area) | NEXT ]
[ SYSID(name) ]
END-EXEC
options
QUEUE

One to eight character queue name.

INTO

The data area into where the data from the queue is to be
written.

SET

Specifies the data area that will contain the address of the
retrieved record.

LENGTH

A binary half word PIC S9(4) COMP field that on input

specifies the length of the data area and on return from the
call has the length of the record that has been read.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

125/256

ITEM

A half word PIC S9(4) COMP field which specifies the item to
be read from the queue.

NUMITEMS

A binary half word field that CICS sets with the number of
items in the queue.

SYSID

Connection name of the remote system where this queue is

defined.

Exceptions
INVREQ

The queue was created for CICS internal use and cannot be
written into by a user program.

IOERR

An IOERR occurred.

ISCINVREQ

An undeterminable error occurred on the remote system that

has the queue.

ITEMERR

No record exists for the item number specified.

LENGERR

The length of the record exceeds the length of the buffer

specified.

QIDERR

The specified queue does not exist.

SYSIDERR

The system
accessed.

defined

by

SYSID

could

not

be

located

or

Notes
The access to TS queues can be sequential or direct. For direct access
specify the item number. Note however that CICS maintains one and only
one position in the queue for all tasks that access the queue. If
multiple tasks access the queue sequentially, tasks may not get the next
record due to intervening access by another task. If tasks want to
reserve the queue for exclusive use they must use CICS ENQ and DEQ
specifying the same resource name.
Since temporary storage queues are created and deleted dynamically,
always check for the QIDERR. If you specify ITEM check for the ITEMERR
condition.
The DELETQ TS command
EXEC CICS
DELETQ TS QUEUE(name)
[ SYSID(name)
END-EXEC

QUEUE

One to eight character queue name.

SYSID

Connection name of the remote system where this queue is

defined.

Exceptions
INVREQ

The queue was created for CICS internal use and cannot be
written into by a user program.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

126/256

ISCINVREQ

An undeterminable error occurred on the remote system that

has the queue.

QIDERR

The specified queue does not exist.

SYSIDERR

The system
accessed.

defined

by

SYSID

could

not

be

located

or

Notes
1. TS queues are automatically created when you write a record to a
queue that does not exist. Once created they have to be explicitly
deleted using the DELETQ command.
2. Queues can be created in virtual storage or via DFHTEMP in a vsam
ESDS file.
3. You can create a unique queue name by using the value in EIBTRMID
field of the EIB.
4. Another way to delete a queue is to issue CEBR and issue a purge
command. Since queues can be deleted so easily, checking of QIDERR is
a must.
A sample Program using TS queues
This is a variant of the CUSTOMER maintenance program presented earlier.
Since the program is pseudo conversational, special considerations need
to be given to the update program function. Between the time the record
to be updated is read and thrown on the terminal screen for user change,
some other transaction may change the record in the data set. Another
version of the maintenance program defended itself against this
possibility by maintaining a copy of the original record in the commarea
which is preserved
across pseudo conversational executions. The
contents of the original record in the commarea are always checked
against the contents after a READ with UPDATE option. The REWRITE is
done only if the just read copy and the commarea copy match.
This version achieves the same result by storing a copy of the original
record in a TS queue rather than in the commarea. This is a good idea if
the record size is large.
This program
APPLICATION.

and

artifacts

are

described

in

the

section

SAMPLE

General TS queue considerations

1. Temporary storage queues remain intact until they are deleted by the
originating task, by any other task, or by an initial or cold start;
2. Before deletion, they can be accessed any number of times.
Even
after the originating task is terminated, temporary data can be
accessed by other tasks through references to the symbolic name under
which it is stored.
3. Temporary data can be stored either in main storage or in auxiliary
storage.
Generally, main storage should be used if the data is
needed for short periods of time;

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

127/256

4. auxiliary storage should be used if the data is to be kept for long

periods of time. Data stored in auxiliary storage is retained after
CICS termination and can be recovered in a subsequent restart, but
data in main storage cannot be recovered.
5. The temporary storage queues can be defined as local, remote, or
shared.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Transient Data Control

128/256

back

Introduction and Usage

Transient Data control is used for simple sequential processing. You can
store data sequentially and retrieve it in the same sequence.
Transient Data means data that passes quickly into and out of existence.
A record passes into a transient data queue when you write it to the
queue. It passes out of the queue and out of existence when you read it.
This is also called a destructive read.
When you write a record to a TD queue, it is always added at the end.
When you read the queue, the first record from the queue is returned to
you as well as removed from the queue. As such you cannot read the same
record twice.
Transient data queues are often called destinations. Unlike the TS
queues where defining them to CICS is optional and dependent on usage,
TD queues must be defined to the system. In earlier versions of CICS you
had to code the DCT (destination control table)using macros and then
assemble and link edit the table into a CICS loadlib. You then had to
point to this table via the SIT. Today CICS uses RDO to define TD
queues.
The following transient data resources can be managed using RDO:
1. Intrapartition queue, that can be accessed from only within the CICS
region.
2. Extrapartition queues can be accessed both by the CICS region as well
as by a batch program running in another address space.
3. Indirect queue is one which points to another queue.
4. Remote queue is one hosted on another CICS image either on this or a
remote system.
An extrapartition destination can reside on any device that is valid for
QSAM. CICS stores intrapartition queues in a VSAM file pointed to by
DFHNTRA.
You use the TDQUEUE definition to describe the physical and operational
characteristics of a transient data queue.
Intrapartition definitions contain attributes that provide information
about recovery characteristics, trigger levels, associated transactions,
facilities, and userids.
Extrapartition definitions contain information about the associated QSAM
data set, and the number of buffers that are to be used.
Indirect definitions identify the underlying queue name.
Remote definitions contain the name of the remote system and the name by
which the queue is known on that remote system.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

129/256

A transient data queue is always installed in an enabled state.

Any
queues that were disabled when a CICS system terminated, will still be
enabled when the system is restored using a warm start or emergency
restart.
You can use the following transactions and commands to inquire about,
set, and discard transient data definitions after they have been
installed:
1.
2.
3.
4.

CEMT INQUIRE TDQUEUE (or EXEC CICS INQUIRE TDQUEUE)

CEMT SET TDQUEUE (or EXEC CICS SET TDQUEUE)
CEMT DISCARD TDQUEUE (or EXEC CICS DISCARD TDQUEUE)
The CECI transaction

Automatic Transaction Initiation

ATI provides a way of automatically starting a task when the number of
entries in the queue reach a level specified in the queue definition.
You define the transaction to be initiated as part of the queue
definition.
Indirect Destinations
This feature lets a single transient data queue be identified by
different names. The physical queue can be either an intrapartition or
an extrapartition queue. You do this when you want to shield a program
from changes in the actual destination name. Typical example is where
the destination is a terminal.
Reserving destinations for exclusive use
CICS does not automatically prevent multiple tasks to access the same TD
queue. For this reason the applications that share a common queue must
employ their own enqueue mechanisms, typically using CICS ENQ and CICS
DEQ.
The WRITEQ TD command
EXEC CICS
WRITEQ TD QUEUE(name)
FROM(data-area)
[ LENGTH(data-value)
[ SYSID(name) ]
END-EXEC.
options
QUEUE

Specifies the one to four character name of the transient

data queue where the data is to be written.

FROM

Specifies the data area from where the record is to be

written.

LENGTH

Specifies a half word PIC S9(4) COMP field that indicates

the length of the record that is to be written.

SYSID

Specifies the one to four character connection name that

points to a remote system.

Exception Conditions
DISABLED
The destination is disabled

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

130/256

INVREQ

Another task has the extrapartition queue open for input.

IOERR

An I/O error occurred

ISCINVREQ

An undeterminable error occurred at the remote system.

LENGERR

The length specified exceeds

allowed for the destination.

NOSPACE

There is not enough space allocated to the destination to

contain the record.

NOTOPEN

The destination is not open

QIDERR

The destination specified in the call is not defined to CICS

(either via RDO or DCT).

SYSIDERR

The remote system could not be located or accessed.

the

maximum

record

length

Notes
There are two types of queues. One is intrapartition and implemented
on VSAM ESDS pointed to by DFHNTRA. The other is a QSAM and is an
extrapartition queue.

An intrapartition queue can have ATI with a specified trigger level.

One common use of ATI is for printing applications.

To have exclusive use of the queue use CICS ENQ and DEQ.

The READQ TD command

EXEC CICS
READQ TD
QUEUE(name)
{ INTO(data-area) | SET(pointer-ref) }
[ LENGTH(data-value) ]
[ SYSID(name) ]
[ NOSUSPEND ]
END-EXEC.
options
QUEUE

Specifies the one to four character name of the transient

data queue from where the data is to be retrieved.

INTO

Specifies the data area to where the record from the queue
is to be written.

SET

Specifies the data area that will contain the address of the
retrieved record.

LENGTH

Specifies a half word PIC S9(4) COMP field that indicates on

input the length of the buffer. On return from the call CICS
sets it with the length of the record fetched.

SYSID

Specifies the one to four character connection name that

points to a remote system.

APPLICATION PROGRAMMING IN CICS BASIC

NOSUSPEND

24/08/2003

131/256

Specifies that if the queue is busy, control is to return

immediately to the program at the point following the READQ
TD command.

Exception Conditions
DISABLED
The destination is disabled
INVREQ

The extrapartition queue has been opened for output.

IOERR

An I/O error occurred

ISCINVREQ

An undeterminable error occurred at the remote system.

LENGERR

The length of the record exceeds the length of the buffer

specified in the LENGTH option.

NOTOPEN

The destination is not open

QBUSY

Another task is writing or deleting a record in the queue.

QZERO

There are no more records in the destination.

QIDERR

The destination specified in the call is not defined to CICS

(either via RDO or DCT).

SYSIDERR

The remote system could not be located or accessed.

Notes
There are two types of queues. One is intrapartition and implemented
on VSAM ESDS pointed to by DFHNTRA. The other is a QSAM and is an
extrapartition queue.

An intrapartition queue can have ATI with a specified trigger level.

One common use of ATI is for printing applications.

Records are always fetched from the queue in the order in which they
were written. Also the read is destructive, the record is deleted.

To have exclusive use of the queue use CICS ENQ and DEQ.

You should expect QZERO condition to arise if the queue is empty.

You can get a QBUSY condition only if you specified NOSUSPEND. If you
had not specified NOSUSPEND, your task blocks until the queue is no
longer busy and your request completes.

The DELETEQ TD command

EXEC CICS
DELETEQ TD QUEUE(name)
[ SYSID(name)
END-EXEC
options
QUEUE

One to four character queue name.

APPLICATION PROGRAMMING IN CICS BASIC

SYSID

24/08/2003

132/256

Connection name of the remote system where this queue is

defined.

Exceptions
DISABLED

The queue has been disabled

INVREQ

The queue is an extrapartition queue.

ISCINVREQ

An undeterminable error occurred on the remote system that

has the queue.

QIDERR

The specified queue does not exist.

SYSIDERR

The system
accessed.

defined

by

SYSID

could

not

be

located

or

Notes
1. Although the reads to a TD queue are destructive, the space occupied
by the deleted records is not released until you issue a DELETEQ TD.
2. The DELETEQ TD just deletes any unread records and reclaims space
from deleted records. The destination itself is not deleted.
3. You can issue a DELETEQ TD only against an intrapartition TD queue.
The ENQ command
EXEC CICS
ENQ
RESOURCE(data-area)
[ LENGTH(data-value) ]
END-EXEC
RESOURCE

Specifies a 1 to 255 character resource name.

LENGTH

A half word PIC S9(4) COMP field that indicates the length
of the resource name in the data-area. If you omit this CICS
takes the address of the data-area as the resource that you
want to ENQ.

The DEQ command

EXEC CICS
DEQ
RESOURCE(data-area)
[ LENGTH(data-value) ]
END-EXEC
RESOURCE

Specifies a 1 to 255 character resource name.

LENGTH

A half word PIC S9(4) COMP field that indicates the length
of the resource name in the data-area. If you omit this CICS
takes the address of the data-area as the resource that you
want to DEQ

A Sample Program
Program

PROLST5.

Overview

Lists the contents of a file of product records.

Input / Output

PRODUCT

Product File

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

133/256

Process Specifications
1. Control is transferred to the program via XCTL from the menu program
INVMENU with no communication area. The user can also start the
program by entering transaction id LST1
2. For each record in the product file, list the product code,
description, unit price and quantity on hand. At the end of the
listing, list the number of products in the file.
3. Use a transient data destination to route the output data to a
printer. An installation developed utility (not included in this
material) will be responsible for reading data from the destination
and writing to the printer.
4. Use ASA control characters in the first position of the destination
record to control printer spacing. The control characters are
Blank
skip one line before printing
0
skip two lines before printing
skip three lines before printing
1 skip to the top of next page before printing
5. CICS ENQ and DEQ are used to reserve the queue to prevent other tasks
from making intervening writes while our listing program is running.
0000
Produce
Product
listing

1000
start
Product
browse

2000
Produce
Product
line

2100
read
Product
record

3000
Print
total
line

2200
Print
Product
line

2210
Print
heading
lines

2220
write
queue
record

2220
write
queue
record

2220
Write
Queue
record

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

134/256

Structure Chart for the product listing program

The PRODUCT copy member
01 PRODUCT-MASTER-RECORD.
*
05 PRM-PRODUCT-CODE
05 PRM-PRODUCT-DESCRIPTION
05 PRM-UNIT-PRICE
05 PRM-QUANTITY-ON-HAND
*
The ERRPARM copy member
01 ERROR-PARAMETERS.
*
05 ERR-RESP
05 ERR-RESP2
05 ERR-TRNID
05 ERR-RSRCE

PIC
PIC
PIC
PIC

S9(8)
S9(8)
X(4).
X(8).

PIC
PIC
PIC
PIC

X(10).
X(20).
S9(7)V99
S9(7)

COMP-3.
COMP-3.

COMP.
COMP.

You must define and install INTra destination L86P before you run this
program (PROLST5).
The Program PROLST5
IDENTIFICATION DIVISION.
*
PROGRAM-ID. PROLST5.
*
ENVIRONMENT DIVISION.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
*
01 SWITCHES.
*
05 PRODUCT-EOF-SW PIC
88 PRODUCT-EOF
*
01 WORK-FIELDS.
*
05 RECORD-COUNT
PIC
*
01 PRINT-FIELDS.
*
05 LINE-COUNT
PIC
05 LINES-ON-PAGE
PIC
05 PAGE-NO
PIC
05 PRINT-AREA
PIC
05 LINE-LENGTH
PIC
*
01 RESPONSE-CODE
PIC
*

VALUE 'N'.
VALUE 'Y'.

S9(5)

VALUE ZERO

S99
VALUE 99
S99
VALUE 50
S999
VALUE 1
X(133).
S9(4)
S9(8)

COMP.

COMP-3.

COMP-3.
COMP-3.
COMP-3.
COMP.

APPLICATION PROGRAMMING IN CICS BASIC

01

01

01

01

01

01

01

01

PIC
PIC
PIC
PIC

X
X(20)
X(20)
X(15)

VALUE
VALUE
VALUE
VALUE

'0'.
' PRODUCT
SPACE.
' UNIT

PIC
PIC
PIC
PIC

X
X(20)
X(20)
X(17)

VALUE
VALUE
VALUE
VALUE

' '.
'
CODE
'ION
' PRICE

PR'.
'.

HL2-CC
FILLER
FILLER
FILLER

'.
QTY'.

HL3-CC
FILLER
FILLER
FILLER

DESCRIPT'.
'.
ON HAND'.

PL-CC
PL-PRODUCT-CODE
FILLER
PL-DESCRIPTION
FILLER
PL-UNIT-PRICE
FILLER
PL-QUANTITY

PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X
VALUE
X(10).
XX
VALUE
X(20).
XX
VALUE
Z,ZZZ,ZZZ.99.
XX
VALUE
Z,ZZZ,ZZ9.

' '.

PIC
PIC
PIC
PIC

X
VALUE '-'.
ZZ,ZZ9.
X(15)
VALUE ' RECORDS IN THE'.
X(15)
VALUE ' PRODUCT FILE. '.

SPACE.
SPACE.
SPACE.

TL-CC
TL-RECORD-COUNT
FILLER
FILLER

FILLER
FILLER

PIC X(15)
PIC X(11)

VALUE 'Inventory listi'.

VALUE 'ng printed.'.

PRODUCT-MASTER-RECORD.
05
05
05
05

'1'.
'
'ODUCT LISTING
'
PAGE: '.

COMPLETION-MESSAGE.
05
05

VALUE
VALUE
VALUE
VALUE

TOTAL-LINE.
05
05
05
05

X
X(20)
X(20)
X(14)
ZZ9.

PRODUCT-LINE.
05
05
05
05
05
05
05
05

PIC
PIC
PIC
PIC
PIC

HEADING-LINE-3.
05
05
05
05

HL1-CC
FILLER
FILLER
FILLER
HL1-PAGE-NO

HEADING-LINE-2.
05
05
05
05

135/256

HEADING-LINE-1.
05
05
05
05
05

24/08/2003

PRM-PRODUCT-CODE
PRM-PRODUCT-DESCRIPTION
PRM-UNIT-PRICE
PRM-QUANTITY-ON-HAND

DESTINATION-ID

COPY ERRPARM.

PROCEDURE DIVISION.

PIC
PIC
PIC
PIC

X(10).
X(20).
S9(7)V99
S9(7)

PIC X(4)

COMP-3.
COMP-3.

VALUE 'L86P'.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

0000-PRODUCE-PRODUCT-LISTING.

PERFORM 1000-START-PRODUCT-BROWSE.
EXEC CICS
ENQ RESOURCE(DESTINATION-ID)
END-EXEC.
PERFORM 2000-PRODUCE-PRODUCT-LINE
UNTIL PRODUCT-EOF.
PERFORM 3000-PRINT-TOTAL-LINE.
EXEC CICS
DEQ RESOURCE(DESTINATION-ID)
END-EXEC.
EXEC CICS
SEND TEXT FROM(COMPLETION-MESSAGE)
ERASE
FREEKB
END-EXEC.
EXEC CICS
XCTL PROGRAM('INVMENU')
RESP(RESPONSE-CODE)
END-EXEC.
EXEC CICS
RETURN
END-EXEC.
1000-START-PRODUCT-BROWSE.

MOVE LOW-VALUE TO PRM-PRODUCT-CODE.

EXEC CICS
STARTBR DATASET('PRODUCT')
RIDFLD(PRM-PRODUCT-CODE)
GTEQ
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'Y' TO PRODUCT-EOF-SW
ELSE IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
GO TO 9999-TERMINATE-PROGRAM.
2000-PRODUCE-PRODUCT-LINE.

PERFORM 2100-READ-PRODUCT-RECORD.
IF NOT PRODUCT-EOF
PERFORM 2200-PRINT-PRODUCT-LINE.
2100-READ-PRODUCT-RECORD.

EXEC CICS
READNEXT DATASET('PRODUCT')
RIDFLD(PRM-PRODUCT-CODE)
INTO(PRODUCT-MASTER-RECORD)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(ENDFILE)
MOVE 'Y' TO PRODUCT-EOF-SW
ELSE IF RESPONSE-CODE = DFHRESP(NORMAL)

136/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

ADD 1 TO RECORD-COUNT

ELSE

GO TO 9999-TERMINATE-PROGRAM.

2200-PRINT-PRODUCT-LINE.

IF LINE-COUNT > LINES-ON-PAGE

PERFORM 2210-PRINT-HEADING-LINES.
MOVE PRM-PRODUCT-CODE
TO PL-PRODUCT-CODE.
MOVE PRM-PRODUCT-DESCRIPTION TO PL-DESCRIPTION.
MOVE PRM-UNIT-PRICE
TO PL-UNIT-PRICE.
MOVE PRM-QUANTITY-ON-HAND
TO PL-QUANTITY.
MOVE PRODUCT-LINE TO PRINT-AREA.
MOVE LENGTH OF PRODUCT-LINE TO LINE-LENGTH.
PERFORM 2220-WRITE-QUEUE-RECORD.
ADD 1 TO LINE-COUNT.
MOVE SPACE TO PL-CC.
2210-PRINT-HEADING-LINES.

MOVE PAGE-NO TO HL1-PAGE-NO.

MOVE HEADING-LINE-1 TO PRINT-AREA.
MOVE LENGTH OF HEADING-LINE-1 TO LINE-LENGTH.
PERFORM 2220-WRITE-QUEUE-RECORD.
ADD 1 TO PAGE-NO.
MOVE HEADING-LINE-2 TO PRINT-AREA.
MOVE LENGTH OF HEADING-LINE-2 TO LINE-LENGTH.
PERFORM 2220-WRITE-QUEUE-RECORD.
MOVE HEADING-LINE-3 TO PRINT-AREA.
MOVE LENGTH OF HEADING-LINE-3 TO LINE-LENGTH.
PERFORM 2220-WRITE-QUEUE-RECORD.
MOVE '0' TO PL-CC.
MOVE ZERO TO LINE-COUNT.
2220-WRITE-QUEUE-RECORD.

EXEC CICS
WRITEQ TD QUEUE(DESTINATION-ID)
FROM(PRINT-AREA)
LENGTH(LINE-LENGTH)
END-EXEC.
3000-PRINT-TOTAL-LINE.

MOVE RECORD-COUNT TO TL-RECORD-COUNT.

MOVE TOTAL-LINE TO PRINT-AREA.
MOVE LENGTH OF TOTAL-LINE TO LINE-LENGTH.
PERFORM 2220-WRITE-QUEUE-RECORD.
*
9999-TERMINATE-PROGRAM.

MOVE
MOVE
MOVE
MOVE
EXEC

EIBRESP
EIBRESP2
EIBTRNID
EIBRSRCE
CICS

TO
TO
TO
TO

ERR-RESP.
ERR-RESP2.
ERR-TRNID.
ERR-RSRCE.

137/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

138/256

XCTL PROGRAM('SYSERR')
COMMAREA(ERROR-PARAMETERS)
END-EXEC.
Notes
1. Note the CICS ENQ and DEQ to reserve and free the TD queue resource
2. You can write a simple spool output program that writes to SYSOUT
using the following CICS calls:The SPOOLOPEN command
EXEC CICS
SPOOLOPEN OUTPUT

TOKEN(data-area)
USERID(data-value)
NODE(data-value)
CLASS(data-value)
ASA
PRINT
RECORDLENGTH(data-value)
RESP(data-area)

END-EXEC
Options
ASA

specifies that the report has each record prefixed with an

ASA carriage-control character, and this character must be
used by the operating system to control formatting when the
report is printed.

CLASS

(data-value).specifies a 1-character class designation.

it is omitted, class A is assumed.

If

PRINT

allows large records (maximum 32760 bytes) to be written to

the spool. This is the default setting.

RECORDLENGTH

(data-value).specifies, as a halfword binary variable, the

maximum length of record to write to a print data set. The
default value is 32760.

TOKEN

(data-area) specifies the 8-character CICS-allocated token

used to identify a report.

USERID

(data-value)specifies the 8-character identifier of the

destination userid that processes the report. The report
carries this identifier, which is used to select the report
at its destination. It is a sender field and must be
declared with a length of 8 characters.

NODE

specifies the 8-character identifier of a destination node

that the system spooler uses to route the file. It is
a sender field.

Conditions
ALLOCERR, ILLOGIC, INVREQ, LENGERR, NODEIDERR, NOSPOOL,NOSTG, NOTFND,
NOTOPEN, OPENERR, OUTDESCERR, SPOLBUSY, STRELERR. See CICS Application
Programming Reference for details.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

139/256

The SPOOLCLOSE command.

EXEC CICS
SPOOLCLOSE TOKEN(data-area)
KEEP
END-EXEC.
Options
KEEP

TOKEN

For an INPUT report, KEEP specifies that the report is to be

read again when SPOOLOPEN INPUT is next issued.
For an OUTPUT report, KEEP specifies that the report is to
be sent to its destination node.
(data-area)specifies the 8-character CICS-allocated token
used to identify a report.

Conditions
ALLOCERR, INVREQ, NOSPOOL, NOSTG, NOTFND, NOTOPEN,

STRELERR

The SPOOLWRITE command

The SPOOLWRITE command writes data to a spool report.
EXEC CICS
SPOOLWRITE TOKEN(data-area)
FROM(data-area)
FLENGTH(data-value)
END-EXEC
Options
FLENGTH

(data-value) specifies the fullword binary variable that is

to be set to the length of the data that is transferred.
This is set by the user on output. It is optional and, if it
is omitted, CICS uses the length of the data area.

FROM

(data-area)specifies the data area from which to take the

variable length data. The data itself is not altered in any
way by CICS. FROM is a sender field.

TOKEN

(data-area) specifies the 8-character CICS-allocated token

used to identify a report. It is a receiver on SPOOLOPEN
and a sender on all other commands.

Conditions
ALLOCERR, INVREQ, LENGERR, NOSPOOL, NOSTG, NOTOPEN, SPOLBUSY, SPOLERR,
STRELERR
A Sample Program
SAMP7
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP7.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 LINE1 PIC X(80) VALUE
"//SCB000JB JOB (SCB-SCB-SCB000-XXX-999),CLASS=C,".
01 LINE2 PIC X(80) VALUE
"//
MSGCLASS=X,MSGLEVEL=(1,1),NOTIFY=SCB000,".
01 LINE2A PIC X(80) VALUE
"//
USER=SCB000,PASSWORD=PAPA15A1".

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

01 LINE3 PIC X(80) VALUE

"//STEP1 EXEC PGM=IDCAMS".
01 LINE4 PIC X(80) VALUE
"//SYSPRINT DD SYSOUT=*".
01 LINE5 PIC X(80) VALUE
"//SYSIN DD *".
01 LINE6 PIC X(80) VALUE
" PRINT INDATASET(SCB000.PRODUCT) CHAR".
01 LINE7 PIC X(80) VALUE
"//".
01 RESP
PIC 9(8) COMP.
01 RESP2
PIC 9(8) COMP.
01 TOKEN
PIC X(8).
01 OUTLEN
PIC S9(8) COMP VALUE +80.
01 WS-COUNT
PIC S9(8) COMP.
77 OUTPRT
PIC X(80) VALUE
'SPOOLOPEN FUNCTIONING'.
01 WS-VARS.
03 WS-RESP
PIC S9(08) COMP VALUE
LINKAGE SECTION.
PROCEDURE DIVISION.
PERFORM MAIN-PARA.
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS SPOOLOPEN OUTPUT
NODE ('HCLIBM')
USERID ('INTRDR')
RESP(RESP) RESP2(RESP2)
TOKEN(TOKEN)
END-EXEC.
PERFORM LOOP-PARA
EXEC CICS SPOOLCLOSE
TOKEN(TOKEN)
RESP(RESP) RESP2(RESP2)
END-EXEC.
LOOP-PARA.
EXEC CICS SPOOLWRITE
FROM(LINE1)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE2)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE2A)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE3)
RESP(RESP) RESP2(RESP2)

140/256

0.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

141/256

FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE4)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE5)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE6)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE7)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC.

END-PARA.
EXEC CICS
RETURN
END-EXEC.

SAMP6 transaction-id SM06

The following program is ATID from L86P. Use CEMT INQ TDQUEUE(L86P) to
inquire and then disable the queue. Then discard the resource. Use CEDA
to alter L86P definition and set Transaction-id toSM06. Make sure that
ATIFACILITY is set to FILE and FACILITYID is set to NULL. Install the
definition again.
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP6.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 LINE1 PIC X(80) VALUE
"//KAMATH1 JOB CLASS=A,MSGLEVEL=(1,1),".
01 LINE2 PIC X(80) VALUE
"//
MSGCLASS=X,NOTIFY=KAMATH,".
01 LINE2A PIC X(80) VALUE
"//
USER=KAMATH,PASSWORD=PAPA19A".
01 LINE3 PIC X(80) VALUE
"//STEP1 EXEC PGM=IDCAMS".
01 LINE4 PIC X(80) VALUE
"//SYSPRINT DD SYSOUT=*".
01 LINE5 PIC X(80) VALUE
"//SYSIN DD *".
01 LINE6 PIC X(80) VALUE

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

"
REPRO INFILE(IN) OUTFILE(SYSP)".
01 LINE7 PIC X(80) VALUE
"/*".
01 LINE8 PIC X(80) VALUE
"//SYSP DD SYSOUT=*".
01 LINE9 PIC X(80) VALUE
"//IN DD *".
01 LINE10 PIC X(80) VALUE
"/*".
01 LINE11 PIC X(80) VALUE
"//".
01 RESP
PIC 9(8) COMP.
01 RESP2
PIC 9(8) COMP.
01 TOKEN
PIC X(8).
01 OUTLEN
PIC S9(8) COMP VALUE +80.
01 WS-COUNT
PIC S9(8) COMP.
01 WS-VARS.
03 WS-RESP
PIC S9(08) COMP VALUE 0.
03 WS-LINE-LENGTH
PIC S9(08).
03 WS-BUFF
PIC X(80)
VALUE " ".
03 WS-DESTINATION-ID
PIC X(4)
VALUE "L86P".
01 WS-FLAGS.
03 WS-FLAG
PIC S9(08) COMP VALUE 0.
LINKAGE SECTION.
PROCEDURE DIVISION.
PERFORM MAIN-PARA.
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS SPOOLOPEN OUTPUT
NODE ('HCLDX390')
USERID ('INTRDR')
RESP(RESP) RESP2(RESP2)
TOKEN(TOKEN)
END-EXEC.
PERFORM LOOP-PARA
EXEC CICS SPOOLCLOSE
TOKEN(TOKEN)
RESP(RESP) RESP2(RESP2)
END-EXEC.
LOOP-PARA.
EXEC CICS SPOOLWRITE
FROM(LINE1)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE2)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE2A)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)

142/256

APPLICATION PROGRAMMING IN CICS BASIC

END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE3)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE4)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE5)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE6)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE7)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE8)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE9)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
PERFORM READTDQ UNTIL WS-FLAG = 1
EXEC CICS SPOOLWRITE
FROM(LINE10)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
EXEC CICS SPOOLWRITE
FROM(LINE11)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC.
READTDQ.

24/08/2003

143/256

APPLICATION PROGRAMMING IN CICS BASIC

MOVE SPACES TO WS-BUFF

MOVE 80 TO WS-LINE-LENGTH
EXEC CICS
READQ TD QUEUE(WS-DESTINATION-ID)
INTO(WS-BUFF)
LENGTH(WS-LINE-LENGTH)
RESP(RESP)
END-EXEC
IF RESP = DFHRESP(NORMAL)
MOVE 80 TO OUTLEN
EXEC CICS SPOOLWRITE
FROM(WS-BUFF)
RESP(RESP) RESP2(RESP2)
FLENGTH(OUTLEN)
TOKEN(TOKEN)
END-EXEC
ELSE
MOVE 1 TO WS-FLAG
END-IF.
END-PARA.
EXEC CICS
RETURN
END-EXEC.

24/08/2003

144/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

145/256

Interval Control

back
CICS Interval control provides a variety of time related functions. They
are ASKTIME, FORMATTIME, START, RETRIEVE, DELAY, POST and CANCEL
commands.
The EIBTIME and EIBDATE fields in the EIB block provide the date and
time the task was dispatched. These fields are not updated when the task
executes and this may not be acceptable for long running tasks. For this
reason the ASKTIME and FORMATTIME commands are provided to get the
time / date which is current at the time of the call. The EIB fields
today have the following format:EIBDATE
contains the date the task is started; this field is updated by the
ASKTIME command. The date is in packed decimal form (0CYYDDD+) where C
shows the century with values 0 for the 1900s and 1 for the 2000s.
For example, the dates 31 December 1999 and 1 January 2000 have EIBDATE
values of 0099365 and 0100001 respectively. The field is represented in
COBOL as PIC S9(7) COMP-3 or in PL/I as FIXED DEC(7,0).
EIBTIME
contains the time at which the task is started (this field is updated by
the ASKTIME command). The time is in packed decimal form (0HHMMSS+).
The fields are represented in COBOL as PIC S9(7) COMP-3 and in PL/I as
FIXED DEC(7,0).
The ASKTIME command places the absolute elapsed time from 0000hours on
January 1st 1900 in milliseconds in your specified data area which must
be a PIC S9(15) COMP-3 field. In PL/I it must be a DECIMAL FIXED(15)
field.
The ASKTIME command
EXEC CICS
ASKTIME [ABSTIME(data-area)
END-EXEC

Note that the receiving data area is optional because the call updates
the EIBDATE and EIBTIME fields as well.
In most cases, you dont need to specify a receiving field if the format
of the EIBTIME and EIBDATE is acceptable. If you need a different
format, you can specify a receiving area and then call FORMATTIME using
the data area as an argument.
The FORMATTIME command
EXEC CICS
FORMATTIME ABSTIME(data-area)
[ DDMMYY(data-area)]
[ DDMMYYYY(data-area)]
[ MMDDYY(data-area)]
[ MMDDYYYY(data-area)]
[YYDDD(data-area)]
[YYDDMM(data-area)]
[YYMMDD(data-area)]
[YYYYDDD(data-area)]
[YYYYDDMM(data-area)]

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

146/256

[YYYYMMDD(data-area)]
[ DATE(data-area) [ DATEFORM(data-area)]]
[ FULLDATE(data-area)]
[ DATESEP [(data-value)]]
[ DAYCOUNT(data-area)]
[ DAYOFWEEK(data-area) ]
[ DAYOFMONTH(data-area) ]
[ MONTHOFYEAR(data-area) ]
[ YEAR(data-area) ]
[ TIME(data-area) [ TIMESEP [(data-value)]]]
END-EXEC
Options
ABSTIME

YY..DD..MM

The data area corresponding to this is the return value from

ASKTIME and is a PIC S9(15) COMP-3 field. It is the elapsed time
in milliseconds from midnight of 1st January 1900.
These represent different formats in which the formatted date is
returned. Make sure that the data-area which is a receiving field
is big enough to hold the returned character string. A / is used
as the separator if DATESEP is specified but the optional data
value is omitted. Make sure that the data area includes space for
the separators too.

DAYCOUNT,DAYOFWEEK,DAYOFMONTH,MONTHOFYEAR,YEAR,TIME
fields of type PIC S9(8) COMP.
TIMESEP

are

set

into

fullword

If you specify TIMESEP but dont give a value the : is used to

separate the hours, minutes and seconds.

Condition: INVREQ
Example
The following example shows the effect of some of the options of the
command. Let "utime" contain the value 002837962864828 in milliseconds.
EXEC CICS ASKTIME ABSTIME(utime)
EXEC CICS FORMATTIME ABSTIME(utime)
DATESEP('-') DDMMYY(date)
TIME(time) TIMESEP
This gives the values 06-12-89 for "date" and 19:01:05 for "time".
Automatic time-ordered transaction initiation
This facility allows you to start a new task using a START command. You
can pass data to the started task, that can be retrieved by the started
task using the RETRIEVE command. You can also request a CANCEL command
for the started task before it starts. This is because the START command
also accepts arguments which let you specify when or after what time
interval the new task is to be started. The START command runs the
started task asynchronously. In other words the task issuing the START
command and the started task can run concurrently. In contrast the LINK
is a synchronous call as the caller blocks until the linked to program
exits. Also the linked to program and the program issuing the LINK run
as one task.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

147/256

How a task is scheduled

The START command is serviced by the CICS component INTERVAL CONTROL. It
creates a ICE or interval control element whenever a START command is
issued. The ICE contains information about the task to be started,
including its transaction-id, Terminal-id, expiration time and the data
to be passed to the started task. Interval Control uses Temporary
Storage to store the passed data.
Since many tasks may issue START commands, and they may have different
expiration periods, it is likely that a number of ICEs may exist in the
CICS region at any point of time. CICS code periodically checks the
ICEs to see if any expiration time has been reached and the new task
can be started.
Note that the task issuing the START command blocks only until CICS
creates a ICE to register the START request. The issuing task unblocks
after the ICE is created and the passed data is written to the TS and
can do whatever other processing it chooses.
The START command
EXEC CICS
START
TRANSID(name)
INTERVAL(hhmmss)
TIME(hhmmss)
AFTER [HOURS(hh)] [MINUTES(mm)] [SECONDS(ss)]
AT
[HOURS(hh)] [MINUTES(mm)] [SECONDS(ss)]
[ TERMID(name) ]
[ SYSID(name) ]
[ FROM(data-area) [ LENGTH(data-value)]]
[ RTERMID(name) ]
[ RTRANSID(name) ]
[ QUEUE(name) ]
[ REQID(name) ]
[ NOCHECK ]
[ PROTECT ]
END-EXEC
Options
TRANSID

A four character transaction identifier.

INTERVAL

Specifies the expiration time interval. You can code a

literal in the form hhmmss. If you specify a data area it
must be a PIC S9(7) COMP-3 field and the value must be in
the form 0hhmmss.

TIME

Specifies a time of the day. You can code a literal in the

form 0hhmmss. If you specify a data area it must be a PIC
S9(7) COMP-3 field and the value must be in the form
0hhmmss.

AFTER

Specifies that the HOURS, MINUTES and SECONDS options

indicate the time of day when the task is to be started. If
INTERVAL, TIME, AFTER and AT are all omitted, interval(0) is
assumed.

HOURS,
MINUTES,

Each is a PIC S9(8) COMP full word. Hours can be from 0-99
minutes can be from 0 to 59 or 0 to 5999

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

148/256

SECONDS.

Seconds can be from 0 to 59 or 0 to 359999

If INTERVAL, TIME, FOR and UNTIL are omitted, INTERVAL(0) is
assumed.

TERMID

Specifies a one to four character terminal ID. If omitted

the task is not attached to any terminal and cannot perform
any terminal I/O.

SYSID

A one to four character Connection name that represents a

remote system where the transaction is to be started.

REQID

Specifies a one to eight character name you specify to

uniquely identify this request. It can be used to CANCEL the
START request before the new task has started. CANCEL has no
effect after the new task has started. You can allow CICS to
generate a REQID in the EIBREQID field as an alternative to
generating one yourself.

FROM

Specifies the data-area from where the data is to be passed

to the started task.

LENGTH

Specifies the length of the data-area from where data is to

be passed to the started task. It is a half word field PIC
S9(4) COMP.

RTRANSID

Specifies a one to four character name that is passed to the

started task. The started task fetches this using the
RTRANSID option of the RETRIEVE command.

QUEUE

Specifies a one to eight character name that is passed to

the started task. The started task fetches this using the
QUEUE option of the RETRIEVE command.

NOCHECK

Specifies that the task issuing the START command should not
wait until the remote system has confirmed that the START
was successfully processed.

PROTECT

Specifies that the task should not be started until the task
issuing the START takes a syncpoint.

Conditions
INVREQ

The START command is invalid. Possible causes are the

expiration period specification is out of range, or REQID
already exists. For example ss may be specified as 70.

IOERR

An I/O error occurred.

ISCINVREQ

An undeterminable error occurred at the remote system.

LENGERR

A length error occurred. Occurs if the length is not greater

than 0. The maximum length, to be on safe side should not
exceed 30000.

SYSIDERR

The remote system could not be accessed / located.

TERMIDERR

The terminal is not known to CICS.

APPLICATION PROGRAMMING IN CICS BASIC

TRANSIDERR

24/08/2003

149/256

the transaction id is not known to CICS.

Notes
1. The START command is useful to divide an application functions into
two separate independent tasks, which can run concurrently. It can
also be used to start transactions at a predetermined time or after a
time interval.
2. If more than one START command is issued for the same target
transaction, the first started task can retrieve all the passed data
by issuing RETRIEVE calls more than once. If it does this CICS does
not start a new started task for each start request.
3. If you specify only one of HOURS | MINUTES | SECONDS, you are not
bound by the limit of 60 for seconds and minutes or 24 for hours. You
can use the higher limits.
The CANCEL command
EXEC CICS
CANCEL
[ REQID(name)]
[ TRANSID(name) ]
[ SYSID(name) ]
END-EXEC
Options
TRANSID

A four character transaction identifier of the transaction

that you want cancelled. Not normally used, as REQID is more
specific. You just specify CANCEL if you want to cancel a
POST command from the same task.

SYSID

A one to four character Connection name that represents a

remote system where a DELAY, POST or START command is to be
cancelled.

REQID

Specifies a one to eight character name that is associated

with the command you want cancelled. The only case where
REQID is not required is when you want to cancel a POST
command you issued earlier from the same task. In this case
dont code any of the options. REQID is required if you code
SYSID or TRANSID.

Conditions
INVREQ

The START command is invalid.

ISCINVREQ

An undeterminable error occurred at the remote system.

NOTFND

There is no unexpired ICE with the REQID specified.

SYSIDERR

The remote system could not be accessed / located.

Notes
1. The key element used by CICS to identify the command
cancelled is the REQID. You can get this by fetching it
EIBREQID field of the EIB after a START, DELAY or POST
Alternately you can specify your own application generated
the REQID field of the START, DELAY or POST command.

you want
from the
command.
REQID in

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

150/256

2. The CANCEL command wont work if the expiration interval of the ICE
has already expired. If you do so you will get a NOTFND condition.
The DELAY command
This command lets you suspend the issuing task until the time interval
has expired, or a specific time of day has arrived.
EXEC

CICS DELAY
{
INTERVAL(hhmmss)
TIME(hhmmss)
FOR
[HOURS(hh)] [MINUTES(mm)] [SECONDS(ss)]
UNTIL [HOURS(hh)] [MINUTES(mm)] [SECONDS(ss)]
}
[ REQID(name) ]
END-EXEC
Options
INTERVAL

Specifies the duration for the delay. You can code a literal
in the form hhmmss. If you specify a data area it must be a
PIC S9(7) COMP-3 field and the value must be in the form
0hhmmss.

TIME

Specifies a time of the day when the delay will end. You can
code a literal in the form hhmmss. If you specify a data
area it must be a PIC S9(7) COMP-3 field and the value must
be in the form 0hhmmss.

FOR

Specifies in HOURS, MINUTES and SECONDS the delay.

UNTIL

Specifies in HOURS, MINUTES and SECONDS the time of the day

when the delay will end.

HOURS,
MINUTES,
SECONDS.

Each is a PIC S9(8) COMP full word. Hours can be from 0-99
minutes can be from 0 to 59 or 0 to 5999
Seconds can be from 0 to 59 or 0 to 359999
If INTERVAL, TIME, FOR and UNTIL are omitted, INTERVAL(0) is
assumed.

REQID

Specifies a one to eight character name used to uniquely

identify this delay command.

Conditions
EXPIRED
INVREQ

The TIME or UNTIL option has already expired. The default

action is to return control immediately to your program.
The command is not valid or the hours, minutes or seconds
are out of range. Default action is to terminate the task.

Notes
1. One good use of the DELAY command is to retry operations that have
failed due to transient conditions. Such operations are worth a retry
after a suitable delay. This delay, or momentary suspension of task
execution can be achieved by the DELAY command.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

151/256

2. One trivial use is to momentarily suspend a transaction that is

notorious for consuming resources. This makes for better sharing of
resources across transactions.
The RETRIEVE command
EXEC CICS
RETRIEVE
{INTO(data-area) | SET(pointer-ref) }
[ LENGTH(data-area) ]
[ RTRANSID(data-area) ]
[ RTERMID(data-area) ]
[ QUEUE(data-area) ]
[ WAIT ]
END-EXEC
Options
INTO

Specifies the data area that will contain the data sent via
the FROM option of the START command.

LENGTH

Specifies the length of the INTO area on input. Must be Half

word PIC S9(4) COMP. On return from the call has the length
of the data actually retrieved.

RTRANSID

Specifies a four character area that will contain the data

sent via the RTRANSID option of the START command.

RTERMID

Specifies a four character area that will contain the data

sent via the RTERMID option of the START command.

QUEUE

Specifies a eight character area that will contain the data

sent via the QUEUE option of the START command.

WAIT

Suspend this task until another ICE expires and the data
associated with that START command is available.

Conditions
ENDDATA

No data is available for the STARTED task.

ENVDEFERR

The retrieve command specified a INTO, SET, RTRANSID,

RTERMID or QUEUE option and no such option was specified in
the START command.

INVREQ

The command is not valid.

IOERR

An I/O error occurred.

LENGERR

The length specified was not enough to fetch the complete

data retrieved.

NOTFND

The data has been deleted by another task.

Notes
1. You can code a iterative server process which issues RETRIEVE
repeatedly until ENDDATA is raised. This prevents more similar tasks
from being started. You can use the WAIT option to good effect if you
are expecting more data in the short term.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

152/256

2. The RTRANSID, RTERMID and QUEUE are provided to pass specific types
of data to the started task. See asynchronous client server scenarios
described earlier in this material.
3. You should always check for the ENDDATA condition.
The POST command
The POST command creates a Timer event control area that expires when a
specified time interval has expired. You can then use a WAIT EVENT
command to block the task until the posted event expires.
EXEC

CICS POST
{
INTERVAL(hhmmss)
TIME(hhmmss)
AFTER [HOURS(hh)] [MINUTES(mm)] [SECONDS(ss)]
AT
[HOURS(hh)] [MINUTES(mm)] [SECONDS(ss)]
}
SET(pointer-ref)
[ REQID(name) ]
END-EXEC
Options
INTERVAL

Specifies the duration after which the event is POSTED. You

can code a literal in the form hhmmss. If you specify a data
area it must be a PIC S9(7) COMP-3 field and the value must
be in the form 0hhmmss.

TIME

Specifies a time of the day when the event expires. You can
code a literal in the form hhmmss. If you specify a data
area it must be a PIC S9(7) COMP-3 field and the value must
be in the form 0hhmmss.

AFTER

Specifies in HOURS, MINUTES and SECONDS the time interval

after which the event expires.

AT

Specifies in HOURS, MINUTES and SECONDS the time of the day

when the event will expire.

HOURS,
MINUTES,
SECONDS.

Each is a PIC S9(8) COMP full word. Hours can be from 0-99
minutes can be from 0 to 59 or 0 to 5999
Seconds can be from 0 to 59 or 0 to 359999
If INTERVAL, TIME, FOR and UNTIL are omitted, INTERVAL(0) is
assumed.

REQID

Specifies a one to eight character name used to uniquely

identify this POST command. You can omit this field and
allow CICS to generate a REQID in the EIBREQID field. This
REQID can be used to CANCEL the POST command.

SET

Specifies a Full Word binary field PIC S9(8) COMP where CICS
places the address of the Timer Event Control area.

Conditions
EXPIRED

The time you specified in the interval or time option has

already expired.

APPLICATION PROGRAMMING IN CICS BASIC

INVREQ

24/08/2003

153/256

The command is invalid, or the HOURS, MINUTES or SECONDS are

out of range.

Notes
1. One useful implementation of this command is to force a minimum
response time on the transaction. Do this by issuing a POST at the
start of the program and then issuing a WAIT EVENT just before
sending the final data.
The WAIT EVENT command
EXEC CICS
WAIT EVENT ECADDR(pointer-ref)
END-EXEC
Options
ECADDR
Conditions
INVREQ

The pointer returned by the POST command in the SET field.

This is a binary full word field PIC S9(8) COMP.
The address of the timer event control area is invalid.

Example of START tranid SM01

IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP1.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-START-DATA
PIC X(30)
VALUE "START DATA FROM SAMP1".
03 WS-START-DATA-LEN
PIC S9(04)
03 WS-RESP
PIC S9(08)
PROCEDURE DIVISION.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
START
TRANSID("SM02")
FROM(WS-START-DATA)
LENGTH(WS-START-DATA-LEN)
TERMID(EIBTRMID)
RESP(WS-RESP)
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
Example of RETRIEVE
tranid SM02
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP2.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-START-DATA
PIC X(30).

COMP VALUE 30.

COMP VALUE 0.

APPLICATION PROGRAMMING IN CICS BASIC

03 WS-START-DATA-LEN
PIC S9(04)
03 WS-RESP
PIC S9(08)
PROCEDURE DIVISION.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
RETRIEVE
INTO(WS-START-DATA)
LENGTH(WS-START-DATA-LEN)
RESP(WS-RESP)
END-EXEC
EXEC CICS
SEND TEXT FROM(WS-START-DATA)
LENGTH(WS-START-DATA-LEN)
RESP(WS-RESP)
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
Example of DELAY

24/08/2003
COMP VALUE 30.
COMP VALUE 0.

154/256

tranid SM03

The program goes to ICWAIT for 30 seconds

IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP3.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-START-DATA
PIC X(30)
VALUE "SAMP3 STARTING...".
03 WS-START-DATA-LEN
PIC S9(04) COMP VALUE 30.
03 WS-RESP
PIC S9(08) COMP VALUE 0.
PROCEDURE DIVISION.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
SEND TEXT FROM(WS-START-DATA)
LENGTH(WS-START-DATA-LEN)
RESP(WS-RESP)
END-EXEC
EXEC CICS
DELAY
FOR
SECONDS(30)
RESP(WS-RESP)
END-EXEC
MOVE "SAMP3 ENDING AFTER DELAY ...." TO WS-START-DATA
EXEC CICS
SEND TEXT FROM(WS-START-DATA)
LENGTH(WS-START-DATA-LEN)
RESP(WS-RESP)
END-EXEC.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

END-PARA.
EXEC CICS
RETURN
END-EXEC.
Example of POST

tranid SM04

The program goes to EKCWAIT for 30 seconds

IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP4.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-START-DATA
PIC X(30)
VALUE "SAMP4 STARTING...".
03 WS-START-DATA-LEN
PIC S9(04)
03 WS-TIMER-PTR
PIC S9(8)
03 WS-TIMER-PTR-LEN
PIC S9(4)
03 WS-RESP
PIC S9(08)
PROCEDURE DIVISION.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
EXEC CICS
SEND TEXT FROM(WS-START-DATA)
LENGTH(WS-START-DATA-LEN)
RESP(WS-RESP)
END-EXEC
EXEC CICS
POST
AFTER
SECONDS(20)
SET(WS-TIMER-PTR)
RESP(WS-RESP)
END-EXEC
EXEC CICS
WAIT EVENT
ECADDR(WS-TIMER-PTR)
RESP(WS-RESP)
END-EXEC
MOVE "SAMP4 ENDING" TO WS-START-DATA
EXEC CICS
SEND TEXT FROM(WS-START-DATA)
LENGTH(WS-START-DATA-LEN)
RESP(WS-RESP)
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.

COMP
COMP
COMP
COMP

VALUE 30.
VALUE 0.
VALUE 4.
VALUE 0.

155/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

Task Control

156/256

back

Introduction and Overview

The CICS task control facility provides functions that synchronize task
activity, or that control the use of resources.
CICS assigns priorities based on the value set by
programmer. Control of the processor is given to the
task that is ready to be processed, and is returned
system when no further work can be done by CICS or by
programs.

the CICS system

highest-priority
to the operating
your application

You can:

Suspend a task (SUSPEND command) to enable tasks of higher priority

to proceed.
This can prevent processor-intensive tasks from
monopolizing the processor. When other eligible tasks have proceeded
and terminated or suspended processing, control is returned to the
issuing task; that is, the task remains dispatchable.

Schedule the use of a resource by a task (ENQ and DEQ commands).

This is sometimes useful in protecting a resource from concurrent use
by more than one task; that is, by making that resource serially
reusable. Each task that is to use the resource issues an enqueue
command (ENQ). The first task to do so has the use of the resource
immediately but, subsequent ENQ commands for the resource, issued by
other tasks, result in those tasks being suspended until the resource
is available.
If the NOSUSPEND option is coded on the ENQ command, control is
always returned to the next instruction in the program.
By
inspecting the contents of the EIBRESP field, you can see whether the
ENQ command was successful or not.
Each task using a resource should issue a dequeue command (DEQ) when
it has finished with it.

Change the priority assigned to a task

EXEC CICS
CHANGE TASK PRIORITY(data-value)
END-EXEC
Data value has a range 1 to 255, 255 being the highest priority.

Wait for events that post MVS format ECBs when they complete.
Two commands are available, WAITCICS and WAIT EXTERNAL.
These
commands cause the issuing task to be suspended until one of the
ECBs has been posted; that is, until one of the events has occurred.
The task can wait on one or more ECBs. If it waits on more than one,
it is dispatchable as soon as one of the ECBs is posted.
You must
ensure that each ECB is cleared (set to binary zeros) no later than
the earliest time it could be posted. CICS cannot do this for you.
If you wait on an ECB that has been previously posted and is not
subsequently cleared, your task is not suspended and continues to run
as though the WAITCICS or WAIT EXTERNAL command had not been issued.
WAIT EXTERNAL usually has less overhead, but the associated ECBs must
always be posted using the MVS POST facility.
They must never be

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

157/256

posted by any other method. If you are in any doubt about the method
of posting, use the WAITCICS command. When dealing with ECBs passed
on a WAIT EXTERNAL command, CICS extends the ECBs and uses the MVS
POST exit facility. A given ECB must not be waited on by more than
one task at once (or appear twice in one task's ECBLIST). Failure to
follow this rule leads to an INVREQ response.
WAITCICS must be used if ECBs are to be posted by any method other
than the MVS POST facility. For example, if your application posts
the ECB by moving a value into it, WAITCICS must be used.
(The
WAITCICS command can also be used for ECBs that are posted using the
MVS POST facility or optimized post.) Whenever CICS goes into an MVS
WAIT, it passes a list to MVS of all the ECBs being waited on by
tasks that have issued a WAITCICS command.
The ECBLIST passed by
CICS on the MVS WAIT contains duplicate addresses, and MVS abends
CICS.
If you use MVS POST, WAIT EXTERNAL, WAITCICS, ENQ, or DEQ commands,
you could create inter-transaction affinities that adversely affect
your ability to perform dynamic transaction routing.
Storage for the timer-event control area on WAIT EVENT and storage
for event control blocks (ECBs) specified on WAIT EXTERNAL and
WAITCICS commands must reside in shared storage if you have specified
ISOLATE(YES).
If CICS is executing with or without transaction isolation, CICS
checks that the timer-event control area and the ECBs are not in
read-only storage.
Controlling sequence of access to resources
If you want a resource to be accessed by two or more tasks in a specific
order, instead of the ENQ and DEQ commands, use one or more WAITCICS
commands in conjunction with one or more hand-posted ECBs.
To hand-post an ECB, a CICS task sets a 4-byte field to either the
cleared state of binary zeros(clear), or the posted state of
X'40008000'(post).
The task can use a START command to start another
task and pass the address of the ECB. The started task receives the
address through a RETRIEVE command.
Either task can set the ECB or wait on it. Use the ECB to control the
sequence in which the tasks access resources. Two tasks can share more
than one ECB if necessary. You can extend this technique to control as
many tasks as you wish. Only one task can wait on a given ECB at any one
time.
The example in Figure below shows how two tasks can sequentially access
a temporary storage queue by using hand-posted ECBs and the WAITCICS
command.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

158/256

PTR_ECB1_ADDR_LIST
+-------------------+

A(ECB1_ADDR_LIST)
+-------------------+

ECB1_ADDR_LIST
ECB1

+-------------------+
+------------+
+-----_
+--------_

A(ECB1)

+-------------------+
+------------+
PTR_ECB2_ADDR_LIST
+-------------------+

A(ECB2_ADDR_LIST)
+-------------------+

ECB2_ADDR_LIST
ECB2

+-------------------+
+------------+
+-----_
+--------_

A(ECB2)

+-------------------+
+------------+
Two tasks sequentially accessing a temporary storage queue
The example uses two ECBs, (ECB1 and ECB2), addressed by the pointers
illustrated in Table below.
In theory, these tasks could exchange data through the temporary storage
queue for ever. In practice, some code would be included to close the
process down in an orderly way.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

159/256

+------------------------------------------------------------------------+
Table
Example of task control

+------------------------------------------------------------------------
Task A
Task B

+------------------------------------+-----------------------------------
Delete temporary storage queue

+------------------------------------+-----------------------------------
Clear ECB1 (set to X'00000000')

+------------------------------------+-----------------------------------
Clear ECB2

+------------------------------------+-----------------------------------
EXEC CICS START TASK B and pass
EXEC CICS RETRIEVE the addresses
the addresses of
passed.

PTR_ECB1_ADDR_LIST and

PTR_ECB2_ADDR_LIST.

+------------------------------------+-----------------------------------

+------------------------------------+-----------------------------------
START OF LOOP:
START OF LOOP:

+------------------------------------+-----------------------------------

EXEC CICS WAITCICS

Write to T/S queue

+------------------------------------+-----------------------------------

ECBLIST(PTR_ECB1_ADDR_LIST

Post ECB1 (set to X'40008000')

+------------------------------------+-----------------------------------

NUMEVENTS(1)

EXEC CICS WAITCICS

+------------------------------------+-----------------------------------

Clear ECB1

ECBLIST(PTR_ECB2_ADDR_LIST

+------------------------------------+-----------------------------------

Read T/S queue

NUMEVENTS(1)

+------------------------------------+-----------------------------------

< act on data from queue >

Clear ECB2

+------------------------------------+-----------------------------------

Delete T/S queue

Read T/S queue

+------------------------------------+-----------------------------------

Write to T/S queue

< act on data from queue >

+------------------------------------+-----------------------------------

Post ECB2

Delete T/S queue

+------------------------------------+-----------------------------------
Go to START OF LOOP
Go to START OF LOOP

+------------------------------------------------------------------------+
The CHANGE TASK command
CHANGE TASK changes the priority of the issuing task. It has immediate
effect (unlike SET TASK), because control is relinquished during
execution of the command so that the current task has to be redispatched.
The re-dispatch does not happen until tasks that are of
higher or equal priority, and that are also ready to run, are
dispatched.
EXEC CICS
CHANGE TASK PRIORITY(data-value)
END-EXEC
Options
PRIORITY(data-value)

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

160/256

Specifies a full word binary value PIC S9(8) COMP in the range 0-255,
defining the priority of the task. You can also have a value of -1 but
this does not change the priority or cause a redispatch.
Conditions
INVREQ
RESP2 values: 1

Your PRIORITY value is outside the range 1 to 255.

The SUSPEND command

SUSPEND relinquishes control to a task of higher or equal dispatching
priority. Control is returned to the task issuing the command as soon
as no other task of a higher or equal priority is ready to be processed.
EXEC CICS
SUSPEND
END-EXEC
The WAIT EVENT command
EXEC CICS
WAIT EVENT ECADDR(pointer-ref)
END-EXEC
Options
ECADDR
Conditions
INVREQ

The pointer returned by the POST command in the SET field.

This is a binary full word field PIC S9(8) COMP.
The address of the timer event control area is invalid.

The WAITCICS command

WAITCICS waits for events that post MVS-format ECBs. The command causes
the issuing task to be suspended until one of the ECBs has been posted,
that is until one of the events has occurred.
The task can wait on one or more ECBs. If it waits on more than one, it
is dispatchable as soon as one of the ECBs is posted. You must ensure
that each ECB is cleared, set to binary zeros, no later than the
earliest time it could be posted. CICS cannot do this for you. If you
wait on an ECB that has been previously posted and not subsequently
cleared, your task is not suspended and continues to run as though the
WAITCICS had not been issued.
CICS includes the addresses of all ECBs passed by WAITCICS commands of
current tasks in the ECBLIST passed by CICS to the MVS WAIT facility
when it runs out of work. Such ECBs can be posted using the MVS POST
facility or by hand posting. Hand posting could, for example, be done
by moving an appropriate value into the ECB.
If hand posting is
definitely not going to be used, it is preferable to use WAIT EXTERNAL.
A given ECB may not be waited on by more than one task at the same time.
If this rule is not followed and the ECBLIST passed by CICS on the MVS
WAIT contains duplicate ECB addresses, MVS abends CICS.
EXEC CICS
WAITCICS ECBLIST(ptr-value)
NUMEVENTS(data-value)
[ NAME(name)]

APPLICATION PROGRAMMING IN CICS BASIC

Options
ECBLIST(ptr-value)

24/08/2003

161/256

Is a pointer to a list of addresses of MVSformat ECBs representing events.

Both the
ECBLIST and the ECBs can be above the 16MB line,
that is they can be 31-bit addresses. Each ECB
must be fullword aligned. Null (X'00000000' and
X'FF000000') ECB addresses are ignored.

NAME(name)

specifies the symbolic name, 1-8 alphanumeric

characters, as the reason for the wait.
The
value
you
specify
is
returned
in
the
SUSPENDVALUE or HVALUE option respectively of
the EXEC CICS INQ TASK or
CEMT INQ TASK
commands.

NUMEVENTS(data-value)

is the number of such events, corresponding to

the number of addresses in the ECBLIST.
The
field is
fullword binary. When NUMEVENTS is
specified as one, ECBLIST must still be an
address that points to a list containing just
one ECB address.

Conditions
INVREQ

An ECB is not valid, for example the ECB is not fullword

aligned. NUMEVENTS is not a positive number. No valid ECBs
have been found in the list, because either the ECBLIST
address is not valid, or all the ECB addresses are not
valid. The event control blocks (ECBs) specified are in
user-key task-lifetime storage, and are inaccessible to
another transaction that is expected to post the ECBs. The
ECBs specified are in read-only storage.

Default action: terminate the task abnormally.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

162/256

Usage of ECBLIST
The following figure shows how to use the ECBLIST parameter to point to
a list of ECB addresses that in turn point to individual ECBs.
Note
that the ECBLIST variable is a pointer pointing to the first address of
the list.
PTR_ECB_ADDR_LIST
+----------------+
A(ECB_ADDR_LIST)
+----------------+

ECB_ADDR_LIST
+--_--------+
+--------_-----------+
ECB1
A(ECB1) +---+ +--------+
+-----------
A(ECB2) +------_--------+
+-----------
ECB2
A(ECB3) +---+ +--------+
+-----------+

+--_--------+
ECB3
+--------+
DCL

ECB1
ECB2
ECB3

FIXED BIN(31),
/* actual
FIXED BIN(31),
/* actual
FIXED BIN(31);
/* actual
DCL
/* list of ecb addresses
1 ECB_ADDR_LIST,
2 ECB_ADDR(3) PTR;
DCL
/* ptr to each addr list
PTR_ECB_ADDR_LIST PTR;
ECB_ADDR(1) = ADDR(ECB1);
ECB_ADDR(2) = ADDR(ECB2);
ECB_ADDR(3) = ADDR(ECB3);
/* set up pointer
PTR_ECB_ADDR_LIST = ADDR(ECB_ADDR_LIST);
/* PTR_ECB_ADDR_LIST = ADDR(ECB_ADDR(1));
(alternative)
EXEC CICS WAITCICS
ECBLIST(PTR_ECB_ADDR_LIST)
NUMEVENTS(3)
PURGEABLE

ecb */
ecb */
ecb */
*/
*/

*/
*/

The WAIT EXTERNAL command

Use this command when you want to wait on events that post MVS-format
ECBs. If a WAIT EXTERNAL ECB is hand posted, for example by another task
moving a value into the ECB, unpredictable errors occur. If there is
any possibility of hand posting, use the WAITCICS command.
Use WAIT
EXTERNAL whenever possible, because it usually has less overhead.
A given ECB must not be waited on by more than one task at the same
time. If this rule is not followed, the second task to wait on the ECB
gets an INVREQ condition.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

163/256

EXEC

CICS
WAIT EXTERNAL ECBLIST(ptr-value)
NUMEVENTS(data-value)
NAME(name)
END EXEC
Options
ECBLIST(ptr-value)

Is a pointer to a list of addresses of MVSformat ECBs representing events.

Both the
ECBLIST and the
ECBs can be above the 16MB
line, that is they can be 31-bit addresses.
Each ECB must be fullword
aligned.
Null
(X'00000000' and X'FF000000') ECB addresses are
ignored.

NAME(name)

Specifies the symbolic name, 1-8 alphanumeric

characters, that is returned in SUSPENDVALUE or
HVALUE, when a task issues WAIT EXTERNAL and is
the subject of an INQ TASK command or a CEMT INQ
TASK.

NUMEVENTS(data-value)

Is the number of such events, corresponding to

the number of addresses in the ECBLIST.
The
field is fullword binary.
When NUMEVENTS is
specified as 1, ECBLIST must still be an address
that points to a list containing just one ECB
address.

Conditions
INVREQ
1. An ECB is not valid, for example the ECB is not fullword aligned.
2. The ECB address is a null pointer, (X'00000000'). or (X'FF000000').
3. NUMEVENTS is not a positive number.
4. No valid ECBs have been found in the list, because either the ECBLIST
address is not valid or all the ECB addresses are not valid.
5. The ECBs specified are in read-only storage.
Default action: terminate the task abnormally.
Notes
The structure of ECBLIST is as illustrated earlier for the WAITCICS command.
The ENQ command
EXEC CICS
ENQ
RESOURCE(data-area)
[ LENGTH(data-value) ]
END-EXEC
Options
RESOURCE
LENGTH

Specifies a 1 to 255 character resource name.

A half word PIC S9(4) COMP field that indicates the length
of the resource name in the data-area. If you omit this CICS
takes the address of the data-area as the resource that you
want to ENQ.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

164/256

The DEQ command

EXEC CICS
DEQ
RESOURCE(data-area)
[ LENGTH(data-value) ]
END-EXEC
Options
RESOURCE
LENGTH

Specifies a 1 to 255 character resource name.

A half word PIC S9(4) COMP field that indicates the length
of the resource name in the data-area. If you omit this CICS
takes the address of the data-area as the resource that you
want to DEQ

Example of synchronizing programs using ECBS and WAITCICS

SAMP5 and SAMP5A
SAMP5
transaction-id SM05
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP5.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-MSG-DATA
PIC X(30).
03 WS-MSG-DATA-LEN
PIC S9(4) COMP VALUE 30.
03 WS-RESP
PIC S9(08) COMP VALUE 0.
03 WS-QUEUE-RECORD-LEN
PIC S9(4) COMP VALUE 14.
03 WS-POST
PIC S9(8) COMP.
03 WS-POST-BIN REDEFINES WS-POST PIC X(4).
03 WS-CLEAR
PIC S9(8) COMP.
03 WS-CLEAR-BIN REDEFINES WS-CLEAR PIC X(4).
03 WS-SAMP5-PTR
USAGE IS POINTER.
03 WS-SAMP5-PTR-LEN
PIC S9(4) COMP VALUE 4.
01 WS-QUEUE-RECORD.
03 WS-QUEUE-DATA
PIC X(10) VALUE "SAMP5 ".
03 WS-COUNT
PIC 9(4) VALUE 0.
LINKAGE SECTION.
01 WS-ECBS.
03 ECB-ONE
PIC S9(8) COMP.
03 ECB-ONE-PTR
POINTER.
03 ECB-ONE-PTR-PTR
POINTER.
03 ECB-TWO
PIC S9(8) COMP.
03 ECB-TWO-PTR
POINTER.
03 ECB-TWO-PTR-PTR
POINTER.
PROCEDURE DIVISION.
PERFORM INIT-PARA.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
MOVE "SAMP5 STARTING ...." TO WS-MSG-DATA
EXEC CICS
SEND TEXT FROM(WS-MSG-DATA)
LENGTH(WS-MSG-DATA-LEN)
RESP(WS-RESP)
END-EXEC
PERFORM LOOP-PARA VARYING WS-COUNT FROM 0 BY 1
UNTIL WS-COUNT EQUAL 10

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

MOVE "SAMP5 ENDING..." TO WS-MSG-DATA

EXEC CICS
SEND TEXT FROM(WS-MSG-DATA)
LENGTH(WS-MSG-DATA-LEN)
RESP(WS-RESP)
END-EXEC.
LOOP-PARA.
EXEC CICS WAITCICS
ECBLIST(ECB-ONE-PTR-PTR)
NUMEVENTS(1)
RESP(WS-RESP)
END-EXEC
MOVE WS-CLEAR TO ECB-ONE
EXEC CICS
WRITEQ TS QUEUE("SAMP5")
FROM(WS-QUEUE-RECORD)
LENGTH(WS-QUEUE-RECORD-LEN)
RESP(WS-RESP)
END-EXEC
MOVE WS-POST TO ECB-TWO.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
INIT-PARA.
MOVE X'40008000' TO WS-POST-BIN
MOVE X'00000000' TO WS-CLEAR-BIN
EXEC CICS
GETMAIN SET(ADDRESS OF WS-ECBS)
FLENGTH(LENGTH OF WS-ECBS)
USERDATAKEY
END-EXEC
MOVE WS-CLEAR TO ECB-ONE
MOVE WS-CLEAR TO ECB-TWO
SET ECB-ONE-PTR TO ADDRESS OF ECB-ONE
SET ECB-ONE-PTR-PTR TO ADDRESS OF ECB-ONE-PTR
SET ECB-TWO-PTR TO ADDRESS OF ECB-TWO
SET ECB-TWO-PTR-PTR TO ADDRESS OF ECB-TWO-PTR.
EXEC CICS
DELETEQ TS QUEUE("SAMP5")
RESP(WS-RESP)
END-EXEC
SET WS-SAMP5-PTR TO ADDRESS OF WS-ECBS
EXEC CICS
START TRANSID("SM5A")
INTERVAL(0)
FROM(WS-SAMP5-PTR)
LENGTH(WS-SAMP5-PTR-LEN)
END-EXEC.
SAMP5A
transaction-id SM5A
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP5A.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.

165/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

03 WS-RESP
PIC S9(08) COMP VALUE 0.
03 WS-QUEUE-RECORD-LEN
PIC S9(4) COMP VALUE 14.
01 WS-QUEUE-RECORD.
03 WS-QUEUE-DATA
PIC X(10) VALUE "SAMP5A".
03 WS-COUNT
PIC 9(4) VALUE 0.
03 WS-POST
PIC S9(8) COMP.
03 WS-POST-BIN REDEFINES WS-POST PIC X(4).
03 WS-CLEAR
PIC S9(8) COMP.
03 WS-CLEAR-BIN REDEFINES WS-CLEAR PIC X(4).
01 WS-ECBS-LEN
PIC S9(4) COMP VALUE 4.
01 WS-SAMP5-WS-PTR
USAGE IS POINTER.
01 WS-SAMP5-WS-PTR-LEN
PIC S9(4) COMP VALUE 4.
LINKAGE SECTION.
01 WS-ECBS.
03 ECB-ONE
PIC S9(8) COMP.
03 ECB-ONE-PTR
POINTER.
03 ECB-ONE-PTR-PTR
POINTER.
03 ECB-TWO
PIC S9(8) COMP.
03 ECB-TWO-PTR
POINTER.
03 ECB-TWO-PTR-PTR
POINTER.
03 NUMEVENTS
PIC S9(8) COMP VALUE 1.
PROCEDURE DIVISION.
PERFORM INIT-PARA.
PERFORM MAIN-PARA
PERFORM END-PARA.
MAIN-PARA.
PERFORM LOOP-PARA VARYING WS-COUNT FROM 0 BY 1
UNTIL WS-COUNT EQUAL 10.
LOOP-PARA.
EXEC CICS
WRITEQ TS QUEUE("SAMP5")
FROM(WS-QUEUE-RECORD)
LENGTH(WS-QUEUE-RECORD-LEN)
RESP(WS-RESP)
END-EXEC.
MOVE WS-POST TO ECB-ONE
EXEC CICS
WAITCICS ECBLIST(ECB-TWO-PTR-PTR)
NUMEVENTS(1)
END-EXEC
MOVE WS-CLEAR TO ECB-TWO.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
INIT-PARA.
MOVE X'40008000' TO WS-POST-BIN
MOVE X'00000000' TO WS-CLEAR-BIN
EXEC CICS
RETRIEVE INTO(WS-SAMP5-WS-PTR)
LENGTH(WS-SAMP5-WS-PTR-LEN)
END-EXEC
SET ADDRESS OF WS-ECBS TO WS-SAMP5-WS-PTR.

166/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

167/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

168/256

A Model CICS Application

Preparatory work
Create the following PDS
userid.COBOL.SOURCE
userid.COBOL.COPYBOOK
userid.PROCLIB
userid.JCL
userid.MAPSET.SOURCE
userid.LOADLIB

recsize=80,blksize=800,recfm=fb,PDS
recsize=80,blksize=800,recfm=fb,PDS
recsize=80,blksize=800,recfm=fb,PDS
recsize=80,blksize=800,recfm=fb,PDS
recsize=80,blksize=800,recfm=fb,PDS
blksize=32760,recfm=vb,PDS

Copy the following procedure into your userid.PROCLIB

//DFHEITVL PROC SUFFIX=1$,
Suffix for translator module
//
INDEX='CICSTS13.CICS',
qualifier(s) for CICS libs
//
COMPHLQ='SYS1.CICSTS13.CICS', QUALIFIER(S) FOR COBOL COMPILER
//
OUTC=*,
Class for print output
//
REG=2M,
Region size for all steps
//
LNKPARM='LIST,XREF',
Link edit parameters
//
STUB='DFHEILIC',
Link edit INCLUDE for DFHECI
//
LIB='SDFHCOB',
Library
//
WORK=SYSDA
Unit for work datasets
//*
This procedure contains 4 steps
//*
1.
Exec the COBOL translator
//*
(using the supplied suffix 1$)
//*
2.
Exec the vs COBOL II compiler
//*
3.
Reblock &LIB(&STUB) for use by the linkedit step
//*
4.
Linkedit the output into dataset &PROGLIB
//*
//*
The following JCL should be used
//*
to execute this procedure
//*
//*
//APPLPROG EXEC DFHEITVL
//*
//TRN.SYSIN DD *
//*
.
//*
. Application program
//*
.
//*
/*
//*
//LKED.SYSIN DD *
//*
NAME anyname(R)
//*
/*
//*
//TRN
EXEC PGM=DFHECP&SUFFIX,
//
PARM='COBOL2',
//
REGION=&REG
//STEPLIB DD DSN=&INDEX..SDFHLOAD,DISP=SHR
//SYSPRINT DD SYSOUT=&OUTC
//SYSPUNCH DD DSN=&&SYSCIN,
//
DISP=(,PASS),UNIT=&WORK,
//
DCB=BLKSIZE=400,
//
SPACE=(400,(400,100))
//*
//COB
EXEC PGM=IGYCRCTL,REGION=&REG,
//
PARM='NODYNAM,LIB,OBJECT,RENT,RES,APOST,MAP,XREF'
//STEPLIB DD DSN=IGY.V2R1M0.SIGYCOMP,DISP=SHR
//SYSLIB
DD DSN=&INDEX..SDFHCOB,DISP=SHR
//
DD DSN=&INDEX..SDFHMAC,DISP=SHR
//
DD DSN=&INDEX..SDFHSAMP,DISP=SHR

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

169/256

//SYSPRINT DD SYSOUT=&OUTC
//SYSIN
DD DSN=&&SYSCIN,DISP=(OLD,DELETE)
//SYSLIN
DD DSN=&&LOADSET,DISP=(MOD,PASS),
//
UNIT=&WORK,SPACE=(80,(250,100))
//SYSUT1
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT2
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT3
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT4
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT5
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT6
DD UNIT=&WORK,SPACE=(460,(350,100))
//SYSUT7
DD UNIT=&WORK,SPACE=(460,(350,100))
//*
//COPYLINK EXEC PGM=IEBGENER,COND=(7,LT,COB)
//SYSUT1
DD DSN=&INDEX..&LIB(&STUB),DISP=SHR
//SYSUT2
DD DSN=&&COPYLINK,DISP=(NEW,PASS),
//
DCB=(LRECL=80,BLKSIZE=400,RECFM=FB),
//
UNIT=&WORK,SPACE=(400,(20,20))
//SYSPRINT DD SYSOUT=&OUTC
//SYSIN
DD DUMMY
//*
//LKED
EXEC PGM=IEWL,REGION=&REG,
//
PARM='&LNKPARM',COND=(5,LT,COB)
//SYSLIB
DD DSN=&INDEX..SDFHLOAD,DISP=SHR
//
DD DSN=&COMPHLQ..SDFHLINK,DISP=SHR
//
DD DSN=CEE.SCEELKED,DISP=SHR
//
DD DSN=CEE.SCEERUN,DISP=SHR
//
DD DSN=TCPIP.SEZATCP,DISP=SHR
//SYSUT1
DD UNIT=&WORK,DCB=BLKSIZE=1024,
//
SPACE=(1024,(200,20))
//SYSPRINT DD SYSOUT=&OUTC
//SYSLIN
DD DSN=&&COPYLINK,DISP=(OLD,DELETE)
//
DD DSN=&&LOADSET,DISP=(OLD,DELETE)
//
DD DDNAME=SYSIN
Copy this into your JCL PDS
//USER0101 JOB NOTIFY=&SYSUID
//
JCLLIB ORDER=(USER01.PROCLIB)
//COMPILE EXEC DFHEITVL
//TRN.SYSIN
DD DSN=USER01.COBOL.SOURCE(memname),DISP=SHR
//LKED.SYSIN DD *
NAME memname(R)
/*
//* THIS FOR USER LOADLIB FOR C0A2
//LKED.SYSLMOD DD DSN=<-loadlib->(memname),DISP=SHR
//
Copy this map preparation procedure into userid.PROCLIB
PROC DFHMAPT
//DFHMAPT PROC INDEX='CICSTS13.CICS', FOR SDFHMAC
//
DSCTLIB='userid.COBOL.COPY', TARGET FOR DSECT
//
MAPNAME=,
NAME OF MAPSET - REQUIRED
//
RMODE=24,
24/ANY
//
ASMBLR=ASMA90,
ASSEMBLER PROGRAM NAME
//
REG=2048K,
REGION FOR ASSEMBLY
//
OUTC=A,
PRINT SYSOUT CLASS
//
WORK=SYSDA
WORK FILE UNIT

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

170/256

//ASMMAP
EXEC PGM=&ASMBLR,REGION=&REG,
// PARM='SYSPARM(MAP),DECK,NOOBJECT'
//SYSPRINT DD SYSOUT=&OUTC
//SYSLIB
DD DSN=&INDEX..SDFHMAC,DISP=SHR
//
DD DSN=SYS1.MACLIB,DISP=SHR
//SYSUT1
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSUT2
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSUT3
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSPUNCH DD DSN=&&MAP,DISP=(,PASS),UNIT=&WORK,
//
DCB=(RECFM=FB,LRECL=80,BLKSIZE=400),
//
SPACE=(400,(50,50))
//SYSIN
DD DSN=userid.MAPSET.SOURCE(&MAPNAME),DISP=SHR
//LINKMAP EXEC PGM=IEWL,PARM='LIST,LET,XREF,RMODE(&RMODE)'
//SYSPRINT DD SYSOUT=&OUTC
//SYSLMOD DD DSN=<- your CICS map set load library ->(&MAPNAME),DISP=SHR
//SYSUT1
DD UNIT=&WORK,SPACE=(1024,(20,20))
//SYSLIN
DD DSN=&&MAP,DISP=(OLD,DELETE)
//ASMDSECT EXEC PGM=&ASMBLR,REGION=&REG,
// PARM='SYSPARM(DSECT),DECK,NOOBJECT'
//SYSPRINT DD SYSOUT=&OUTC
//SYSLIB
DD DSN=&INDEX..SDFHMAC,DISP=SHR
//
DD DSN=SYS1.MACLIB,DISP=SHR
//SYSUT1
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSUT2
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSUT3
DD UNIT=&WORK,SPACE=(CYL,(5,5))
//SYSPUNCH DD DSN=&DSCTLIB(&MAPNAME),DISP=OLD
//SYSIN
DD DSN=user01.MAPSET.SOURCE(&MAPNAME),DISP=SHR
Copy this into userid.JCL
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//
JCLLIB ORDER=(userid.PROCLIB)
//STEP1 EXEC DFHMAPT,MAPNAME=member-name
//

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

171/256

Broad Structure of the Application and Resources definition

Program:-INVMENU
Transid:-MENU
Mapset :-MENSET1
Map
:-MENMAP1
Files :-None
XCTLS TO
CUSTINQ1
CUSTMNT1
ORDRENT1

Program:-ORDRENT1
Transid:-ORD1
Mapset :-ORDSET1
Map
:-ORDMAP1
Calls :-GETINV
Called from:-INVMENU
XCTLS TO:-INVMENU
(PF3,PF12)
Files:INVOICE
CUSTMAS
PRODUCT
INVCTL

Program:-CUSTMNT1
Transid:-MNT1
Mapset :-MNTSET1
Map
:-MNTMAP1
:-MNTMAP2
Called from:-INVMENU
XCTLS TO:-INVMENU
(PF3,PF12)
Files:CUSTMAS

Program:-CUSTINQ1
Transid:-INQ1
Mapset :-INQSET1
Map
:-INQMAP1
Called from:-INVMENU
XCTLS TO:-INVMENU
(PF3,PF12)
Files:CUSTMAS
INVPATH (customer
number path to
invoice file)

The numbers are the order in which you must implement the parts
of the application!.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

172/256

Resource naming conventions

Program:-INVMENUn
Transid:-MENn
Mapset :-MENSETn
Map
:-MENMAPn
Files :-None
XCTLS TO
CUSTIN1n
CUSTMN1n
ORDREN1n

Program:-ORDRENTn
Transid:-ORDn
Mapset :-ORDSETn
Map
:-ORDMAPn
Calls :-GETINV
Called from:-INVMENn
XCTLS TO:-INVMENUn
(PF3,PF12)
Files:INVOICEn
CUSTMASn
PRODUCTn
INVCTLn

Program:-CUSTMNTn
Transid:-MNTn
Mapset :-MNTSETn
Map
:-MNTMAPn
:-MNTMA2n
Called from:-INVMENn
XCTLS TO:-INVMENUn
(PF3,PF12)
Files:CUSTMASn

Program:-CUSTINQn
Transid:-INQn
Mapset :-INQSETn
Map
:-INQMAPn
Called from:-INVMENn
XCTLS TO:-INVMENUn
(PF3,PF12)
Files:CUSTMASn
INVPATHn (customer
number path to
invoice file)

1. Two students will each form a group and the n will vary from 1 to 9
for the groups.
2. Each groups resources will be in a group TRNG0n
3. The instructor will define the resources on request.
4. All programs MUST be tested using CEDF before allowing them to run.
This is to guard against programs going in a loop and disturbing
other users of the system.
5. The subprograms SYSERR,GETINV,INTEDIT and NUMEDIT will be defined in
group TRNGCOMN and can be shared by all.
6. Dont forget to change the COBOL and BMS source to reflect the naming
conventions above!.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

173/256

Data Sets and Sample Data

CUSTMAS

01

CUSTOMER-MASTER-RECORD.
05
05
05
05
05
05
05

Sample data
112233ANNE
FRESNO
123455COLUMBUS
COLUMBUS
123456RAUL
FRESNO

CM-CUSTOMER-NUMBER
CM-FIRST-NAME
CM-LAST-NAME
CM-ADDRESS
CM-CITY
CM-STATE
CM-ZIP-CODE

PIC
PIC
PIC
PIC
PIC
PIC
PIC

X(6).
X(20).
X(30).
X(30).
X(20).
X(2).
X(10).

PRINCE
CA93711-0000
CHRISTOPHER
OH92939
MENENDEZ
CA93711-2765

1122 ELM ST
1122 NEW WORLD LN
888 CICS WAY

Since the application has the facility to add a customer record, you can get that
part of the application (CUSTMN1n, transid MN1n) to work and add these records.
Defining the data set
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE USER01.CUSTMAS CLUSTER
DEFINE CLUSTER (NAME(USER01.CUSTMAS) INDEXED KEYS(6,0) RECORDSIZE(118,118) TRACKS(2,2)) DATA(CONTROLINTERVALSIZE(1024))
//
PRODUCT

01

PRODUCT-MASTER-RECORD.
05
05
05
05

PRM-PRODUCT-CODE
PRM-PRODUCT-DESCRIPTION
PRM-UNIT-PRICE
PRM-QUANTITY-ON-HAND

PIC
PIC
PIC
PIC

X(10).
X(20).
S9(7)V99
S9(7)

COMP-3.
COMP-3.

10
20
5
4

Sample Data
See PRODUCT file. Cut paste it into a data set userid.PRODUCT.DATA. A
load using REPRO is suggested. It is also a good idea to print the data
set using PRINT with HEX output. Note that the ORDRENT program wont work
without this data set and data.
Optionally you can use the program SAMP18 earlier in this document to
generate the data for this file automatically.
Defining the data set
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *

APPLICATION PROGRAMMING IN CICS BASIC

//

24/08/2003

174/256

DELETE userid.CUSTMAS CLUSTER

DEFINE CLUSTER (NAME(userid.PRODUCT) INDEXED KEYS(10,0) RECORDSIZE(39,39) TRACKS(1,1)) DATA(CONTROLINTERVALSIZE(1024))

Loading the data set

//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
REPRO INDATASET(userid.PRODUCT.DATA) OUTDATASET(userid.PRODUCT)
//
Printing the data set
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
PRINT INDATASET(userid.PRODUCT) HEX
//
INVOICE
01 INVOICE-RECORD.
*
05 INV-INVOICE-NUMBER
05 INV-INVOICE-DATE
05 INV-CUSTOMER-NUMBER
05 INV-PO-NUMBER
05 INV-LINE-ITEM
10 INV-PRODUCT-CODE
10 INV-QUANTITY
10 INV-UNIT-PRICE
10 INV-AMOUNT
05 INV-INVOICE-TOTAL
*

PIC 9(6).
PIC X(8).
PIC X(6).
PIC X(10).
OCCURS 10.
PIC X(10).
PIC S9(7)
PIC S9(7)V99
PIC S9(7)V99
PIC S9(7)V99

COMP-3.
COMP-3.
COMP-3.
COMP-3.

10
4
5
5

6
8
6
10
240

Defining the data set

//KAMATH1 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE KAMATH.INVOICE CLUSTER
DEFINE CLUSTER (NAME(KAMATH.INVOICE) INDEXED KEYS(6,0) RECORDSIZE(275,275) TRACKS(2,2)) DATA(CONTROLINTERVALSIZE(1024))
//

This data set has an alternate index built over the INV-CUSTOMER-NUMBER
field. When using an alternate index, you simply specify the name of the
path as a FILE resource to CICS.
Three Access Method Services commands are used as below:
1. DEFINE ALTERNATEINDEX :-defines the alternate index as a data set to
VSAM.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

175/256

2. BLDINDEX :-places the pointers to the relevant records in the

alternate index.
3. DEFINE PATH:-defines an entity that can be associated with a PL/I
file in a DD statement.
DEFINING A ALTERNATE INDEX FOR A VSAM KSDS FILE
//USER011 JOB MSGCLASS=A,NOTIFY=&SYSUID
//STEP1 EXEC PGM=IDCAMS,REGION=512K
//SYSPRINT DD SYSOUT=*
//SYSIN
DD *
DELETE USER01.INVOICE.ALTINDEX ALTERNATEINDEX
DEFINE ALTERNATEINDEX (NAME(USER01.INVOICE.ALTINDEX)NONUNIQUEKEY KEYS(6 14) RECORDSIZE(40 400) TRACKS(2 2) RELATE(USER01.INVOICE))
/*
//
EXAMPLE OF THE ALTERNATE INDEX AND DEFINING THE PATH
//USER011 JOB MSGCLASS=A,NOTIFY=&SYSUID
//STEP1 EXEC PGM=IDCAMS,REGION=512K
//SYSPRINT DD SYSOUT=*
//DD1
DD DSN=USER01.INVOICE,DISP=OLD
//DD2
DD DSN=USER01.INVOICE.ALTINDEX,DISP=OLD
//SYSIN
DD *
BLDINDEX INFILE(DD1) OUTFILE(DD2)
DEFINE PATH(NAME(USER01.INVOICE.PATH)PATHENTRY(USER01.INVOICE.ALTINDEX))
/*
//
You can create invoices using the ORDRENT program. In case you want
data, it is available in the file INVOICE. Note that the Product Code
you enter here must be available in the PRODUCT file.
You can test the proper operation of the Alternate Index by using the
Customer Inquiry program.
INVCTL
1
INVCTL-RECORD.
*
05 INVCTL-RECORD-KEY
PIC X.
5
INVCTL-NEXT-RECORD-NUMBER PIC 9(6).
*
Defining the data set
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1)
//STEP1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE USER01.INVCTL CLUSTER
DEFINE CLUSTER (NAME(USER01.INVCTL) INDEXED KEYS(1,0) -

APPLICATION PROGRAMMING IN CICS BASIC

//

24/08/2003

RECORDSIZE(7,7) TRACKS(1,1)) DATA(CONTROLINTERVALSIZE(1024))

176/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

177/256

IMPORTANT NOTE-1
1. The Application expects the current date and company name to be in
the common work area in the following format:01 COMMON-WORK-AREA.
05 CWA-DATE
PIC X(6).
05 CWA-COMPANY-NAME
PIC X(40).
Since the CWA is a system wide shared area, the storage allocated
for this application use may be different. Check with operations
and adjust your COMMON-WORK-AREA structure accordingly.
2. You will have to write a separate program (one program for the whole
Class Will do) to set the CWA to the current date and company name.

IMPORTANT NOTE-2
There is no program to maintain the PRODUCT master file. Write one from
scratch. It is enough if this program has facility to create a new
entry.
Modify INVMENU to invoke this program from the main menu.
This will be your test for the lab exercises.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

178/256

Miscellaneous sub programs

back
Compile and Link Edit this program and define it to CICS as GETINV.
GETINV
IDENTIFICATION DIVISION.
PROGRAM-ID. GETINV.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY INVCTL.
LINKAGE SECTION.
01 DFHCOMMAREA
PIC 9(06).
PROCEDURE DIVISION.
0000-GET-INVOICE-NUMBER.
MOVE ZERO TO INVCTL-RECORD-KEY.
EXEC CICS
READ FILE('INVCTL')
INTO(INVCTL-RECORD)
RIDFLD(INVCTL-RECORD-KEY)
UPDATE
END-EXEC.
MOVE INVCTL-NEXT-INVOICE-NUMBER TO DFHCOMMAREA.
ADD 1 TO INVCTL-NEXT-INVOICE-NUMBER.
EXEC CICS
REWRITE FILE('INVCTL')
FROM(INVCTL-RECORD)
END-EXEC.
EXEC CICS
RETURN
END-EXEC.
Prime INVCTL with one Data record with this program after
defining the following:1. file INVCTL
2. Program PUTINV
3. Transaction PUTI
PUTINV

transaction-id PUTI

IDENTIFICATION DIVISION.
PROGRAM-ID. PUTINV.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY INVCTL.
01 WS-RESP
PIC S9(8) COMP.
LINKAGE SECTION.
PROCEDURE DIVISION.
0000-GET-INVOICE-NUMBER.
MOVE ZERO TO INVCTL-RECORD-KEY.
MOVE 1 TO INVCTL-NEXT-INVOICE-NUMBER.
EXEC CICS
WRITE FILE('INVCTL')
FROM(INVCTL-RECORD)
RIDFLD(INVCTL-RECORD-KEY)
RESP(WS-RESP)
END-EXEC
EXEC CICS
RETURN

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

179/256

END-EXEC.
Use SAMP18 to populate the PRODUCT master with 100 records
SAMP18
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMP18.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VARS.
03 WS-RESP
PIC S9(08) COMP VALUE 0.
01 PRODUCT-MASTER-RECORD.
*
05 PRM-PRODUCT-CODE
PIC 9(10) VALUE 10.
05 PRM-PRODUCT-DESCRIPTION.
10 PROD-KEY
PIC 9(10).
10 DESCRIPTION
PIC X(10) VALUE "ABCDEFGH".
05 PRM-UNIT-PRICE
PIC S9(7)V99 COMP-3 VALUE 10.00.
05 PRM-QUANTITY-ON-HAND
PIC S9(7)
COMP-3 VALUE 10.
*
01 WS-COUNT
PIC 9(10) VALUE 1.
PROCEDURE DIVISION.
PERFORM MAIN-PARA VARYING WS-COUNT FROM 0 BY 1
UNTIL WS-COUNT EQUAL 100
PERFORM END-PARA.
MAIN-PARA.
MOVE WS-COUNT TO PROD-KEY
MOVE WS-COUNT TO PRM-PRODUCT-CODE
ADD 1 TO PRM-UNIT-PRICE
ADD 1 TO PRM-QUANTITY-ON-HAND
EXEC CICS
WRITE FILE('PRODUCT')
FROM(PRODUCT-MASTER-RECORD)
RIDFLD(PRM-PRODUCT-CODE)
RESP(WS-RESP)
END-EXEC.
END-PARA.
EXEC CICS
RETURN
END-EXEC.
Compile and Link Edit this program and define it to CICS as SYSERR.
SYSERR This is a XCTLD to program, does not need a Trans-id
IDENTIFICATION DIVISION.
PROGRAM-ID. SYSERR.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ERROR-MESSAGE.
05 ERROR-LINE-1.
10 FILLER
PIC X(20) VALUE 'A serious error has '.
10 FILLER
PIC X(20) VALUE 'occurred. Please co'.
10 FILLER
PIC X(20) VALUE 'ntact technical supp'.
10 FILLER
PIC X(19) VALUE 'ort.
'.
05 ERROR-LINE-2
PIC X(79) VALUE SPACE.
05 ERROR-LINE-3.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

10 FILLER
PIC X(11) VALUE 'EIBRESP
10 EM-RESP
PIC Z(08)9.
10 FILLER
PIC X(59) VALUE SPACE.
05 ERROR-LINE-4.
10 FILLER
PIC X(11) VALUE 'EIBRESP2
10 EM-RESP2
PIC Z(08)9.
10 FILLER
PIC X(59) VALUE SPACE.
05 ERROR-LINE-5.
10 FILLER
PIC X(11) VALUE 'EIBTRNID
10 EM-TRNID
PIC X(04).
10 FILLER
PIC X(64) VALUE SPACE.
05 ERROR-LINE-6.
10 FILLER
PIC X(11) VALUE 'EIBRSRCE
10 EM-RSRCE
PIC X(08).
10 FILLER
PIC X(60) VALUE SPACE.
05 ERROR-LINE-7
PIC X(79) VALUE SPACE.
COPY ERRPARM.
LINKAGE SECTION.
01 DFHCOMMAREA
PIC X(20).
PROCEDURE DIVISION.
0000-DISPLAY-ERROR-MESSAGE.
MOVE DFHCOMMAREA TO ERROR-PARAMETERS.
MOVE ERR-RESP TO EM-RESP.
MOVE ERR-RESP2 TO EM-RESP2.
MOVE ERR-TRNID TO EM-TRNID.
MOVE ERR-RSRCE TO EM-RSRCE.
EXEC CICS
SEND TEXT FROM(ERROR-MESSAGE)
ERASE
ALARM
FREEKB
END-EXEC.
EXEC CICS
RETURN
END-EXEC.

Set up the CWA with this program

SETCWA transaction-id SCWA
IDENTIFICATION DIVISION.
PROGRAM-ID. SETCWA.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY INVCTL.
01 UTIME PIC S9(15) COMP-3.
LINKAGE SECTION.
01 COMMON-WORK-AREA.
05 CWA-DATE
PIC X(8).
05 CWA-COMPANY-NAME
PIC X(40).
PROCEDURE DIVISION.
0000-SET-CWA.
EXEC CICS
ADDRESS CWA(ADDRESS OF COMMON-WORK-AREA)
END-EXEC

= '.

= '.

= '.

= '.

180/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

181/256

EXEC CICS
ASKTIME ABSTIME(UTIME)
END-EXEC
EXEC CICS
FORMATTIME MMDDYY(WS-DATE) DATESEP ABSTIME(UTIME)
END-EXEC
MOVE "ABC COMPANY" TO CWA-COMPANY-NAME
MOVE WS-DATE-TWO TO CWA-DATE.
EXEC CICS
RETURN
END-EXEC.
Use the following JCL to compile INTEDIT and NUMEDIT programs. Note that
these programs are not used anymore in the sample application, having
been replaced by BIF DEEDIT CICS API Call.
//USER011 JOB NOTIFY=&SYSUID
//
JCLLIB ORDER=(USER01.PROCLIB)
//COMPILE EXEC CICSCOMP
//TRN.SYSIN
DD DSN=USER01.COBOL.SOURCE(INTEDIT),DISP=SHR
//COB.SYSLIN DD DSN=USER01.COBOL.OBJECT(INTEDIT),DISP=SHR
//
This procedure must be in your private PROCLIB
//CICSCOB PROC SUFFIX=1$,
SUFFIX FOR TRANSLATOR MODULE
//
INDEX='CICSTS13.CICS'
QUALIFIER(S) FOR CICS LIBS
//TRN
EXEC PGM=DFHECP&SUFFIX,PARM='COBOL2',REGION=2M
//STEPLIB DD DSN=&INDEX..SDFHLOAD,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSPUNCH DD DSN=&&SYSCIN,DISP=(,PASS),UNIT=SYSDA,DCB=BLKSIZE=400,
//
SPACE=(400,(400,100))
//COB
EXEC PGM=IGYCRCTL,COND=(4,LT,TRN),PARM='LIST,MAP'
//STEPLIB DD DSN=IGY.V2R1M0.SIGYCOMP,DISP=SHR
//SYSIN
DD DSN=&&SYSCIN,DISP=(OLD,DELETE)
//SYSLIB
DD DSN=&INDEX..SDFHCOB,DISP=SHR
//
DD DSN=&INDEX..SDFHMAC,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//SYSUT1
DD SPACE=(800,(500,500),,,ROUND),UNIT=SYSDA
//SYSUT2
DD SPACE=(800,(500,500),,,ROUND),UNIT=SYSDA
//SYSUT3
DD SPACE=(800,(500,500),,,ROUND),UNIT=SYSDA
//SYSUT4
DD SPACE=(800,(500,500),,,ROUND),UNIT=SYSDA
//SYSUT5
DD SPACE=(800,(500,500),,,ROUND),UNIT=SYSDA
//SYSUT6
DD SPACE=(800,(500,500),,,ROUND),UNIT=SYSDA
//SYSUT7
DD SPACE=(800,(500,500),,,ROUND),UNIT=SYSDA

INTEDIT
IDENTIFICATION DIVISION.
PROGRAM-ID. INTEDIT.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WORK-FIELDS.
05 INTEGER-PART
05 INTEGER-LENGTH
LINKAGE SECTION.

PIC 9(05).
PIC S9(03)

COMP-3.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

01
01
01

UNEDITED-NUMBER
PIC X(05).
EDITED-NUMBER
PIC 9(05).
VALID-NUMBER-SW
PIC X(01).
88 VALID-NUMBER
VALUE 'Y'.
PROCEDURE DIVISION USING UNEDITED-NUMBER
EDITED-NUMBER
VALID-NUMBER-SW.
0000-EDIT-NUMBER.
MOVE ZERO TO INTEGER-LENGTH.
INSPECT UNEDITED-NUMBER
REPLACING LEADING SPACE BY ZERO.
INSPECT UNEDITED-NUMBER
TALLYING INTEGER-LENGTH FOR CHARACTERS
BEFORE INITIAL SPACE.
IF UNEDITED-NUMBER(1:INTEGER-LENGTH) NUMERIC
MOVE UNEDITED-NUMBER(1:INTEGER-LENGTH)
TO EDITED-NUMBER
MOVE 'Y' TO VALID-NUMBER-SW
ELSE
MOVE 'N' TO VALID-NUMBER-SW
END-IF.
0000-EXIT.
EXIT PROGRAM.
NUMEDIT
IDENTIFICATION DIVISION.
PROGRAM-ID. NUMEDIT.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WORK-FIELDS.
05 INTEGER-PART
PIC 9(10).
05 INTEGER-PART-X
REDEFINES
INTEGER-PART.
10 INTEGER-CHAR
PIC X(01)
OCCURS 10.
05 DECIMAL-PART
PIC V9(10).
05 DECIMAL-PART-X
REDEFINES
DECIMAL-PART.
10 DECIMAL-CHAR
PIC X(01)
OCCURS 10.
05 DECIMAL-POS
PIC S9(03) COMP-3.
05 INTEGER-LENGTH
PIC S9(03) COMP-3.
05 INTEGER-SUB
PIC S9(03) COMP-3.
05 DECIMAL-SUB
PIC S9(03) COMP-3.
05 UNEDIT-SUB
PIC S9(03) COMP-3.
LINKAGE SECTION.
01 UNEDITED-NUMBER.
05 UNEDITED-CHAR
OCCURS 10
PIC X.
01 EDITED-NUMBER
PIC 9(07)V99.
01 VALID-NUMBER-SW
PIC X(01).
88 VALID-NUMBER
VALUE 'Y'.
PROCEDURE DIVISION USING UNEDITED-NUMBER
EDITED-NUMBER
VALID-NUMBER-SW.
0000-EDIT-NUMBER.
MOVE 'Y' TO VALID-NUMBER-SW.
MOVE ZERO TO INTEGER-PART
DECIMAL-PART
DECIMAL-POS.
INSPECT UNEDITED-NUMBER

182/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

183/256

TALLYING DECIMAL-POS FOR CHARACTERS

BEFORE INITIAL '.'.
IF DECIMAL-POS < 10
PERFORM 1000-EDIT-DECIMAL-NUMBER
ELSE
PERFORM 2000-EDIT-INTEGER
END-IF.
IF VALID-NUMBER
COMPUTE EDITED-NUMBER = INTEGER-PART + DECIMAL-PART
END-IF.
0000-EXIT.
EXIT PROGRAM.
1000-EDIT-DECIMAL-NUMBER.
MOVE 10 TO INTEGER-SUB.
PERFORM 1100-EDIT-INTEGER-PART
VARYING UNEDIT-SUB FROM DECIMAL-POS BY -1
UNTIL UNEDIT-SUB < 1.
MOVE 1 TO DECIMAL-SUB.
ADD 2 TO DECIMAL-POS.
PERFORM 1200-EDIT-DECIMAL-PART
VARYING UNEDIT-SUB FROM DECIMAL-POS BY 1
UNTIL UNEDIT-SUB > 10.
1100-EDIT-INTEGER-PART.
IF UNEDITED-CHAR(UNEDIT-SUB) NUMERIC
MOVE UNEDITED-CHAR(UNEDIT-SUB)
TO INTEGER-CHAR(INTEGER-SUB)
SUBTRACT 1 FROM INTEGER-SUB
ELSE IF UNEDITED-CHAR(UNEDIT-SUB) NOT = SPACE
MOVE 'N' TO VALID-NUMBER-SW
END-IF.
1200-EDIT-DECIMAL-PART.
IF UNEDITED-CHAR(UNEDIT-SUB) NUMERIC
MOVE UNEDITED-CHAR(UNEDIT-SUB)
TO DECIMAL-CHAR(DECIMAL-SUB)
ADD 1 TO DECIMAL-SUB
ELSE IF UNEDITED-CHAR(UNEDIT-SUB) NOT = SPACE
MOVE 'N' TO VALID-NUMBER-SW
END-IF.
2000-EDIT-INTEGER.
INSPECT UNEDITED-NUMBER
REPLACING LEADING SPACE BY ZERO.
MOVE ZERO TO INTEGER-LENGTH.
INSPECT UNEDITED-NUMBER
TALLYING INTEGER-LENGTH FOR CHARACTERS
BEFORE INITIAL SPACE.
MOVE 10 TO INTEGER-SUB.
PERFORM 1100-EDIT-INTEGER-PART
VARYING UNEDIT-SUB FROM INTEGER-LENGTH BY -1
UNTIL UNEDIT-SUB < 1.
MOVE ZERO TO DECIMAL-PART.

APPLICATION PROGRAMMING IN CICS BASIC

The MENU program
Program
INVMENU

24/08/2003

184/256
back

Overview

Displays a menu and lets the user select which program to

run. The three choices are Customer Inquiry, Customer
Maintenance, or Order Entry.

Input /
Output
Specs

MENMAP1

Menu Map

Processing Specifications
1. The menu program is invoked when the user enters the trans-id MENU or
when another programs invokes it via XCTL with no communication area.
Either way it should respond by showing the menu map
2. On the menu map the user enters an action code. If the action code is
valid(1,2 or 3), the program should XCTL to the inquiry program, the
maintenance program, or the order entry program. If the action code
is invalid, the program should display an error message.
3. If the user presses PF3 or PF12, the program should display the
message session ended and terminate by issuing a RETURN command
without a transaction id.
Event
Start the program
PF3
PF12
Enter

Clear
PA1,PA2, or PA3
Any other key

Response
Display the menu map
Display a termination message and end
Display a termination message and end
1. If the action code is 1, XCTL to the inquiry
program
2. If the action code is 2, XCTL to the
maintenance program
3. If the action code is 3, XCTL to the order
entry program
4. Otherwise display an error message
Redisplay the menu map
Ignore the key
Display an appropriate error message

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

185/256

Structure Chart for the menu program

0000
process
master
menu

1100
receive
menu
map

1000
process
menu
map

1400
send
menu
map

1200
edit
menu
data

1300
branch
to
program

2000
send
termination
message

1400
send
menu
map

The MENSET1 mapset

PRINT NOGEN
MENSET1 DFHMSD TYPE=&SYSPARM,
X
LANG=COBOL,
X
MODE=INOUT,
X
TERM=3270-2,
X
CTRL=FREEKB,
X
STORAGE=AUTO,
X
DSATTS=(COLOR,HILIGHT),
X
MAPATTS=(COLOR,HILIGHT),
X
TIOAPFX=YES
***********************************************************************
MENMAP1 DFHMDI SIZE=(24,80),
X
LINE=1,
X
COLUMN=1
***********************************************************************
DFHMDF POS=(1,1),
X
LENGTH=7,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='MENMAP1'
DFHMDF POS=(1,20),
X
LENGTH=11,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='MASTER MENU'
***********************************************************************
DFHMDF POS=(3,1),
X
LENGTH=36,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='SELECT AN ACTION. THEN PRESS ENTER.'
DFHMDF POS=(5,1),
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

186/256

LENGTH=14,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='ACTION . . . .'
ACTION
DFHMDF POS=(5,16),
X
LENGTH=1,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_'
DFHMDF POS=(5,18),
X
LENGTH=32,
X
ATTRB=(NORM,ASKIP),
X
COLOR=NEUTRAL,
X
INITIAL='1. DISPLAY CUSTOMER INFORMATION'
DFHMDF POS=(6,18),
X
LENGTH=33,
X
ATTRB=(NORM,PROT),
X
COLOR=NEUTRAL,
X
INITIAL='2. MAINTAIN CUSTOMER INFORMATION'
DFHMDF POS=(7,18),
X
LENGTH=16,
X
ATTRB=(NORM,PROT),
X
COLOR=NEUTRAL,
X
INITIAL='3. ENTER ORDERS'
***********************************************************************
MESSAGE DFHMDF POS=(23,1),
X
LENGTH=79,
X
COLOR=YELLOW,
X
ATTRB=(BRT,PROT)
DFHMDF POS=(24,1),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='F3=EXIT
F12=CANCEL'
DUMMY
DFHMDF POS=(24,79),
X
LENGTH=1,
X
ATTRB=(DRK,PROT,FSET),
X
INITIAL=' '
***********************************************************************
DFHMSD TYPE=FINAL
END

APPLICATION PROGRAMMING IN CICS BASIC

MENMAP1

24/08/2003

187/256

Select an action.

Master Menu

Action . . . . _ 1.
2.
3.

Then press Enter.

Display customer information
Maintain customer information
Enter orders

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
F3=Exit
F12=Cancel
X

APPLICATION PROGRAMMING IN CICS BASIC

The MENSET1 symbolic map

01 MENMAP1I.
02
FILLER
PIC X(12).
02
ACTIONL
PIC S9(4) COMP.
02
ACTIONF
PIC X.
02
FILLER REDEFINES ACTIONF.
03 ACTIONA
PIC X.
02
FILLER
PIC X(0002).
02
ACTIONI
PIC X(0001).
02
MESSAGEL PIC S9(4) COMP.
02
MESSAGEF PIC X.
02
FILLER REDEFINES MESSAGEF.
03 MESSAGEA PIC X.
02
FILLER
PIC X(0002).
02
MESSAGEI PIC X(0079).
02
DUMMYL
PIC S9(4) COMP.
02
DUMMYF
PIC X.
02
FILLER REDEFINES DUMMYF.
03 DUMMYA
PIC X.
02
FILLER
PIC X(0002).
02
DUMMYI
PIC X(0001).
01 MENMAP1O REDEFINES MENMAP1I.
02
FILLER
PIC X(12).
02
FILLER
PIC X(3).
02
ACTIONC
PIC X.
02
ACTIONH
PIC X.
02
ACTIONO
PIC X(0001).
02
FILLER
PIC X(3).
02
MESSAGEC PIC X.
02
MESSAGEH PIC X.
02
MESSAGEO PIC X(0079).
02
FILLER
PIC X(3).
02
DUMMYC
PIC X.
02
DUMMYH
PIC X.
02
DUMMYO
PIC X(0001).

24/08/2003

188/256

APPLICATION PROGRAMMING IN CICS BASIC

The INVMENU program
IDENTIFICATION DIVISION.
PROGRAM-ID. INVMENU.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SWITCHES.
05 VALID-DATA-SW
88 VALID-DATA
01 FLAGS.
05 SEND-FLAG
88 SEND-ERASE
88 SEND-DATAONLY
88 SEND-DATAONLY-ALARM
01 PROGRAM-TABLE.
05 PROGRAM-LIST.
10 PROGRAM-1
10 PROGRAM-2
10 PROGRAM-3
05 PROGRAM-NAME
01

24/08/2003

PIC X
PIC X.

PIC X(8)
PIC X(8)
PIC X(8)
REDEFINES
OCCURS 3
PIC X(8).

189/256

VALUE 'Y'.
VALUE 'Y'.
VALUE '1'.
VALUE '2'.
VALUE '3'.
VALUE 'CUSTINQ1'.
VALUE 'CUSTMNT1'.
VALUE 'ORDRENT1'.
PROGRAM-LIST

ACTION-ALPHA.
05 ACTION-NUM
PIC 9.
01 END-OF-SESSION-MESSAGE
PIC X(13) VALUE 'SESSION ENDED'.
01 RESPONSE-CODE
PIC S9(8) COMP.
01 COMMUNICATION-AREA
PIC X.
COPY MENSET1.
COPY DFHAID.
COPY ATTR.
LINKAGE SECTION.
01 DFHCOMMAREA
PIC X.
PROCEDURE DIVISION.
0000-PROCESS-MASTER-MENU.
EVALUATE TRUE
WHEN EIBCALEN = ZERO
MOVE LOW-VALUE TO MENMAP1O
MOVE -1 TO ACTIONL
SET SEND-ERASE TO TRUE
PERFORM 1400-SEND-MENU-MAP
WHEN EIBAID = DFHCLEAR
MOVE LOW-VALUE TO MENMAP1O
MOVE -1 TO ACTIONL
SET SEND-ERASE TO TRUE
PERFORM 1400-SEND-MENU-MAP
WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
CONTINUE
WHEN EIBAID = DFHPF3 OR DFHPF12
PERFORM 2000-SEND-TERMINATION-MESSAGE
EXEC CICS
RETURN
END-EXEC
WHEN EIBAID = DFHENTER
PERFORM 1000-PROCESS-MENU-MAP
WHEN OTHER
MOVE 'INVALID KEY PRESSED.' TO MESSAGEO
MOVE -1 TO ACTIONL

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

SET SEND-DATAONLY-ALARM TO TRUE

PERFORM 1400-SEND-MENU-MAP
END-EVALUATE
EXEC CICS
RETURN TRANSID('MENU')
COMMAREA(COMMUNICATION-AREA)
LENGTH(1)
END-EXEC.
1000-PROCESS-MENU-MAP.
PERFORM 1100-RECEIVE-MENU-MAP.
PERFORM 1200-EDIT-MENU-DATA.
IF VALID-DATA
PERFORM 1300-BRANCH-TO-PROGRAM.
SET SEND-DATAONLY-ALARM TO TRUE.
MOVE -1 TO ACTIONL.
PERFORM 1400-SEND-MENU-MAP.
1100-RECEIVE-MENU-MAP.
EXEC CICS
RECEIVE MAP('MENMAP1')
MAPSET('MENSET1')
INTO(MENMAP1I)
END-EXEC.
1200-EDIT-MENU-DATA.
IF ACTIONI NOT = '1' AND '2' AND '3'
MOVE ATTR-REVERSE TO ACTIONH
MOVE 'YOU MUST ENTER 1, 2, OR 3.' TO MESSAGEO
MOVE 'N' TO VALID-DATA-SW
ELSE
MOVE ACTIONI TO ACTION-ALPHA.
1300-BRANCH-TO-PROGRAM.
EXEC CICS
XCTL PROGRAM(PROGRAM-NAME(ACTION-NUM))
RESP(RESPONSE-CODE)
END-EXEC
*
MOVE LOW-VALUE TO MENMAP1O
MOVE 'THAT PROGRAM IS NOT AVAILABLE.' TO MESSAGEO
MOVE -1 TO ACTIONL.
1400-SEND-MENU-MAP.
IF SEND-ERASE
EXEC CICS
SEND MAP('MENMAP1')
MAPSET('MENSET1')
FROM(MENMAP1O)
ERASE
CURSOR
END-EXEC
ELSE IF SEND-DATAONLY
EXEC CICS
SEND MAP('MENMAP1')
MAPSET('MENSET1')
FROM(MENMAP1O)
DATAONLY
CURSOR
END-EXEC
ELSE IF SEND-DATAONLY-ALARM
EXEC CICS
SEND MAP('MENMAP1')

190/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

MAPSET('MENSET1')
FROM(MENMAP1O)
DATAONLY
CURSOR
END-EXEC.
2000-SEND-TERMINATION-MESSAGE.
EXEC CICS
SEND TEXT FROM(END-OF-SESSION-MESSAGE)
ERASE
FREEKB
END-EXEC.

191/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

The customer maintenance program

Program
CUSTMNT1

192/256
back

Overview

Maintains information in the customer master file by

allowing the user to enter new customers, change existing
customers, or delete existing customers.

Input /
Output
Specs

CUSTMAS
MNTMAP1
MNTMAP2

Processing
1. Control
INVMENU
program
program
map.

Customer master file

Customer maintenance key map
Customer maintenance data map

specifications
is transferred to this program
with no communication area.
by entering the transaction
should respond by displaying

via XCTL from

The user can
id MNT1. In
the customer

the menu program

also start the
either case the
maintenance key

2. On the key map the user selects a processing action (add, change or
delete ) and enters a customer number. Both the action field and the
customer number field must be entered. If the user selects add, the
customer number entered must not exist in the file. For change or
delete, the customer number must exist in the file.
3. If the user enters a valid combination of action and customer number,
display the customer data maintenance map. For an addition or a
change request, all data fields must be entered. For a delete
request, all fields are set to protected so the user cannot enter
changes.
4. If the user presses PF3 from either the key map or the data map,
return to the menu program INVMENU by issuing an XCTL command. If the
user presses PF12 from the key map, return to the menu program.
However if the user presses PF12 from the data map, redisplay the key
map without processing any data that was entered.
5. For a change or deletion, maintain an image of the customer record in
a TS queue between program executions. If the record is changed in
any way between program executions, notify the user and abort the
change or delete process.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

193/256

Event / response chart for the customer maintenance program

Event
Start
program
PF3

Context
n/a

Response
Display the key map

New context
Get key

All

n/a

PF12

Get key

PF12
Enter

Add customer
Change customer
Delete customer
Get key

Transfer control to the

menu program
Transfer control to the
menu program
Cancel the operation and
display the key map

Add, Change or
Delete customer

Enter

Add customer

Edit input data

If valid
Read customer record
Display the data map
Else
Display error message
Edit input data
If valid
Add customer record
Display the key map
Else
Display error message
Edit input data
If valid
Change customer record
Display the key map
Else
Display error message
Delete customer record
Display the key map
Redisplay
the
current
map
Ignore the key
Display an appropriate
Message

Unchanged

Enter

Change customer

Enter

Delete customer

Clear

All

PA1,
PA2, PA3
Any
other
key

All
All

n/a
Get key

Get key

Get key
Add customer

Get key
Change customer
Get key
Unchanged
Unchanged

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

194/256

Structure chart for the customer maintenance program

Process 0000
Customer
maintenance
1000
Process
Key
map

1100
Receive
Key
map

1200
Edit
Key
data

2000
Process
add
customer

1400
Send
Customer
map

3000
4000
1400
process
process
send
change
delete
customer
customer customer
map

1500
send
key
map

1300
read
customer
record

2100
receive
customer
map

2100
receive
customer
map

3100
read
customer
for update

2200
edit
customer
data

2200
edit
customer
data

2300
write
customer
record

3100
read
customer
for update

4100
delete
customer
record

1500
send
key
map

1500
send
key
map

3200
rewrite
customer
record

1400
send
customer
map

1400
send
customer
map

1500
send
key
map

1500
send
key
map

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

195/256

Mapset for the customer maintenance program

PRINT NOGEN
MNTSET1 DFHMSD TYPE=&SYSPARM,
X
LANG=COBOL,
X
MODE=INOUT,
X
TERM=3270-2,
X
CTRL=FREEKB,
X
STORAGE=AUTO,
X
DSATTS=(COLOR,HILIGHT),
X
MAPATTS=(COLOR,HILIGHT),
X
TIOAPFX=YES
***********************************************************************
MNTMAP1 DFHMDI SIZE=(24,80),
X
LINE=1,
X
COLUMN=1
***********************************************************************
DFHMDF POS=(1,1),
X
LENGTH=7,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='MNTMAP1'
DFHMDF POS=(1,20),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='CUSTOMER MAINTENANCE'
***********************************************************************
DFHMDF POS=(3,1),
X
LENGTH=63,
X
ATTRB=(NORM,PROT),
X
COLOR=NEUTRAL,
X
INITIAL='TYPE A CUSTOMER NUMBER. THEN SELECT AN ACTION X
AND PRESS ENTER.'
DFHMDF POS=(5,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='CUSTOMER NUMBER. . . . .'
CUSTNO1 DFHMDF POS=(5,26),
X
LENGTH=6,
X
ATTRB=(NORM,UNPROT,FSET),
X
COLOR=TURQUOISE,
X
INITIAL='______'
DFHMDF POS=(5,33),
X
LENGTH=1,
X
ATTRB=ASKIP
DFHMDF POS=(7,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='ACTION . . . . . . . . .'
ACTION
DFHMDF POS=(7,26),
X
LENGTH=1,
X
ATTRB=(NORM,NUM,FSET),
X
COLOR=TURQUOISE,
X
INITIAL='_'
DFHMDF POS=(7,28),
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

196/256

LENGTH=21,
X
ATTRB=(NORM,ASKIP),
X
COLOR=NEUTRAL,
X
INITIAL='1. ADD A NEW CUSTOMER'
DFHMDF POS=(8,28),
X
LENGTH=30,
X
ATTRB=(NORM,ASKIP),
X
COLOR=NEUTRAL,
X
INITIAL='2. CHANGE AN EXISTING CUSTOMER'
DFHMDF POS=(9,28),
X
LENGTH=21,
X
ATTRB=(NORM,ASKIP),
X
COLOR=NEUTRAL,
X
INITIAL='3. DELETE AN EXISTING CUSTOMER'
MSG1
DFHMDF POS=(23,1),
X
LENGTH=79,
X
ATTRB=(BRT,PROT),
X
COLOR=YELLOW
DFHMDF POS=(24,1),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='F3=EXIT
F12=CANCEL'
DUMMY1
DFHMDF POS=(24,79),
X
LENGTH=1,
X
ATTRB=(DRK,PROT,FSET),
X
INITIAL=' '
***********************************************************************
MNTMAP2 DFHMDI SIZE=(24,80),
X
LINE=1,
X
COLUMN=1
***********************************************************************
DFHMDF POS=(1,1),
X
LENGTH=7,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='MNTMAP2'
DFHMDF POS=(1,20),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='CUSTOMER MAINTENANCE'
***********************************************************************
INSTR2
DFHMDF POS=(3,1),
X
LENGTH=79,
X
ATTRB=(NORM,PROT),
X
COLOR=NEUTRAL
DFHMDF POS=(5,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='CUSTOMER NUMBER. . . . :'
CUSTNO2 DFHMDF POS=(5,26),
X
LENGTH=6,
X
ATTRB=(NORM,PROT,FSET),
X
COLOR=TURQUOISE
***********************************************************************

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

197/256

DFHMDF POS=(7,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='LAST NAME. . . . . . . .'
LNAME
DFHMDF POS=(7,26),
X
LENGTH=30,
X
ATTRB=(NORM,UNPROT,FSET),
X
COLOR=TURQUOISE
DFHMDF POS=(7,57),
X
LENGTH=1,
X
ATTRB=ASKIP
***********************************************************************
DFHMDF POS=(8,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='FIRST NAME . . . . . . .'
FNAME
DFHMDF POS=(8,26),
X
LENGTH=20,
X
ATTRB=(NORM,UNPROT,FSET),
X
COLOR=TURQUOISE
DFHMDF POS=(8,47),
X
LENGTH=1,
X
ATTRB=ASKIP
***********************************************************************
DFHMDF POS=(9,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='ADDRESS. . . . . . . . .'
ADDR
DFHMDF POS=(9,26),
X
LENGTH=30,
X
ATTRB=(NORM,UNPROT,FSET),
X
COLOR=TURQUOISE
DFHMDF POS=(9,57),
X
LENGTH=1,
X
ATTRB=ASKIP
***********************************************************************
DFHMDF POS=(10,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='CITY . . . . . . . . . .'
CITY
DFHMDF POS=(10,26),
X
LENGTH=20,
X
ATTRB=(NORM,UNPROT,FSET),
X
COLOR=TURQUOISE
DFHMDF POS=(10,47),
X
LENGTH=1,
X
ATTRB=ASKIP
***********************************************************************
DFHMDF POS=(11,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='STATE. . . . . . . . . .'

APPLICATION PROGRAMMING IN CICS BASIC

STATE

24/08/2003

198/256

DFHMDF POS=(11,26),
X
LENGTH=2,
X
ATTRB=(NORM,UNPROT,FSET),
X
COLOR=TURQUOISE
DFHMDF POS=(11,29),
X
LENGTH=1,
X
ATTRB=ASKIP
***********************************************************************
DFHMDF POS=(12,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='ZIP CODE . . . . . . . .'
ZIPCODE DFHMDF POS=(12,26),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT,FSET),
X
COLOR=TURQUOISE
DFHMDF POS=(12,37),
X
LENGTH=1,
X
ATTRB=ASKIP
***********************************************************************
MSG2
DFHMDF POS=(23,1),
X
LENGTH=79,
X
ATTRB=(BRT,PROT),
X
COLOR=YELLOW
DFHMDF POS=(24,1),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='F3=EXIT
F12=CANCEL'
DUMMY2
DFHMDF POS=(24,79),
X
LENGTH=1,
X
ATTRB=(DRK,PROT,FSET),
X
INITIAL=' '
***********************************************************************
DFHMSD TYPE=FINAL
END

APPLICATION PROGRAMMING IN CICS BASIC

MNTMAP1

24/08/2003

199/256

Customer Maintenance

Type a customer number.

Then select an action and press Enter.

Customer number. . . . . ______

Action . . . . . . . . . _ 1. Add a new customer
2. Change an existing customer
3. Delete an existing customer

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
F3=Exit
F12=Cancel

MNTMAP2

Customer Maintenance

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Customer number. . . . : XXXXXX
Last name.
First name
Address. .
City . . .
State. . .
Zip Code .

.
.
.
.
.
.

.
.
.
.
.
.

.
.
.
.
.
.

.
.
.
.
.
.

.
.
.
.
.
.

.
.
.
.
.
.

.
.
.
.
.
.

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XX
XXXXXXXXXX

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
F3=Exit
F12=Cancel
X

APPLICATION PROGRAMMING IN CICS BASIC

The symbolic map
*
MNTSET1 Mapset. Date - 05/01/92
01 MNTMAP1I.
02
FILLER
PIC X(12).
02
CUSTNO1L PIC S9(4) COMP.
02
CUSTNO1F PIC X.
02
FILLER REDEFINES CUSTNO1F.
03 CUSTNO1A PIC X.
02
FILLER
PIC X(0002).
02
CUSTNO1I PIC X(0006).
02
ACTIONL
PIC S9(4) COMP.
02
ACTIONF
PIC X.
02
FILLER REDEFINES ACTIONF.
03 ACTIONA
PIC X.
02
FILLER
PIC X(0002).
02
ACTIONI
PIC X(0001).
02
MSG1L
PIC S9(4) COMP.
02
MSG1F
PIC X.
02
FILLER REDEFINES MSG1F.
03 MSG1A
PIC X.
02
FILLER
PIC X(0002).
02
MSG1I
PIC X(0079).
02
DUMMY1L
PIC S9(4) COMP.
02
DUMMY1F
PIC X.
02
FILLER REDEFINES DUMMY1F.
03 DUMMY1A
PIC X.
02
FILLER
PIC X(0002).
02
DUMMY1I
PIC X(0001).
01 MNTMAP1O REDEFINES MNTMAP1I.
02
FILLER
PIC X(12).
02
FILLER
PIC X(3).
02
CUSTNO1C PIC X.
02
CUSTNO1H PIC X.
02
CUSTNO1O PIC X(0006).
02
FILLER
PIC X(3).
02
ACTIONC
PIC X.
02
ACTIONH
PIC X.
02
ACTIONO
PIC X(0001).
02
FILLER
PIC X(3).
02
MSG1C
PIC X.
02
MSG1H
PIC X.
02
MSG1O
PIC X(0079).
02
FILLER
PIC X(3).
02
DUMMY1C
PIC X.
02
DUMMY1H
PIC X.
02
DUMMY1O
PIC X(0001).
01 MNTMAP2I.
02
FILLER
PIC X(12).
02
INSTR2L
PIC S9(4) COMP.
02
INSTR2F
PIC X.
02
FILLER REDEFINES INSTR2F.
03 INSTR2A
PIC X.
02
FILLER
PIC X(0002).
02
INSTR2I
PIC X(0079).
02
CUSTNO2L PIC S9(4) COMP.
02
CUSTNO2F PIC X.
02
FILLER REDEFINES CUSTNO2F.

24/08/2003

Time -

9:52:58

200/256

APPLICATION PROGRAMMING IN CICS BASIC

01

03 CUSTNO2A PIC X.
02
FILLER
PIC X(0002).
02
CUSTNO2I PIC X(0006).
02
LNAMEL
PIC S9(4) COMP.
02
LNAMEF
PIC X.
02
FILLER REDEFINES LNAMEF.
03 LNAMEA
PIC X.
02
FILLER
PIC X(0002).
02
LNAMEI
PIC X(0030).
02
FNAMEL
PIC S9(4) COMP.
02
FNAMEF
PIC X.
02
FILLER REDEFINES FNAMEF.
03 FNAMEA
PIC X.
02
FILLER
PIC X(0002).
02
FNAMEI
PIC X(0020).
02
ADDRL
PIC S9(4) COMP.
02
ADDRF
PIC X.
02
FILLER REDEFINES ADDRF.
03 ADDRA
PIC X.
02
FILLER
PIC X(0002).
02
ADDRI
PIC X(0030).
02
CITYL
PIC S9(4) COMP.
02
CITYF
PIC X.
02
FILLER REDEFINES CITYF.
03 CITYA
PIC X.
02
FILLER
PIC X(0002).
02
CITYI
PIC X(0020).
02
STATEL
PIC S9(4) COMP.
02
STATEF
PIC X.
02
FILLER REDEFINES STATEF.
03 STATEA
PIC X.
02
FILLER
PIC X(0002).
02
STATEI
PIC X(0002).
02
ZIPCODEL PIC S9(4) COMP.
02
ZIPCODEF PIC X.
02
FILLER REDEFINES ZIPCODEF.
03 ZIPCODEA PIC X.
02
FILLER
PIC X(0002).
02
ZIPCODEI PIC X(0010).
02
MSG2L
PIC S9(4) COMP.
02
MSG2F
PIC X.
02
FILLER REDEFINES MSG2F.
03 MSG2A
PIC X.
02
FILLER
PIC X(0002).
02
MSG2I
PIC X(0079).
02
DUMMY2L
PIC S9(4) COMP.
02
DUMMY2F
PIC X.
02
FILLER REDEFINES DUMMY2F.
03 DUMMY2A
PIC X.
02
FILLER
PIC X(0002).
02
DUMMY2I
PIC X(0001).
MNTMAP2O REDEFINES MNTMAP2I.
02
FILLER
PIC X(12).
02
FILLER
PIC X(3).
02
INSTR2C
PIC X.
02
INSTR2H
PIC X.
02
INSTR2O
PIC X(0079).

24/08/2003

201/256

APPLICATION PROGRAMMING IN CICS BASIC

02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02
02

FILLER
CUSTNO2C
CUSTNO2H
CUSTNO2O
FILLER
LNAMEC
LNAMEH
LNAMEO
FILLER
FNAMEC
FNAMEH
FNAMEO
FILLER
ADDRC
ADDRH
ADDRO
FILLER
CITYC
CITYH
CITYO
FILLER
STATEC
STATEH
STATEO
FILLER
ZIPCODEC
ZIPCODEH
ZIPCODEO
FILLER
MSG2C
MSG2H
MSG2O
FILLER
DUMMY2C
DUMMY2H
DUMMY2O

PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X(3).
X.
X.
X(0006).
X(3).
X.
X.
X(0030).
X(3).
X.
X.
X(0020).
X(3).
X.
X.
X(0030).
X(3).
X.
X.
X(0020).
X(3).
X.
X.
X(0002).
X(3).
X.
X.
X(0010).
X(3).
X.
X.
X(0079).
X(3).
X.
X.
X(0001).

The other COPY books

01 CUSTOMER-MASTER-RECORD.
*
05 CM-CUSTOMER-NUMBER
05 CM-FIRST-NAME
05 CM-LAST-NAME
05 CM-ADDRESS
05 CM-CITY
05 CM-STATE
05 CM-ZIP-CODE
01
*

24/08/2003

PIC
PIC
PIC
PIC
PIC
PIC
PIC

X(6).
X(20).
X(30).
X(30).
X(20).
X(2).
X(10).

ATTRIBUTE-DEFINITIONS.
05
05
05
05
05
05

ATTR-UNPROT
ATTR-UNPROT-MDT
ATTR-UNPROT-BRT
ATTR-UNPROT-BRT-MDT
ATTR-UNPROT-DARK
ATTR-UNPROT-DARK-MDT

PIC
PIC
PIC
PIC
PIC
PIC

X
X
X
X
X
X

VALUE
VALUE
VALUE
VALUE
VALUE
VALUE

' '.
X'C1'.
X'C8'.
X'C9'.
X'4C'.
X'4D'.

202/256

APPLICATION PROGRAMMING IN CICS BASIC

01
*

24/08/2003

05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05
05

ATTR-UNPROT-NUM
ATTR-UNPROT-NUM-MDT
ATTR-UNPROT-NUM-BRT
ATTR-UNPROT-NUM-BRT-MDT
ATTR-UNPROT-NUM-DARK
ATTR-UNPROT-NUM-DARK-MDT
ATTR-PROT
ATTR-PROT-MDT
ATTR-PROT-BRT
ATTR-PROT-BRT-MDT
ATTR-PROT-DARK
ATTR-PROT-DARK-MDT
ATTR-PROT-SKIP
ATTR-PROT-SKIP-MDT
ATTR-PROT-SKIP-BRT
ATTR-PROT-SKIP-BRT-MDT
ATTR-PROT-SKIP-DARK
ATTR-PROT-SKIP-DARK-MDT

PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X

VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE

X'50'.
X'D1'.
X'D8'.
X'D9'.
X'5C'.
X'5D'.
X'60'.
X'61'.
X'E8'.
X'E9'.
'%'.
X'6D'.
X'F0'.
X'F1'.
X'F8'.
X'F9'.
X'7C'.
X'7D'.

05
05
05
05

ATTR-NO-HIGHLIGHT
ATTR-BLINK
ATTR-REVERSE
ATTR-UNDERSCORE

PIC
PIC
PIC
PIC

X
X
X
X

VALUE
VALUE
VALUE
VALUE

X'00'.
'1'.
'2'.
'4'.

05
05
05
05
05
05
05
05

ATTR-DEFAULT-COLOR
ATTR-BLUE
ATTR-RED
ATTR-PINK
ATTR-GREEN
ATTR-TURQUOISE
ATTR-YELLOW
ATTR-NEUTRAL

PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X
X
X
X
X
X
X
X

VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE

X'00'.
'1'.
'2'.
'3'.
'4'.
'5'.
'6'.
'7'.

ERROR-PARAMETERS.
05
05
05
05

ERR-RESP
ERR-RESP2
ERR-TRNID
ERR-RSRCE

PIC
PIC
PIC
PIC

S9(8)
S9(8)
X(4).
X(8).

COMP.
COMP.

203/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

204/256

The CUSTMNT1 program

IDENTIFICATION DIVISION.
PROGRAM-ID. CUSTMNT1.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SWITCHES.
05 VALID-DATA-SW
PIC X VALUE 'Y'.
88 VALID-DATA
VALUE 'Y'.
01 FLAGS.
05 SEND-FLAG
PIC X.
88 SEND-ERASE
VALUE '1'.
88 SEND-ERASE-ALARM
VALUE '2'.
88 SEND-DATAONLY
VALUE '3'.
88 SEND-DATAONLY-ALARM
VALUE '4'.
01 WORK-FIELDS.
05 RESPONSE-CODE
PIC S9(8) COMP.
01 COMMUNICATION-AREA.
05 CA-CONTEXT-FLAG
PIC X.
88 PROCESS-KEY-MAP
VALUE '1'.
88 PROCESS-ADD-CUSTOMER
VALUE '2'.
88 PROCESS-CHANGE-CUSTOMER
VALUE '3'.
88 PROCESS-DELETE-CUSTOMER
VALUE '4'.
01 TEMPORARY-STORAGE-FIELDS.
05 TS-QUEUE-NAME.
10 TS-TERMINAL-ID
PIC X(4).
10 FILLER
PIC X(4) VALUE 'MNT1'.
05 TS-ITEM-NUMBER
PIC S9(4) COMP VALUE +1.
05 TS-CUSTOMER-RECORD.
10 TS-CUSTOMER-NUMBER
PIC X(6).
10 FILLER
PIC X(112).
05 TS-RECORD-LENGTH
PIC S9(4) COMP VALUE 118.
COPY CUSTMAS.
COPY MNTSET1.
COPY DFHAID.
COPY ATTR.
COPY ERRPARM.
LINKAGE SECTION.
01 DFHCOMMAREA
PIC X.
PROCEDURE DIVISION.
0000-PROCESS-CUSTOMER-MAINT.
MOVE DFHCOMMAREA TO COMMUNICATION-AREA.
MOVE EIBTRMID
TO TS-TERMINAL-ID.
EVALUATE TRUE
WHEN EIBCALEN = ZERO
MOVE LOW-VALUE TO TS-CUSTOMER-RECORD
EXEC CICS
WRITEQ TS QUEUE(TS-QUEUE-NAME)
FROM(TS-CUSTOMER-RECORD)
END-EXEC
MOVE LOW-VALUE TO MNTMAP1O
MOVE -1 TO CUSTNO1L
SET SEND-ERASE TO TRUE
PERFORM 1500-SEND-KEY-MAP
SET PROCESS-KEY-MAP TO TRUE
WHEN EIBAID = DFHPF3
EXEC CICS

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

DELETEQ TS QUEUE(TS-QUEUE-NAME)
END-EXEC
EXEC CICS
XCTL PROGRAM('INVMENU')
END-EXEC
WHEN EIBAID = DFHPF12
IF PROCESS-KEY-MAP
EXEC CICS
DELETEQ TS QUEUE(TS-QUEUE-NAME)
END-EXEC
EXEC CICS
XCTL PROGRAM('INVMENU')
END-EXEC
ELSE
MOVE LOW-VALUE TO MNTMAP1O
MOVE -1 TO CUSTNO1L
SET SEND-ERASE TO TRUE
PERFORM 1500-SEND-KEY-MAP
SET PROCESS-KEY-MAP TO TRUE
END-IF
WHEN EIBAID = DFHCLEAR
IF PROCESS-KEY-MAP
MOVE LOW-VALUE TO MNTMAP1O
MOVE -1 TO CUSTNO1L
SET SEND-ERASE TO TRUE
PERFORM 1500-SEND-KEY-MAP
ELSE
MOVE LOW-VALUE TO MNTMAP2O
MOVE -1 TO CUSTNO2L
SET SEND-ERASE TO TRUE
PERFORM 1400-SEND-CUSTOMER-MAP
END-IF
WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
CONTINUE
WHEN EIBAID = DFHENTER
IF PROCESS-KEY-MAP
PERFORM 1000-PROCESS-KEY-MAP
ELSE IF PROCESS-ADD-CUSTOMER
PERFORM 2000-PROCESS-ADD-CUSTOMER
ELSE IF PROCESS-CHANGE-CUSTOMER
PERFORM 3000-PROCESS-CHANGE-CUSTOMER
ELSE IF PROCESS-DELETE-CUSTOMER
PERFORM 4000-PROCESS-DELETE-CUSTOMER
END-IF
END-IF
END-IF
END-IF
WHEN OTHER
IF PROCESS-KEY-MAP
MOVE LOW-VALUE TO MNTMAP1O
MOVE -1 TO CUSTNO1L
MOVE 'THAT KEY IS UNASSIGNED.' TO MSG1O
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1500-SEND-KEY-MAP
ELSE
MOVE LOW-VALUE TO MNTMAP2O
MOVE -1 TO CUSTNO2L

205/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

MOVE 'THAT KEY IS UNASSIGNED.' TO MSG2O

SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1400-SEND-CUSTOMER-MAP
END-IF
END-EVALUATE.
EXEC CICS
RETURN TRANSID('MNT1')
COMMAREA(COMMUNICATION-AREA)
END-EXEC.
1000-PROCESS-KEY-MAP.
PERFORM 1100-RECEIVE-KEY-MAP.
PERFORM 1200-EDIT-KEY-DATA.
IF VALID-DATA
MOVE LOW-VALUE TO MNTMAP2O
INSPECT CUSTOMER-MASTER-RECORD
REPLACING ALL SPACE BY '_'
MOVE CUSTNO1I
TO CUSTNO2O
MOVE CM-LAST-NAME TO LNAMEO
MOVE CM-FIRST-NAME TO FNAMEO
MOVE CM-ADDRESS
TO ADDRO
MOVE CM-CITY
TO CITYO
MOVE CM-STATE
TO STATEO
MOVE CM-ZIP-CODE
TO ZIPCODEO
MOVE -1
TO LNAMEL
SET SEND-ERASE TO TRUE
PERFORM 1400-SEND-CUSTOMER-MAP
ELSE
MOVE LOW-VALUE TO CUSTNO1O
ACTIONO
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1500-SEND-KEY-MAP
END-IF.
1100-RECEIVE-KEY-MAP.
EXEC CICS
RECEIVE MAP('MNTMAP1')
MAPSET('MNTSET1')
INTO(MNTMAP1I)
END-EXEC.
INSPECT MNTMAP1I
REPLACING ALL '_' BY SPACE.
1200-EDIT-KEY-DATA.
MOVE ATTR-NO-HIGHLIGHT TO ACTIONH
CUSTNO1H.
IF ACTIONI NOT = '1' AND '2' AND '3'
MOVE ATTR-REVERSE TO ACTIONH
MOVE -1 TO ACTIONL
MOVE 'ACTION MUST BE 1, 2, OR 3.' TO MSG1O
MOVE 'N' TO VALID-DATA-SW
END-IF
IF
CUSTNO1L = ZERO
OR CUSTNO1I = SPACE
MOVE ATTR-REVERSE TO CUSTNO1H
MOVE -1 TO CUSTNO1L
MOVE 'YOU MUST ENTER A CUSTOMER NUMBER.' TO MSG1O
MOVE 'N' TO VALID-DATA-SW
END-IF
IF VALID-DATA

206/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

207/256

EVALUATE ACTIONI
WHEN '1'
PERFORM 1300-READ-CUSTOMER-RECORD
IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'TYPE INFORMATION FOR NEW CUSTOMER. THE
'N PRESS ENTER.' TO INSTR2O
SET PROCESS-ADD-CUSTOMER TO TRUE
MOVE SPACE TO CUSTOMER-MASTER-RECORD
ELSE
MOVE 'THAT CUSTOMER ALREADY EXISTS.'
TO MSG1O
MOVE 'N' TO VALID-DATA-SW
END-IF
WHEN '2'
PERFORM 1300-READ-CUSTOMER-RECORD
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'TYPE CHANGES. THEN PRESS ENTER.'
TO INSTR2O
SET PROCESS-CHANGE-CUSTOMER TO TRUE
ELSE
MOVE 'THAT CUSTOMER DOES NOT EXIST.' TO MSG1O
MOVE 'N' TO VALID-DATA-SW
END-IF
WHEN '3'
PERFORM 1300-READ-CUSTOMER-RECORD
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'PRESS ENTER TO DELETE THIS CUSTOMER OR
'PRESS F12 TO CANCEL.' TO INSTR2O
SET PROCESS-DELETE-CUSTOMER TO TRUE
MOVE ATTR-PROT TO LNAMEA
FNAMEA
ADDRA
CITYA
STATEA
ZIPCODEA
ELSE
MOVE 'THAT CUSTOMER DOES NOT EXIST.' TO MSG1O
MOVE 'N' TO VALID-DATA-SW
END-IF
END-EVALUATE
END-IF.
1300-READ-CUSTOMER-RECORD.
EXEC CICS
READ DATASET('CUSTMAS')
INTO(CUSTOMER-MASTER-RECORD)
RIDFLD(CUSTNO1I)
RESP(RESPONSE-CODE)
END-EXEC.
IF
RESPONSE-CODE NOT = DFHRESP(NORMAL)
AND RESPONSE-CODE NOT = DFHRESP(NOTFND)
GO TO 9999-TERMINATE-PROGRAM
END-IF
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE CUSTOMER-MASTER-RECORD TO TS-CUSTOMER-RECORD
EXEC CICS
WRITEQ TS QUEUE(TS-QUEUE-NAME)
FROM(TS-CUSTOMER-RECORD)

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

ITEM(TS-ITEM-NUMBER)
REWRITE
END-EXEC
END-IF.
1400-SEND-CUSTOMER-MAP.
EVALUATE TRUE
WHEN SEND-ERASE
EXEC CICS
SEND MAP('MNTMAP2')
MAPSET('MNTSET1')
FROM(MNTMAP2O)
ERASE
CURSOR
END-EXEC
WHEN SEND-DATAONLY-ALARM
EXEC CICS
SEND MAP('MNTMAP2')
MAPSET('MNTSET1')
FROM(MNTMAP2O)
DATAONLY
CURSOR
END-EXEC
END-EVALUATE.
1500-SEND-KEY-MAP.
EVALUATE TRUE
WHEN SEND-ERASE
EXEC CICS
SEND MAP('MNTMAP1')
MAPSET('MNTSET1')
FROM(MNTMAP1O)
ERASE
CURSOR
END-EXEC
WHEN SEND-ERASE-ALARM
EXEC CICS
SEND MAP('MNTMAP1')
MAPSET('MNTSET1')
FROM(MNTMAP1O)
ERASE
CURSOR
END-EXEC
WHEN SEND-DATAONLY-ALARM
EXEC CICS
SEND MAP('MNTMAP1')
MAPSET('MNTSET1')
FROM(MNTMAP1O)
DATAONLY
CURSOR
END-EXEC
END-EVALUATE.
2000-PROCESS-ADD-CUSTOMER.
PERFORM 2100-RECEIVE-CUSTOMER-MAP.
PERFORM 2200-EDIT-CUSTOMER-DATA.
IF VALID-DATA
PERFORM 2300-WRITE-CUSTOMER-RECORD
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'CUSTOMER RECORD ADDED.' TO MSG1O

208/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

209/256

SET SEND-ERASE TO TRUE

ELSE

MOVE 'ANOTHER USER HAS ADDED A RECORD WITH THAT CUSTO

'MER NUMBER.' TO MSG1O
SET SEND-ERASE-ALARM TO TRUE
END-IF
PERFORM 1500-SEND-KEY-MAP
SET PROCESS-KEY-MAP TO TRUE

ELSE

MOVE LOW-VALUE TO LNAMEO

FNAMEO
ADDRO
CITYO
STATEO
ZIPCODEO
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1400-SEND-CUSTOMER-MAP
END-IF.
2100-RECEIVE-CUSTOMER-MAP.
EXEC CICS
RECEIVE MAP('MNTMAP2')
MAPSET('MNTSET1')
INTO(MNTMAP2I)
END-EXEC.
INSPECT MNTMAP2I
REPLACING ALL '_' BY SPACE.
2200-EDIT-CUSTOMER-DATA.
MOVE ATTR-NO-HIGHLIGHT TO ZIPCODEH
STATEH
CITYH
ADDRH
FNAMEH
LNAMEH.
IF
ZIPCODEI = SPACE
OR ZIPCODEL = ZERO
MOVE ATTR-REVERSE TO ZIPCODEH
MOVE -1 TO ZIPCODEL
MOVE 'YOU MUST ENTER A ZIP CODE.' TO MSG2O
MOVE 'N' TO VALID-DATA-SW
END-IF
IF
STATEI = SPACE
OR STATEL = ZERO
MOVE ATTR-REVERSE TO STATEH
MOVE -1 TO STATEL
MOVE 'YOU MUST ENTER A STATE.' TO MSG2O
MOVE 'N' TO VALID-DATA-SW
END-IF
IF
CITYI = SPACE
OR CITYL = ZERO
MOVE ATTR-REVERSE TO CITYH
MOVE -1 TO CITYL
MOVE 'YOU MUST ENTER A CITY.' TO MSG2O
MOVE 'N' TO VALID-DATA-SW
END-IF
IF
ADDRI = SPACE
OR ADDRL = ZERO
MOVE ATTR-REVERSE TO ADDRH

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

210/256

MOVE -1 TO ADDRL
MOVE 'YOU MUST ENTER AN ADDRESS.' TO MSG2O
MOVE 'N' TO VALID-DATA-SW
END-IF
IF
FNAMEI = SPACE
OR FNAMEL = ZERO
MOVE ATTR-REVERSE TO FNAMEH
MOVE -1 TO FNAMEL
MOVE 'YOU MUST ENTER A FIRST NAME.' TO MSG2O
MOVE 'N' TO VALID-DATA-SW
END-IF
IF
LNAMEI = SPACE
OR LNAMEL = ZERO
MOVE ATTR-REVERSE TO LNAMEH
MOVE -1 TO LNAMEL
MOVE 'YOU MUST ENTER A LAST NAME.' TO MSG2O
MOVE 'N' TO VALID-DATA-SW
END-IF.
2300-WRITE-CUSTOMER-RECORD.
MOVE CUSTNO2I TO CM-CUSTOMER-NUMBER.
MOVE LNAMEI
TO CM-LAST-NAME.
MOVE FNAMEI
TO CM-FIRST-NAME.
MOVE ADDRI
TO CM-ADDRESS.
MOVE CITYI
TO CM-CITY.
MOVE STATEI
TO CM-STATE.
MOVE ZIPCODEI TO CM-ZIP-CODE.
EXEC CICS
WRITE DATASET('CUSTMAS')
FROM(CUSTOMER-MASTER-RECORD)
RIDFLD(CM-CUSTOMER-NUMBER)
RESP(RESPONSE-CODE)
END-EXEC.
IF
RESPONSE-CODE NOT = DFHRESP(NORMAL)
AND RESPONSE-CODE NOT = DFHRESP(DUPREC)
GO TO 9999-TERMINATE-PROGRAM
END-IF.
3000-PROCESS-CHANGE-CUSTOMER.
PERFORM 2100-RECEIVE-CUSTOMER-MAP.
PERFORM 2200-EDIT-CUSTOMER-DATA.
IF VALID-DATA
MOVE CUSTNO2I TO CM-CUSTOMER-NUMBER
PERFORM 3100-READ-CUSTOMER-FOR-UPDATE
IF RESPONSE-CODE = DFHRESP(NORMAL)
EXEC CICS
READQ TS QUEUE(TS-QUEUE-NAME)
INTO(TS-CUSTOMER-RECORD)
LENGTH(TS-RECORD-LENGTH)
ITEM(TS-ITEM-NUMBER)
END-EXEC
IF CUSTOMER-MASTER-RECORD = TS-CUSTOMER-RECORD
PERFORM 3200-REWRITE-CUSTOMER-RECORD
MOVE 'CUSTOMER RECORD UPDATED.' TO MSG1O
SET SEND-ERASE TO TRUE
ELSE
MOVE 'ANOTHER USER HAS UPDATED THE RECORD.
'GAIN.' TO MSG1O
SET SEND-ERASE-ALARM TO TRUE

TRY A

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

211/256

END-IF

ELSE

MOVE 'ANOTHER USER HAS DELETED THE RECORD.' TO MSG1O

SET SEND-ERASE-ALARM TO TRUE
END-IF
PERFORM 1500-SEND-KEY-MAP
SET PROCESS-KEY-MAP TO TRUE

ELSE

SET SEND-DATAONLY-ALARM TO TRUE

PERFORM 1400-SEND-CUSTOMER-MAP
END-IF.
3100-READ-CUSTOMER-FOR-UPDATE.
EXEC CICS
READ DATASET('CUSTMAS')
INTO(CUSTOMER-MASTER-RECORD)
RIDFLD(CM-CUSTOMER-NUMBER)
UPDATE
RESP(RESPONSE-CODE)
END-EXEC.
IF
RESPONSE-CODE NOT = DFHRESP(NORMAL)
AND RESPONSE-CODE NOT = DFHRESP(NOTFND)
GO TO 9999-TERMINATE-PROGRAM
END-IF.
3200-REWRITE-CUSTOMER-RECORD.
MOVE LNAMEI
TO CM-LAST-NAME.
MOVE FNAMEI
TO CM-FIRST-NAME.
MOVE ADDRI
TO CM-ADDRESS.
MOVE CITYI
TO CM-CITY.
MOVE STATEI
TO CM-STATE.
MOVE ZIPCODEI TO CM-ZIP-CODE.
EXEC CICS
REWRITE DATASET('CUSTMAS')
FROM(CUSTOMER-MASTER-RECORD)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
GO TO 9999-TERMINATE-PROGRAM
END-IF.
4000-PROCESS-DELETE-CUSTOMER.
EXEC CICS
READQ TS QUEUE(TS-QUEUE-NAME)
INTO(TS-CUSTOMER-RECORD)
LENGTH(TS-RECORD-LENGTH)
ITEM(TS-ITEM-NUMBER)
END-EXEC.
MOVE TS-CUSTOMER-NUMBER TO CM-CUSTOMER-NUMBER.
PERFORM 3100-READ-CUSTOMER-FOR-UPDATE.
IF RESPONSE-CODE = DFHRESP(NORMAL)
IF CUSTOMER-MASTER-RECORD = TS-CUSTOMER-RECORD
PERFORM 4100-DELETE-CUSTOMER-RECORD
MOVE 'CUSTOMER DELETED.' TO MSG1O
SET SEND-ERASE TO TRUE
ELSE
MOVE 'ANOTHER USER HAS UPDATED THE RECORD.
'.' TO MSG1O
SET SEND-ERASE-ALARM TO TRUE
END-IF

TRY AGAIN

APPLICATION PROGRAMMING IN CICS BASIC

ELSE

24/08/2003

212/256

MOVE 'ANOTHER USER HAS DELETED THE RECORD.' TO MSG1O

SET SEND-ERASE-ALARM TO TRUE
END-IF
PERFORM 1500-SEND-KEY-MAP
SET PROCESS-KEY-MAP TO TRUE.
4100-DELETE-CUSTOMER-RECORD.
EXEC CICS
DELETE DATASET('CUSTMAS')
RESP(RESPONSE-CODE)
END-EXEC.
IF
RESPONSE-CODE NOT = DFHRESP(NORMAL)
GO TO 9999-TERMINATE-PROGRAM
END-IF.
9999-TERMINATE-PROGRAM.
MOVE EIBRESP TO ERR-RESP.
MOVE EIBRESP2 TO ERR-RESP2.
MOVE EIBTRNID TO ERR-TRNID.
MOVE EIBRSRCE TO ERR-RSRCE.
EXEC CICS
XCTL PROGRAM('SYSERR')
COMMAREA(ERROR-PARAMETERS)
END-EXEC.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

The Order Entry Program

Program
ORDRENT1

213/256
back

Overview

Writes orders to an invoice file based on data entered by

the user

Input /
Output

INVOICE
CUSTMAS
INVCTL
PRODUCT
ORDMAP1

Specs

Invoice file
Customer Master File
Keeps track of running invoice number
Product (inventory) file
Order entry map

Processing Specifications
1. Control is transferred to this program via XCTL from the main program
INVMENU with no communication area. The user can also invoke this
program directly by entering the transaction id ORD1. In either case
the program should respond by displaying the order entry map.
2. On the order entry map, the user enters a customer number, a p/o
number, and data for up to 10 line items. The order entry program
edits the data according to the rules listed in step 3. If the data
is valid, the program displays the map with all fields protected. The
user can post the order by pressing the enter key or make additional
changes by pressing PF4. If the user presses PF4 the program should
unprotect the entry fields and permit the user to make the changes.
If the user presses PF12, the program should cancel the order and
redisplay the entry screens with blank fields. The user ends the
program by pressing PF3.
3. Order entry data is validated as below
Customer number
must be in the customer file
Product code
must be in the product file
Quantity
must be a valid integer(call the INTEDIT user
subprogram)
Net price
must be a valid decimal number(call the NUMEDIT
user subprogram)
In addition the following cross validations are made
a) If the user enters a product code, he must also enter a quantity
for that line
b) The user cannot enter a quantity or net price on a line where he
did not enter a product code
c) The user must enter at least one line item
4. If the user does not enter a net price, use the list price from the
appropriate product record.
5. To obtain the invoice number, invoke the GETINV program with a LINK
command
6. Use the data stored in the CWA for the invoice date field

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

214/256

7. When the user exits the program, display a total of the number of
orders entered before returning to the menu.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

215/256

Event / response chart for the order entry program

Event
Start the
program
PF3

Context
n/a

Response
Display the order map

All

PF12

Process entry

PF12

Process verify

Enter

Process entry

Enter

Process verify

PF4

Process entry

PF4

Process verify

Clear

All

Transfer control to the menu

program
Transfer control to the menu
program
Cancel the order and
redisplay the order map with
entry fields unprotected
Edit input data
If valid
Protect all fields
Display confirmation info
Else
Display error message
Get the invoice number
Write the order record
Redisplay the order map with
entry fields unprotected
Display invalid key
message
Redisplay the order map with
fields unprotected
Redisplay the map

PA1, PA2,
or PA3
Any other
key

All

Ignore the key

All

Display an appropriate error

message

New context
Process
entry
n/a
n/a
Process
entry
Process
verify
Process
Entry
Process
entry
Unchanged
Process
entry
Process
entry
Unchanged
unchanged

APPLICATION PROGRAMMING IN CICS BASIC

The Structure Chart for the

24/08/2003

216/256

order entry program

0000
Process
Order
entry

1000
Process
Order
map

1100
receive
Order
map

1210
read
customer
record

1400
send
Order
map

1200
edit
Order
data

1220
edit
line
item

1230
read
product
record

1300
format
invoice
record

2000
Process
post
order

1400
send
Order
map

1410
set
attributes

GETINV
get
invoice
number

1420
reset
attributes

3000
send
total
line

2100
write
invoice
record

1400
send
Order
map

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

217/256

The BMS source for the order entry program

PRINT NOGEN
ORDSET1 DFHMSD TYPE=&SYSPARM,
X
LANG=COBOL,
X
MODE=INOUT,
X
TERM=3270-2,
X
CTRL=FREEKB,
X
STORAGE=AUTO,
X
DSATTS=(COLOR,HILIGHT),
X
MAPATTS=(COLOR,HILIGHT),
X
TIOAPFX=YES
***********************************************************************
ORDMAP1 DFHMDI SIZE=(24,80),
X
LINE=1,
X
COLUMN=1
***********************************************************************
DFHMDF POS=(1,1),
X
LENGTH=8,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='ORDMAP1'
DFHMDF POS=(1,20),
X
LENGTH=11,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='ORDER ENTRY'
***********************************************************************
INSTR
DFHMDF POS=(3,1),
X
LENGTH=79,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN
DFHMDF POS=(5,1),
X
LENGTH=21,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='CUSTOMER NUMBER . . .'
CUSTNO
DFHMDF POS=(5,23),
X
LENGTH=6,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='______'
DFHMDF POS=(5,30),
X
LENGTH=1,
X
ATTRB=ASKIP
DFHMDF POS=(5,36),
X
LENGTH=9,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='CUSTOMER:'
LNAME
DFHMDF POS=(5,46),
X
LENGTH=30,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
DFHMDF POS=(6,1),
X
LENGTH=21,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

218/256

INITIAL='P.O. NUMBER . . . . .'

DFHMDF POS=(6,23),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(6,34),
X
LENGTH=1,
X
ATTRB=ASKIP
FNAME
DFHMDF POS=(6,46),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
ADDR
DFHMDF POS=(7,46),
X
LENGTH=30,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
CITY
DFHMDF POS=(8,46),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
STATE
DFHMDF POS=(8,67),
X
LENGTH=2,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
ZIPCODE DFHMDF POS=(8,70),
X
LENGTH=10,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
DFHMDF POS=(10,1),
X
LENGTH=33,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='PROD CODE
QTY
DESCRIPTION'
DFHMDF POS=(10,49),
X
LENGTH=29,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL=' LIST
NET
AMOUNT'
***********************************************************************
*
LINE PCODE 1
*
***********************************************************************
PCODE1
DFHMDF POS=(11,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(11,13),
X
LENGTH=1,
X
ATTRB=ASKIP
QTY1
DFHMDF POS=(11,15),
X
LENGTH=5,
X
ATTRB=(NORM,UNPROT,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(11,21),
X
LENGTH=1,
X
PO

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

219/256

ATTRB=ASKIP
DFHMDF POS=(11,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST1
DFHMDF POS=(11,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET1
DFHMDF POS=(11,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT1
DFHMDF POS=(11,68),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 2
*
***********************************************************************
PCODE2
DFHMDF POS=(12,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(12,13),
X
LENGTH=1,
X
ATTRB=ASKIP
QTY2
DFHMDF POS=(12,15),
X
LENGTH=5,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(12,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC2
DFHMDF POS=(12,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST2
DFHMDF POS=(12,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET2
DFHMDF POS=(12,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT2
DFHMDF POS=(12,68),
X
LENGTH=12,
X
DESC1

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

220/256

ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 3
*
***********************************************************************
PCODE3
DFHMDF POS=(13,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(13,13),
X
LENGTH=1,
X
ATTRB=ASKIP
QTY3
DFHMDF POS=(13,15),
X
LENGTH=5,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(13,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC3
DFHMDF POS=(13,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST3
DFHMDF POS=(13,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET3
DFHMDF POS=(13,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT3
DFHMDF POS=(13,68),
LENGTH=12,
ATTRB=(NORM,PROT),
COLOR=TURQUOISE,
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 4
*
***********************************************************************
PCODE4
DFHMDF POS=(14,1),
LENGTH=10,
ATTRB=(NORM,UNPROT),
COLOR=TURQUOISE,
INITIAL='__________'
DFHMDF POS=(14,13),
LENGTH=1,
ATTRB=ASKIP
QTY4
DFHMDF POS=(14,15),
LENGTH=5,
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

221/256

INITIAL='_____'
DFHMDF POS=(14,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC4
DFHMDF POS=(14,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST4
DFHMDF POS=(14,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET4
DFHMDF POS=(14,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT4
DFHMDF POS=(14,68),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 5
*
***********************************************************************
PCODE5
DFHMDF POS=(15,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(15,13),
X
LENGTH=1,
X
ATTRB=ASKIP
QTY5
DFHMDF POS=(15,15),
X
LENGTH=5,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(15,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC5
DFHMDF POS=(15,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST5
DFHMDF POS=(15,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET5
DFHMDF POS=(15,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

222/256

INITIAL='__________'
DFHMDF POS=(15,68),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 6
*
***********************************************************************
PCODE6
DFHMDF POS=(16,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(16,13),
X
LENGTH=1,
X
ATTRB=ASKIP
QTY6
DFHMDF POS=(16,15),
X
LENGTH=5,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(16,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC6
DFHMDF POS=(16,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST6
DFHMDF POS=(16,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET6
DFHMDF POS=(16,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT6
DFHMDF POS=(16,68),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 7
*
***********************************************************************
PCODE7
DFHMDF POS=(17,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(17,13),
X
LENGTH=1,
X
ATTRB=ASKIP
QTY7
DFHMDF POS=(17,15),
X
AMT5

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

223/256

LENGTH=5,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(17,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC7
DFHMDF POS=(17,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST7
DFHMDF POS=(17,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET7
DFHMDF POS=(17,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT7
DFHMDF POS=(17,68),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 8
*
***********************************************************************
PCODE8
DFHMDF POS=(18,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(18,13),
X
LENGTH=1,
X
ATTRB=ASKIP
QTY8
DFHMDF POS=(18,15),
X
LENGTH=5,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(18,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC8
DFHMDF POS=(18,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST8
DFHMDF POS=(18,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET8
DFHMDF POS=(18,57),
X
LENGTH=10,
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

224/256

ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT8
DFHMDF POS=(18,68),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 9
*
***********************************************************************
PCODE9
DFHMDF POS=(19,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(19,13),
X
LENGTH=1,
X
ATTRB=ASKIP
QTY9
DFHMDF POS=(19,15),
X
LENGTH=5,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(19,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC9
DFHMDF POS=(19,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST9
DFHMDF POS=(19,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET9
DFHMDF POS=(19,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT9
DFHMDF POS=(19,68),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
*
LINE PCODE 10
*
***********************************************************************
PCODE10 DFHMDF POS=(20,1),
X
LENGTH=10,
X
ATTRB=(NORM,UNPROT),
X
COLOR=TURQUOISE,
X
INITIAL='__________'
DFHMDF POS=(20,13),
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

225/256

LENGTH=1,
X
ATTRB=ASKIP
QTY10
DFHMDF POS=(20,15),
X
LENGTH=5,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
INITIAL='_____'
DFHMDF POS=(20,21),
X
LENGTH=1,
X
ATTRB=ASKIP
DESC10
DFHMDF POS=(20,23),
X
LENGTH=20,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE
LIST10
DFHMDF POS=(20,44),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
NET10
DFHMDF POS=(20,57),
X
LENGTH=10,
X
ATTRB=(NORM,NUM),
X
COLOR=TURQUOISE,
X
PICOUT='ZZZZZZ9.99',
X
INITIAL='__________'
AMT10
DFHMDF POS=(20,68),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
DFHMDF POS=(22,44),
X
LENGTH=14,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='INVOICE TOTAL:'
TOTAL
DFHMDF POS=(22,66),
X
LENGTH=12,
X
ATTRB=(NORM,PROT),
X
COLOR=TURQUOISE,
X
PICOUT='Z,ZZZ,ZZ9.99'
***********************************************************************
MSG
DFHMDF POS=(23,1),
X
LENGTH=79,
X
ATTRB=(BRT,PROT),
X
COLOR=YELLOW
FKEY
DFHMDF POS=(24,1),
X
LENGTH=40,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE
DUMMY
DFHMDF POS=(24,79),
X
LENGTH=1,
X
ATTRB=(DRK,PROT,FSET),
X
INITIAL=' '
***********************************************************************
DFHMSD TYPE=FINAL
END

APPLICATION PROGRAMMING IN CICS BASIC

ORDMAP1

24/08/2003

226/256

Order Entry

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Customer number . . . ______
P.O. number . . . . . __________

Prod code
__________
__________
__________
__________
__________
__________
__________
__________
__________
__________

Qty
_____
_____
_____
_____
_____
_____
_____
_____
_____
_____

Customer: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX XX XXXXXXXXXX

Description
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX

List
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99

Net
__________
__________
__________
__________
__________
__________
__________
__________
__________
__________

Amount
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99
Z,ZZZ,ZZ9.99

Invoice total:
Z,ZZZ,ZZ9.99
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

The Programmer generated symbolic Map (member ORDMAP1)

01 ORDMAP1.
*
05 FILLLER
PIC X(12).
*
05 ORD-L-INSTR
PIC S9(04) COMP.
05 ORD-A-INSTR
PIC X(01).
05 ORD-C-INSTR
PIC X(01).
05 ORD-H-INSTR
PIC X(01).
05 ORD-D-INSTR
PIC X(79).
*
05 ORD-L-CUSTNO
PIC S9(04) COMP.
05 ORD-A-CUSTNO
PIC X(01).
05 ORD-C-CUSTNO
PIC X(01).
05 ORD-H-CUSTNO
PIC X(01).
05 ORD-D-CUSTNO
PIC X(06).
*
05 ORD-L-LNAME
PIC S9(04) COMP.
05 ORD-A-LNAME
PIC X(01).
05 ORD-C-LNAME
PIC X(01).
05 ORD-H-LNAME
PIC X(01).
05 ORD-D-LNAME
PIC X(30).
*
05 ORD-L-PO
PIC S9(04) COMP.
05 ORD-A-PO
PIC X(01).
05 ORD-C-PO
PIC X(01).
05 ORD-H-PO
PIC X(01).
05 ORD-D-PO
PIC X(10).
*
05 ORD-L-FNAME
PIC S9(04) COMP.
05 ORD-A-FNAME
PIC X(01).
05 ORD-C-FNAME
PIC X(01).
05 ORD-H-FNAME
PIC X(01).
05 ORD-D-FNAME
PIC X(20).
*
05 ORD-L-ADDR
PIC S9(04) COMP.
05 ORD-A-ADDR
PIC X(01).
05 ORD-C-ADDR
PIC X(01).
05 ORD-H-ADDR
PIC X(01).
05 ORD-D-ADDR
PIC X(30).
*
05 ORD-L-CITY
PIC S9(04) COMP.
05 ORD-A-CITY
PIC X(01).
05 ORD-C-CITY
PIC X(01).
05 ORD-H-CITY
PIC X(01).
05 ORD-D-CITY
PIC X(20).
*
05 ORD-L-STATE
PIC S9(04) COMP.
05 ORD-A-STATE
PIC X(01).
05 ORD-C-STATE
PIC X(01).
05 ORD-H-STATE
PIC X(01).
05 ORD-D-STATE
PIC X(02).
*
05 ORD-L-ZIPCODE
PIC S9(04) COMP.
05 ORD-A-ZIPCODE
PIC X(01).
05 ORD-C-ZIPCODE
PIC X(01).
05 ORD-H-ZIPCODE
PIC X(01).

227/256

APPLICATION PROGRAMMING IN CICS BASIC

*
*

05

ORD-D-ZIPCODE

PIC X(10).

05

ORD-LINE-ITEM

OCCURS 10 TIMES.

10
10
10
10
10

ORD-L-PCODE
ORD-A-PCODE
ORD-C-PCODE
ORD-H-PCODE
ORD-D-PCODE

PIC
PIC
PIC
PIC
PIC

10
10
10
10
10

ORD-L-QTY
ORD-A-QTY
ORD-C-QTY
ORD-H-QTY
ORD-D-QTY

10

ORD-D-QTY-ALPHA

PIC S9(04) COMP.

PIC X(01).
PIC X(01).
PIC X(01).
PIC ZZZZ9
BLANK WHEN ZERO.
REDEFINES ORD-D-QTY
PIC X(05).

10
10
10
10
10

ORD-L-DESC
ORD-A-DESC
ORD-C-DESC
ORD-H-DESC
ORD-D-DESC

PIC
PIC
PIC
PIC
PIC

10
10
10
10
10

ORD-L-LIST
ORD-A-LIST
ORD-C-LIST
ORD-H-LIST
ORD-D-LIST

PIC S9(04) COMP.

PIC X(01).
PIC X(01).
PIC X(01).
PIC Z,ZZZ,ZZ9.99
BLANK WHEN ZERO.

10
10
10
10
10

ORD-L-NET
ORD-A-NET
ORD-C-NET
ORD-H-NET
ORD-D-NET

10

ORD-D-NET-ALPHA

PIC S9(04) COMP.

PIC X(01).
PIC X(01).
PIC X(01).
PIC ZZZ,ZZ9.99
BLANK WHEN ZERO.
REDEFINES ORD-D-NET
PIC X(10).

10
10
10
10
10

ORD-L-AMOUNT
ORD-A-AMOUNT
ORD-C-AMOUNT
ORD-H-AMOUNT
ORD-D-AMOUNT

24/08/2003

S9(04)
X(01).
X(01).
X(01).
X(10).

S9(04)
X(01).
X(01).
X(01).
X(20).

COMP.

COMP.

PIC S9(04) COMP.

PIC X(01).
PIC X(01).
PIC X(01).
PIC Z,ZZZ,ZZ9.99
BLANK WHEN ZERO.

05
05
05
05
05

ORD-L-TOTAL
ORD-A-TOTAL
ORD-C-TOTAL
ORD-H-TOTAL
ORD-D-TOTAL

PIC S9(04) COMP.

PIC X(01).
PIC X(01).
PIC X(01).
PIC Z,ZZZ,ZZ9.99
BLANK WHEN ZERO.

05
05

ORD-L-MESSAGE
ORD-A-MESSAGE

PIC S9(04)
PIC X(01).

COMP.

228/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

05
05
05

ORD-C-MESSAGE
ORD-H-MESSAGE
ORD-D-MESSAGE

PIC X(01).
PIC X(01).
PIC X(79).

05
05
05
05
05

ORD-L-FKEY
ORD-A-FKEY
ORD-C-FKEY
ORD-H-FKEY
ORD-D-FKEY

PIC
PIC
PIC
PIC
PIC

S9(04)
X(01).
X(01).
X(01).
X(40).

COMP.

05
05
05
05
05

ORD-L-DUMMY
ORD-A-DUMMY
ORD-C-DUMMY
ORD-H-DUMMY
ORD-D-DUMMY

PIC
PIC
PIC
PIC
PIC

S9(04)
X(01).
X(01).
X(01).
X(01).

COMP.

The INVOICE copy book

01 INVOICE-RECORD.
*
05 INV-INVOICE-NUMBER
05 INV-INVOICE-DATE
05 INV-CUSTOMER-NUMBER
05 INV-PO-NUMBER
05 INV-LINE-ITEM
10 INV-PRODUCT-CODE
10 INV-QUANTITY
10 INV-UNIT-PRICE
10 INV-AMOUNT
05 INV-INVOICE-TOTAL
*
The CUSTMAS copy book
01 CUSTOMER-MASTER-RECORD.
*
05 CM-CUSTOMER-NUMBER
05 CM-FIRST-NAME
05 CM-LAST-NAME
05 CM-ADDRESS
05 CM-CITY
05 CM-STATE
05 CM-ZIP-CODE

229/256

PIC 9(06).
PIC X(08).
PIC X(06).
PIC X(10).
OCCURS 10 TIMES.
PIC X(10).
PIC S9(07)
COMP-3.
PIC S9(07)V99 COMP-3.
PIC S9(07)V99 COMP-3.
PIC S9(07)V99 COMP-3.

PIC
PIC
PIC
PIC
PIC
PIC
PIC

The PRODUCT copy book

01 PRODUCT-MASTER-RECORD.
*
05 PRM-PRODUCT-CODE
05 PRM-PRODUCT-DESCRIPTION
05 PRM-UNIT-PRICE
05 PRM-QUANTITY-ON-HAND
*
The INVCTL copy book
01 INVCTL-RECORD.
*
05 INVCTL-RECORD-KEY
05 INVCTL-NEXT-INVOICE-NUMBER
*

X(6).
X(20).
X(30).
X(30).
X(20).
X(2).
X(10).

PIC
PIC
PIC
PIC

X(10).
X(20).
S9(07)V99
S9(07)

PIC X(01).
PIC 9(06).

COMP-3.
COMP-3.

APPLICATION PROGRAMMING IN CICS BASIC

The ATTR copy book

01 ATTRIBUTE-DEFINITIONS.
*
05 ATTR-UNPROT
05 ATTR-UNPROT-MDT
05 ATTR-UNPROT-BRT
05 ATTR-UNPROT-BRT-MDT
05 ATTR-UNPROT-DARK
05 ATTR-UNPROT-DARK-MDT
05 ATTR-UNPROT-NUM
05 ATTR-UNPROT-NUM-MDT
05 ATTR-UNPROT-NUM-BRT
05 ATTR-UNPROT-NUM-BRT-MDT
05 ATTR-UNPROT-NUM-DARK
05 ATTR-UNPROT-NUM-DARK-MDT
05 ATTR-PROT
05 ATTR-PROT-MDT
05 ATTR-PROT-BRT
05 ATTR-PROT-BRT-MDT
05 ATTR-PROT-DARK
05 ATTR-PROT-DARK-MDT
05 ATTR-PROT-SKIP
05 ATTR-PROT-SKIP-MDT
05 ATTR-PROT-SKIP-BRT
05 ATTR-PROT-SKIP-BRT-MDT
05 ATTR-PROT-SKIP-DARK
05 ATTR-PROT-SKIP-DARK-MDT
*
05 ATTR-NO-HIGHLIGHT
05 ATTR-BLINK
05 ATTR-REVERSE
05 ATTR-UNDERSCORE
*
05 ATTR-DEFAULT-COLOR
05 ATTR-BLUE
05 ATTR-RED
05 ATTR-PINK
05 ATTR-GREEN
05 ATTR-TURQUOISE
05 ATTR-YELLOW
05 ATTR-NEUTRAL
The ERRPARM copy book
01 ERROR-PARAMETERS.
*
05 ERR-RESP
05 ERR-RESP2
05 ERR-TRNID
05 ERR-RSRCE

PIC
PIC
PIC
PIC

S9(8)
S9(8)
X(4).
X(8).

24/08/2003

PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X

VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE

' '.
X'C1'.
X'C8'.
X'C9'.
X'4C'.
X'4D'.
X'50'.
X'D1'.
X'D8'.
X'D9'.
X'5C'.
X'5D'.
X'60'.
X'61'.
X'E8'.
X'E9'.
'%'.
X'6D'.
X'F0'.
X'F1'.
X'F8'.
X'F9'.
X'7C'.
X'7D'.

PIC
PIC
PIC
PIC

X
X
X
X

VALUE
VALUE
VALUE
VALUE

X'00'.
'1'.
'2'.
'4'.

PIC
PIC
PIC
PIC
PIC
PIC
PIC
PIC

X
X
X
X
X
X
X
X

VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE
VALUE

X'00'.
'1'.
'2'.
'3'.
'4'.
'5'.
'6'.
'7'.

COMP.
COMP.

230/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

231/256

The ORDRENT1 program transaction-id ORD1

Note:-This program uses the Programmer generated symbolic map
ORDMAP1 shown above.
IDENTIFICATION DIVISION.
PROGRAM-ID. ORDRENT1.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SWITCHES.
05 VALID-DATA-SW
PIC X
VALUE 'Y'.
88 VALID-DATA
VALUE 'Y'.
05 CUSTOMER-FOUND-SW
PIC X
VALUE 'Y'.
88 CUSTOMER-FOUND
VALUE 'Y'.
05 PRODUCT-FOUND-SW
PIC X
VALUE 'Y'.
88 PRODUCT-FOUND
VALUE 'Y'.
05 VALID-QUANTITY-SW
PIC X
VALUE 'Y'.
88 VALID-QUANTITY
VALUE 'Y'.
05 VALID-NET-SW
PIC X
VALUE 'Y'.
88 VALID-NET
VALUE 'Y'.
01 FLAGS.
05 SEND-FLAG
PIC X.
88 SEND-ERASE
VALUE '1'.
88 SEND-DATAONLY
VALUE '2'.
88 SEND-DATAONLY-ALARM
VALUE '3'.
05 ATTRIBUTE-SET-FLAG
PIC X.
88 SET-ATTRIBUTES
VALUE '1'.
88 RESET-ATTRIBUTES
VALUE '2'.
01 WORK-FIELDS.
05 ITEM-SUB
PIC S9(3)
COMP-3 VALUE ZERO.
05 LINE-ITEM-COUNT
PIC S9(3)
COMP-3 VALUE ZERO.
05 NET-NUMERIC
PIC 9(8)V99.
05 NET-NUMERIC-C REDEFINES NET-NUMERIC PIC X(10).
05 QTY-NUMERIC
PIC 9(5).
05 QTY-NUMERIC-C REDEFINES QTY-NUMERIC PIC X(5).
01 RESPONSE-CODE
PIC S9(8)
COMP.
01 COMMUNICATION-AREA.
05 CA-CONTEXT-FLAG
PIC X.
88 PROCESS-ENTRY
VALUE '1'.
88 PROCESS-VERIFY
VALUE '2'.
05 CA-TOTAL-ORDERS
PIC S9(3) COMP-3.
05 CA-INVOICE-RECORD
PIC X(318).
05 CA-FIELDS-ENTERED.
10 CA-PO-ENTERED-SW
PIC X.
88 CA-PO-ENTERED
VALUE 'Y'.
10 CA-LINE-ITEM
OCCURS 10.
15 CA-PCODE-ENTERED-SW
PIC X.
88 CA-PCODE-ENTERED
VALUE 'Y'.
15 CA-QTY-ENTERED-SW
PIC X.
88 CA-QTY-ENTERED
VALUE 'Y'.
15 CA-NET-ENTERED-SW
PIC X.
88 CA-NET-ENTERED
VALUE 'Y'.
01 TOTAL-LINE.
05 TL-TOTAL-ORDERS
PIC ZZ9.
05 FILLER
PIC X(20) VALUE ' ORDERS ENTERED. PR'.
05 FILLER
PIC X(20) VALUE 'ESS ENTER TO CONTINU'.
COPY INVOICE.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

232/256

COPY CUSTMAS.
COPY PRODUCT.
COPY INVCTL.
COPY ORDMAP1.
COPY DFHAID.
COPY ATTR.
COPY ERRPARM.
LINKAGE SECTION.
01 DFHCOMMAREA
PIC X(352).
01 COMMON-WORK-AREA.
05 CWA-DATE
PIC X(8).
05 CWA-COMPANY-NAME
PIC X(40).
PROCEDURE DIVISION.
0000-ENTER-ORDERS.
MOVE DFHCOMMAREA TO COMMUNICATION-AREA.
EVALUATE TRUE
WHEN EIBCALEN = ZERO
MOVE LOW-VALUE TO ORDMAP1
MOVE LOW-VALUE TO COMMUNICATION-AREA
MOVE ZERO
TO CA-TOTAL-ORDERS
MOVE 'TYPE ORDER DETAILS. THEN PRESS ENTER.'
TO ORD-D-INSTR
MOVE 'F3=EXIT
F12=CANCEL' TO ORD-D-FKEY
MOVE -1 TO ORD-L-CUSTNO
SET SEND-ERASE TO TRUE
PERFORM 1400-SEND-ORDER-MAP
SET PROCESS-ENTRY TO TRUE
WHEN EIBAID = DFHCLEAR
MOVE LOW-VALUE TO ORDMAP1
MOVE LOW-VALUE TO CA-INVOICE-RECORD
CA-FIELDS-ENTERED
MOVE 'TYPE ORDER DETAILS. THEN PRESS ENTER.'
TO ORD-D-INSTR
MOVE 'F3=EXIT
F12=CANCEL' TO ORD-D-FKEY
MOVE -1 TO ORD-L-CUSTNO
SET SEND-ERASE TO TRUE
PERFORM 1400-SEND-ORDER-MAP
SET PROCESS-ENTRY TO TRUE
WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
CONTINUE
WHEN EIBAID = DFHPF3
PERFORM 3000-SEND-TOTAL-LINE
EXEC CICS
RETURN TRANSID('MENU')
END-EXEC
WHEN EIBAID = DFHPF12
IF PROCESS-VERIFY
MOVE LOW-VALUE TO ORDMAP1
MOVE LOW-VALUE TO CA-INVOICE-RECORD
CA-FIELDS-ENTERED
MOVE 'TYPE ORDER DETAILS. THEN PRESS ENTER.'
TO ORD-D-INSTR
MOVE 'F3=EXIT
F12=CANCEL' TO ORD-D-FKEY
MOVE -1 TO ORD-L-CUSTNO
SET SEND-ERASE TO TRUE
PERFORM 1400-SEND-ORDER-MAP
SET PROCESS-ENTRY TO TRUE

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

233/256

ELSE IF PROCESS-ENTRY
EXEC CICS
XCTL PROGRAM('INVMENU')
END-EXEC
END-IF
END-IF
WHEN EIBAID = DFHENTER
IF PROCESS-ENTRY
PERFORM 1000-PROCESS-ORDER-MAP
ELSE IF PROCESS-VERIFY
PERFORM 2000-PROCESS-POST-ORDER
SET PROCESS-ENTRY TO TRUE
END-IF
END-IF
WHEN EIBAID = DFHPF4
IF PROCESS-VERIFY
MOVE LOW-VALUE TO ORDMAP1
MOVE 'TYPE CORRECTIONS. THEN PRESS ENTER.'
TO ORD-D-INSTR
MOVE 'F3=EXIT
F12=CANCEL' TO ORD-D-FKEY
MOVE -1 TO ORD-L-CUSTNO
SET RESET-ATTRIBUTES TO TRUE
SET SEND-DATAONLY TO TRUE
PERFORM 1400-SEND-ORDER-MAP
SET PROCESS-ENTRY TO TRUE
ELSE IF PROCESS-ENTRY
MOVE LOW-VALUE TO ORDMAP1
MOVE 'INVALID KEY PRESSED.' TO ORD-D-MESSAGE
MOVE -1 TO ORD-L-CUSTNO
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1400-SEND-ORDER-MAP
END-IF
END-IF
WHEN OTHER
MOVE LOW-VALUE TO ORDMAP1
MOVE 'INVALID KEY PRESSED.' TO ORD-D-MESSAGE
MOVE -1 TO ORD-L-CUSTNO
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1400-SEND-ORDER-MAP
END-EVALUATE.
EXEC CICS
RETURN TRANSID('ORD1')
COMMAREA(COMMUNICATION-AREA)
END-EXEC.
1000-PROCESS-ORDER-MAP.
PERFORM 1100-RECEIVE-ORDER-MAP.
PERFORM 1200-EDIT-ORDER-DATA
IF VALID-DATA
PERFORM 1300-FORMAT-INVOICE-RECORD
MOVE 'PRESS ENTER TO POST THIS ORDER. OR PRESS F4 TO ENT
'ER CORRECTIONS.' TO ORD-D-INSTR
MOVE 'F3=EXIT
F4=CHANGE
F12=CANCEL' TO ORD-D-FKEY
MOVE SPACE TO ORD-D-MESSAGE
SET SEND-DATAONLY TO TRUE
SET SET-ATTRIBUTES TO TRUE
PERFORM 1400-SEND-ORDER-MAP
SET PROCESS-VERIFY TO TRUE

APPLICATION PROGRAMMING IN CICS BASIC

ELSE

24/08/2003

MOVE 'TYPE CORRECTIONS. THEN PRESS ENTER.'

TO ORD-D-INSTR
MOVE 'F3=EXIT
F12=CANCEL' TO ORD-D-FKEY
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1400-SEND-ORDER-MAP
END-IF.
1100-RECEIVE-ORDER-MAP.
EXEC CICS
RECEIVE MAP('ORDMAP1')
MAPSET('ORDSET1')
INTO(ORDMAP1)
END-EXEC.
INSPECT ORDMAP1
REPLACING ALL '_' BY SPACE.
1200-EDIT-ORDER-DATA.
MOVE ATTR-NO-HIGHLIGHT TO ORD-H-CUSTNO
ORD-H-PO.
MOVE ZERO TO LINE-ITEM-COUNT
INV-INVOICE-TOTAL.
PERFORM 1220-EDIT-LINE-ITEM
VARYING ITEM-SUB FROM 10 BY -1
UNTIL ITEM-SUB < 1.
MOVE INV-INVOICE-TOTAL TO ORD-D-TOTAL.
IF
LINE-ITEM-COUNT = ZERO
AND VALID-DATA
MOVE ATTR-REVERSE TO ORD-H-PCODE(1)
MOVE -1 TO ORD-L-PCODE(1)
MOVE 'YOU MUST ENTER AT LEAST ONE LINE ITEM'
TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
END-IF
IF
ORD-L-PO = ZERO
OR ORD-D-PO = SPACE
MOVE 'N' TO CA-PO-ENTERED-SW
ELSE
MOVE 'Y' TO CA-PO-ENTERED-SW
END-IF
IF
ORD-L-CUSTNO = ZERO
OR ORD-D-CUSTNO = SPACE
MOVE ATTR-REVERSE TO ORD-H-CUSTNO
MOVE -1 TO ORD-L-CUSTNO
MOVE 'YOU MUST ENTER A CUSTOMER NUMBER'
TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
ELSE
PERFORM 1210-READ-CUSTOMER-RECORD
IF CUSTOMER-FOUND
MOVE CM-LAST-NAME TO ORD-D-LNAME
MOVE CM-FIRST-NAME TO ORD-D-FNAME
MOVE CM-ADDRESS
TO ORD-D-ADDR
MOVE CM-CITY
TO ORD-D-CITY
MOVE CM-STATE
TO ORD-D-STATE
MOVE CM-ZIP-CODE
TO ORD-D-ZIPCODE
ELSE
MOVE SPACE TO ORD-D-LNAME
ORD-D-FNAME

234/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

235/256

ORD-D-ADDR
ORD-D-CITY
ORD-D-STATE
ORD-D-ZIPCODE
MOVE ATTR-REVERSE TO ORD-H-CUSTNO
MOVE -1 TO ORD-L-CUSTNO
MOVE 'THAT CUSTOMER DOES NOT EXIST'
TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
END-IF
END-IF
IF VALID-DATA
MOVE -1 TO ORD-L-CUSTNO.
1210-READ-CUSTOMER-RECORD.
EXEC CICS
READ DATASET('CUSTMAS')
INTO(CUSTOMER-MASTER-RECORD)
RIDFLD(ORD-D-CUSTNO)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'Y' TO CUSTOMER-FOUND-SW
ELSE IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'N' TO CUSTOMER-FOUND-SW
ELSE
PERFORM 9999-TERMINATE-PROGRAM
END-IF
END-IF.
1220-EDIT-LINE-ITEM.
MOVE ATTR-NO-HIGHLIGHT TO ORD-H-PCODE(ITEM-SUB)
ORD-H-QTY(ITEM-SUB)
ORD-H-NET(ITEM-SUB).
MOVE 'N' TO PRODUCT-FOUND-SW.
IF
ORD-L-PCODE(ITEM-SUB) > ZERO
AND ORD-D-PCODE(ITEM-SUB) NOT = SPACE
MOVE 'Y' TO CA-PCODE-ENTERED-SW(ITEM-SUB)
ELSE
MOVE 'N' TO CA-PCODE-ENTERED-SW(ITEM-SUB).
IF
ORD-L-QTY(ITEM-SUB) > ZERO
AND ORD-D-QTY-ALPHA(ITEM-SUB) NOT = SPACE
MOVE 'Y' TO CA-QTY-ENTERED-SW(ITEM-SUB)
ELSE
MOVE 'N' TO CA-QTY-ENTERED-SW(ITEM-SUB).
IF
ORD-L-NET(ITEM-SUB) > ZERO
AND ORD-D-NET-ALPHA(ITEM-SUB) NOT = SPACE
MOVE 'Y' TO CA-NET-ENTERED-SW(ITEM-SUB)
ELSE
MOVE 'N' TO CA-NET-ENTERED-SW(ITEM-SUB).
IF
CA-NET-ENTERED(ITEM-SUB)
AND NOT CA-PCODE-ENTERED(ITEM-SUB)
MOVE ATTR-REVERSE TO ORD-H-PCODE(ITEM-SUB)
MOVE -1 TO ORD-L-PCODE(ITEM-SUB)
MOVE 'YOU CANNOT ENTER A NET PRICE WITHOUT A PRODUCT CODE
'.' TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW.
IF CA-NET-ENTERED(ITEM-SUB)
MOVE ORD-D-NET-ALPHA(ITEM-SUB) TO NET-NUMERIC-C

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

236/256

EXEC CICS
BIF DEEDIT FIELD(NET-NUMERIC) LENGTH(10)
END-EXEC
IF NET-NUMERIC > 0 MOVE "Y" TO VALID-NET-SW
IF VALID-NET
MOVE NET-NUMERIC TO ORD-D-NET(ITEM-SUB)
ELSE
MOVE ATTR-REVERSE TO ORD-H-NET(ITEM-SUB)
MOVE -1 TO ORD-L-NET(ITEM-SUB)
MOVE 'NET PRICE MUST BE NUMERIC' TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
MOVE 'N' TO VALID-QUANTITY-SW.
IF
CA-QTY-ENTERED(ITEM-SUB)
AND NOT CA-PCODE-ENTERED(ITEM-SUB)
MOVE ATTR-REVERSE TO ORD-H-PCODE(ITEM-SUB)
MOVE -1 TO ORD-L-PCODE(ITEM-SUB)
MOVE 'YOU CANNOT ENTER A QUANTITY WITHOUT A PRODUCT CODE'
TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW.
IF CA-QTY-ENTERED(ITEM-SUB)
MOVE ORD-D-QTY-ALPHA(ITEM-SUB) TO QTY-NUMERIC-C
EXEC CICS
BIF DEEDIT FIELD(QTY-NUMERIC) LENGTH(5)
END-EXEC
IF QTY-NUMERIC > 0 MOVE "Y" TO VALID-QUANTITY-SW
IF VALID-QUANTITY
IF QTY-NUMERIC > ZERO
MOVE QTY-NUMERIC TO ORD-D-QTY(ITEM-SUB)
ELSE
MOVE ATTR-REVERSE TO ORD-H-QTY(ITEM-SUB)
MOVE -1 TO ORD-L-QTY(ITEM-SUB)
MOVE 'QUANTITY MUST BE GREATER THAN ZERO'
TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
MOVE 'N' TO VALID-QUANTITY-SW
ELSE
MOVE ATTR-REVERSE TO ORD-H-QTY(ITEM-SUB)
MOVE -1 TO ORD-L-QTY(ITEM-SUB)
MOVE 'QUANTITY MUST BE NUMERIC' TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
MOVE 'N' TO VALID-QUANTITY-SW.
IF
CA-PCODE-ENTERED(ITEM-SUB)
AND NOT CA-QTY-ENTERED(ITEM-SUB)
MOVE ATTR-REVERSE TO ORD-H-QTY(ITEM-SUB)
MOVE -1 TO ORD-L-QTY(ITEM-SUB)
MOVE 'YOU MUST ENTER A QUANTITY' TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW.
IF NOT CA-PCODE-ENTERED(ITEM-SUB)
MOVE SPACE TO ORD-D-DESC(ITEM-SUB)
MOVE ZERO TO ORD-D-LIST(ITEM-SUB)
ORD-D-AMOUNT(ITEM-SUB)
ELSE
ADD 1 TO LINE-ITEM-COUNT
PERFORM 1230-READ-PRODUCT-RECORD
IF PRODUCT-FOUND
MOVE PRM-PRODUCT-DESCRIPTION
TO ORD-D-DESC(ITEM-SUB)

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

237/256

MOVE PRM-UNIT-PRICE TO ORD-D-LIST(ITEM-SUB)

IF NOT CA-NET-ENTERED(ITEM-SUB)
MOVE PRM-UNIT-PRICE TO ORD-D-NET(ITEM-SUB)
NET-NUMERIC
END-IF
IF VALID-QUANTITY AND VALID-NET
MULTIPLY NET-NUMERIC BY QTY-NUMERIC
GIVING ORD-D-AMOUNT(ITEM-SUB)
INV-AMOUNT(ITEM-SUB)
ON SIZE ERROR
MOVE ATTR-REVERSE TO ORD-H-QTY(ITEM-SUB)
MOVE -1 TO ORD-L-QTY(ITEM-SUB)
MOVE 'LINE ITEM AMOUNT IS TOO LARGE'
TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
MOVE ZERO TO ORD-D-AMOUNT(ITEM-SUB)
INV-AMOUNT(ITEM-SUB)
END-MULTIPLY
ADD INV-AMOUNT(ITEM-SUB) TO INV-INVOICE-TOTAL
ON SIZE ERROR
MOVE ATTR-REVERSE TO ORD-H-QTY(ITEM-SUB)
MOVE -1 TO ORD-L-QTY(ITEM-SUB)
MOVE 'INVOICE TOTAL IS TOO LARGE'
TO ORD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
MOVE ZERO TO INV-INVOICE-TOTAL
END-ADD
END-IF
ELSE

MOVE SPACE TO ORD-D-DESC(ITEM-SUB)

MOVE ZERO TO ORD-D-LIST(ITEM-SUB)
ORD-D-AMOUNT(ITEM-SUB)
MOVE ATTR-REVERSE TO ORD-H-PCODE(ITEM-SUB)
MOVE -1
TO ORD-L-PCODE(ITEM-SUB)
MOVE 'THAT PRODUCT DOES NOT EXIST'
TO ORD-D-MESSAGE
MOVE 'N'
TO VALID-DATA-SW.
1230-READ-PRODUCT-RECORD.
EXEC CICS
READ DATASET('PRODUCT')
INTO(PRODUCT-MASTER-RECORD)
RIDFLD(ORD-D-PCODE(ITEM-SUB))
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'Y' TO PRODUCT-FOUND-SW
ELSE IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'N' TO PRODUCT-FOUND-SW
ELSE
PERFORM 9999-TERMINATE-PROGRAM.
1300-FORMAT-INVOICE-RECORD.
EXEC CICS
ADDRESS CWA(ADDRESS OF COMMON-WORK-AREA)
END-EXEC
MOVE CWA-DATE
TO INV-INVOICE-DATE.
MOVE ORD-D-CUSTNO TO INV-CUSTOMER-NUMBER.
MOVE ORD-D-PO
TO INV-PO-NUMBER.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

PERFORM VARYING ITEM-SUB FROM 1 BY 1

UNTIL ITEM-SUB > 10
IF CA-PCODE-ENTERED(ITEM-SUB)
MOVE ORD-D-PCODE(ITEM-SUB)
TO INV-PRODUCT-CODE(ITEM-SUB)
MOVE ORD-D-QTY(ITEM-SUB)
TO INV-QUANTITY(ITEM-SUB)
MOVE ORD-D-NET(ITEM-SUB)
TO INV-UNIT-PRICE(ITEM-SUB)
ELSE
MOVE SPACE TO INV-PRODUCT-CODE(ITEM-SUB)
MOVE ZERO TO INV-QUANTITY(ITEM-SUB)
INV-UNIT-PRICE(ITEM-SUB)
INV-AMOUNT(ITEM-SUB)
END-IF
END-PERFORM.
MOVE INVOICE-RECORD TO CA-INVOICE-RECORD.
1400-SEND-ORDER-MAP.
IF SET-ATTRIBUTES
PERFORM 1410-SET-ATTRIBUTES
ELSE IF RESET-ATTRIBUTES
PERFORM 1420-RESET-ATTRIBUTES.
IF SEND-ERASE
EXEC CICS
SEND MAP('ORDMAP1')
MAPSET('ORDSET1')
FROM(ORDMAP1)
CURSOR
ERASE
END-EXEC
ELSE IF SEND-DATAONLY
EXEC CICS
SEND MAP('ORDMAP1')
MAPSET('ORDSET1')
FROM(ORDMAP1)
CURSOR
DATAONLY
END-EXEC
ELSE IF SEND-DATAONLY-ALARM
EXEC CICS
SEND MAP('ORDMAP1')
MAPSET('ORDSET1')
FROM(ORDMAP1)
CURSOR
DATAONLY
ALARM
END-EXEC.
1410-SET-ATTRIBUTES.
MOVE ATTR-PROT TO ORD-A-CUSTNO.
IF CA-PO-ENTERED
MOVE ATTR-PROT TO ORD-A-PO
ELSE
MOVE ATTR-PROT-DARK TO ORD-A-PO.
PERFORM VARYING ITEM-SUB FROM 1 BY 1
UNTIL ITEM-SUB > 10
IF CA-PCODE-ENTERED(ITEM-SUB)
MOVE ATTR-PROT TO ORD-A-PCODE(ITEM-SUB)

238/256

APPLICATION PROGRAMMING IN CICS BASIC

ELSE

24/08/2003

MOVE ATTR-PROT-DARK TO ORD-A-PCODE(ITEM-SUB)

END-IF
IF CA-QTY-ENTERED(ITEM-SUB)
MOVE ATTR-PROT TO ORD-A-QTY(ITEM-SUB)
ELSE
MOVE ATTR-PROT-DARK TO ORD-A-QTY(ITEM-SUB)
END-IF
IF
CA-NET-ENTERED(ITEM-SUB)
OR CA-PCODE-ENTERED(ITEM-SUB)
MOVE ATTR-PROT TO ORD-A-NET(ITEM-SUB)
ELSE
MOVE ATTR-PROT-DARK TO ORD-A-NET(ITEM-SUB)
END-IF
END-PERFORM.
1420-RESET-ATTRIBUTES.
MOVE ATTR-UNPROT-MDT TO ORD-A-CUSTNO.
IF CA-PO-ENTERED
MOVE ATTR-UNPROT-MDT TO ORD-A-PO
ELSE
MOVE ATTR-UNPROT
TO ORD-A-PO.
PERFORM VARYING ITEM-SUB FROM 1 BY 1
UNTIL ITEM-SUB > 10
IF CA-PCODE-ENTERED(ITEM-SUB)
MOVE ATTR-UNPROT-MDT TO ORD-A-PCODE(ITEM-SUB)
ELSE
MOVE ATTR-UNPROT
TO ORD-A-PCODE(ITEM-SUB)
END-IF
IF CA-QTY-ENTERED(ITEM-SUB)
MOVE ATTR-UNPROT-MDT TO ORD-A-QTY(ITEM-SUB)
ELSE
MOVE ATTR-UNPROT
TO ORD-A-QTY(ITEM-SUB)
END-IF
IF CA-NET-ENTERED(ITEM-SUB)
MOVE ATTR-UNPROT-MDT TO ORD-A-NET(ITEM-SUB)
ELSE
MOVE ATTR-UNPROT
TO ORD-A-NET(ITEM-SUB)
END-IF
END-PERFORM.
2000-PROCESS-POST-ORDER.
MOVE CA-INVOICE-RECORD TO INVOICE-RECORD.
EXEC CICS
LINK PROGRAM('GETINV')
COMMAREA(INV-INVOICE-NUMBER)
END-EXEC.
PERFORM 2100-WRITE-INVOICE-RECORD.
ADD 1 TO CA-TOTAL-ORDERS.
MOVE 'TYPE ORDER DETAILS. THEN PRESS ENTER.'
TO ORD-D-INSTR.
MOVE 'ORDER POSTED.' TO ORD-D-MESSAGE.
MOVE 'F3=EXIT
F12=CANCEL' TO ORD-D-FKEY.
MOVE -1 TO ORD-L-CUSTNO.
SET SEND-ERASE TO TRUE.
PERFORM 1400-SEND-ORDER-MAP.
2100-WRITE-INVOICE-RECORD.
EXEC CICS
WRITE DATASET('INVOICE')

239/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

FROM(INVOICE-RECORD)
RIDFLD(INV-INVOICE-NUMBER)
END-EXEC.
3000-SEND-TOTAL-LINE.
MOVE CA-TOTAL-ORDERS TO TL-TOTAL-ORDERS.
EXEC CICS
SEND TEXT FROM(TOTAL-LINE)
ERASE
FREEKB
END-EXEC.
9999-TERMINATE-PROGRAM.
MOVE EIBRESP TO ERR-RESP.
MOVE EIBRESP2 TO ERR-RESP2.
MOVE EIBTRNID TO ERR-TRNID.
MOVE EIBRSRCE TO ERR-RSRCE.
EXEC CICS
XCTL PROGRAM('SYSERR')
COMMAREA(ERROR-PARAMETERS)
END-EXEC.

240/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

241/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

The Customer Inquiry Program

Program
CUSTINQ1

242/256
back

Overview

Displays records from the customer and invoice files,

allowing the user to scroll forwards or backwards using PF
keys.

Input /
Output
Specs

INQMAP1
CUSTMAS
INVPATH

Processing
1. Control
INVMENU
program
program

Customer inquiry map

customer master file
customer number path to invoice file

Specifications
is transferred to this program via XCTL from the menu program
with no communication area. The user can also start the
by entering the transaction id INQ1. In either case, the
should respond by displaying the customer inquiry map

2. The user selects a customer record display by pressing an attention

key, as follows:Enter
display the customer indicated by the entry in the
customer entry field.
PF5
PF6
PF7
PF8

Display
Display
Display
Display

the
the
the
the

first customer in the file

last customer in the file
previous customer
next customer

3. For each customer record selected, display the first 10 invoice

records from the invoice file. Use the INVPATH path to access the
invoice records via the customer number alternate key.
4. Use the pseudo conversational programming technique. To restart the
browse during each program execution, save the key of the customer
currently displayed in the communication area.
5. If the user presses PF3 or PF12, return to the menu program INVMENU
by issuing an XCTL command.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

243/256

Event / response chart for the customer inquiry program

Event
Start
the
program
PF3 or PF12
Enter
PF5
PF6
PF7
PF8
Clear
PA1, PA2 or
PA3
Any other key

Response
Display the inquiry map
Transfer control to the menu program
Read and display the customer and related invoice
records indicated by the customer number entered by
the user.
Read and display the first customer record and
related invoice records
Read and display the last customer record and related
invoice records
Read and display the previous customer record and
related invoice records
Read and display the next customer record and related
invoice records
Redisplay the current map
Ignore the key
Display an appropriate error message

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

244/256

Structure Chart for the customer inquiry program

0000
Process
Customer
inquiry

1000
Display
selected
customer

1100
Receive
inquiry
map

2000
3000
4000
5000
Display
display
display
display
First
last
prev
next
customer customer customer customer

1200
1300
Edit
Read
Customer Customer
number
record

1400
Display
Inquiry
results

1410
start
invoice
browse

1500
Send
Inquiry
map

1420
format
invoice
record
1430
read
next
invoice

2100
2200
start
read
customer
next
browse
customer

1400
display
inquiry
results

2100
3100
start
read
customer previous
browse
customer

1400
display
inquiry
results

2100
2200
3100
start
read
read
customer
next
prev
browse
customer customer

1400
display
inquiry
results

2100
2200
start
read
customer
next
browse
customer

1400
display
inquiry
results

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

245/256

The Mapset
PRINT NOGEN
INQSET1 DFHMSD TYPE=&SYSPARM,
X
LANG=COBOL,
X
MODE=INOUT,
X
TERM=3270-2,
X
CTRL=FREEKB,
X
MAPATTS=(COLOR),
X
STORAGE=AUTO,
X
TIOAPFX=YES
***********************************************************************
INQMAP1 DFHMDI SIZE=(24,80),
X
LINE=1,
X
COLUMN=1
***********************************************************************
DFHMDF POS=(1,1),
X
LENGTH=8,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='INQMAP1'
DFHMDF POS=(1,20),
X
LENGTH=16,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='CUSTOMER INQUIRY'
***********************************************************************
DFHMDF POS=(3,1),
X
LENGTH=65,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='TO START A NEW BROWSE, TYPE A CUSTOMER NUMBER. X
THEN PRESS ENTER.'
DFHMDF POS=(5,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='CUSTOMER NUMBER. . . . .'
CUSTNO
DFHMDF POS=(5,26),
X
LENGTH=6,
X
ATTRB=(NORM,UNPROT,IC),
X
COLOR=TURQUOISE,
X
INITIAL='______'
DFHMDF POS=(5,33),
X
LENGTH=1,
X
ATTRB=ASKIP
***********************************************************************
DFHMDF POS=(7,1),
X
LENGTH=24,
X
ATTRB=(NORM,PROT),
X
COLOR=GREEN,
X
INITIAL='NAME AND ADDRESS . . . :'
LNAME
DFHMDF POS=(7,26),
X
LENGTH=30,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
FNAME
DFHMDF POS=(8,26),
X
LENGTH=20,
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

246/256

COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
ADDR
DFHMDF POS=(9,26),
X
LENGTH=30,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
CITY
DFHMDF POS=(10,26),
X
LENGTH=20,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
STATE
DFHMDF POS=(10,47),
X
LENGTH=2,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
ZIPCODE DFHMDF POS=(10,50),
X
LENGTH=10,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
***********************************************************************
DFHMDF POS=(12,1),
X
LENGTH=43,
X
COLOR=GREEN,
X
ATTRB=(NORM,PROT),
X
INITIAL='INVOICE PO NUMBER
DATE
TOTAL'
INV1
DFHMDF POS=(13,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV2
DFHMDF POS=(14,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV3
DFHMDF POS=(15,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV4
DFHMDF POS=(16,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV5
DFHMDF POS=(17,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV6
DFHMDF POS=(18,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV7
DFHMDF POS=(19,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV8
DFHMDF POS=(20,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV9
DFHMDF POS=(21,2),
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

247/256

LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
INV10
DFHMDF POS=(22,2),
X
LENGTH=42,
X
COLOR=TURQUOISE,
X
ATTRB=(NORM,PROT)
***********************************************************************
MESSAGE DFHMDF POS=(23,1),
X
LENGTH=79,
X
ATTRB=(BRT,PROT),
X
COLOR=YELLOW
DFHMDF POS=(24,1),
X
LENGTH=34,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='F3=EXIT F5=FIRST F6=LAST F7=PREV'
DFHMDF POS=(24,38),
X
LENGTH=19,
X
ATTRB=(NORM,PROT),
X
COLOR=BLUE,
X
INITIAL='F8=NEXT F12=CANCEL'
DUMMY
DFHMDF POS=(24,79),
X
LENGTH=1,
X
ATTRB=(DRK,PROT,FSET),
X
INITIAL=' '
***********************************************************************
DFHMSD TYPE=FINAL
END

APPLICATION PROGRAMMING IN CICS BASIC

INQMAP1

24/08/2003

248/256

Customer Inquiry

To start a new browse, type a customer number. Then press Enter.

Customer number. . . . . ______
Name and address . . . : XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX XX XXXXXXXXXX
Invoice PO Number
Date
Total
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
999999 XXXXXXXXXX Z9/99/99 Z,ZZZ,ZZ9.99
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
F3=Exit F5=First F6=Last F7=Prev F8=Next F12=Cancel
X

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

The programmer generated symbolic map

Cut paste as member INQSET1 into your copybook library
01

*
*

*
*

CUSTOMER-INQUIRY-MAP.
05

FILLER

PIC X(12).

05
05
05

CIM-L-CUSTNO
CIM-A-CUSTNO
CIM-D-CUSTNO

PIC S9(4)
PIC X.
PIC X(6).

COMP.

05
05
05

CIM-L-LNAME
CIM-A-LNAME
CIM-D-LNAME

PIC S9(4)
PIC X.
PIC X(30).

COMP.

05
05
05

CIM-L-FLAME
CIM-A-FNAME
CIM-D-FNAME

PIC S9(4)
PIC X.
PIC X(20).

COMP.

05
05
05

CIM-L-ADDR
CIM-A-ADDR
CIM-D-ADDR

PIC S9(4)
PIC X.
PIC X(30).

COMP.

05
05
05

CIM-L-CITY
CIM-A-CITY
CIM-D-CITY

PIC S9(4)
PIC X.
PIC X(20).

COMP.

05
05
05

CIM-L-STATE
CIM-A-STATE
CIM-D-STATE

PIC S9(4)
PIC X.
PIC XX.

COMP.

05
05
05

CIM-L-ZIPCODE
CIM-A-ZIPCODE
CIM-D-ZIPCODE

PIC S9(4)
PIC X.
PIC X(10).

COMP.

05

CIM-INVOICE-LINE

OCCURS 10.

10
10
10

PIC S9(4)
PIC X.
PIC X(42).

COMP.

CIM-L-INVOICE-LINE
CIM-A-INVOICE-LINE
CIM-D-INVOICE-LINE

05
05
05

CIM-L-MESSAGE
CIM-A-MESSAGE
CIM-D-MESSAGE

PIC S9(4)
PIC X.
PIC X(79).

COMP.

05
05
05

CIM-L-DUMMY
CIM-A-DUMMY
CIM-D-DUMMY

PIC S9(4)
PIC X.
PIC X.

COMP.

249/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

250/256

The CUSTINQ1 program

Use the programmer generated logical map copy book INQSET1 shown
above.
IDENTIFICATION DIVISION.
PROGRAM-ID. CUSTINQ1.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SWITCHES.
05 VALID-DATA-SW
PIC X
VALUE 'Y'.
88 VALID-DATA
VALUE 'Y'.
05 CUSTOMER-FOUND-SW
PIC X
VALUE 'Y'.
88 CUSTOMER-FOUND
VALUE 'Y'.
05 MORE-INVOICES-SW
PIC X
VALUE 'Y'.
88 MORE-INVOICES
VALUE 'Y'.
01 FLAGS.
05 DISPLAY-FLAG
PIC X.
88 DISPLAY-NEW-CUSTOMER
VALUE '1'.
88 DISPLAY-SPACES
VALUE '2'.
88 DISPLAY-LOW-VALUES
VALUE '3'.
05 SEND-FLAG
PIC X.
88 SEND-ERASE
VALUE '1'.
88 SEND-DATAONLY
VALUE '2'.
88 SEND-DATAONLY-ALARM
VALUE '3'.
01 WORK-FIELDS.
05 INVOICE-SUB
PIC S9(4) COMP.
01 INVOICE-LINE.
05 IL-INVOICE-NUMBER
PIC 9(6).
05 FILLER
PIC XX
VALUE SPACE.
05 IL-PO-NUMBER
PIC X(10).
05 FILLER
PIC XX
VALUE SPACE.
05 IL-INVOICE-DATE
PIC Z9/99/99.
05 FILLER
PIC XX
VALUE SPACE.
05 IL-INVOICE-TOTAL
PIC Z,ZZZ,ZZ9.99.
01 COMMUNICATION-AREA.
05 CA-CUSTOMER-NUMBER
PIC X(6).
01 RESPONSE-CODE
PIC S9(8) COMP.
COPY CUSTMAS.
COPY INVOICE.
COPY INQSET1.
COPY DFHAID.
COPY ERRPARM.
LINKAGE SECTION.
01 DFHCOMMAREA
PIC X(6).
PROCEDURE DIVISION.
0000-PROCESS-CUSTOMER-INQUIRY.
MOVE DFHCOMMAREA TO COMMUNICATION-AREA.
EVALUATE TRUE
WHEN EIBCALEN = ZERO
MOVE LOW-VALUE TO CA-CUSTOMER-NUMBER
MOVE LOW-VALUE TO CUSTOMER-INQUIRY-MAP
SET SEND-ERASE TO TRUE
PERFORM 1500-SEND-INQUIRY-MAP
WHEN EIBAID = DFHCLEAR
MOVE LOW-VALUE TO CA-CUSTOMER-NUMBER
MOVE LOW-VALUE TO CUSTOMER-INQUIRY-MAP
SET SEND-ERASE TO TRUE

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

PERFORM 1500-SEND-INQUIRY-MAP
WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
CONTINUE
WHEN EIBAID = DFHPF3 OR DFHPF12
EXEC CICS
XCTL PROGRAM('INVMENU')
END-EXEC
WHEN EIBAID = DFHENTER
PERFORM 1000-DISPLAY-SELECTED-CUSTOMER
WHEN EIBAID = DFHPF5
PERFORM 2000-DISPLAY-FIRST-CUSTOMER
WHEN EIBAID = DFHPF6
PERFORM 3000-DISPLAY-LAST-CUSTOMER
WHEN EIBAID = DFHPF7
PERFORM 4000-DISPLAY-PREV-CUSTOMER
WHEN EIBAID = DFHPF8
PERFORM 5000-DISPLAY-NEXT-CUSTOMER
WHEN OTHER
MOVE LOW-VALUE TO CUSTOMER-INQUIRY-MAP
MOVE 'INVALID KEY PRESSED.' TO CIM-D-MESSAGE
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1500-SEND-INQUIRY-MAP
END-EVALUATE.
EXEC CICS
RETURN TRANSID('INQ1')
COMMAREA(COMMUNICATION-AREA)
END-EXEC.
1000-DISPLAY-SELECTED-CUSTOMER.
PERFORM 1100-RECEIVE-INQUIRY-MAP.
PERFORM 1200-EDIT-CUSTOMER-NUMBER.
IF VALID-DATA
PERFORM 1300-READ-CUSTOMER-RECORD
IF CUSTOMER-FOUND
SET DISPLAY-NEW-CUSTOMER TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
MOVE CM-CUSTOMER-NUMBER TO CA-CUSTOMER-NUMBER
ELSE
SET DISPLAY-SPACES TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
ELSE
SET DISPLAY-LOW-VALUES TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS.
1100-RECEIVE-INQUIRY-MAP.
EXEC CICS
RECEIVE MAP('INQMAP1')
MAPSET('INQSET1')
INTO(CUSTOMER-INQUIRY-MAP)
END-EXEC.
INSPECT CUSTOMER-INQUIRY-MAP
REPLACING ALL '_' BY SPACE.
1200-EDIT-CUSTOMER-NUMBER.
IF
CIM-L-CUSTNO = ZERO
OR CIM-D-CUSTNO = SPACE
MOVE 'N' TO VALID-DATA-SW
MOVE 'YOU MUST ENTER A CUSTOMER NUMBER.'
TO CIM-D-MESSAGE.
1300-READ-CUSTOMER-RECORD.

251/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

252/256

EXEC CICS
READ DATASET('CUSTMAS')
INTO(CUSTOMER-MASTER-RECORD)
RIDFLD(CIM-D-CUSTNO)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'N' TO CUSTOMER-FOUND-SW
MOVE 'THAT CUSTOMER DOES NOT EXIST.' TO CIM-D-MESSAGE
ELSE IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
GO TO 9999-TERMINATE-PROGRAM.
1400-DISPLAY-INQUIRY-RESULTS.
IF DISPLAY-NEW-CUSTOMER
MOVE CM-CUSTOMER-NUMBER TO CIM-D-CUSTNO
MOVE CM-LAST-NAME
TO CIM-D-LNAME
MOVE CM-FIRST-NAME
TO CIM-D-FNAME
MOVE CM-ADDRESS
TO CIM-D-ADDR
MOVE CM-CITY
TO CIM-D-CITY
MOVE CM-STATE
TO CIM-D-STATE
MOVE CM-ZIP-CODE
TO CIM-D-ZIPCODE
PERFORM 1410-START-INVOICE-BROWSE
PERFORM 1420-FORMAT-INVOICE-LINE
VARYING INVOICE-SUB FROM 1 BY 1
UNTIL INVOICE-SUB > 10
SET SEND-DATAONLY TO TRUE
ELSE IF DISPLAY-SPACES
MOVE LOW-VALUE TO CIM-D-CUSTNO
MOVE SPACE
TO CIM-D-LNAME
CIM-D-FNAME
CIM-D-ADDR
CIM-D-CITY
CIM-D-STATE
CIM-D-ZIPCODE
PERFORM VARYING INVOICE-SUB FROM 1 BY 1
UNTIL INVOICE-SUB > 10
MOVE SPACE TO CIM-D-INVOICE-LINE(INVOICE-SUB)
END-PERFORM
SET SEND-DATAONLY-ALARM TO TRUE
ELSE IF DISPLAY-LOW-VALUES
SET SEND-DATAONLY-ALARM TO TRUE.
PERFORM 1500-SEND-INQUIRY-MAP.
1410-START-INVOICE-BROWSE.
EXEC CICS
STARTBR DATASET('INVPATH')
RIDFLD(CM-CUSTOMER-NUMBER)
EQUAL
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'N' TO MORE-INVOICES-SW
ELSE IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
GO TO 9999-TERMINATE-PROGRAM.
1420-FORMAT-INVOICE-LINE.
IF MORE-INVOICES
PERFORM 1430-READ-NEXT-INVOICE
MOVE INV-INVOICE-NUMBER TO IL-INVOICE-NUMBER
MOVE INV-PO-NUMBER
TO IL-PO-NUMBER

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

253/256

MOVE INV-INVOICE-DATE
TO IL-INVOICE-DATE
MOVE INV-INVOICE-TOTAL TO IL-INVOICE-TOTAL
MOVE INVOICE-LINE TO CIM-D-INVOICE-LINE(INVOICE-SUB)

ELSE

MOVE SPACE TO CIM-D-INVOICE-LINE(INVOICE-SUB).

1430-READ-NEXT-INVOICE.
EXEC CICS
READNEXT DATASET('INVPATH')
RIDFLD(CM-CUSTOMER-NUMBER)
INTO(INVOICE-RECORD)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'N' TO MORE-INVOICES-SW
ELSE IF RESPONSE-CODE NOT = DFHRESP(DUPKEY)
GO TO 9999-TERMINATE-PROGRAM.
1500-SEND-INQUIRY-MAP.
IF SEND-ERASE
EXEC CICS
SEND MAP('INQMAP1')
MAPSET('INQSET1')
FROM(CUSTOMER-INQUIRY-MAP)
ERASE
END-EXEC
ELSE IF SEND-DATAONLY
EXEC CICS
SEND MAP('INQMAP1')
MAPSET('INQSET1')
FROM(CUSTOMER-INQUIRY-MAP)
DATAONLY
END-EXEC
ELSE IF SEND-DATAONLY-ALARM
EXEC CICS
SEND MAP('INQMAP1')
MAPSET('INQSET1')
FROM(CUSTOMER-INQUIRY-MAP)
DATAONLY
END-EXEC.
2000-DISPLAY-FIRST-CUSTOMER.
MOVE LOW-VALUE TO CM-CUSTOMER-NUMBER
CUSTOMER-INQUIRY-MAP.
PERFORM 2100-START-CUSTOMER-BROWSE.
IF CUSTOMER-FOUND
PERFORM 2200-READ-NEXT-CUSTOMER.
IF CUSTOMER-FOUND
SET DISPLAY-NEW-CUSTOMER TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
MOVE CM-CUSTOMER-NUMBER TO CA-CUSTOMER-NUMBER
ELSE
SET DISPLAY-SPACES TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS.
2100-START-CUSTOMER-BROWSE.
EXEC CICS
STARTBR DATASET('CUSTMAS')
RIDFLD(CM-CUSTOMER-NUMBER)
RESP(RESPONSE-CODE)
END-EXEC.

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'Y' TO CUSTOMER-FOUND-SW
MOVE SPACE TO CIM-D-MESSAGE
ELSE IF RESPONSE-CODE = DFHRESP(NOTFND)
MOVE 'N' TO CUSTOMER-FOUND-SW
MOVE 'THERE ARE NO CUSTOMERS IN THE FILE.'
TO CIM-D-MESSAGE
ELSE
GO TO 9999-TERMINATE-PROGRAM.
2200-READ-NEXT-CUSTOMER.
EXEC CICS
READNEXT DATASET('CUSTMAS')
INTO(CUSTOMER-MASTER-RECORD)
RIDFLD(CM-CUSTOMER-NUMBER)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'Y' TO CUSTOMER-FOUND-SW
ELSE IF RESPONSE-CODE = DFHRESP(ENDFILE)
MOVE 'N' TO CUSTOMER-FOUND-SW
MOVE 'THERE ARE NO MORE RECORDS IN THE FILE.'
TO CIM-D-MESSAGE
ELSE
GO TO 9999-TERMINATE-PROGRAM.
3000-DISPLAY-LAST-CUSTOMER.
MOVE HIGH-VALUE TO CM-CUSTOMER-NUMBER.
MOVE LOW-VALUE TO CUSTOMER-INQUIRY-MAP.
PERFORM 2100-START-CUSTOMER-BROWSE.
IF CUSTOMER-FOUND
PERFORM 3100-READ-PREV-CUSTOMER.
IF CUSTOMER-FOUND
SET DISPLAY-NEW-CUSTOMER TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
MOVE CM-CUSTOMER-NUMBER TO CA-CUSTOMER-NUMBER
ELSE
SET DISPLAY-SPACES TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS.
3100-READ-PREV-CUSTOMER.
EXEC CICS
READPREV DATASET('CUSTMAS')
INTO(CUSTOMER-MASTER-RECORD)
RIDFLD(CM-CUSTOMER-NUMBER)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE = DFHRESP(NORMAL)
MOVE 'Y' TO CUSTOMER-FOUND-SW
ELSE IF RESPONSE-CODE = DFHRESP(ENDFILE)
MOVE 'N' TO CUSTOMER-FOUND-SW
MOVE 'THERE ARE NO MORE RECORDS IN THE FILE.'
TO CIM-D-MESSAGE
ELSE
GO TO 9999-TERMINATE-PROGRAM.
4000-DISPLAY-PREV-CUSTOMER.
MOVE CA-CUSTOMER-NUMBER TO CM-CUSTOMER-NUMBER.
MOVE LOW-VALUE
TO CUSTOMER-INQUIRY-MAP.
PERFORM 2100-START-CUSTOMER-BROWSE.
IF CUSTOMER-FOUND

254/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

PERFORM 2200-READ-NEXT-CUSTOMER
PERFORM 3100-READ-PREV-CUSTOMER
PERFORM 3100-READ-PREV-CUSTOMER.
IF CUSTOMER-FOUND
SET DISPLAY-NEW-CUSTOMER TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
MOVE CM-CUSTOMER-NUMBER TO CA-CUSTOMER-NUMBER
ELSE
SET DISPLAY-LOW-VALUES TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS.
5000-DISPLAY-NEXT-CUSTOMER.
MOVE CA-CUSTOMER-NUMBER TO CM-CUSTOMER-NUMBER.
MOVE LOW-VALUE
TO CUSTOMER-INQUIRY-MAP.
PERFORM 2100-START-CUSTOMER-BROWSE.
IF CUSTOMER-FOUND
PERFORM 2200-READ-NEXT-CUSTOMER
PERFORM 2200-READ-NEXT-CUSTOMER.
IF CUSTOMER-FOUND
SET DISPLAY-NEW-CUSTOMER TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
MOVE CM-CUSTOMER-NUMBER TO CA-CUSTOMER-NUMBER
ELSE
SET DISPLAY-LOW-VALUES TO TRUE
PERFORM 1400-DISPLAY-INQUIRY-RESULTS.
9999-TERMINATE-PROGRAM.
MOVE EIBRESP TO ERR-RESP.
MOVE EIBRESP2 TO ERR-RESP2.
MOVE EIBTRNID TO ERR-TRNID.
MOVE EIBRSRCE TO ERR-RSRCE.
EXEC CICS
XCTL PROGRAM('SYSERR')
COMMAREA(ERROR-PARAMETERS)
END-EXEC.

255/256

APPLICATION PROGRAMMING IN CICS BASIC

24/08/2003

256/256