000100 IDENTIFICATION DIVISION.                                                 
000200 PROGRAM-ID.                 COB$DOW.                                     
000400*REMARKS.                    GET DAY-OF-WEEK.                             
000700 EJECT                                                                    
000800 ENVIRONMENT DIVISION.                                                    
002700 DATA DIVISION.                                                           
010900 EJECT                                                                    
011000 WORKING-STORAGE SECTION.                                                 
011100 01  PGM-ID-VERSION.                                                      
011200     03  PGM-ID                 PIC X(10) VALUE 'COB$DOW: '.              
011300     03  PGM-VERSION            PIC X(16) VALUE SPACES.                   
011400     03  FILLER                 PIC X(7)  VALUE ' START'.                 
       01  WDOW                       PIC 9.                                    
       01  WDOW-ENTRIES.                                                        
           05                         PIC X(9) VALUE 'MONDAY   '.               
           05                         PIC X(9) VALUE 'TUESDAY  '.               
           05                         PIC X(9) VALUE 'WEDNESDAY'.               
           05                         PIC X(9) VALUE 'THURSDAY '.               
           05                         PIC X(9) VALUE 'FRIDAY   '.               
           05                         PIC X(9) VALUE 'SATURDAY '.               
           05                         PIC X(9) VALUE 'SUNDAY   '.               
       01                             REDEFINES WDOW-ENTRIES.                   
           05  WDOW-ENTRY             PIC X(9) OCCURS 7 TIMES.                  
       EJECT                                                                    
       LINKAGE SECTION.                                                         
       01   IP-CCYYMMDD                PIC 9(8).                                
       01   IP-DOW                     PIC X(9).                                
       EJECT                                                                    
       PROCEDURE DIVISION USING IP-CCYYMMDD, IP-DOW.                            
                                                                                
           ACCEPT IP-CCYYMMDD FROM DATE YYYYMMDD                                
           ACCEPT WDOW        FROM DAY-OF-WEEK                                  
           MOVE WDOW-ENTRY (WDOW) TO IP-DOW                                     
           GOBACK.