- Employee List Program Simple List
MTMAPRD.SOURCE.PROGRAM(ESONP)
Cobol
Identification Division.
Program-Id. ESONP.
Data Division.
Working-Storage Section.
copy DFHAID.
copy DFHBMSCA.
copy ESONMAP.
01 Application-Constants.
copy ECONST.
01 MON-Container-Data.
copy EMONCTR.
01 Registered-User-Record.
copy EREGUSR.
01 W-Commarea.
05 W-UserId pic x(08).
05 W-Password pic x(08).
01 W-Resp pic s9(9) binary.
01 W-Current-Date.
05 W-YYYYMMDDHHMMSS pic x(14).
05 filler pic x(07).
01 W-Success-Message.
05 W-Success-UserId pic x(08).
05 filler pic x(30)
value ' successful sign no'.
01 W-Not-Found-Message.
05 W-Not-Found-UserId pic x(08).
05 filler pic x(30)
value ' is not in the file'.
01 W-Password-No-Match-Message.
05 filler pic x(08) value 'User Id '.
05 W-No-Match-UserId pic x(08).
05 filler pic x(30)
value ' passwords didn''t match'.
01 W-Not-Active-Message.
05 filler pic x(08) value 'User Id '.
05 W-Not-Active-UserId pic x(08).
05 filler pic x(30)
value ' is not active'.
01 W-Landing-Program-Error.
05 filler pic x(22)
value 'Error transferring to '.
05 W-Landing-Program-Name pic x(08).
05 filler pic x(10)
value '. EIBRESP='.
05 W-Landing-Error-EIBRESP pic 9(08).
05 filler pic x(11)
value '; EIBRESP2='.
05 W-Landing-Error-EIBRESP2 pic 9(08).
05 filler pic x value '.'.
01 W-Resp-Message.
05 filler pic x(08) value 'RIDFLD: '.
05 W-Show-RIDFLD pic x(08).
05 filler pic x(10) value ' W-Resp: '.
05 W-Show-W-Resp pic 9(09).
05 filler pic x(10) value ' EIBRESP: '.
05 W-Show-EIBRESP pic 9(09).
01 W-Status-Error.
05 filler pic x(40)
value 'Activity Monitor returned invalid value '.
05 filler pic x(23)
value 'for Signed-On-Status: <'.
05 W-Status-Error-Value pic x.
05 filler pic x(02) value '>.'.
01 W-General-Error.
05 W-General-Command pic x(30).
05 filler pic x(09) value ' EIBRESP='.
05 W-General-EIBRESP pic 9(09).
05 filler pic x(11) value ', EIBRESP2='.
05 W-General-EIBRESP2 pic 9(09).
linkage Section.
01 DFHCOMMAREA pic x(16).
Procedure Division.
if EIBCALEN equal zero
perform 0000-First-Time
else
perform 1000-Process-User-Input
end-if
.
0000-First-Time.
perform 0100-Initialize-Commarea
perform 0200-Initialize-Map
perform 9200-Send-and-Return
.
0100-Initialize-Commarea.
move spaces to W-Commarea
.
0200-Initialize-Map.
move low-values to ESONMO
.
1000-Process-User-Input.
move DFHCOMMAREA to W-Commarea
EXEC CICS RECEIVE
MAP(CON-Sign-On-Map-Name)
MAPSET(CON-Sign-On-Mapset-Name)
INTO(ESONMI)
RESP(W-Resp)
END-EXEC
evaluate EIBAID
when DFHPF3
when DFHPF12
perform 2000-Cancel-Sign-On
when DFHENTER
perform 3000-Process-Sign-On-Request
when other
continue
end-evaluate
perform 9200-Send-and-Return
.
2000-Cancel-Sign-On.
EXEC CICS SEND CONTROL
FREEKB
ERASE
END-EXEC
EXEC CICS RETURN
END-EXEC
.
3000-Process-Sign-On-Request.
perform 3100-Set-UserId-and-Password
perform 3200-Check-Users-Status
perform 3300-Look-Up-UserId
.
3100-Set-UserId-and-Password.
if USERIDI equal low-values
or USERIDI equal spaces
continue
else
move USERIDI to W-UserId
end-if
if PASSWDI equal low-values
or PASSWDI equal spaces
continue
else
move PASSWDI to W-Password
end-if
.
3200-Check-Users-Status.
******************************************************************
* LINK to the Activity Monitor to check the user's current
* sign-on status
******************************************************************
set MON-Action-Sign-On to true
perform 3260-Call-Activity-Monitor
perform 3280-Check-User-Activity
.
3220-Notify-Activity-Monitor.
set MON-Action-Notify to true
perform 3260-Call-Activity-Monitor
.
3260-Call-Activity-Monitor.
move CON-Sign-On-Program-Name to MON-Linking-Program
move W-UserId to MON-UserId
EXEC CICS PUT
CONTAINER(CON-Monitor-Container-Name)
CHANNEL(CON-Monitor-Channel-Name)
FROM(MON-Container-Data)
FLENGTH(length of MON-Container-Data)
RESP(W-Resp)
END-EXEC
if W-Resp equal DFHRESP(NORMAL)
continue
else
move 'PUT CONTAINER' to W-General-Command
perform 8100-Set-General-Error-Fields
end-if
EXEC CICS LINK
PROGRAM(CON-Activity-Monitor)
CHANNEL(CON-Monitor-Channel-Name)
TRANSID(EIBTRNID)
RESP(W-Resp)
END-EXEC
if W-Resp equal DFHRESP(NORMAL)
continue
else
move 'LINK to EACTMON' to W-General-Command
perform 8100-Set-General-Error-Fields
end-if
.
3280-Check-User-Activity.
******************************************************************
* Pick up the results of a LINK to the Activity Monitor and take
* appropriate action
******************************************************************
EXEC CICS GET
CONTAINER(CON-Monitor-Container-Name)
CHANNEL(CON-Monitor-Channel-Name)
INTO(MON-Container-Data)
RESP(W-Resp)
END-EXEC
if W-Resp equal DFHRESP(NORMAL)
continue
else
move 'GET CONTAINER' to W-General-Command
perform 8100-Set-General-Error-Fields
end-if
evaluate true
when MON-Processing-Error
when MON-Status-Locked-Out
move MON-Message to MESSO
perform 9200-Send-and-Return
when MON-Status-Signed-On
perform 9100-Transfer-to-Landing-Page
when MON-Status-Signing-On
when MON-Status-Not-Set
continue
when other
move MON-Sign-On-Status to W-Status-Error-Value
move W-Status-Error to MESSO
perform 9200-Send-and-Return
end-evaluate
.
3300-Look-Up-UserId.
EXEC CICS READ
FILE(CON-Registered-Users-Filename)
RIDFLD(W-UserId)
INTO(Registered-User-Record)
RESP(W-Resp)
END-EXEC
evaluate W-Resp
when DFHRESP(NORMAL)
perform 3400-Check-User-Credentials
when DFHRESP(NOTFND)
move W-UserId to W-Not-Found-UserId
move W-Not-Found-Message to MESSO
when other
move W-UserId to W-Show-RIDFLD
move W-Resp to W-Show-W-Resp
move EIBRESP to W-Show-EIBRESP
move W-Resp-Message to MESSO
end-evaluate
.
3400-Check-User-Credentials.
if W-Password equal Registered-Password
if ACTIVE
move function CURRENT-DATE to W-Current-Date
if W-Current-Date not less than
Last-Effective-Date-Time
* move Registered-User-Type
* to MON-User-Category
perform 3220-Notify-Activity-Monitor
perform 9100-Transfer-to-Landing-Page
else
move W-UserId to W-Not-Active-UserId
move W-Not-Active-Message to MESSO
end-if
else
move W-UserId to W-Not-Active-UserId
move W-Not-Active-Message to MESSO
end-if
else
move W-UserId to W-No-Match-UserId
move W-Password-No-Match-Message to MESSO
end-if
.
5100-Put-Container.
*****************************************************************
* PUT CONTAINER command performed from multiple places in
* the program
*****************************************************************
EXEC CICS PUT
CONTAINER(CON-Monitor-Container-Name)
CHANNEL(CON-Monitor-Channel-Name)
FROM(MON-Container-Data)
FLENGTH(length of MON-Container-Data)
RESP(W-Resp)
END-EXEC
if W-Resp equal DFHRESP(NORMAL)
continue
else
move 'PUT CONTAINER' to W-General-Command
perform 8100-Set-General-Error-Fields
end-if
.
8100-Set-General-Error-Fields.
*****************************************************************
* Common processing to prepare general error message
*****************************************************************
move W-Resp to W-General-EIBRESP
move EIBRESP2 to W-General-EIBRESP2
move W-General-Error to MESSO
.
9100-Transfer-to-Landing-Page.
*****************************************************************
* Transfer control to the initial Employee Application program
*****************************************************************
perform 5100-Put-Container
EXEC CICS XCTL
PROGRAM(CON-Landing-Program-Name)
CHANNEL(CON-Monitor-Channel-Name)
RESP(W-Resp)
END-EXEC
evaluate W-Resp
when DFHRESP(NORMAL)
continue
when other
move CON-Landing-Program-Name
to W-Landing-Program-Name
move W-Resp to W-Landing-Error-EIBRESP
move EIBRESP2 to W-Landing-Error-EIBRESP2
move W-Landing-Program-Error to MESSO
end-evaluate
.
9200-Send-and-Return.
******************************************************************
* Populate fields in the output map with current values and
* display the screen
******************************************************************
move EIBTRNID to TRANIDO
move W-UserId to USERIDO
move W-Password to PASSWDO
EXEC CICS SEND
MAP(CON-Sign-On-Map-Name)
MAPSET(CON-Sign-On-Mapset-Name)
FROM(ESONMO)
ERASE
END-EXEC
EXEC CICS RETURN
TRANSID(EIBTRNID)
COMMAREA(W-Commarea)
LENGTH(length of W-Commarea)
END-EXEC
.MTMAPRD.SOURCE.PROGRAM(ELISTP)
Cobol
Identification Division.
Program-Id. ELISTP.
Data Division.
Working-Storage Section.
copy DFHAID.
copy DFHBMSCA.
copy ELSTMAP.
01 Application-Constants.
copy ECONST.
01 MON-Container-Data.
copy EMONCTR.
01 LST-Container-Data.
copy ELSTCTR.
01 Employee-Master-Record.
copy EMPMAST.
01 W-Resp pic s9(09) binary.
01 Container-Transfer-Fields.
05 XFER-Channel-Name pic x(16).
05 XFER-Container-Name pic x(16).
05 XFER-Container-Data pic x(4096).
05 XFER-Container-Data-Length pic s9(09) binary.
01 Display-Messages.
05 MSG-No-Filters-Are-Set pic x(06) value '(None)'.
05 MSG-Out pic x(79).
05 MSG-Container-Error.
10 filler pic x(14)
value 'GET CONTAINER('.
10 ERR-Container-Name pic x(16).
10 filler pic x(10)
value ') CHANNEL('.
10 ERR-Channel-Name pic x(16).
10 filler pic x(02) value ') '.
10 ERR-Container-EIBRESP pic 9(08).
10 filler pic x value ' '.
10 ERR-Container-EIBRESP2 pic 9(08).
Procedure Division.
******************************************************************
* Paragraph numbering scheme
* 0000-0999 Initialization
* 1000-1999 Processing terminal input
* 4000-4999 Pseudoconversational support
* 5000-5999 Processing filters
* 6000-6999 Interaction with User Activity Monitor
* 7000-7999 Common helper routines
* 8000-8999 Error-handling routines
* 9000-9999 Exiting or returning
******************************************************************
perform 4400-Get-List-Container
evaluate W-Resp
when DFHRESP(NORMAL)
perform 1000-Process-User-Input
when DFHRESP(CHANNELERR)
when DFHRESP(CONTAINERERR)
perform 0000-First-Time
when other
perform 8100-Container-Error
end-evaluate
.
0000-First-Time.
******************************************************************
* First entry into this program in a conversation
******************************************************************
perform 0100-Initialize-List-Container
* perform 0300-Initialize-Filters-Map
* perform 9200-Solicit-Filters
perform 0200-Initialize-List-Map
move zero to Employee-Id
perform 1100-Next-by-Employee-Id
.
0100-Initialize-List-Container.
******************************************************************
* Prepare the List Container work area for first-time use
******************************************************************
initialize LST-Container-Data
move CON-List-Program-Name to LST-Program-Name
move 1 to LST-Current-Page-Number
.
0200-Initialize-List-Map.
******************************************************************
* Prepare the List map for initial display
******************************************************************
move low-values to ELSTMO
move spaces to MSG-Out
.
1000-Process-User-Input.
******************************************************************
* Take the action associated with the Attention Identifier key
* transmitted from the terminal
******************************************************************
EXEC CICS RECEIVE
MAP(CON-List-Map-Name)
MAPSET(CON-List-Mapset-Name)
INTO(ELSTMI)
RESP(W-Resp)
END-EXEC
evaluate EIBAID
when DFHENTER
perform 1500-Display-Details
when DFHPF3
perform 9200-Solicit-Filters
when DFHPF7
perform 1150-Prev-by-Employee-Id
when DFHPF8
perform 1100-Next-by-Employee-Id
when DFHPF10
perform 9900-Sign-User-Off
when DFHPF12
perform 7200-Clear-Filters
perform 9200-Solicit-Filters
when other
move 'Undefined PF key' to MSG-Out
end-evaluate
perform 9100-Display-and-Return
.
1100-Next-by-Employee-Id.
******************************************************************
* Read the next set of records from the Employee Master file
******************************************************************
perform 7500-Browse-Forward
perform 4200-Put-List-Container
move '1100-Next-by-Employee-Id' to MSG-Out
perform 9100-Display-and-Return
.
1150-Prev-by-Employee-Id.
******************************************************************
* Read the previous set of records from the Employee Master file
******************************************************************
move '1150-Prev-by-Employee-Id' to MSG-Out
perform 9100-Display-and-Return
.
1500-Display-Details.
******************************************************************
* Transfer to detail display program.
******************************************************************
move '1500-Display-Details: Did not detect the cursor'
to MSG-Out
move SELCT01F to DFHBMFLG
if DFHCURSR
move '1500-Display-Details: Cursor is on record 1'
to MSG-Out
else
move SELCT02F to DFHBMFLG
if DFHCURSR
move '1500-Display-Details: Cursor is on record 2'
to MSG-Out
else
move SELCT03F to DFHBMFLG
if DFHCURSR
move '1500-Display-Details: Cursor is on record 3'
to MSG-Out
end-if
end-if
end-if
.
1600-Copy-Container-to-Map.
******************************************************************
* Copy the current set of records to the output map
******************************************************************
move low-values to ELSTMO
move EIBTRNID to TRANIDO
move LST-Current-Page-Number to PAGENO
if LST-No-Filters-Are-Set
move MSG-No-Filters-Are-Set to FLTRSO
end-if
move MSG-Out to MESSO
move LST-Current-Record(1) to Employee-Master-Record
move Employee-Id to EMPID01O
move Primary-Name to PRMNM01O
move Job-Title to JOBTL01O
move Department-Id to DPTID01O
move LST-Current-Record(2) to Employee-Master-Record
move Employee-Id to EMPID02O
move Primary-Name to PRMNM02O
move Job-Title to JOBTL02O
move Department-Id to DPTID02O
move LST-Current-Record(3) to Employee-Master-Record
move Employee-Id to EMPID03O
move Primary-Name to PRMNM03O
move Job-Title to JOBTL03O
move Department-Id to DPTID03O
.
4200-Put-List-Container.
******************************************************************
* Copy working storage data to the List container
******************************************************************
move CON-List-Container-Name
to XFER-Container-Name
move CON-List-Channel-Name
to XFER-Channel-Name
move LST-Container-Data
to XFER-Container-Data
move length of LST-Container-Data
to XFER-Container-Data-Length
perform 7300-Put-Container
.
4400-Get-List-Container.
******************************************************************
* Copy List container data to working storage
******************************************************************
move CON-LIST-Container-Name
to XFER-Container-Name
move CON-List-Channel-Name
to XFER-Channel-Name
move length of LST-Container-Data
to XFER-Container-Data-Length
perform 7400-Get-Container
move XFER-Container-Data
to LST-Container-Data
.
7200-Clear-Filters.
******************************************************************
* Rest search/filter values
******************************************************************
continue
.
7300-Put-Container.
******************************************************************
* Copy working storage data to container
******************************************************************
EXEC CICS PUT
CONTAINER(XFER-Container-Name)
CHANNEL(XFER-Channel-Name)
FROM(XFER-Container-Data)
FLENGTH(XFER-Container-Data-Length)
RESP(W-Resp)
END-EXEC
if W-Resp equal DFHRESP(NORMAL)
continue
else
perform 8100-Container-Error
end-if
.
7400-Get-Container.
******************************************************************
* Copy data from a container to working storage
******************************************************************
EXEC CICS GET CONTAINER(XFER-Container-Name)
CHANNEL(XFER-Channel-Name)
INTO(XFER-Container-Data)
FLENGTH(XFER-Container-Data-Length)
RESP(W-Resp)
END-EXEC
.
7500-Browse-Forward.
******************************************************************
* Browse forward starting with the current value of Employee-Id
******************************************************************
EXEC CICS STARTBR
FILE(CON-EMPMAST-File-Name)
RIDFLD(Employee-Id)
RESP(W-Resp)
END-EXEC
move spaces to LST-Current-Record-Area
perform 7520-Read-Next-Record
with test before
varying LST-Record-Index from 1 by 1
until LST-Record-Index greater than 3
EXEC CICS ENDBR
FILE(CON-EMPMAST-File-Name)
END-EXEC
.
7520-Read-Next-Record.
******************************************************************
* Read the next logical record from the Employee Master file
******************************************************************
EXEC CICS READNEXT
FILE(CON-EMPMAST-File-Name)
RIDFLD(Employee-Id)
INTO(Employee-Master-Record)
RESP(W-Resp)
END-EXEC
move Employee-Master-Record
to LST-Current-Record(LST-Record-Index)
.
8100-Container-Error.
******************************************************************
* Display response codes after unexpected condition when
* getting a container
******************************************************************
move XFER-Channel-Name to ERR-Channel-Name
move XFER-Container-Name to ERR-Container-Name
move EIBRESP to ERR-Container-EIBRESP
move EIBRESP2 to ERR-Container-EIBRESP2
move MSG-Container-Error to Msg-Out
perform 9100-Display-and-Return
.
9100-Display-and-Return.
******************************************************************
* Populate fields in the output map with current values and
* display the screen. Pseudoconversational return
******************************************************************
perform 1600-Copy-Container-to-Map
EXEC CICS SEND
MAP(CON-List-Map-Name)
MAPSET(CON-List-Mapset-Name)
FROM(ELSTMO)
ERASE
FREEKB
END-EXEC
EXEC CICS RETURN
TRANSID(EIBTRNID)
CHANNEL(CON-List-Channel-Name)
END-EXEC
.
9200-Solicit-Filters.
******************************************************************
* Display filter input screen to get user's filter values
******************************************************************
move '9200-Solicit-Filters' to Msg-Out
perform 9100-Display-and-Return
.
9900-Sign-User-Off.
******************************************************************
* Call the Activity Monitor to sign the user off and clean up
******************************************************************
EXEC CICS SEND CONTROL
ERASE FREEKB
END-EXEC
EXEC CICS RETURN
END-EXEC
.