****************************************************************** * Program : CBACT02C.CBL * Application : CardDemo * Type : BATCH COBOL Program * Function : Read and print card data 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. CBACT02C. AUTHOR. AWS. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT CARDFILE-FILE ASSIGN TO CARDFILE ORGANIZATION IS INDEXED ACCESS MODE IS SEQUENTIAL RECORD KEY IS FD-CARD-NUM FILE STATUS IS CARDFILE-STATUS. * DATA DIVISION. FILE SECTION. FD CARDFILE-FILE. 01 FD-CARDFILE-REC. 05 FD-CARD-NUM PIC X(16). 05 FD-CARD-DATA PIC X(134). WORKING-STORAGE SECTION. ***************************************************************** COPY CVACT02Y. 01 CARDFILE-STATUS. 05 CARDFILE-STAT1 PIC X. 05 CARDFILE-STAT2 PIC X. 01 IO-STATUS. 05 IO-STAT1 PIC X. 05 IO-STAT2 PIC X. 01 TWO-BYTES-BINARY PIC 9(4) BINARY. 01 TWO-BYTES-ALPHA REDEFINES TWO-BYTES-BINARY. 05 TWO-BYTES-LEFT PIC X. 05 TWO-BYTES-RIGHT PIC X. 01 IO-STATUS-04. 05 IO-STATUS-0401 PIC 9 VALUE 0. 05 IO-STATUS-0403 PIC 999 VALUE 0. 01 APPL-RESULT PIC S9(9) COMP. 88 APPL-AOK VALUE 0. 88 APPL-EOF VALUE 16. 01 END-OF-FILE PIC X(01) VALUE 'N'. 01 ABCODE PIC S9(9) BINARY. 01 TIMING PIC S9(9) BINARY. ***************************************************************** PROCEDURE DIVISION. DISPLAY 'START OF EXECUTION OF PROGRAM CBACT02C'. PERFORM 0000-CARDFILE-OPEN. PERFORM UNTIL END-OF-FILE = 'Y' IF END-OF-FILE = 'N' PERFORM 1000-CARDFILE-GET-NEXT IF END-OF-FILE = 'N' DISPLAY CARD-RECORD END-IF END-IF END-PERFORM. PERFORM 9000-CARDFILE-CLOSE. DISPLAY 'END OF EXECUTION OF PROGRAM CBACT02C'. GOBACK. ***************************************************************** * I/O ROUTINES TO ACCESS A KSDS, VSAM DATA SET... * ***************************************************************** 1000-CARDFILE-GET-NEXT. READ CARDFILE-FILE INTO CARD-RECORD. IF CARDFILE-STATUS = '00' MOVE 0 TO APPL-RESULT * DISPLAY CARD-RECORD ELSE IF CARDFILE-STATUS = '10' MOVE 16 TO APPL-RESULT ELSE MOVE 12 TO APPL-RESULT END-IF END-IF IF APPL-AOK CONTINUE ELSE IF APPL-EOF MOVE 'Y' TO END-OF-FILE ELSE DISPLAY 'ERROR READING CARDFILE' MOVE CARDFILE-STATUS TO IO-STATUS PERFORM 9910-DISPLAY-IO-STATUS PERFORM 9999-ABEND-PROGRAM END-IF END-IF EXIT. *---------------------------------------------------------------* 0000-CARDFILE-OPEN. MOVE 8 TO APPL-RESULT. OPEN INPUT CARDFILE-FILE IF CARDFILE-STATUS = '00' MOVE 0 TO APPL-RESULT ELSE MOVE 12 TO APPL-RESULT END-IF IF APPL-AOK CONTINUE ELSE DISPLAY 'ERROR OPENING CARDFILE' MOVE CARDFILE-STATUS TO IO-STATUS PERFORM 9910-DISPLAY-IO-STATUS PERFORM 9999-ABEND-PROGRAM END-IF EXIT. *---------------------------------------------------------------* 9000-CARDFILE-CLOSE. ADD 8 TO ZERO GIVING APPL-RESULT. CLOSE CARDFILE-FILE IF CARDFILE-STATUS = '00' SUBTRACT APPL-RESULT FROM APPL-RESULT ELSE ADD 12 TO ZERO GIVING APPL-RESULT END-IF IF APPL-AOK CONTINUE ELSE DISPLAY 'ERROR CLOSING CARDFILE' MOVE CARDFILE-STATUS TO IO-STATUS PERFORM 9910-DISPLAY-IO-STATUS PERFORM 9999-ABEND-PROGRAM END-IF EXIT. 9999-ABEND-PROGRAM. DISPLAY 'ABENDING PROGRAM' MOVE 0 TO TIMING MOVE 999 TO ABCODE CALL 'CEE3ABD'. ***************************************************************** 9910-DISPLAY-IO-STATUS. IF IO-STATUS NOT NUMERIC OR IO-STAT1 = '9' MOVE IO-STAT1 TO IO-STATUS-04(1:1) MOVE 0 TO TWO-BYTES-BINARY MOVE IO-STAT2 TO TWO-BYTES-RIGHT MOVE TWO-BYTES-BINARY TO IO-STATUS-0403 DISPLAY 'FILE STATUS IS: NNNN' IO-STATUS-04 ELSE MOVE '0000' TO IO-STATUS-04 MOVE IO-STATUS TO IO-STATUS-04(3:2) DISPLAY 'FILE STATUS IS: NNNN' IO-STATUS-04 END-IF EXIT. * * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:31 CDT *