Quelle  Table-Prog.cob   Sprache: Cobol

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*******************************************************************