cant able to write records to PS file



Support for OS/VS COBOL, VS COBOL II, COBOL for OS/390 & VM and Enterprise COBOL for z/OS

cant able to write records to PS file

Postby 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.

 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.
gowthamgyaa
 
Posts: 101
Joined: Wed Sep 05, 2012 11:18 pm
Has thanked: 67 times
Been thanked: 0 time

Re: cant able to write records to PS file

 

Re: cant able to write records to PS file

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

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

 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

 000185                MOVE OUTREC TO INREC
 000186                WRITE INREC
.

These users thanked the author Pandora-Box for the post:
gowthamgyaa (Thu Nov 01, 2012 8:02 pm)
User avatar
Pandora-Box
 
Posts: 65
Joined: Fri Feb 10, 2012 8:30 pm
Location: Mars
Has thanked: 3 times
Been thanked: 6 times

Re: cant able to write records to PS file

Postby 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.

These users thanked the author Robert Sample for the post:
gowthamgyaa (Thu Nov 01, 2012 8:02 pm)
Robert Sample
Global moderator
 
Posts: 3367
Joined: Sat Dec 19, 2009 8:32 pm
Location: East Dubuque, Illinois
Has thanked: 1 time
Been thanked: 222 times


Return to IBM Cobol

 


  • Related topics
    Replies
    Views
    Last post