|
000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. TABLE-PROG.
000030 AUTHOR. TIMOTHY R P BROWN.
000035
000037*****************************************************
000040* Program to update a football league table *
000045* and output a new updated table *
000046* Based on English Premiership season 1999-2000 *
000047*****************************************************
000048
000050 ENVIRONMENT DIVISION.
000060 INPUT-OUTPUT SECTION.
000070 FILE-CONTROL.
000080 SELECT TEAM-REC-IN ASSIGN TO "INPUT.REC"
000090 ORGANIZATION IS SEQUENTIAL.
000100 SELECT WORK-FILE ASSIGN TO SORTWK01.
000105* for MicroFocus compiler
000107* replace SORTWK01 with 'WORKFILE.DAT'
000110 SELECT SORT-OUT ASSIGN TO "SORTED.REC"
000120 ORGANIZATION IS SEQUENTIAL.
000130 SELECT PRINT-FILE ASSIGN TO PRINTER.
000140
000150
000160 DATA DIVISION.
000170 FILE SECTION.
000180 FD TEAM-REC-IN.
000190 01 TEAM-REC.
000200 03 TEAM-CODE PIC XXX.
000210 03 TEAM-NAME PIC X(20).
000220 03 PLAYED PIC 99.
000230 03 GOALS-FOR PIC 99.
000240 03 GOALS-AGST PIC 99.
000250 03 G-WON PIC 99.
000260 03 G-LOST PIC 99.
000270 03 G-DRAWN PIC 99.
000280 03 GOAL-DIFF PIC S99 SIGN LEADING SEPARATE.
000290 03 POINTS PIC 99.
000300
000310 SD WORK-FILE.
000320 01 WORK-REC.
000330 03 TEAM-CODE-KEY PIC XXX.
000340 03 PIC X(22).
000350 03 GF-KEY PIC 99.
000360 03 PIC X(8).
000370 03 GD-KEY PIC S99 SIGN LEADING SEPARATE.
000380 03 POINTS-KEY PIC 99.
000390
000400
000410 FD PRINT-FILE.
000420 01 TEXT-OUT PIC X(60).
000430
000440 FD SORT-OUT.
000450 01 TEAM-REC-OUT.
000460 03 STEAM-CODE PIC XXX.
000470 03 STEAM-NAME PIC X(20).
000480 03 SPLAYED PIC 99.
000490 03 SGOALS-FOR PIC 99.
000500 03 SGOALS-AGST PIC 99.
000510 03 SG-WON PIC 99.
000520 03 SG-LOST PIC 99.
000530 03 SG-DRAWN PIC 99.
000540 03 SGOAL-DIFF PIC S999.
000550 03 SPOINTS PIC 99.
000560
000570
000580
000590
000600 WORKING-STORAGE SECTION.
000610
000620 01 M PIC 99.
000630 01 REAL-GOAL-DIFF PIC S999.
000640
000650 01 W-DATE.
000660 03 W-YEAR PIC 99.
000670 03 W-MON PIC 99.
000680 03 W-DAY PIC 99.
000690
000700
000710 01 SCORE.
000720 03 W-H-SCR PIC 9.
000730 03 PIC X VALUE "-".
000740 03 W-A-SCR PIC 9.
000750
000760 01 P-TITLE.
000770 03 PIC X(5) VALUE SPACES.
000780 03 TAB-TITLE PIC X(34)
000790 VALUE "The English FA Premier League".
000800
000810 03 P-DATE.
000820 05 P-DAY PIC XX.
000830 05 PIC X VALUE "/".
000840 05 P-MON PIC XX.
000850 05 PIC X VALUE "/".
000860 05 P-YEAR PIC XX.
000870
000880 01 P-UNDERLINE PIC X(45) VALUE ALL "-".
000890 01 P-GAP PIC X VALUE SPACE.
000900
000910 01 P-HEADER.
000920 03 PIC X(6) VALUE SPACES.
000930 03 TAB-TEAM PIC X(4) VALUE "TEAM".
000940 03 PIC X(11) VALUE SPACES.
000950 03 PLY PIC X(5) VALUE "Playd".
000960 03 PIC X VALUE SPACE.
000970 03 WO PIC XXX VALUE "Won".
000980 03 PIC X VALUE SPACE.
000990 03 DR PIC XXXX VALUE "Drwn".
001000 03 PIC X VALUE SPACE.
001010 03 LO PIC XXXX VALUE "Lost".
001020 03 PIC X VALUE SPACE.
001030 03 GF PIC XXX VALUE "For".
001040 03 PIC X VALUE SPACE.
001050 03 GA PIC X(5) VALUE "Agnst".
001060 03 PIC X VALUE SPACE.
001070 03 GD PIC XX VALUE "GD".
001080 03 PIC X VALUE SPACE.
001090 03 PTS PIC XXX VALUE "PTS".
001100
001110 01 W-TEXT-OUT.
001120 03 P-TAB-POS PIC 99.
001130 03 PIC X VALUE SPACE.
001140 03 P-TEAM PIC X(20).
001150 03 P-PLAYED PIC 99.
001160 03 PIC XXX VALUE SPACES.
001170 03 P-G-WON PIC Z9.
001180 03 PIC XX VALUE SPACES.
001190 03 P-G-DRAWN PIC Z9.
001200 03 PIC XXX VALUE SPACES.
001210 03 P-G-LOST PIC Z9.
001220 03 PIC XXX VALUE SPACES.
001230 03 P-GOALS-FOR PIC 99.
001240 03 PIC XX VALUE SPACES.
001250 03 P-GOALS-AGST PIC 99.
001260 03 PIC XX VALUE SPACES.
001270 03 P-GOAL-DIFF PIC ZZ9.
001280 03 PIC XX VALUE SPACES.
001290 03 P-POINTS PIC Z9.
001300
001310
001320 01 SCORE-TAB.
001330 03 TAB-SCORE PIC 9 OCCURS 2.
001340 01 T-POINTS-TAB.
001350 03 T-POINTS PIC 99 OCCURS 20.
001360 01 POINTS-TAB.
001370 03 TAB-POINTS PIC 9 OCCURS 2.
001380 01 T-G-FOR-TAB.
001390 03 T-G-FOR PIC 99 OCCURS 20.
001400 01 T-G-AGST-TAB.
001410 03 T-G-AGST PIC 99 OCCURS 20.
001420 01 T-G-DIFF-TAB.
001430 03 T-G-DIFF PIC 99 OCCURS 20.
001440 01 TAB-TEAM-NAME.
001450 03 TEAM PIC XXX OCCURS 2.
001460
001470
001480 01 V-TEAM-FLAG PIC X.
001490 88 V-TEAM VALUE "Y".
001500 01 V-SCORE-FLAG PIC X.
001510 88 V-SCORE VALUE "Y".
001520 01 SORT-ONLY-FLAG PIC X.
001530 88 SORT-ONLY VALUE "Y".
001540
001550
001560 01 ENDING-KEY PIC X VALUE SPACE.
001570 01 SWITCH PIC 9.
001580 01 EOF-FLAG PIC X VALUE "N".
001590 01 COUNTER PIC 99.
001600 01 W-GOAL-DIFF PIC 99.
001610 01 LAST-SCORE PIC X.
001620 01 N PIC 99.
001630
001640*****************************************************
001650
001660 PROCEDURE DIVISION.
001670
001680 MAIN-PARAGRAPH.
001690
001700 PERFORM DISPLAY-INSTRUCTIONS
001710 PERFORM INPUT-DATA
001720 PERFORM SORT-TABLE
001730 PERFORM PRINT-TABLE
001740 DISPLAY " Type Q or X to exit program."
001750 ACCEPT ENDING-KEY
001760 STOP RUN.
001770*******************************************************************
001780 DISPLAY-INSTRUCTIONS.
001790 DISPLAY " Instructions"
001800 DISPLAY " "
001810 DISPLAY " Following prompts, enter the first "
001820 DISPLAY "3 letters of the team in lower case. "
001830 DISPLAY " Then enter the score (home team score first)."
001840 DISPLAY " To perform SORT ONLY function, type 'xxx' "
001850 DISPLAY "at both team prompts. ".
001860*******************************************************************
001870 INPUT-DATA.
001880 MOVE "n" TO LAST-SCORE
001890 MOVE "N" TO SORT-ONLY-FLAG
001900 PERFORM UNTIL LAST-SCORE = "y" OR "Y"
001910 MOVE "N" TO V-SCORE-FLAG
001920 MOVE "N" TO V-TEAM-FLAG
001930 PERFORM UNTIL V-TEAM
001940 DISPLAY "INPUT HOME TEAM >"
001950 ACCEPT TEAM (1)
001960 DISPLAY "INPUT AWAY TEAM >"
001970 ACCEPT TEAM (2)
001980 PERFORM VAL-TEAM
001990 END-PERFORM
002000 IF TEAM (1) = "XXX" OR "xxx" THEN
002010 MOVE "Y" TO LAST-SCORE
002020 PERFORM SORT-TABLE
002030 ELSE
002040 PERFORM UNTIL V-SCORE or SORT-ONLY
002050 DISPLAY "INPUT RESULT AS 'X-Y'"
002060 ACCEPT SCORE
002070 MOVE W-H-SCR TO TAB-SCORE (1)
002080 MOVE W-A-SCR TO TAB-SCORE (2)
002090 PERFORM VAL-SCORE
002100 END-PERFORM
002110 DISPLAY "LAST RESULT? Y/N"
002120 ACCEPT LAST-SCORE
002130 PERFORM CALC-POINTS
002140 PERFORM UPDATE-RECORD
002150 END-IF
002160 END-PERFORM.
002170*******************************************************************
002180 VAL-TEAM.
002190 PERFORM VARYING COUNTER FROM 1 BY 1
002200 UNTIL COUNTER > 2
002210
002220 EVALUATE TRUE
002230 WHEN TEAM (COUNTER) = "ars" or "ast" or "bra" or
002240 "che" or "cov" or "der" or
002250 "eve" or "lee" or "lei" or
002260 "liv" or "man" or "mid" or
002270 "new" or "she" or "sou" or
002280 "sun" or "tot" or "wat" or
002290 "wes" or "wim"
002300 MOVE "Y" TO V-TEAM-FLAG
002310 WHEN OTHER MOVE "N" TO V-TEAM-FLAG
002320 END-EVALUATE
002340 END-PERFORM
002350 IF NOT V-TEAM THEN DISPLAY
002360 "INVALID TEAM CODE ENTERED-"
002370 "RE-ENTER BOTH TEAM CODES AGAIN."
002380 END-IF.
002390*******************************************************************
002400 VAL-SCORE.
002410 IF ( W-H-SCR > 9 ) OR ( W-A-SCR > 9 )
002420 THEN PERFORM BIG-SCORE
002430 END-IF
002440 IF ( W-H-SCR NOT NUMERIC) OR ( W-H-SCR NOT NUMERIC)
002450 THEN MOVE "N" TO V-SCORE-FLAG
002460 ELSE MOVE "Y" TO V-SCORE-FLAG
002470 END-IF
002480 IF NOT V-SCORE THEN
002490 DISPLAY "INVALID SCORE ENTRY. PLEASE RE-ENTER SCORE."
002500 END-IF.
002510*******************************************************************
002520 BIG-SCORE.
002525* Putting a STOP RUN in this paragraph is probably
002527* very bad programming practise. Better logic could be used!
002530 DISPLAY "A team has scored more than 10 goals. "
002540 DISPLAY "This program will terminate now. "
002550 DISPLAY "Following this, the record in Input.rec "
002560 DISPLAY "will have to be ammended manually"
002580 DISPLAY " Following this perform SORT ONLY procedure."
002600 ACCEPT ENDING-KEY
002610 STOP RUN.
002620
002630*******************************************************************
002640 CALC-POINTS.
002650 IF TAB-SCORE (1) > TAB-SCORE (2) THEN
002660 MOVE 3 TO TAB-POINTS (1)
002670 ELSE
002680 IF TAB-SCORE (2) > TAB-SCORE (1) THEN
002690 ADD 3 TO TAB-POINTS (2)
002700 ELSE
002710 MOVE 1 TO TAB-POINTS (1)
002720 MOVE 1 TO TAB-POINTS (2)
002730 END-IF
002740 END-IF.
002750
002760*******************************************************************
002770 UPDATE-RECORD.
002790 MOVE 1 TO N
002800 MOVE 1 TO M
002810 OPEN I-O TEAM-REC-IN
002820 PERFORM UNTIL M > 20
002830 READ TEAM-REC-IN
002840 AT END
002850 DISPLAY TEAM (1) " has details ammended"
002860 NOT AT END
002870 IF TEAM (1) = TEAM-CODE THEN
002880 PERFORM ADJUST-DATA
002890
002900 END-IF
002910 ADD 1 TO M
002920 END-READ
002930 END-PERFORM
002940
002950 CLOSE TEAM-REC-IN
002955
002970 MOVE 2 TO N
002980 MOVE 1 TO M
002980
002990 OPEN I-O TEAM-REC-IN
003000 PERFORM UNTIL M > 20
003010 READ TEAM-REC-IN
003020 AT END
003030 DISPLAY TEAM (2) " has details ammended"
003040 NOT AT END
003050 IF TEAM (2) = TEAM-CODE THEN
003060 PERFORM ADJUST-DATA
003080 END-IF
003090 ADD 1 TO M
003100 END-READ
003110 END-PERFORM
003120 CLOSE TEAM-REC-IN
003130 DISPLAY "Table has been updated".
003140*******************************************************************
003150 ADJUST-DATA.
003160 IF N = 1 THEN MOVE 2 TO SWITCH
003170 ELSE MOVE 1 TO SWITCH
003180 END-IF
003190 ADD TAB-SCORE (N) TO GOALS-FOR
003200 ADD TAB-SCORE (SWITCH) TO GOALS-AGST
003210 SUBTRACT GOALS-AGST FROM GOALS-FOR GIVING GOAL-DIFF
003220 ADD TAB-POINTS (N) TO POINTS
003230 ADD 1 TO PLAYED
003240 EVALUATE TAB-POINTS (N)
003250 WHEN 3 ADD 1 TO G-WON
003260 WHEN ZERO ADD 1 TO G-LOST
003270 WHEN 1 ADD 1 TO G-DRAWN
003280 END-EVALUATE
003290 REWRITE TEAM-REC.
003300*******************************************************************
003310 SORT-TABLE.
003320 SORT WORK-FILE
003330 ON DESCENDING KEY POINTS-KEY GD-KEY GF-KEY
003340 USING TEAM-REC-IN
003350 GIVING SORT-OUT.
003360
003370*******************************************************************
003380 PRINT-TABLE.
003390 ACCEPT W-DATE FROM DATE
003400 MOVE W-DAY TO P-DAY
003410 MOVE W-MON TO P-MON
003420 MOVE W-YEAR TO P-YEAR
003430
003440 OPEN INPUT SORT-OUT
003450 OUTPUT PRINT-FILE
003460
003470 WRITE TEXT-OUT FROM P-TITLE AFTER 1 LINE
003480 WRITE TEXT-OUT FROM P-UNDERLINE AFTER 1 LINE
003490 WRITE TEXT-OUT FROM P-GAP AFTER 1 LINE
003500 WRITE TEXT-OUT FROM P-HEADER AFTER 1 LINE
003510 MOVE 1 TO N
003520 PERFORM UNTIL N > 20
003530 READ SORT-OUT
003540 AT END MOVE "Y" TO EOF-FLAG
003550 NOT AT END
003560 MOVE N TO P-TAB-POS
003570 MOVE STEAM-NAME TO P-TEAM
003580 MOVE SPLAYED TO P-PLAYED
003590 MOVE SG-WON TO P-G-WON
003600 MOVE SG-LOST TO P-G-LOST
003610 MOVE SG-DRAWN TO P-G-DRAWN
003620 MOVE SGOALS-FOR TO P-GOALS-FOR
003630 MOVE SGOALS-AGST TO P-GOALS-AGST
003650 MOVE SGOAL-DIFF TO P-GOAL-DIFF
003660 MOVE SPOINTS TO P-POINTS
003670
003680 WRITE TEXT-OUT FROM W-TEXT-OUT
003700 END-READ
003710 ADD 1 TO N
003720 END-PERFORM
003730 CLOSE SORT-OUT PRINT-FILE
003740 DISPLAY "Table is now written to the printer".
003750*******************************************************************
¤ Dauer der Verarbeitung: 0.27 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
