****************************************************************** * Program : COUSR02C.CBL * Application : CardDemo * Type : CICS COBOL Program * Function : Update a user in 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. COUSR02C. AUTHOR. AWS. ENVIRONMENT DIVISION. CONFIGURATION SECTION. DATA DIVISION. *----------------------------------------------------------------* * WORKING STORAGE SECTION *----------------------------------------------------------------* WORKING-STORAGE SECTION. 01 WS-VARIABLES. 05 WS-PGMNAME PIC X(08) VALUE 'COUSR02C'. 05 WS-TRANID PIC X(04) VALUE 'CU02'. 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-RESP-CD PIC S9(09) COMP VALUE ZEROS. 05 WS-REAS-CD PIC S9(09) COMP VALUE ZEROS. 05 WS-USR-MODIFIED PIC X(01) VALUE 'N'. 88 USR-MODIFIED-YES VALUE 'Y'. 88 USR-MODIFIED-NO VALUE 'N'. COPY COCOM01Y. 05 CDEMO-CU02-INFO. 10 CDEMO-CU02-USRID-FIRST PIC X(08). 10 CDEMO-CU02-USRID-LAST PIC X(08). 10 CDEMO-CU02-PAGE-NUM PIC 9(08). 10 CDEMO-CU02-NEXT-PAGE-FLG PIC X(01) VALUE 'N'. 88 NEXT-PAGE-YES VALUE 'Y'. 88 NEXT-PAGE-NO VALUE 'N'. 10 CDEMO-CU02-USR-SEL-FLG PIC X(01). 10 CDEMO-CU02-USR-SELECTED PIC X(08). COPY COUSR02. 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 USR-MODIFIED-NO TO TRUE MOVE SPACES TO WS-MESSAGE ERRMSGO OF COUSR2AO 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 COUSR2AO MOVE -1 TO USRIDINL OF COUSR2AI IF CDEMO-CU02-USR-SELECTED NOT = SPACES AND LOW-VALUES MOVE CDEMO-CU02-USR-SELECTED TO USRIDINI OF COUSR2AI PERFORM PROCESS-ENTER-KEY END-IF PERFORM SEND-USRUPD-SCREEN ELSE PERFORM RECEIVE-USRUPD-SCREEN EVALUATE EIBAID WHEN DFHENTER PERFORM PROCESS-ENTER-KEY WHEN DFHPF3 PERFORM UPDATE-USER-INFO IF CDEMO-FROM-PROGRAM = SPACES OR LOW-VALUES MOVE 'COADM01C' TO CDEMO-TO-PROGRAM ELSE MOVE CDEMO-FROM-PROGRAM TO CDEMO-TO-PROGRAM END-IF PERFORM RETURN-TO-PREV-SCREEN WHEN DFHPF4 PERFORM CLEAR-CURRENT-SCREEN WHEN DFHPF5 PERFORM UPDATE-USER-INFO WHEN DFHPF12 MOVE 'COADM01C' TO CDEMO-TO-PROGRAM PERFORM RETURN-TO-PREV-SCREEN WHEN OTHER MOVE 'Y' TO WS-ERR-FLG MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE PERFORM SEND-USRUPD-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 USRIDINI OF COUSR2AI = SPACES OR LOW-VALUES MOVE 'Y' TO WS-ERR-FLG MOVE 'User ID can NOT be empty...' TO WS-MESSAGE MOVE -1 TO USRIDINL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN WHEN OTHER MOVE -1 TO USRIDINL OF COUSR2AI CONTINUE END-EVALUATE IF NOT ERR-FLG-ON MOVE SPACES TO FNAMEI OF COUSR2AI LNAMEI OF COUSR2AI PASSWDI OF COUSR2AI USRTYPEI OF COUSR2AI MOVE USRIDINI OF COUSR2AI TO SEC-USR-ID PERFORM READ-USER-SEC-FILE END-IF. IF NOT ERR-FLG-ON MOVE SEC-USR-FNAME TO FNAMEI OF COUSR2AI MOVE SEC-USR-LNAME TO LNAMEI OF COUSR2AI MOVE SEC-USR-PWD TO PASSWDI OF COUSR2AI MOVE SEC-USR-TYPE TO USRTYPEI OF COUSR2AI PERFORM SEND-USRUPD-SCREEN END-IF. *----------------------------------------------------------------* * UPDATE-USER-INFO *----------------------------------------------------------------* UPDATE-USER-INFO. EVALUATE TRUE WHEN USRIDINI OF COUSR2AI = SPACES OR LOW-VALUES MOVE 'Y' TO WS-ERR-FLG MOVE 'User ID can NOT be empty...' TO WS-MESSAGE MOVE -1 TO USRIDINL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN WHEN FNAMEI OF COUSR2AI = SPACES OR LOW-VALUES MOVE 'Y' TO WS-ERR-FLG MOVE 'First Name can NOT be empty...' TO WS-MESSAGE MOVE -1 TO FNAMEL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN WHEN LNAMEI OF COUSR2AI = SPACES OR LOW-VALUES MOVE 'Y' TO WS-ERR-FLG MOVE 'Last Name can NOT be empty...' TO WS-MESSAGE MOVE -1 TO LNAMEL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN WHEN PASSWDI OF COUSR2AI = SPACES OR LOW-VALUES MOVE 'Y' TO WS-ERR-FLG MOVE 'Password can NOT be empty...' TO WS-MESSAGE MOVE -1 TO PASSWDL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN WHEN USRTYPEI OF COUSR2AI = SPACES OR LOW-VALUES MOVE 'Y' TO WS-ERR-FLG MOVE 'User Type can NOT be empty...' TO WS-MESSAGE MOVE -1 TO USRTYPEL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN WHEN OTHER MOVE -1 TO FNAMEL OF COUSR2AI CONTINUE END-EVALUATE IF NOT ERR-FLG-ON MOVE USRIDINI OF COUSR2AI TO SEC-USR-ID PERFORM READ-USER-SEC-FILE IF FNAMEI OF COUSR2AI NOT = SEC-USR-FNAME MOVE FNAMEI OF COUSR2AI TO SEC-USR-FNAME SET USR-MODIFIED-YES TO TRUE END-IF IF LNAMEI OF COUSR2AI NOT = SEC-USR-LNAME MOVE LNAMEI OF COUSR2AI TO SEC-USR-LNAME SET USR-MODIFIED-YES TO TRUE END-IF IF PASSWDI OF COUSR2AI NOT = SEC-USR-PWD MOVE PASSWDI OF COUSR2AI TO SEC-USR-PWD SET USR-MODIFIED-YES TO TRUE END-IF IF USRTYPEI OF COUSR2AI NOT = SEC-USR-TYPE MOVE USRTYPEI OF COUSR2AI TO SEC-USR-TYPE SET USR-MODIFIED-YES TO TRUE END-IF IF USR-MODIFIED-YES PERFORM UPDATE-USER-SEC-FILE ELSE MOVE 'Please modify to update ...' TO WS-MESSAGE MOVE DFHRED TO ERRMSGC OF COUSR2AO PERFORM SEND-USRUPD-SCREEN END-IF END-IF. *----------------------------------------------------------------* * 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-USRUPD-SCREEN *----------------------------------------------------------------* SEND-USRUPD-SCREEN. PERFORM POPULATE-HEADER-INFO MOVE WS-MESSAGE TO ERRMSGO OF COUSR2AO EXEC CICS SEND MAP('COUSR2A') MAPSET('COUSR02') FROM(COUSR2AO) ERASE CURSOR END-EXEC. *----------------------------------------------------------------* * RECEIVE-USRUPD-SCREEN *----------------------------------------------------------------* RECEIVE-USRUPD-SCREEN. EXEC CICS RECEIVE MAP('COUSR2A') MAPSET('COUSR02') INTO(COUSR2AI) 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 COUSR2AO MOVE CCDA-TITLE02 TO TITLE02O OF COUSR2AO MOVE WS-TRANID TO TRNNAMEO OF COUSR2AO MOVE WS-PGMNAME TO PGMNAMEO OF COUSR2AO 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 COUSR2AO 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 COUSR2AO. *----------------------------------------------------------------* * READ-USER-SEC-FILE *----------------------------------------------------------------* READ-USER-SEC-FILE. EXEC CICS READ DATASET (WS-USRSEC-FILE) INTO (SEC-USER-DATA) LENGTH (LENGTH OF SEC-USER-DATA) RIDFLD (SEC-USR-ID) KEYLENGTH (LENGTH OF SEC-USR-ID) UPDATE RESP (WS-RESP-CD) RESP2 (WS-REAS-CD) END-EXEC. EVALUATE WS-RESP-CD WHEN DFHRESP(NORMAL) CONTINUE MOVE 'Press PF5 key to save your updates ...' TO WS-MESSAGE MOVE DFHNEUTR TO ERRMSGC OF COUSR2AO PERFORM SEND-USRUPD-SCREEN WHEN DFHRESP(NOTFND) MOVE 'Y' TO WS-ERR-FLG MOVE 'User ID NOT found...' TO WS-MESSAGE MOVE -1 TO USRIDINL OF COUSR2AI PERFORM SEND-USRUPD-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 FNAMEL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN END-EVALUATE. *----------------------------------------------------------------* * UPDATE-USER-SEC-FILE *----------------------------------------------------------------* UPDATE-USER-SEC-FILE. EXEC CICS REWRITE DATASET (WS-USRSEC-FILE) FROM (SEC-USER-DATA) LENGTH (LENGTH OF SEC-USER-DATA) RESP (WS-RESP-CD) RESP2 (WS-REAS-CD) END-EXEC. EVALUATE WS-RESP-CD WHEN DFHRESP(NORMAL) MOVE SPACES TO WS-MESSAGE MOVE DFHGREEN TO ERRMSGC OF COUSR2AO STRING 'User ' DELIMITED BY SIZE SEC-USR-ID DELIMITED BY SPACE ' has been updated ...' DELIMITED BY SIZE INTO WS-MESSAGE PERFORM SEND-USRUPD-SCREEN WHEN DFHRESP(NOTFND) MOVE 'Y' TO WS-ERR-FLG MOVE 'User ID NOT found...' TO WS-MESSAGE MOVE -1 TO USRIDINL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN WHEN OTHER DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD MOVE 'Y' TO WS-ERR-FLG MOVE 'Unable to Update User...' TO WS-MESSAGE MOVE -1 TO FNAMEL OF COUSR2AI PERFORM SEND-USRUPD-SCREEN END-EVALUATE. *----------------------------------------------------------------* * CLEAR-CURRENT-SCREEN *----------------------------------------------------------------* CLEAR-CURRENT-SCREEN. PERFORM INITIALIZE-ALL-FIELDS. PERFORM SEND-USRUPD-SCREEN. *----------------------------------------------------------------* * INITIALIZE-ALL-FIELDS *----------------------------------------------------------------* INITIALIZE-ALL-FIELDS. MOVE -1 TO USRIDINL OF COUSR2AI MOVE SPACES TO USRIDINI OF COUSR2AI FNAMEI OF COUSR2AI LNAMEI OF COUSR2AI PASSWDI OF COUSR2AI USRTYPEI OF COUSR2AI WS-MESSAGE. * * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:34 CDT *