I need to transfer Records in PS file to a KSDS file. But my KSDS file shows open error 39 , I need help to clear the error. I'l post my cobol code and PS file below.
please provide me a solution.
000001 IDENTIFICATION DIVISION.
000002 * **************TRANSFERRING PS BACKUP TO KSDS***********
000003 PROGRAM-ID. COBOSS01.
000004 AUTHOR. GOWTHAM.
000005 DATE-WRITTEN. 31.10.12.
000006 DATE-COMPILED. 15.10.12.
000007 ENVIRONMENT DIVISION.
000008 CONFIGURATION SECTION.
000009 SOURCE-COMPUTER. LENOVO.
000010 OBJECT-COMPUTER. LENOVO.
000011 INPUT-OUTPUT SECTION.
000012 FILE-CONTROL.
000013 SELECT INFILE ASSIGN TO SYSUT1
000014 ORGANIZATION IS SEQUENTIAL
000015 ACCESS IS SEQUENTIAL
000016 FILE STATUS IS PS.
000017 SELECT OUTFILE ASSIGN TO SYSUT2
000018 ORGANIZATION IS INDEXED
000019 ACCESS IS SEQUENTIAL
000020 RECORD KEY CU1-CUSTNO
000021 FILE STATUS IS KS.
000022 DATA DIVISION.
000023 FILE SECTION.
000024 FD INFILE.
000025 01 INREC.
000026 88 C-EOF VALUE HIGH-VALUES.
000027 02 CU-CUSTNO PIC X(2).
000028 02 FILLER PIC X(1).
000029 02 CU-CUSTNAME PIC A(3).
000030 02 FILLER PIC X(1).
000031 02 CU-ADDR PIC X(3).
000032 02 FILLER PIC X(1).
000033 02 CU-REGION PIC X(3).
000034 02 FILLER PIC X(1).
000035 02 IT-ITEMNO PIC 9(2).
000036 02 FILLER PIC X(1).
000037 02 IT-ITEMNAME PIC 9(5).
000038 02 FILLER PIC X(1).
000039 02 TQREQ PIC 9(2).
000040 02 FILLER PIC X(1).
000041 02 RPQ PIC 9(2).
000042 02 FILLER PIC X(1).
000043 02 CU-NR PIC 9(3).
000044 02 FILLER PIC X(1).
000045 02 CU-CRPD PIC 9(3).
000046 02 FILLER PIC X(1).
000047 02 CU-CRBAL PIC 9(3).
000048 02 FILLER PIC X(1).
000049 02 DATEOFORDER PIC 9(2).
000050 02 FILLER PIC X(1).
000051 02 DATEOFDELIVERY PIC 9(2).
000052 02 FILLER PIC X(1).
000053 02 DAYSREMAIN PIC 9(2).
000054 02 FILLER PIC X(1).
000055 02 FILLER PIC X(29).
000056 FD OUTFILE.
000057 01 OUTREC.
000058 88 C1-EOF VALUE HIGH-VALUES.
000059 02 CU1-CUSTNO PIC X(2).
000060 02 FILLER PIC X(1).
000061 02 CU1-CUSTNAME PIC A(3).
000062 02 FILLER PIC X(1).
000063 02 CU1-ADDR PIC X(3).
000064 02 FILLER PIC X(1).
000065 02 CU1-REGION PIC X(3).
000066 02 FILLER PIC X(1).
000067 02 IT1-ITEMNO PIC 9(2).
000068 02 FILLER PIC X(1).
000069 02 IT1-ITEMNAME PIC 9(5).
000070 02 FILLER PIC X(1).
000071 02 TQREQ1 PIC 9(2).
000072 02 FILLER PIC X(1).
000073 02 RPQ1 PIC 9(2).
000074 02 FILLER PIC X(1).
000075 02 CU-NR1 PIC 9(3).
000076 02 FILLER PIC X(1).
000077 02 CU-CRPD1 PIC 9(3).
000078 02 FILLER PIC X(1).
000079 02 CU-CRBAL1 PIC 9(3).
000080 02 FILLER PIC X(1).
000081 02 DATEOFORDER1 PIC 9(2).
000082 02 FILLER PIC X(1).
000083 02 DATEOFDELIVERY1 PIC 9(2).
000084 02 FILLER PIC X(1).
000085 02 DAYSREMAIN PIC 9(2).
000086 02 FILLER PIC X(1).
000087 02 FILLER PIC X(29).
000088 WORKING-STORAGE SECTION.
000089 77 PS PIC X(2).
000090 77 KS PIC X(2).
000091 PROCEDURE DIVISION.
000092 MAIN-PARA.
000093 PERFORM OPEN-PARA.
000094 PERFORM READWRITE-PARA.
000095 PERFORM CLOSE-PARA.
000096 STOP RUN.
000097 OPEN-PARA.
000098 OPEN INPUT INFILE.
000099 IF PS NOT = '00'
000100 DISPLAY "OPEN ERROR:" PS
000101 PERFORM CLOSE-PARA
000102 ELSE
000103 DISPLAY "OPEN SUCCESS:" PS
000104 OPEN OUTPUT OUTFILE.
000105 IF KS NOT = '00'
000106 DISPLAY "OPEN ERROR:" KS
000107 PERFORM CLOSE-PARA
000108 ELSE
000109 DISPLAY "OPEN SUCCESS:" KS
000110 END-IF.
000111 READWRITE-PARA.
000112 PERFORM UNTIL C-EOF
000113 READ INFILE AT END SET C-EOF TO TRUE
000114 NOT AT END
000115 DISPLAY INREC
000116 MOVE INREC TO OUTREC
000117 WRITE OUTREC
000118 IF KS NOT = '00'
000119 DISPLAY "WRITE ERROR:" KS
000120 ELSE
000121 DISPLAY "WRITE SUCCESS:" KS
000122 END-IF
000123 END-READ
000124 END-PERFORM.
000125 CLOSE-PARA.
000126 CLOSE INFILE.
000127 CLOSE OUTFILE.
000002 * **************TRANSFERRING PS BACKUP TO KSDS***********
000003 PROGRAM-ID. COBOSS01.
000004 AUTHOR. GOWTHAM.
000005 DATE-WRITTEN. 31.10.12.
000006 DATE-COMPILED. 15.10.12.
000007 ENVIRONMENT DIVISION.
000008 CONFIGURATION SECTION.
000009 SOURCE-COMPUTER. LENOVO.
000010 OBJECT-COMPUTER. LENOVO.
000011 INPUT-OUTPUT SECTION.
000012 FILE-CONTROL.
000013 SELECT INFILE ASSIGN TO SYSUT1
000014 ORGANIZATION IS SEQUENTIAL
000015 ACCESS IS SEQUENTIAL
000016 FILE STATUS IS PS.
000017 SELECT OUTFILE ASSIGN TO SYSUT2
000018 ORGANIZATION IS INDEXED
000019 ACCESS IS SEQUENTIAL
000020 RECORD KEY CU1-CUSTNO
000021 FILE STATUS IS KS.
000022 DATA DIVISION.
000023 FILE SECTION.
000024 FD INFILE.
000025 01 INREC.
000026 88 C-EOF VALUE HIGH-VALUES.
000027 02 CU-CUSTNO PIC X(2).
000028 02 FILLER PIC X(1).
000029 02 CU-CUSTNAME PIC A(3).
000030 02 FILLER PIC X(1).
000031 02 CU-ADDR PIC X(3).
000032 02 FILLER PIC X(1).
000033 02 CU-REGION PIC X(3).
000034 02 FILLER PIC X(1).
000035 02 IT-ITEMNO PIC 9(2).
000036 02 FILLER PIC X(1).
000037 02 IT-ITEMNAME PIC 9(5).
000038 02 FILLER PIC X(1).
000039 02 TQREQ PIC 9(2).
000040 02 FILLER PIC X(1).
000041 02 RPQ PIC 9(2).
000042 02 FILLER PIC X(1).
000043 02 CU-NR PIC 9(3).
000044 02 FILLER PIC X(1).
000045 02 CU-CRPD PIC 9(3).
000046 02 FILLER PIC X(1).
000047 02 CU-CRBAL PIC 9(3).
000048 02 FILLER PIC X(1).
000049 02 DATEOFORDER PIC 9(2).
000050 02 FILLER PIC X(1).
000051 02 DATEOFDELIVERY PIC 9(2).
000052 02 FILLER PIC X(1).
000053 02 DAYSREMAIN PIC 9(2).
000054 02 FILLER PIC X(1).
000055 02 FILLER PIC X(29).
000056 FD OUTFILE.
000057 01 OUTREC.
000058 88 C1-EOF VALUE HIGH-VALUES.
000059 02 CU1-CUSTNO PIC X(2).
000060 02 FILLER PIC X(1).
000061 02 CU1-CUSTNAME PIC A(3).
000062 02 FILLER PIC X(1).
000063 02 CU1-ADDR PIC X(3).
000064 02 FILLER PIC X(1).
000065 02 CU1-REGION PIC X(3).
000066 02 FILLER PIC X(1).
000067 02 IT1-ITEMNO PIC 9(2).
000068 02 FILLER PIC X(1).
000069 02 IT1-ITEMNAME PIC 9(5).
000070 02 FILLER PIC X(1).
000071 02 TQREQ1 PIC 9(2).
000072 02 FILLER PIC X(1).
000073 02 RPQ1 PIC 9(2).
000074 02 FILLER PIC X(1).
000075 02 CU-NR1 PIC 9(3).
000076 02 FILLER PIC X(1).
000077 02 CU-CRPD1 PIC 9(3).
000078 02 FILLER PIC X(1).
000079 02 CU-CRBAL1 PIC 9(3).
000080 02 FILLER PIC X(1).
000081 02 DATEOFORDER1 PIC 9(2).
000082 02 FILLER PIC X(1).
000083 02 DATEOFDELIVERY1 PIC 9(2).
000084 02 FILLER PIC X(1).
000085 02 DAYSREMAIN PIC 9(2).
000086 02 FILLER PIC X(1).
000087 02 FILLER PIC X(29).
000088 WORKING-STORAGE SECTION.
000089 77 PS PIC X(2).
000090 77 KS PIC X(2).
000091 PROCEDURE DIVISION.
000092 MAIN-PARA.
000093 PERFORM OPEN-PARA.
000094 PERFORM READWRITE-PARA.
000095 PERFORM CLOSE-PARA.
000096 STOP RUN.
000097 OPEN-PARA.
000098 OPEN INPUT INFILE.
000099 IF PS NOT = '00'
000100 DISPLAY "OPEN ERROR:" PS
000101 PERFORM CLOSE-PARA
000102 ELSE
000103 DISPLAY "OPEN SUCCESS:" PS
000104 OPEN OUTPUT OUTFILE.
000105 IF KS NOT = '00'
000106 DISPLAY "OPEN ERROR:" KS
000107 PERFORM CLOSE-PARA
000108 ELSE
000109 DISPLAY "OPEN SUCCESS:" KS
000110 END-IF.
000111 READWRITE-PARA.
000112 PERFORM UNTIL C-EOF
000113 READ INFILE AT END SET C-EOF TO TRUE
000114 NOT AT END
000115 DISPLAY INREC
000116 MOVE INREC TO OUTREC
000117 WRITE OUTREC
000118 IF KS NOT = '00'
000119 DISPLAY "WRITE ERROR:" KS
000120 ELSE
000121 DISPLAY "WRITE SUCCESS:" KS
000122 END-IF
000123 END-READ
000124 END-PERFORM.
000125 CLOSE-PARA.
000126 CLOSE INFILE.
000127 CLOSE OUTFILE.
My PS REcords.
000001 01 RAJ TNR CHN 10 INCOM 20 15 300 150 150 19 05 14
000002 02 MAN RFT DEL 20 IPDEV 20 10 200 100 100 15 07 08
000003 03 VIN DAR MUM 30 CDBDS 30 10 300 150 150 20 12 08
000004 04 VEN HRA CAL 40 STGDV 40 05 200 100 100 30 10 20
000005 05 ASH BVN BLR 50 ODVIC 20 15 300 150 150 20 15 05
000006 06 SUR TIR HYD 60 CABLE 10 20 200 100 100 30 20 10
000007 07 HEL KAS PUN 70 STMDA 30 20 600 300 300 10 05 05
000002 02 MAN RFT DEL 20 IPDEV 20 10 200 100 100 15 07 08
000003 03 VIN DAR MUM 30 CDBDS 30 10 300 150 150 20 12 08
000004 04 VEN HRA CAL 40 STGDV 40 05 200 100 100 30 10 20
000005 05 ASH BVN BLR 50 ODVIC 20 15 300 150 150 20 15 05
000006 06 SUR TIR HYD 60 CABLE 10 20 200 100 100 30 20 10
000007 07 HEL KAS PUN 70 STMDA 30 20 600 300 300 10 05 05
Kind regards
gyaa