IBM Mainframe Forum

by **gowthamgyaa** » Thu Nov 01, 2012 6:26 pm

Hi everyone,
I created a table of records, when i try to write that records to PS file its not written but program has been run successfully.
I ll post the code below kindly help me to get out of this problem.

Select all

000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. COBOSS01.
000003 AUTHOR. GOWTHAM.
000004 DATE-WRITTEN. 31.10.12.
000005 DATE-COMPILED. 15.10.12.
000006 ENVIRONMENT DIVISION.
000007 CONFIGURATION SECTION.
000008 SOURCE-COMPUTER. LENOVO.
000009 OBJECT-COMPUTER. LENOVO.
000010 INPUT-OUTPUT SECTION.
000011 FILE-CONTROL.
000012 SELECT INFILE ASSIGN TO SYSUT1
000013 ORGANIZATION IS SEQUENTIAL
000014 ACCESS IS SEQUENTIAL
000015 FILE STATUS IS PS.
000016 DATA DIVISION.
000017 FILE SECTION.
000018 FD INFILE.
000019 01 INREC.
000020 02 CU-CUSTNO PIC 9(2).
000021 02 FILLER PIC X(3) VALUE SPACES.
000022 02 CU-CUSTNAME PIC A(3).
000023 02 FILLER PIC X(3) VALUE SPACES.
000024 02 CU-ADDR PIC X(3).
000025 02 FILLER PIC X(2) VALUE SPACES.
000026 02 CU-REGION PIC X(3).
000027 02 FILLER PIC X(2) VALUE SPACES.
000028 02 IT-ITEMNO PIC 9(2).
000029 02 FILLER PIC X(2) VALUE SPACES.
000030 02 IT-ITEMNAME PIC 9(5).
000031 02 FILLER PIC X(4) VALUE SPACES.
000032 02 TQREQ PIC 9(3).
000033 02 FILLER PIC X(3) VALUE SPACES.
000034 02 RPQ PIC 9(3).
000035 02 FILLER PIC X(2) VALUE SPACES.
000036 02 CU-NR PIC 9(5).
000037 02 FILLER PIC X(2) VALUE SPACES.
000038 02 CU-CRPD PIC 9(5).
000039 02 FILLER PIC X(2) VALUE SPACES.
000040 02 CU-CRBAL PIC 9(5).
000041 02 FILLER PIC X(2) VALUE SPACES.
000042 02 DATEOFORDER PIC 9(2).
000043 02 FILLER PIC X(2) VALUE SPACES.
000044 02 DATEOFDELIVERY PIC 9(2).
000045 02 FILLER PIC X(2) VALUE SPACES.
000046 02 DAYSREMAIN PIC 9(2).
000047 02 FILLER PIC X(2) VALUE SPACES.
000048 02 SHIPPINGDET PIC X(1).
000049 02 PRIORITY PIC X(1).
000050 WORKING-STORAGE SECTION.
000051 77 PS PIC 9(2).
000052 01 OUTREC.
000053 02 CU1-CUSTNO PIC 9(2).
000054 02 FILLER PIC X(3) VALUE SPACES.
000055 02 CU1-CUSTNAME PIC A(3).
000056 02 FILLER PIC X(3) VALUE SPACES.
000057 02 CU1-ADDR PIC X(3).
000058 02 FILLER PIC X(2) VALUE SPACES.
000059 02 CU1-REGION PIC X(3).
000060 02 FILLER PIC X(2) VALUE SPACES.
000061 02 IT1-ITEMNO PIC 9(2).
000062 02 FILLER PIC X(2) VALUE SPACES.
000063 02 IT1-ITEMNAME PIC 9(5).
000064 02 FILLER PIC X(4) VALUE SPACES.
000065 02 TQREQ1 PIC 9(3).
000066 02 FILLER PIC X(3) VALUE SPACES.
000067 02 RPQ1 PIC 9(3).
000068 02 FILLER PIC X(2) VALUE SPACES.
000069 02 CU-NR1 PIC 9(5).
000070 02 FILLER PIC X(2) VALUE SPACES.
000071 02 CU-CRPD1 PIC 9(5).
000072 02 FILLER PIC X(2) VALUE SPACES.
000073 02 CU-CRBAL1 PIC 9(5).
000074 02 FILLER PIC X(2) VALUE SPACES.
000075 02 DATEOFORDER1 PIC 9(2).
000076 02 FILLER PIC X(2) VALUE SPACES.
000077 02 DATEOFDELIVERY1 PIC 9(2).
000078 02 FILLER PIC X(2) VALUE SPACES.
000079 02 DAYSREMAIN1 PIC 9(2).
000080 02 FILLER PIC X(2) VALUE SPACES.
000081 02 SHIPPINGDET1 PIC X(1).
000082 02 PRIORITY1 PIC X(1).
000083 01 MAINHEAD1.
000084 02 FILLER PIC X(30) VALUE SPACES.
000085 02 FILLER PIC X(20) VALUE "ABC COMPANY LTD".
000086 02 FILLER PIC X(30) VALUE SPACES.
000087 01 MAINHEAD2.
000088 02 FILLER PIC X(25) VALUE SPACES.
000089 02 FILLER PIC X(30) VALUE "PURCHASE ORDER ENTRY SYSTEM".
000090 02 FILLER PIC X(25) VALUE SPACES.
000091 01 MAINHEAD3.
000092 02 FILLER PIC X(20) VALUE SPACES.
000093 02 FILLER PIC X(20) VALUE "CUSTOMER DETAILS ".
000094 02 FILLER PIC X(2) VALUE "&".
000095 02 FILLER PIC X(20) VALUE "DELIVERY INSTRUC".
000096 02 FILLER PIC X(13) VALUE SPACES.
000097 01 MAINHEAD4.
000098 02 FILLER PIC X(60) VALUE SPACES.
000099 02 C-DATE PIC 99/99/99.
000100 02 FILLER PIC X(10) VALUE SPACES.
000101 01 SUBHEAD.
000102 02 FILLER PIC X(80) VALUE ALL '-'.
000103 01 SUBHEAD1.
000104 02 FILLER PIC X(3) VALUE "CNO".
000105 02 FILLER PIC X(2) VALUE SPACES.
000106 02 FILLER PIC X(3) VALUE "CNM".
000107 02 FILLER PIC X(3) VALUE SPACES.
000108 02 FILLER PIC X(3) VALUE "ADR".
000109 02 FILLER PIC X(3) VALUE SPACES.
000110 02 FILLER PIC X(3) VALUE "REG".
000111 02 FILLER PIC X(2) VALUE SPACES.
000112 02 FILLER PIC X(3) VALUE "INO".
000113 02 FILLER PIC X(2) VALUE SPACES.
000114 02 FILLER PIC X(3) VALUE "INM".
000115 02 FILLER PIC X(7) VALUE SPACES.
000116 02 FILLER PIC X(3) VALUE "TQR".
000117 02 FILLER PIC X(2) VALUE SPACES.
000118 02 FILLER PIC X(3) VALUE "RPQ".
000119 02 FILLER PIC X(2) VALUE SPACES.
000120 02 FILLER PIC X(3) VALUE "NRT".
000121 02 FILLER PIC X(2) VALUE SPACES.
000122 02 FILLER PIC X(4) VALUE "PAID".
000123 02 FILLER PIC X(2) VALUE SPACES.
000124 02 FILLER PIC X(3) VALUE "BAL".
000125 02 FILLER PIC X(2) VALUE SPACES.
000126 02 FILLER PIC X(3) VALUE "DOO".
000127 02 FILLER PIC X(2) VALUE SPACES.
000128 02 FILLER PIC X(3) VALUE "DOD".
000129 02 FILLER PIC X(2) VALUE SPACES.
000130 02 FILLER PIC X(3) VALUE "RED".
000131 02 FILLER PIC X(1) VALUE SPACES.
000132 01 SUBHEAD2.
000133 02 FILLER PIC X(80) VALUE ALL '-'.
000134 PROCEDURE DIVISION.
000135 FILLER-PARA.
000136 DISPLAY MAINHEAD1.
000137 DISPLAY MAINHEAD2.
000138 DISPLAY MAINHEAD3.
000139 ACCEPT C-DATE FROM DATE YYYYMMDD.
000140 DISPLAY MAINHEAD4.
000141 DISPLAY SUBHEAD.
000142 DISPLAY SUBHEAD1.
000143 MAIN-PARA.
000144 PERFORM OPEN-PARA.
000145 PERFORM NET-PARA.
000146 PERFORM PAID-PARA.
000147 PERFORM BAL-PARA.
000148 PERFORM DAYSREMAIN-PARA.
000149 PERFORM SHIPMENT-PARA.
000150 PERFORM PRTY-PARA.
000151 PERFORM READWRITE-PARA.
000152 PERFORM CLOSE-PARA.
000153 STOP RUN.
000154 OPEN-PARA.
000155 OPEN OUTPUT INFILE.
000156 IF PS NOT = '00'
000157 DISPLAY "OPEN ERROR:" PS
000158 PERFORM CLOSE-PARA
000159 ELSE
000160 DISPLAY "OPEN SUCCESS:" PS
000161 END-IF.
000162 NET-PARA.
000163 COMPUTE CU-NR1 = TQREQ1 * RPQ1.
000164 PAID-PARA.
000165 COMPUTE CU-CRPD1 = CU-NR1 / 2.
000166 BAL-PARA.
000167 MOVE CU-CRPD1 TO CU-CRBAL1.
000168 DAYSREMAIN-PARA.
000169 COMPUTE DAYSREMAIN1 = DATEOFORDER1 - DATEOF
000170 - DELIVERY1.
000171 SHIPMENT-PARA.
000172 IF (CU1-REGION NOT = "CHN")
000173 DISPLAY "SHIPPINGDET1:" 'Y'
000174 ELSE
000175 DISPLAY "SHIPPINGDET1:" 'N'
000176 END-IF.
000177 PRTY-PARA.
000178 IF (DAYSREMAIN1 <= 10)
000179 DISPLAY "PRIORITY1:" '1'
000180 ELSE
000181 DISPLAY "PRIORITY1:" '0'
000182 END-IF.
000183 READWRITE-PARA.
000184 IF PS NOT = '10'
000185 MOVE OUTREC TO INREC
000186 WRITE INREC
000187 ELSE
000188 DISPLAY "END OCCURED"
000189 END-IF.
000190 CLOSE-PARA.
000191 CLOSE INFILE.

. . . . . . . . . . . . . . . . . . . . . . . . . . .

Please provide me a solution.

Kind regards
Gyaa.

by **Pandora-Box** » Thu Nov 01, 2012 6:39 pm

I did not go through the code completely but what is strange to me is

Select all

000184 IF PS NOT = '10'
000185 MOVE OUTREC TO INREC
000186 WRITE INREC
000187 ELSE
000188 DISPLAY "END OCCURED"
000189 END-IF.

change the above to

Select all

000185 MOVE OUTREC TO INREC
000186 WRITE INREC
.

by **Robert Sample** » Thu Nov 01, 2012 7:01 pm

1. You have VALUE clauses in your 01 under the FD -- why? An FD 01 is completely replaced with a READ or WRITE statement, so placing VALUE clauses on variables under the 01 in the FD has ABSOLUTELY no use.
2. Follow the logic -- you open for OUTPUT INFILE (which is completely misleading to start with), then you COMPUTE CU-NR1 = TQREQ1 * RPQ1. You defined TQREQ1 and RPQ1 as variables in WORKING-STORAGE but you have never assigned them values. At best, you may be lucky enough that those memory locations may have numeric values and allow the COMPUTE to occur, but it is far more likely that your COMPUTE statement causes an ABEND for using non-numeric data in numeric variables.
3. The same comment applies to all your other uses of variables in OUTREC -- they are defined but have no values when you use them.
4. In READWRITE-PARA you check Ps to not have the value 10 (end of file) and if true then you write INREC. Just how do you expect PS to have a value of 10 since the file it references is only used for OUTPUT? A file status code of 10 only occurs on files that are read, not written.
5. It looks like you are ATTEMPTING to write a program to read a file of data records, do some processing against the data in those records, and then write a file of result records. If this is, indeed, what you are attempting to do then your program falls considerably short -- it needs another SELECT statement for the input file, another FD for the input file, another file status variable for the input file, PROCEDURE DIVSION code to open the input file, read the input file, and close the input file.

IBM Mainframe Forum

cant able to write records to PS file

cant able to write records to PS file

Re: cant able to write records to PS file

Re: cant able to write records to PS file