Query with some coding 2

[scurf]

Can anyone help me, I have a list of my coding below...
At the end of the program I have a procedure called WRITE-VALIDFILE...When the program is compiled using my test data, all of the records are being written to my Valid File....Not just the valid ones....I am confused.....Any help or guidance would be appreciated.....

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. 495955P1.
000030 ENVIRONMENT DIVISION.
000040 INPUT-OUTPUT SECTION.
000050 FILE-CONTROL.
000060 SELECT TRANSACTION-FILE ASSIGN TO "495955TD.DAT"
000070 ORGANIZATION LINE SEQUENTIAL.
000080 SELECT VALID-FILE ASSIGN TO "495955VF.DAT"
000090 ORGANIZATION LINE SEQUENTIAL.
000100 SELECT INVALID-FILE ASSIGN TO PRINTER.
000110 DATA DIVISION.
000120 FILE SECTION.
000130 FD TRANSACTION-FILE.
000140 01 I-R-RECORD.
000150 03 RECORD-TYPE PIC X.
000160 88 VALID-TYPE VALUES "I" "R" "D" "C".
000170 03 IN-CUSTCODE.
000180 05 INCODE-DIGIT.
000190 07 INCODE-DGT PIC 9 OCCURS 4.
000200 05 INCODE-CHKDGT PIC X.
000210 03 IN-PARTNO.
000220 05 INPART-DIGIT.
000230 07 INPART-DGT PIC 9 OCCURS 5.
000240 05 INPART-CHKDGT PIC X.
000250 03 IN-QUANTITY.
000260 05 IN-QUANT PIC X(4).
000270 01 DELETION.
000280 03 PIC X(6).
000290 01 CREATION.
000300 03 PIC X(6).
000310 03 CUST-NAME PIC X(20).
000320 03 CUST-ADDRESS PIC X(60).
000330 03 CUST-BAL.
000340 05 CUST-BALANCE PIC X(9).
000350 03 CREDIT-LIM.
000360 05 CREDIT-LIMIT PIC X(7).
000370 FD VALID-FILE.
000380 01 VALID-REC PIC X(102).
000390 FD INVALID-FILE
000400 LINAGE IS 60 LINES
000410 WITH FOOTING AT 56
000420 LINES AT TOP 2
000430 LINES AT BOTTOM 4.
000440 01 PRINT-RECORD PIC X(120).
000450 WORKING-STORAGE SECTION.
000460 01 W-REC-COUNT PIC 999 VALUE 0.
000470 01 W-PAGENO PIC 99 VALUE 0.
000480 01 W-LINENO PIC 99.
000490 01 W-DOS-DATE.
000500 03 W-DOS-YEAR PIC 99.
000510 03 W-DOS-MONTH PIC 99.
000520 03 W-DOS-DAY PIC 99.
000530 01 W-IN-DATE.
000540 03 W-IN-YEAR PIC 99.
000550 03 W-IN-MONTH PIC 99.
000560 03 W-IN-YEAR PIC 99.
000570 *WS SECTION FOR BREAKING THE CUSTOMER CODE INTO PARTS FOR MODULUS
000575 *11 CHECK
000580 01 W-CUSTCODE-WEIGHTS VALUE "5432".
000590 03 W-C-WT PIC 9 OCCURS 4.
000600 01 W-C-SUB PIC 9.
000610 01 W-C-PRODUCT PIC 99.
000620 01 W-C-SUM PIC 999.
000630 01 W-C-MOD PIC 99 VALUE 11.
000640 01 W-C-REM PIC 99.
000650 01 W-C-CHK.
000660 03 W-C-CHK-NUM PIC 9.
000670*BREAK THE PART NUMBER DOWN FOR MODULUS 11 CHECK
000680 01 W-PARTNO-WEIGHTS VALUE "65432".
000690 03 W-P-WT PIC 9 OCCURS 5.
000700 01 W-P-SUB PIC 9.
000710 01 W-P-PRODUCT PIC 99.
000720 01 W-P-SUM PIC 999.
000730 01 W-P-MOD PIC 99 VALUE 11.
000740 01 W-P-REM PIC 99.
000750 01 W-P-CHK.
000760 03 W-P-CHK-NUM PIC 9.
000770 01 W-ERROR-REC-FLAG PIC X VALUE "N".
000780 88 VALID-RECORD VALUE "Y".
000790 01 END-TRANSACTION-FILE-FLAG PIC X VALUE "N".
000800 88 END-OF-TRANSACTION-FILE VALUE "Y".
000810 01 P-HDG.
000820 03 PIC X(4) VALUE
000830 "DATE".
000840 03 PIC X VALUE SPACES.
000850 03 PIC X(10) VALUE SPACES.
000860 03 P-HDG-DAY PIC 99.
000870 03 PIC X VALUE "/".
000880 03 P-HDG-MONTH PIC 99.
000890 03 PIC X VALUE "/".
000900 03 P-HDG-YEAR PIC 99.
000910 03 PIC X(36) VALUE
000920 "ZENITH-PAINTS-INVALID-RECORDS-REPORT".
000930 03 PIC X(31) VALUE
000940 "PAGE.".
000950 03 P-PAGENO PIC Z9.
000960 01 P-SUB-HDG.
000970 03 PIC X(11) VALUE
000980 "RECORD-TYPE".
000990 03 PIC X(13) VALUE
001000 "CUSTOMER-CODE".
001010 03 PIC X(15) VALUE
001020 "PART-NUMBER".
001030 03 PIC X(16) VALUE
001040 "QUANTITY".
001050 03 PIC X(16) VALUE
001060 "REJECTION REASON".
001070 01 P-DETAIL-LINE.
001080 03 PIC X(15) VALUE SPACES.
001090 03 P-RECORD-TYPE PIC X.
001100 03 PIC X(15) VALUE SPACES.
001110 03 P-CUST-CODE PIC 9(5).
001120 03 PIC X(23) VALUE SPACES.
001130 03 P-PART-NO PIC 9(6).
001140 03 PIC X(20) VALUE SPACES.
001150 03 P-IR-QUANT PIC 9(4).
001160 03 PIC X(12) VALUE SPACES.
001170 03 P-REJECTION-REASON PIC X(21).
001180 01 P-FILE-EMPTY-LINE.
001190 03 PIC X(35) VALUE
001200 "NO RECORDS ON THIS FILE".
001210 01 P-FINAL-LINE.
001220 03 PIC X(35) VALUE
001230 "*NO MORE INVALID RECORDS*".
001240 PROCEDURE DIVISION.
001250 CONTROL-PARAGRAPH.
001260 PERFORM INITIAL-PROCESS
001270 PERFORM MAIN-PROCESS UNTIL END-OF-TRANSACTION-FILE
001280 PERFORM TERMINATION
001290 STOP RUN.
001300 INITIAL-PROCESS.
001310 OPEN INPUT TRANSACTION-FILE
001320 OUTPUT INVALID-FILE
001330 VALID-FILE
001340 ACCEPT W-DOS-DATE FROM DATE
001350*DOS stores the date in YYMMDD format.
001360*Adjustment is needed for DDMMYY format in the heading.
001370 MOVE W-DOS-YEAR TO P-HDG-YEAR
001380 MOVE W-DOS-MONTH TO P-HDG-MONTH
001390 MOVE W-DOS-DAY TO P-HDG-DAY
001400 PERFORM PRINT-HEADINGS
001410 READ TRANSACTION-FILE AT END
001420 DISPLAY "FILE CONTAINS NO RECORDS*"
001430 MOVE "Y" TO END-TRANSACTION-FILE-FLAG
001440 END-READ.
001450 PRINT-HEADINGS.
001460 MOVE 0 TO W-LINENO
001470 ADD 1 TO W-PAGENO
001480 MOVE W-PAGENO TO P-PAGENO
001490 WRITE PRINT-RECORD FROM P-HDG AFTER PAGE
001500 WRITE PRINT-RECORD FROM P-SUB-HDG AFTER 1
001510 MOVE SPACES TO PRINT-RECORD
001520 WRITE PRINT-RECORD AFTER 1.
001530 MAIN-PROCESS.
001540 IF RECORD-TYPE = "I" OR "R" THEN
001550 PERFORM VALIDATE-CUSTCODE
001590 PERFORM VALIDATE-PARTNO
001591 PERFORM VALIDATE-QUANTITY
001592 ELSE
001594 IF RECORD-TYPE = "D" THEN
001596 PERFORM VALIDATE-CUSTCODE
001600 ELSE
001602 IF RECORD-TYPE = "C" THEN
001603 PERFORM VALIDATE-CUSTCODE
001610 PERFORM VALIDATE-CUST-NAME
001620 PERFORM VALIDATE-CUST-BALANCE
001630 PERFORM VALIDATE-CREDIT-LIMIT
001640 PERFORM WRITE-VALIDFILE
001650 IF W-REC-COUNT = 0 THEN
001660 PERFORM PRINT-HEADINGS
001670 WRITE PRINT-RECORD FROM
001680 P-FILE-EMPTY-LINE AFTER 2
001690 END-IF
001692 END-IF
001694 END-IF
001700 ELSE
001702 MOVE "Y" TO W-ERROR-REC-FLAG
001703 MOVE"INVALID RECORD TYPE" TO P-REJECTION-REASON.
001704 END-IF.
001710 VALIDATE-CUSTCODE.
001720 *this procedure will validate the Customer Code using Modulus 11
001730 *the 5th digit is the check digit
001740 IF INCODE-DIGIT NOT NUMERIC THEN
001750 MOVE "Y" TO W-ERROR-REC-FLAG
001760 MOVE "CUSTOMER CODE NOT NUMERIC" TO P-REJECTION-REASON
001770 ELSE
001780 MOVE ZERO TO W-C-SUM
001790 PERFORM VARYING W-C-SUB FROM 1 BY 1
001800 UNTIL W-C-SUB > 4
001810 MULTIPLY INCODE-DGT (W-C-SUB) BY W-C-WT (W-C-SUB)
001820 GIVING W-C-PRODUCT
001830 ADD W-C-PRODUCT TO W-C-SUM
001840 END-PERFORM
001850 END-IF
001860 DIVIDE W-C-SUM BY W-C-MOD GIVING W-C-SUM
001870 REMAINDER W-C-REM
001880 IF W-C-REM > 1 THEN
001890 SUBTRACT W-C-REM FROM W-C-MOD GIVING W-C-CHK-NUM
001900 ELSE
001910 IF W-C-REM = 1 THEN
001920 MOVE ZERO TO W-C-CHK
001930 ELSE
001940 MOVE "X" TO W-C-CHK
001950 END-IF
001960 END-IF
001970 IF INCODE-CHKDGT NOT = W-C-CHK THEN
001980 MOVE "INVALID CUSTOMER CODE" TO P-REJECTION-REASON
001990 END-IF.
002000 VALIDATE-PARTNO.
002010*this procedure will validate the part number using Modulus 11 the
002020*6th digit is the check digit.
002030 IF INPART-DIGIT NOT NUMERIC THEN
002040 MOVE "Y" TO W-ERROR-REC-FLAG
002050 MOVE "PART NUMBER NOT NUMERIC" TO P-REJECTION-REASON
002060 ELSE
002070 MOVE ZERO TO W-P-SUM
002080 PERFORM VARYING W-P-SUB FROM 1 BY 1
002090 UNTIL W-P-SUB > 5
002100 MULTIPLY INPART-DGT (W-P-SUB) BY W-P-WT (W-P-SUB)
002110 GIVING W-P-PRODUCT
002120 ADD W-P-PRODUCT TO W-P-SUM
002130 END-PERFORM
002140 END-IF
002150 DIVIDE W-P-SUM BY W-P-MOD GIVING W-P-SUM
002160 REMAINDER W-P-REM
002170 IF W-P-REM > 1 THEN
002180 SUBTRACT W-P-REM FROM W-P-MOD GIVING W-P-CHK-NUM
002190 ELSE
002200 IF W-P-REM = 1 THEN
002210 MOVE ZERO TO W-P-CHK
002220 ELSE
002230 MOVE "X" TO W-P-CHK
002240 END-IF
002250 END-IF
002260 IF INPART-CHKDGT NOT = W-C-CHK THEN
002270 MOVE "INVALID CUSTOMER CODE" TO P-REJECTION-REASON
002280 END-IF
002290 IF W-P-CHK-NUM NOT = W-P-CHK THEN
002300 MOVE "INVALID PART NUMBER" TO P-REJECTION-REASON
002310 MOVE "Y" TO W-ERROR-REC-FLAG
002320 END-IF.
002330 VALIDATE-QUANTITY.
002340 IF IN-QUANT NOT NUMERIC THEN
002350 MOVE "QUANTITY INVALID" TO P-REJECTION-REASON
002360 MOVE "Y" TO W-ERROR-REC-FLAG
002370 END-IF.
002380 VALIDATE-CUST-NAME.
002390 IF CUST-NAME = SPACES THEN
002400 MOVE "NO CUSTOMER NAME" TO P-REJECTION-REASON
002410 MOVE "Y" TO W-ERROR-REC-FLAG
002420 END-IF.
002430 VALIDATE-CUST-BALANCE.
002440 IF CUST-BALANCE NOT NUMERIC THEN
002450 MOVE "NON NUMERIC BALANCE" TO P-REJECTION-REASON
002460 MOVE "Y" TO W-ERROR-REC-FLAG
002470 END-IF.
002480 VALIDATE-CREDIT-LIMIT.
002490 IF CREDIT-LIMIT NOT NUMERIC THEN
002500 MOVE "NON NUMERIC CREDIT LIMIT" TO P-REJECTION-REASON
002510 MOVE "Y" TO W-ERROR-REC-FLAG
002520 END-IF.
002530 WRITE-VALIDFILE.
002540 CLOSE TRANSACTION-FILE
002550 OPEN INPUT TRANSACTION-FILE
002560 PERFORM UNTIL END-OF-TRANSACTION-FILE
002570 READ TRANSACTION-FILE
002580 AT END
002590 MOVE "Y" TO END-TRANSACTION-FILE-FLAG
002600 CLOSE TRANSACTION-FILE
002610 OPEN OUTPUT TRANSACTION-FILE
002620 NOT AT END
002630 WRITE VALID-REC FROM I-R-RECORD
002640 END-READ
002650 END-PERFORM.
002660 TERMINATION.
002670 CLOSE TRANSACTION-FILE
002680 CLOSE INVALID-FILE
002690 CLOSE VALID-FILE
002700 STOP RUN.

 

[Dimandja]

This is what I think happens the first time you try to write a valid record:
1. The transaction file is closed than opened for input. (?)
2. The transaction file is read to the end.
3. Each transaction record is written to the 'valid' records file. (!)
4. END-OF-TRANSACTION-FILE is reached and the program terminates.

I thought you wanted this to happen:
1. Open and read each trans record.
2. Edit each trans record.
3. Write each 'valid' trans record to 'valid' file.
4. Repeat 1 thru 3 until END-OF-TRANSACTION-FILE.

Let me know if this sheds some light.

Dimandja

 

[MarcLodge]

Scurf,
specifically your 3rd END-IF in the MAIN-PROCESS is in the wrong place as I assume that valid record types are I, R, D, and C. There should be two END-IFS, followed by an ELSE.

More importantly, your indenting of the IFs is a little weird. If you were having no problem I'd be inclined to say that it's just style and forget about it, but the way that you have it, makes it difficult to read. Try lining each IF up with it's relevant ELSE and END-IF, in this way you will see you error a little easier. eg
001540 IF RECORD-TYPE = "I" OR "R" THEN
001550 PERFORM VALIDATE-CUSTCODE
001590 PERFORM VALIDATE-PARTNO
001591 PERFORM VALIDATE-QUANTITY
001592 ELSE
001594 IF RECORD-TYPE = "D" THEN
001596 PERFORM VALIDATE-CUSTCODE
001600 ELSE
001602 IF RECORD-TYPE = "C" THEN
001603 PERFORM VALIDATE-CUSTCODE
001610 PERFORM VALIDATE-CUST-NAME
001620 PERFORM VALIDATE-CUST-BALANCE
001630 PERFORM VALIDATE-CREDIT-LIMIT
001640 PERFORM WRITE-VALIDFILE
001650 IF W-REC-COUNT = 0 THEN
001660 PERFORM PRINT-HEADINGS
001670 WRITE PRINT-RECORD FROM
001680 P-FILE-EMPTY-LINE AFTER 2
001690 END-IF
ELSE invalid condition
I think that your ELSE invalid condition should be the next line, which is easier to (I think) if indented like this.
To be honest I'm surprised it compiled ok.
Hope this helps.
Marc

 

[scurf]

That is just what I am looking for, where should I adjust my code...
I wasnt expecting such a quick response.....

sausages@scurfield.fsnet.co.uk

Thanks, Garry

 

[MarcLodge]

Garry,
Was your last post in response to Dimandja, or mine? (oh and by the way, I meant 2nd END-IF, not 3rd! )

 

[scurf]

I think I might be able to work this out now....Thanks to you all, I owe you all a pint!!!
I will return if I get stuck again....

Cheers


Garry

 

[StephenJSpiro]

This compiler has obviously implemented the NEW STANDARD "Fixed format", which eliminated the old SECTION A and SECTION B. This is a good example of why that change was a bad idea. Code starts in column 8 (sometimes!), and it is hard to see where paragraphs begin and end. Write to your compiler-maker and ask the company to AT LEAST provide a compiler option which will enforce SECTION A and SECTION B. This kind of code is unreadable.

Sorry, scurf, but as Marc Lodge pointed out, style DOES make a difference in maintainability.

Stephen J Spiro
Member, ANSI COBOL Standards Committee