COBOL Prog to delete record from KSDS :
*Record can not be deleted from ESDS or flat file(PS) thru program, records can be deleted only from KSDS & RRDS files.
IDENTIFICATION DIVISION.
PROGRAM-ID. DLKSDSRC.
AUTHOR. SANDIP WALSINGE.
DATE-WRITTEN. 2020-05-04.
DATE-COMPILED. 2020-05-04.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-390.
OBJECT-COMPUTER. IBM-390.
SPECIAL-NAMES.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INFILE ASSIGN TO DD1
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS EIDI
FILE STATUS IS FS1.
DATA DIVISION.
FILE SECTION.
FD INFILE.
01 INREC.
05 EIDI PIC X(05).
05 FILLER PIC X(01).
05 ENAMEI PIC X(06).
05 FILLER PIC X(01).
05 ESALI PIC 9(05).
05 FILLER PIC X(62).
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-COUNT PIC 9(04) VALUE ZERO.
05 WS-REC.
10 WS-EID PIC X(05).
10 FILLER PIC X(01).
10 WS-ENAME PIC X(06).
10 FILLER PIC X(01).
10 WS-SAL PIC 9(05).
10 FILLER PIC X(64).
05 FS1 PIC X(02).
05 FS2 PIC X(02).
05 FILE-END PIC X(01).
88 EOF VALUE 'Y'.
88 NOT-EOF VALUE 'N'.
PROCEDURE DIVISION.
SET NOT-EOF TO TRUE
PERFORM OPEN-PARA
PERFORM PROC-PARA UNTIL EOF
PERFORM CLOS-PARA
PERFORM STOP-PARA.
OPEN-PARA.
OPEN I-O INFILE
DISPLAY 'OPEN INFILE STATUS : ' FS1
MOVE '21400' TO EIDI
EXIT.
PROC-PARA.
IF FS1 = '00'
READ INFILE
INTO WS-REC
KEY IS EIDI
INVALID KEY
DISPLAY ' RECORD NOT FOUND '
NOT INVALID KEY
DISPLAY ' DELETING RECORD '
DISPLAY ' DELETED RECORD ' WS-REC
DELETE INFILE
ADD 1 TO WS-COUNT
SET EOF TO TRUE
END-READ
END-IF.
EXIT.
CLOS-PARA.
CLOSE INFILE
DISPLAY 'CLOSE INFILE STATUS : ' FS1
EXIT.
STOP-PARA.
DISPLAY ' TOTAL RECORD COUNT : ' WS-COUNT.
DISPLAY ' THIS IS END OF PROGRAM '.
STOP RUN.
JCL TO EXECUTE ABOVE PROGRAM:
//Z57658SA JOB (3P10),'RUN JCL',
// CLASS=A,
// MSGCLASS=Q,
// NOTIFY=Z57658
//*
//JCL1 JCLLIB ORDER=Z57658.SOURCE.PROCLIB
//*
//STEP1 EXEC IGYWCLG,MEM=DLKSDSRC
//COBOL.SYSIN DD DSN=Z57658.SOURCE.COBOL(&MEM),DISP=SHR
//LKED.SYSLMOD DD DSN=Z57658.SOURCE.LOADLIB(&MEM),DISP=SHR
//GO.DD1 DD DSN=Z57658.TEST.KSDS,DISP=SHR => BASE CLUSTER
//GO.SYSIN DD *
//*
DATA FROM INPUT KSDS CLUSTER FILE:
View Z57658.TEST.KSDS
Command ===>
Type KSDS
Key
<===>----10---+----2----+----3---
****** **** Top of data ****
000001 21000 MANJIT 75500
000002 21400 SANDIP 25500
000003 21500 MANDIP 35500
000004 21600 RANDIP 45500
000005 21700 BALDIP 55500
000006 21800 KULDIP 65500
****** **** End of data ****
OUTPUT OF PROGRAM:
********************************* TOP OF DATA **
OPEN INFILE STATUS : 00
DELETING RECORD
DELETED RECORD 21400 SANDIP 25500
CLOSE INFILE STATUS : 00
TOTAL RECORD COUNT : 0001
THIS IS END OF PROGRAM
******************************** BOTTOM OF DATA
DATA OF KSDS FILE AFTER EXECUTION OF PROGRAM:
View Z57658.TEST.KSDS
Command ===>
Type KSDS
Key
<===>----10---+----2----+----3----
****** **** Top of data ****
000001 21000 MANJIT 75500
000002 21500 MANDIP 35500
000003 21600 RANDIP 45500
000004 21700 BALDIP 55500
000005 21800 KULDIP 65500
****** **** End of data ****
*Record can not be deleted from ESDS or flat file(PS) thru program, records can be deleted only from KSDS & RRDS files.
IDENTIFICATION DIVISION.
PROGRAM-ID. DLKSDSRC.
AUTHOR. SANDIP WALSINGE.
DATE-WRITTEN. 2020-05-04.
DATE-COMPILED. 2020-05-04.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-390.
OBJECT-COMPUTER. IBM-390.
SPECIAL-NAMES.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INFILE ASSIGN TO DD1
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS EIDI
FILE STATUS IS FS1.
DATA DIVISION.
FILE SECTION.
FD INFILE.
01 INREC.
05 EIDI PIC X(05).
05 FILLER PIC X(01).
05 ENAMEI PIC X(06).
05 FILLER PIC X(01).
05 ESALI PIC 9(05).
05 FILLER PIC X(62).
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-COUNT PIC 9(04) VALUE ZERO.
05 WS-REC.
10 WS-EID PIC X(05).
10 FILLER PIC X(01).
10 WS-ENAME PIC X(06).
10 FILLER PIC X(01).
10 WS-SAL PIC 9(05).
10 FILLER PIC X(64).
05 FS1 PIC X(02).
05 FS2 PIC X(02).
05 FILE-END PIC X(01).
88 EOF VALUE 'Y'.
88 NOT-EOF VALUE 'N'.
PROCEDURE DIVISION.
SET NOT-EOF TO TRUE
PERFORM OPEN-PARA
PERFORM PROC-PARA UNTIL EOF
PERFORM CLOS-PARA
PERFORM STOP-PARA.
OPEN-PARA.
OPEN I-O INFILE
DISPLAY 'OPEN INFILE STATUS : ' FS1
MOVE '21400' TO EIDI
EXIT.
PROC-PARA.
IF FS1 = '00'
READ INFILE
INTO WS-REC
KEY IS EIDI
INVALID KEY
DISPLAY ' RECORD NOT FOUND '
NOT INVALID KEY
DISPLAY ' DELETING RECORD '
DISPLAY ' DELETED RECORD ' WS-REC
DELETE INFILE
ADD 1 TO WS-COUNT
SET EOF TO TRUE
END-READ
END-IF.
EXIT.
CLOS-PARA.
CLOSE INFILE
DISPLAY 'CLOSE INFILE STATUS : ' FS1
EXIT.
STOP-PARA.
DISPLAY ' TOTAL RECORD COUNT : ' WS-COUNT.
DISPLAY ' THIS IS END OF PROGRAM '.
STOP RUN.
JCL TO EXECUTE ABOVE PROGRAM:
//Z57658SA JOB (3P10),'RUN JCL',
// CLASS=A,
// MSGCLASS=Q,
// NOTIFY=Z57658
//*
//JCL1 JCLLIB ORDER=Z57658.SOURCE.PROCLIB
//*
//STEP1 EXEC IGYWCLG,MEM=DLKSDSRC
//COBOL.SYSIN DD DSN=Z57658.SOURCE.COBOL(&MEM),DISP=SHR
//LKED.SYSLMOD DD DSN=Z57658.SOURCE.LOADLIB(&MEM),DISP=SHR
//GO.DD1 DD DSN=Z57658.TEST.KSDS,DISP=SHR => BASE CLUSTER
//GO.SYSIN DD *
//*
DATA FROM INPUT KSDS CLUSTER FILE:
View Z57658.TEST.KSDS
Command ===>
Type KSDS
Key
<===>----10---+----2----+----3---
****** **** Top of data ****
000001 21000 MANJIT 75500
000002 21400 SANDIP 25500
000003 21500 MANDIP 35500
000004 21600 RANDIP 45500
000005 21700 BALDIP 55500
000006 21800 KULDIP 65500
****** **** End of data ****
OUTPUT OF PROGRAM:
********************************* TOP OF DATA **
OPEN INFILE STATUS : 00
DELETING RECORD
DELETED RECORD 21400 SANDIP 25500
CLOSE INFILE STATUS : 00
TOTAL RECORD COUNT : 0001
THIS IS END OF PROGRAM
******************************** BOTTOM OF DATA
DATA OF KSDS FILE AFTER EXECUTION OF PROGRAM:
View Z57658.TEST.KSDS
Command ===>
Type KSDS
Key
<===>----10---+----2----+----3----
****** **** Top of data ****
000001 21000 MANJIT 75500
000002 21500 MANDIP 35500
000003 21600 RANDIP 45500
000004 21700 BALDIP 55500
000005 21800 KULDIP 65500
****** **** End of data ****
No comments:
Post a Comment