******************************************************************
* Program : COUSR00C.CBL
* Application : CardDemo
* Type : CICS COBOL Program
* Function : List all users from USRSEC file
******************************************************************
* Copyright Amazon.com, Inc. or its affiliates.
* All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License").
* You may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
* either express or implied. See the License for the specific
* language governing permissions and limitations under the License
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. COUSR00C.
AUTHOR. AWS.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
*----------------------------------------------------------------*
* WORKING STORAGE SECTION
*----------------------------------------------------------------*
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-PGMNAME PIC X(08) VALUE 'COUSR00C'.
05 WS-TRANID PIC X(04) VALUE 'CU00'.
05 WS-MESSAGE PIC X(80) VALUE SPACES.
05 WS-USRSEC-FILE PIC X(08) VALUE 'USRSEC '.
05 WS-ERR-FLG PIC X(01) VALUE 'N'.
88 ERR-FLG-ON VALUE 'Y'.
88 ERR-FLG-OFF VALUE 'N'.
05 WS-USER-SEC-EOF PIC X(01) VALUE 'N'.
88 USER-SEC-EOF VALUE 'Y'.
88 USER-SEC-NOT-EOF VALUE 'N'.
05 WS-SEND-ERASE-FLG PIC X(01) VALUE 'Y'.
88 SEND-ERASE-YES VALUE 'Y'.
88 SEND-ERASE-NO VALUE 'N'.
05 WS-RESP-CD PIC S9(09) COMP VALUE ZEROS.
05 WS-REAS-CD PIC S9(09) COMP VALUE ZEROS.
05 WS-REC-COUNT PIC S9(04) COMP VALUE ZEROS.
05 WS-IDX PIC S9(04) COMP VALUE ZEROS.
05 WS-PAGE-NUM PIC S9(04) COMP VALUE ZEROS.
01 WS-USER-DATA.
02 USER-REC OCCURS 10 TIMES.
05 USER-SEL PIC X(01).
05 FILLER PIC X(02).
05 USER-ID PIC X(08).
05 FILLER PIC X(02).
05 USER-NAME PIC X(25).
05 FILLER PIC X(02).
05 USER-TYPE PIC X(08).
COPY COCOM01Y.
05 CDEMO-CU00-INFO.
10 CDEMO-CU00-USRID-FIRST PIC X(08).
10 CDEMO-CU00-USRID-LAST PIC X(08).
10 CDEMO-CU00-PAGE-NUM PIC 9(08).
10 CDEMO-CU00-NEXT-PAGE-FLG PIC X(01) VALUE 'N'.
88 NEXT-PAGE-YES VALUE 'Y'.
88 NEXT-PAGE-NO VALUE 'N'.
10 CDEMO-CU00-USR-SEL-FLG PIC X(01).
10 CDEMO-CU00-USR-SELECTED PIC X(08).
COPY COUSR00.
COPY COTTL01Y.
COPY CSDAT01Y.
COPY CSMSG01Y.
COPY CSUSR01Y.
COPY DFHAID.
COPY DFHBMSCA.
*----------------------------------------------------------------*
* LINKAGE SECTION
*----------------------------------------------------------------*
LINKAGE SECTION.
01 DFHCOMMAREA.
05 LK-COMMAREA PIC X(01)
OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
*----------------------------------------------------------------*
* PROCEDURE DIVISION
*----------------------------------------------------------------*
PROCEDURE DIVISION.
MAIN-PARA.
SET ERR-FLG-OFF TO TRUE
SET USER-SEC-NOT-EOF TO TRUE
SET NEXT-PAGE-NO TO TRUE
SET SEND-ERASE-YES TO TRUE
MOVE SPACES TO WS-MESSAGE
ERRMSGO OF COUSR0AO
MOVE -1 TO USRIDINL OF COUSR0AI
IF EIBCALEN = 0
MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
PERFORM RETURN-TO-PREV-SCREEN
ELSE
MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA
IF NOT CDEMO-PGM-REENTER
SET CDEMO-PGM-REENTER TO TRUE
MOVE LOW-VALUES TO COUSR0AO
PERFORM PROCESS-ENTER-KEY
PERFORM SEND-USRLST-SCREEN
ELSE
PERFORM RECEIVE-USRLST-SCREEN
EVALUATE EIBAID
WHEN DFHENTER
PERFORM PROCESS-ENTER-KEY
WHEN DFHPF3
MOVE 'COADM01C' TO CDEMO-TO-PROGRAM
PERFORM RETURN-TO-PREV-SCREEN
WHEN DFHPF7
PERFORM PROCESS-PF7-KEY
WHEN DFHPF8
PERFORM PROCESS-PF8-KEY
WHEN OTHER
MOVE 'Y' TO WS-ERR-FLG
MOVE -1 TO USRIDINL OF COUSR0AI
MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE
PERFORM SEND-USRLST-SCREEN
END-EVALUATE
END-IF
END-IF
EXEC CICS RETURN
TRANSID (WS-TRANID)
COMMAREA (CARDDEMO-COMMAREA)
END-EXEC.
*----------------------------------------------------------------*
* PROCESS-ENTER-KEY
*----------------------------------------------------------------*
PROCESS-ENTER-KEY.
EVALUATE TRUE
WHEN SEL0001I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0001I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID01I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0002I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0002I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID02I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0003I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0003I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID03I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0004I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0004I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID04I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0005I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0005I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID05I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0006I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0006I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID06I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0007I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0007I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID07I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0008I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0008I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID08I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0009I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0009I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID09I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN SEL0010I OF COUSR0AI NOT = SPACES AND LOW-VALUES
MOVE SEL0010I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
MOVE USRID10I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
WHEN OTHER
MOVE SPACES TO CDEMO-CU00-USR-SEL-FLG
MOVE SPACES TO CDEMO-CU00-USR-SELECTED
END-EVALUATE
IF (CDEMO-CU00-USR-SEL-FLG NOT = SPACES AND LOW-VALUES) AND
(CDEMO-CU00-USR-SELECTED NOT = SPACES AND LOW-VALUES)
EVALUATE CDEMO-CU00-USR-SEL-FLG
WHEN 'U'
WHEN 'u'
MOVE 'COUSR02C' TO CDEMO-TO-PROGRAM
MOVE WS-TRANID TO CDEMO-FROM-TRANID
MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
MOVE 0 TO CDEMO-PGM-CONTEXT
EXEC CICS
XCTL PROGRAM(CDEMO-TO-PROGRAM)
COMMAREA(CARDDEMO-COMMAREA)
END-EXEC
WHEN 'D'
WHEN 'd'
MOVE 'COUSR03C' TO CDEMO-TO-PROGRAM
MOVE WS-TRANID TO CDEMO-FROM-TRANID
MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
MOVE 0 TO CDEMO-PGM-CONTEXT
EXEC CICS
XCTL PROGRAM(CDEMO-TO-PROGRAM)
COMMAREA(CARDDEMO-COMMAREA)
END-EXEC
WHEN OTHER
MOVE
'Invalid selection. Valid values are U and D' TO
WS-MESSAGE
MOVE -1 TO USRIDINL OF COUSR0AI
END-EVALUATE
END-IF
IF USRIDINI OF COUSR0AI = SPACES OR LOW-VALUES
MOVE LOW-VALUES TO SEC-USR-ID
ELSE
MOVE USRIDINI OF COUSR0AI TO SEC-USR-ID
END-IF
MOVE -1 TO USRIDINL OF COUSR0AI
MOVE 0 TO CDEMO-CU00-PAGE-NUM
PERFORM PROCESS-PAGE-FORWARD
IF NOT ERR-FLG-ON
MOVE SPACE TO USRIDINO OF COUSR0AO
END-IF.
*----------------------------------------------------------------*
* PROCESS-PF7-KEY
*----------------------------------------------------------------*
PROCESS-PF7-KEY.
IF CDEMO-CU00-USRID-FIRST = SPACES OR LOW-VALUES
MOVE LOW-VALUES TO SEC-USR-ID
ELSE
MOVE CDEMO-CU00-USRID-FIRST TO SEC-USR-ID
END-IF
SET NEXT-PAGE-YES TO TRUE
MOVE -1 TO USRIDINL OF COUSR0AI
IF CDEMO-CU00-PAGE-NUM > 1
PERFORM PROCESS-PAGE-BACKWARD
ELSE
MOVE 'You are already at the top of the page...' TO
WS-MESSAGE
SET SEND-ERASE-NO TO TRUE
PERFORM SEND-USRLST-SCREEN
END-IF.
*----------------------------------------------------------------*
* PROCESS-PF8-KEY
*----------------------------------------------------------------*
PROCESS-PF8-KEY.
IF CDEMO-CU00-USRID-LAST = SPACES OR LOW-VALUES
MOVE HIGH-VALUES TO SEC-USR-ID
ELSE
MOVE CDEMO-CU00-USRID-LAST TO SEC-USR-ID
END-IF
MOVE -1 TO USRIDINL OF COUSR0AI
IF NEXT-PAGE-YES
PERFORM PROCESS-PAGE-FORWARD
ELSE
MOVE 'You are already at the bottom of the page...' TO
WS-MESSAGE
SET SEND-ERASE-NO TO TRUE
PERFORM SEND-USRLST-SCREEN
END-IF.
*----------------------------------------------------------------*
* PROCESS-PAGE-FORWARD
*----------------------------------------------------------------*
PROCESS-PAGE-FORWARD.
PERFORM STARTBR-USER-SEC-FILE
IF NOT ERR-FLG-ON
IF EIBAID NOT = DFHENTER AND DFHPF7 AND DFHPF3
PERFORM READNEXT-USER-SEC-FILE
END-IF
IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 10
PERFORM INITIALIZE-USER-DATA
END-PERFORM
END-IF
MOVE 1 TO WS-IDX
PERFORM UNTIL WS-IDX >= 11 OR USER-SEC-EOF OR ERR-FLG-ON
PERFORM READNEXT-USER-SEC-FILE
IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
PERFORM POPULATE-USER-DATA
COMPUTE WS-IDX = WS-IDX + 1
END-IF
END-PERFORM
IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
COMPUTE CDEMO-CU00-PAGE-NUM =
CDEMO-CU00-PAGE-NUM + 1
PERFORM READNEXT-USER-SEC-FILE
IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
SET NEXT-PAGE-YES TO TRUE
ELSE
SET NEXT-PAGE-NO TO TRUE
END-IF
ELSE
SET NEXT-PAGE-NO TO TRUE
IF WS-IDX > 1
COMPUTE CDEMO-CU00-PAGE-NUM = CDEMO-CU00-PAGE-NUM
+ 1
END-IF
END-IF
PERFORM ENDBR-USER-SEC-FILE
MOVE CDEMO-CU00-PAGE-NUM TO PAGENUMI OF COUSR0AI
MOVE SPACE TO USRIDINO OF COUSR0AO
PERFORM SEND-USRLST-SCREEN
END-IF.
*----------------------------------------------------------------*
* PROCESS-PAGE-BACKWARD
*----------------------------------------------------------------*
PROCESS-PAGE-BACKWARD.
PERFORM STARTBR-USER-SEC-FILE
IF NOT ERR-FLG-ON
IF EIBAID NOT = DFHENTER AND DFHPF8
PERFORM READPREV-USER-SEC-FILE
END-IF
IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 10
PERFORM INITIALIZE-USER-DATA
END-PERFORM
END-IF
MOVE 10 TO WS-IDX
PERFORM UNTIL WS-IDX <= 0 OR USER-SEC-EOF OR ERR-FLG-ON
PERFORM READPREV-USER-SEC-FILE
IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
PERFORM POPULATE-USER-DATA
COMPUTE WS-IDX = WS-IDX - 1
END-IF
END-PERFORM
IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
PERFORM READPREV-USER-SEC-FILE
IF NEXT-PAGE-YES
IF USER-SEC-NOT-EOF AND ERR-FLG-OFF AND
CDEMO-CU00-PAGE-NUM > 1
SUBTRACT 1 FROM CDEMO-CU00-PAGE-NUM
ELSE
MOVE 1 TO CDEMO-CU00-PAGE-NUM
END-IF
END-IF
END-IF
PERFORM ENDBR-USER-SEC-FILE
MOVE CDEMO-CU00-PAGE-NUM TO PAGENUMI OF COUSR0AI
PERFORM SEND-USRLST-SCREEN
END-IF.
*----------------------------------------------------------------*
* POPULATE-USER-DATA
*----------------------------------------------------------------*
POPULATE-USER-DATA.
EVALUATE WS-IDX
WHEN 1
MOVE SEC-USR-ID TO USRID01I OF COUSR0AI
CDEMO-CU00-USRID-FIRST
MOVE SEC-USR-FNAME TO FNAME01I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME01I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE01I OF COUSR0AI
WHEN 2
MOVE SEC-USR-ID TO USRID02I OF COUSR0AI
MOVE SEC-USR-FNAME TO FNAME02I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME02I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE02I OF COUSR0AI
WHEN 3
MOVE SEC-USR-ID TO USRID03I OF COUSR0AI
MOVE SEC-USR-FNAME TO FNAME03I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME03I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE03I OF COUSR0AI
WHEN 4
MOVE SEC-USR-ID TO USRID04I OF COUSR0AI
MOVE SEC-USR-FNAME TO FNAME04I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME04I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE04I OF COUSR0AI
WHEN 5
MOVE SEC-USR-ID TO USRID05I OF COUSR0AI
MOVE SEC-USR-FNAME TO FNAME05I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME05I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE05I OF COUSR0AI
WHEN 6
MOVE SEC-USR-ID TO USRID06I OF COUSR0AI
MOVE SEC-USR-FNAME TO FNAME06I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME06I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE06I OF COUSR0AI
WHEN 7
MOVE SEC-USR-ID TO USRID07I OF COUSR0AI
MOVE SEC-USR-FNAME TO FNAME07I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME07I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE07I OF COUSR0AI
WHEN 8
MOVE SEC-USR-ID TO USRID08I OF COUSR0AI
MOVE SEC-USR-FNAME TO FNAME08I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME08I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE08I OF COUSR0AI
WHEN 9
MOVE SEC-USR-ID TO USRID09I OF COUSR0AI
MOVE SEC-USR-FNAME TO FNAME09I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME09I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE09I OF COUSR0AI
WHEN 10
MOVE SEC-USR-ID TO USRID10I OF COUSR0AI
CDEMO-CU00-USRID-LAST
MOVE SEC-USR-FNAME TO FNAME10I OF COUSR0AI
MOVE SEC-USR-LNAME TO LNAME10I OF COUSR0AI
MOVE SEC-USR-TYPE TO UTYPE10I OF COUSR0AI
WHEN OTHER
CONTINUE
END-EVALUATE.
*----------------------------------------------------------------*
* INITIALIZE-USER-DATA
*----------------------------------------------------------------*
INITIALIZE-USER-DATA.
EVALUATE WS-IDX
WHEN 1
MOVE SPACES TO USRID01I OF COUSR0AI
MOVE SPACES TO FNAME01I OF COUSR0AI
MOVE SPACES TO LNAME01I OF COUSR0AI
MOVE SPACES TO UTYPE01I OF COUSR0AI
WHEN 2
MOVE SPACES TO USRID02I OF COUSR0AI
MOVE SPACES TO FNAME02I OF COUSR0AI
MOVE SPACES TO LNAME02I OF COUSR0AI
MOVE SPACES TO UTYPE02I OF COUSR0AI
WHEN 3
MOVE SPACES TO USRID03I OF COUSR0AI
MOVE SPACES TO FNAME03I OF COUSR0AI
MOVE SPACES TO LNAME03I OF COUSR0AI
MOVE SPACES TO UTYPE03I OF COUSR0AI
WHEN 4
MOVE SPACES TO USRID04I OF COUSR0AI
MOVE SPACES TO FNAME04I OF COUSR0AI
MOVE SPACES TO LNAME04I OF COUSR0AI
MOVE SPACES TO UTYPE04I OF COUSR0AI
WHEN 5
MOVE SPACES TO USRID05I OF COUSR0AI
MOVE SPACES TO FNAME05I OF COUSR0AI
MOVE SPACES TO LNAME05I OF COUSR0AI
MOVE SPACES TO UTYPE05I OF COUSR0AI
WHEN 6
MOVE SPACES TO USRID06I OF COUSR0AI
MOVE SPACES TO FNAME06I OF COUSR0AI
MOVE SPACES TO LNAME06I OF COUSR0AI
MOVE SPACES TO UTYPE06I OF COUSR0AI
WHEN 7
MOVE SPACES TO USRID07I OF COUSR0AI
MOVE SPACES TO FNAME07I OF COUSR0AI
MOVE SPACES TO LNAME07I OF COUSR0AI
MOVE SPACES TO UTYPE07I OF COUSR0AI
WHEN 8
MOVE SPACES TO USRID08I OF COUSR0AI
MOVE SPACES TO FNAME08I OF COUSR0AI
MOVE SPACES TO LNAME08I OF COUSR0AI
MOVE SPACES TO UTYPE08I OF COUSR0AI
WHEN 9
MOVE SPACES TO USRID09I OF COUSR0AI
MOVE SPACES TO FNAME09I OF COUSR0AI
MOVE SPACES TO LNAME09I OF COUSR0AI
MOVE SPACES TO UTYPE09I OF COUSR0AI
WHEN 10
MOVE SPACES TO USRID10I OF COUSR0AI
MOVE SPACES TO FNAME10I OF COUSR0AI
MOVE SPACES TO LNAME10I OF COUSR0AI
MOVE SPACES TO UTYPE10I OF COUSR0AI
WHEN OTHER
CONTINUE
END-EVALUATE.
*----------------------------------------------------------------*
* RETURN-TO-PREV-SCREEN
*----------------------------------------------------------------*
RETURN-TO-PREV-SCREEN.
IF CDEMO-TO-PROGRAM = LOW-VALUES OR SPACES
MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
END-IF
MOVE WS-TRANID TO CDEMO-FROM-TRANID
MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
MOVE ZEROS TO CDEMO-PGM-CONTEXT
EXEC CICS
XCTL PROGRAM(CDEMO-TO-PROGRAM)
COMMAREA(CARDDEMO-COMMAREA)
END-EXEC.
*----------------------------------------------------------------*
* SEND-USRLST-SCREEN
*----------------------------------------------------------------*
SEND-USRLST-SCREEN.
PERFORM POPULATE-HEADER-INFO
MOVE WS-MESSAGE TO ERRMSGO OF COUSR0AO
IF SEND-ERASE-YES
EXEC CICS SEND
MAP('COUSR0A')
MAPSET('COUSR00')
FROM(COUSR0AO)
ERASE
CURSOR
END-EXEC
ELSE
EXEC CICS SEND
MAP('COUSR0A')
MAPSET('COUSR00')
FROM(COUSR0AO)
* ERASE
CURSOR
END-EXEC
END-IF.
*----------------------------------------------------------------*
* RECEIVE-USRLST-SCREEN
*----------------------------------------------------------------*
RECEIVE-USRLST-SCREEN.
EXEC CICS RECEIVE
MAP('COUSR0A')
MAPSET('COUSR00')
INTO(COUSR0AI)
RESP(WS-RESP-CD)
RESP2(WS-REAS-CD)
END-EXEC.
*----------------------------------------------------------------*
* POPULATE-HEADER-INFO
*----------------------------------------------------------------*
POPULATE-HEADER-INFO.
MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
MOVE CCDA-TITLE01 TO TITLE01O OF COUSR0AO
MOVE CCDA-TITLE02 TO TITLE02O OF COUSR0AO
MOVE WS-TRANID TO TRNNAMEO OF COUSR0AO
MOVE WS-PGMNAME TO PGMNAMEO OF COUSR0AO
MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COUSR0AO
MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COUSR0AO.
*----------------------------------------------------------------*
* STARTBR-USER-SEC-FILE
*----------------------------------------------------------------*
STARTBR-USER-SEC-FILE.
EXEC CICS STARTBR
DATASET (WS-USRSEC-FILE)
RIDFLD (SEC-USR-ID)
KEYLENGTH (LENGTH OF SEC-USR-ID)
* GTEQ
RESP (WS-RESP-CD)
RESP2 (WS-REAS-CD)
END-EXEC.
EVALUATE WS-RESP-CD
WHEN DFHRESP(NORMAL)
CONTINUE
WHEN DFHRESP(NOTFND)
CONTINUE
SET USER-SEC-EOF TO TRUE
MOVE 'You are at the top of the page...' TO
WS-MESSAGE
MOVE -1 TO USRIDINL OF COUSR0AI
PERFORM SEND-USRLST-SCREEN
WHEN OTHER
DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
MOVE 'Y' TO WS-ERR-FLG
MOVE 'Unable to lookup User...' TO
WS-MESSAGE
MOVE -1 TO USRIDINL OF COUSR0AI
PERFORM SEND-USRLST-SCREEN
END-EVALUATE.
*----------------------------------------------------------------*
* READNEXT-USER-SEC-FILE
*----------------------------------------------------------------*
READNEXT-USER-SEC-FILE.
EXEC CICS READNEXT
DATASET (WS-USRSEC-FILE)
INTO (SEC-USER-DATA)
LENGTH (LENGTH OF SEC-USER-DATA)
RIDFLD (SEC-USR-ID)
KEYLENGTH (LENGTH OF SEC-USR-ID)
RESP (WS-RESP-CD)
RESP2 (WS-REAS-CD)
END-EXEC.
EVALUATE WS-RESP-CD
WHEN DFHRESP(NORMAL)
CONTINUE
WHEN DFHRESP(ENDFILE)
CONTINUE
SET USER-SEC-EOF TO TRUE
MOVE 'You have reached the bottom of the page...' TO
WS-MESSAGE
MOVE -1 TO USRIDINL OF COUSR0AI
PERFORM SEND-USRLST-SCREEN
WHEN OTHER
DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
MOVE 'Y' TO WS-ERR-FLG
MOVE 'Unable to lookup User...' TO
WS-MESSAGE
MOVE -1 TO USRIDINL OF COUSR0AI
PERFORM SEND-USRLST-SCREEN
END-EVALUATE.
*----------------------------------------------------------------*
* READPREV-USER-SEC-FILE
*----------------------------------------------------------------*
READPREV-USER-SEC-FILE.
EXEC CICS READPREV
DATASET (WS-USRSEC-FILE)
INTO (SEC-USER-DATA)
LENGTH (LENGTH OF SEC-USER-DATA)
RIDFLD (SEC-USR-ID)
KEYLENGTH (LENGTH OF SEC-USR-ID)
RESP (WS-RESP-CD)
RESP2 (WS-REAS-CD)
END-EXEC.
EVALUATE WS-RESP-CD
WHEN DFHRESP(NORMAL)
CONTINUE
WHEN DFHRESP(ENDFILE)
CONTINUE
SET USER-SEC-EOF TO TRUE
MOVE 'You have reached the top of the page...' TO
WS-MESSAGE
MOVE -1 TO USRIDINL OF COUSR0AI
PERFORM SEND-USRLST-SCREEN
WHEN OTHER
DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
MOVE 'Y' TO WS-ERR-FLG
MOVE 'Unable to lookup User...' TO
WS-MESSAGE
MOVE -1 TO USRIDINL OF COUSR0AI
PERFORM SEND-USRLST-SCREEN
END-EVALUATE.
*----------------------------------------------------------------*
* ENDBR-USER-SEC-FILE
*----------------------------------------------------------------*
ENDBR-USER-SEC-FILE.
EXEC CICS ENDBR
DATASET (WS-USRSEC-FILE)
END-EXEC.
*
* Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:34 CDT
*