000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. TB17P4.
000030 AUTHOR. TIMOTHY R P BROWN 494417.
000040 DATE-COMPILED. 16-11-00.
000050
000060********************************************************
000070** PROGRAM-4 **
000080** Program to print new master file (TB17NF.DAT) in **
000090** report form, indicating customers with a balance **
000100** that exceeds their credit limit. **
000110********************************************************
000120
000130 ENVIRONMENT DIVISION.
000140 INPUT-OUTPUT SECTION.
000150 FILE-CONTROL.
000160
000170 SELECT IN-FILE ASSIGN TO 'A:TB17NF.DAT'
000180 ORGANIZATION IS LINE SEQUENTIAL.
000190 SELECT PRINT-FILE ASSIGN TO PRINTER.
000200
000210
000220*******************************************************
000230
000240 DATA DIVISION.
000250 FILE SECTION.
000260
000270 FD IN-FILE.
000280 01 RECORD-IN.
000290 03 CUS-CODE PIC X(5).
000300 03 CUS-NAME PIC X(20).
000310 03 CUS-ADDRESS PIC X(60).
000320 03 CUS-BALANCE PIC S9(7)V99.
000330 03 CUS-CRED-LIMIT PIC 9(7).
000340 03 MOV-DATE.
000350 05 MOV-YEAR PIC 99.
000360 05 MOV-MONTH PIC 99.
000370 05 MOV-DAY PIC 99.
000380
000390 FD PRINT-FILE.
000400 01 PRINT-LINE PIC X(120).
000410
000420
000430*******************************************************
000440
000450 WORKING-STORAGE SECTION.
000460
000470 01 EOF-FLAG PIC X VALUE 'N'.
000480 88 END-OF-IN-FILE VALUE 'Y'.
000490
000500 01 DATE-IN.
000510 03 DOS-YEAR PIC 99.
000520 03 DOS-MONTH PIC 99.
000530 03 DOS-DAY PIC 99.
000540 01 W-LINE-NO PIC 99 VALUE ZERO.
000550 01 W-PAGE-NO PIC 999 VALUE ZERO.
000560 01 RECORD-COUNT PIC 9(4) VALUE ZERO.
000570 01 TOTAL-DEBTORS PIC 9(3) VALUE ZERO.
000580 01 TOTAL-BALANCE PIC S9(7)V99 VALUE ZERO.
000590 01 BALANCE-LIMIT-DIFFERENCE PIC S9(7)V99 VALUE ZERO.
000600
000610 01 SUBS-NO PIC 9.
000620 01 ADDRESS-LINE-NO PIC 9 VALUE ZERO.
000630 01 P-ADDR-TABLE.
000640 03 P-ADDRESS PIC X(30) OCCURS 4.
000650
000660* Print items
000670
000680 01 P-BLANK-LINE PIC X(102) VALUE SPACES.
000690
000700 01 P-TITLE-1.
000710 03 PIC X(20) VALUE SPACES.
000720 03 PIC X(13) VALUE 'ZENITH PAINTS'.
000730 01 P-TITLE-2.
000740 03 PIC X(14) VALUE SPACES.
000750 03 PIC X(57)
000760 VALUE 'UPDATED CUSTOMER MASTER FILE REPORT (Program 4 output) '.
000770 03 PIC X(6) VALUE 'DATE: '.
000780 03 DOS-DAY PIC 99.
000790 03 PIC X VALUE '-'.
000800 03 DOS-MONTH PIC 99.
000810 03 PIC X VALUE '-'.
000820 03 DOS-YEAR PIC 99.
000830
000840 01 P-BRING-FOR.
000850 03 PIC X(60) VALUE SPACES.
000860 03 PIC X(26) VALUE
000870 'BALANCE BROUGHT FORWARD: £'.
000880 03 P-BROUGHT-FORWARD PIC -(6)9.99.
000890 01 P-CARRY-FOR.
000900 03 PIC X(60) VALUE SPACES.
000910 03 PIC X(26) VALUE
000920 'BALANCE CARRIED FORWARD: £'.
000930 03 P-CARRIED-FORWARD PIC -(6)9.99.
000940
000950 01 P-PAGE-NO-HEAD.
000960 03 PIC X(7) VALUE ' PAGE '.
000970 03 P-PAGE-NO PIC ZZ9.
000980 01 P-UNDERLINE PIC X(103) VALUE ALL '-'.
000990 01 P-HEADING-1.
001000 03 PIC X(6) VALUE SPACES.
001010 03 PIC X(75) VALUE 'CUSTOMER'.
001020 03 PIC X(14) VALUE 'CREDIT LAST'.
001030 01 P-HEADING-2.
001040 03 PIC X(8) VALUE SPACES.
001050 03 PIC X(30) VALUE 'CODE NAME'.
001060 03 PIC X(31) VALUE 'ADDRESS'.
001070 03 PIC X(35) VALUE
001080 'BALANCE(£) LIMIT(£) MOVEMENT DATE'.
001090
001100 01 P-XS-BALANCE.
001110 03 PIC X(67) VALUE SPACES.
001120 03 PIC X(17) VALUE
001130 'EXCESS BALANCE: £'.
001140 03 P-BAL-LIM-DIFF PIC Z(5)9.99.
001150
001160 01 P-RECORD-LINE.
001170 03 PIC XXX VALUE SPACES.
001180 03 P-DEBT-WARNING PIC XXXX VALUE SPACES.
001190 03 P-CUS-CODE PIC X(5).
001200 03 PIC XX VALUE SPACES.
001210 03 P-NAME PIC X(20).
001220 03 PIC XXX VALUE SPACES.
001230 03 P-CUS-ADDRESS PIC X(30).
001240 03 PIC XX VALUE SPACES.
001250 03 P-BALANCE PIC Z(6)9.99CR.
001260 03 PIC XX VALUE SPACES.
001270 03 P-CRED-LIMIT PIC Z(6)9.
001280 03 PIC XXXX VALUE SPACES.
001290 03 P-DAY PIC 99.
001300 03 PIC X VALUE '-'.
001310 03 P-MONTH PIC 99.
001320 03 PIC X VALUE '-'.
001330 03 P-YEAR PIC 99.
001340
001350 01 P-MORE-ADDRESS-LINES.
001360 03 PIC X(37) VALUE SPACES.
001370 03 P-EXTRA-LINE PIC X(30).
001380
001390 01 P-FOOTER-1.
001400 03 PIC X(10) VALUE SPACES.
001410 03 PIC X(17) VALUE 'TOTAL BALANCE = £'.
001420 03 P-TOT-BALANCE PIC -(6)9.99.
001430 01 P-FOOTER-2.
001440 03 PIC X(10) VALUE SPACES.
001450 03 PIC X(34) VALUE
001460 'TOTAL NUMBER OF RECORDS PRINTED = '.
001470 03 P-REC-COUNT PIC ZZZ9.
001480 01 P-FOOTER-3.
001490 03 PIC X(10) VALUE SPACES.
001500 03 PIC X(26) VALUE
001510 'TOTAL NUMBER OF DEBTORS = '.
001520 03 P-TOT-DEBTORS PIC ZZ9.
001530 01 P-FOOTER-4.
001540 03 PIC X(10) VALUE SPACES.
001550 03 PIC X(83) VALUE
001560 '>>> = CUSTOMER WITH DEBIT BALANCE THAT EXCEEDS CREDIT LIMIT. CR = CREDIT BALANCE'.
001570 01 P-FOOTER-5 PIC X(33) VALUE
001580 ' *** END OF REPORT ***'.
001590
001600
001610
001620
001630* End of Data Division
001640*******************************************************
001650*******************************************************
001660
001670 PROCEDURE DIVISION.
001680
001690 CONTROL-PARAGRAPH.
001700
001710 PERFORM INITIAL-PROCESS
001720 PERFORM MAIN-PROCESS UNTIL END-OF-IN-FILE
001730 PERFORM TERMINATION-PROCESS
001740
001750 STOP RUN.
001760
001770*******************************************************
001780
001790 INITIAL-PROCESS.
001800* Paragraph to open files & print report titles & headers
001810
001820 OPEN INPUT IN-FILE
001830 OUTPUT PRINT-FILE
001840
001850*---- print report titles with system date -----*
001860 ACCEPT DATE-IN FROM DATE
001870 MOVE CORRESPONDING DATE-IN TO P-TITLE-2
001880 WRITE PRINT-LINE FROM P-TITLE-1 AFTER PAGE
001890 WRITE PRINT-LINE FROM P-TITLE-2 AFTER 2 LINES
001900
001910 PERFORM PRINT-HEADERS
001920
001930*---- read first record ------*
001940 READ IN-FILE
001950 AT END
001960 MOVE 'Y' TO EOF-FLAG
001970 NOT AT END
001980 ADD 1 TO RECORD-COUNT
001990 END-READ.
002000
002010*******************************************************
002020
002030 MAIN-PROCESS.
002040* Paragraph to print report lines, testing for debtors
002050
002060*---- test if customer is debtor; if true then mark ---*
002070 IF CUS-BALANCE > CUS-CRED-LIMIT THEN
002080 MOVE '>>> ' TO P-DEBT-WARNING
002090 ADD 1 TO TOTAL-DEBTORS
002100 ELSE
002110 MOVE SPACES TO P-DEBT-WARNING
002120 END-IF
002130
002140*---- update running balance total -----*
002150 ADD CUS-BALANCE TO TOTAL-BALANCE
002160 ON SIZE ERROR
002170 DISPLAY 'BALANCE HAS EXCEEDED PROGRAM LIMITS'
002180 END-ADD
002190
002200*---- print the record -----*
002210 PERFORM PRINT-CUSTOMER-RECORD
002220
002230*---- test line number -----*
002240 IF W-LINE-NO > 40 THEN
002250 MOVE TOTAL-BALANCE TO P-CARRIED-FORWARD
002260 P-BROUGHT-FORWARD
002270 WRITE PRINT-LINE FROM P-CARRY-FOR
002280 WRITE PRINT-LINE FROM P-BLANK-LINE AFTER PAGE
002290 PERFORM PRINT-HEADERS
002300 END-IF
002310
002320*---- read next record ------*
002330 READ IN-FILE
002340 AT END
002350 MOVE 'Y' TO EOF-FLAG
002360 NOT AT END
002370 ADD 1 TO RECORD-COUNT
002380 END-READ.
002390
002400*******************************************************
002410
002420 PRINT-HEADERS.
002430* Paragraph to print report headers and page number
002440
002450 ADD 1 TO W-PAGE-NO
002460
002470 IF W-PAGE-NO > 1 THEN
002480 WRITE PRINT-LINE FROM P-BRING-FOR AFTER 1 LINE
002490 END-IF
002500
002510 MOVE W-PAGE-NO TO P-PAGE-NO
002520 WRITE PRINT-LINE FROM P-PAGE-NO-HEAD AFTER 2 LINES
002530 WRITE PRINT-LINE FROM P-HEADING-1 AFTER 1 LINE
002540 WRITE PRINT-LINE FROM P-HEADING-2 AFTER 1 LINE
002550 WRITE PRINT-LINE FROM P-UNDERLINE AFTER 1 LINE
002560 MOVE ZERO TO W-LINE-NO.
002570
002580*******************************************************
002590
002600 PRINT-CUSTOMER-RECORD.
002610* Paragraph to print record line on error report
002620
002630 MOVE CUS-CODE TO P-CUS-CODE
002640 MOVE CUS-NAME TO P-NAME
002650 MOVE CUS-BALANCE TO P-BALANCE
002660 MOVE CUS-CRED-LIMIT TO P-CRED-LIMIT
002670 MOVE MOV-DAY TO P-DAY
002680 MOVE MOV-MONTH TO P-MONTH
002690 MOVE MOV-YEAR TO P-YEAR
002700
002710*--- unstring address into 30-character lines ------*
002720*--- using ';' delimiter ---------------------------*
002730 MOVE ZERO TO ADDRESS-LINE-NO
002740 UNSTRING CUS-ADDRESS DELIMITED BY ';'
002750 INTO P-CUS-ADDRESS P-ADDRESS (2)
002760 P-ADDRESS (3) P-ADDRESS (4)
002770 TALLYING IN ADDRESS-LINE-NO
002780 END-UNSTRING
002790
002800*---- print main record line ------*
002810 WRITE PRINT-LINE FROM P-RECORD-LINE
002820 ADD 1 TO W-LINE-NO
002830
002840
002850*---- print additional address lines -------*
002860 PERFORM VARYING SUBS-NO FROM 2 BY 1
002870 UNTIL SUBS-NO > ADDRESS-LINE-NO
002880 IF P-ADDRESS (SUBS-NO) NOT = SPACES THEN
002890 MOVE P-ADDRESS (SUBS-NO) TO P-EXTRA-LINE
002900 WRITE PRINT-LINE FROM P-MORE-ADDRESS-LINES
002910 ADD 1 TO W-LINE-NO
002920 END-IF
002930 END-PERFORM
002940
002950*---- print details of excess balance when relevant --*
002960 IF P-DEBT-WARNING = '>>> ' THEN
002970 COMPUTE BALANCE-LIMIT-DIFFERENCE =
002980 CUS-BALANCE - CUS-CRED-LIMIT
002990 MOVE BALANCE-LIMIT-DIFFERENCE TO P-BAL-LIM-DIFF
003000 WRITE PRINT-LINE FROM P-XS-BALANCE
003010 WRITE PRINT-LINE FROM P-BLANK-LINE
003020 ADD 2 TO W-LINE-NO
003030 ELSE
003040 WRITE PRINT-LINE FROM P-BLANK-LINE
003050 ADD 1 TO W-LINE-NO
003060 END-IF.
003070
003080*******************************************************
003090
003100 TERMINATION-PROCESS.
003110* Paragraph to print footers and close files
003120
003130 MOVE TOTAL-DEBTORS TO P-TOT-DEBTORS
003140 MOVE RECORD-COUNT TO P-REC-COUNT
003150 MOVE TOTAL-BALANCE TO P-TOT-BALANCE
003160
003170 IF W-LINE-NO > 20 THEN
003180 WRITE PRINT-LINE FROM P-BLANK-LINE AFTER PAGE
003190 END-IF
003200
003210 WRITE PRINT-LINE FROM P-UNDERLINE
003220 WRITE PRINT-LINE FROM P-FOOTER-1 AFTER 2 LINES
003230 WRITE PRINT-LINE FROM P-FOOTER-2 AFTER 1 LINE
003240 WRITE PRINT-LINE FROM P-FOOTER-3 AFTER 1 LINE
003250 WRITE PRINT-LINE FROM P-FOOTER-4 AFTER 2 LINES
003260 WRITE PRINT-LINE FROM P-FOOTER-5 AFTER 2 LINES
003270
003280 CLOSE IN-FILE PRINT-FILE.
003290
003300*******************************************************
003310** **
003320** END OF PROGRAM-4 **
003330** **
003340*******************************************************
|