Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
Tutorialspoint

Compile and Execute COBOL Online

IDENTIFICATION DIVISION.
PROGRAM-ID. HW15RG.
AUTHOR. RACHEL GRAHAM.
DATE-WRITTEN. 03-09-2019.
DATA DIVISION.
WORKING-STORAGE SECTION.

01  CURRENT-DATE.
    05  CURRENT-YEAR            PIC 99.
    05  CURRENT-MONTH           PIC 99.
    05  CURRENT-DAY             PIC 99.

01  WS-FORMATTED-DATE.
    05 WS-FORMATTED-DATE-MM    PIC X(02).
    05 FILLER                  PIC X(01) VALUE '/'.
    05 WS-FORMATTED-DATE-DD    PIC X(02).
    05 FILLER                  PIC X(01) VALUE '/'.
    05 WS-FORMATTED-DATE-YY    PIC X(02).
    
01 ALPHABET-TABLE-DATA.
    05 FILLER                  PIC X(02) VALUE 'Aa'.
    05 FILLER                  PIC X(02) VALUE 'Bb'.
    05 FILLER                  PIC X(02) VALUE 'Cc'.
    05 FILLER                  PIC X(02) VALUE 'Dd'.
    05 FILLER                  PIC X(02) VALUE 'Ee'.
    05 FILLER                  PIC X(02) VALUE 'Ff'.
    05 FILLER                  PIC X(02) VALUE 'Gg'.
    05 FILLER                  PIC X(02) VALUE 'Hh'.
    05 FILLER                  PIC X(02) VALUE 'Ii'.
    05 FILLER                  PIC X(02) VALUE 'Jj'.
    05 FILLER                  PIC X(02) VALUE 'Kk'.
    05 FILLER                  PIC X(02) VALUE 'Ll'.
    05 FILLER                  PIC X(02) VALUE 'Mm'.
    05 FILLER                  PIC X(02) VALUE 'Nn'.
    05 FILLER                  PIC X(02) VALUE 'Oo'.
    05 FILLER                  PIC X(02) VALUE 'Pp'.
    05 FILLER                  PIC X(02) VALUE 'Qq'.
    05 FILLER                  PIC X(02) VALUE 'Rr'.
    05 FILLER                  PIC X(02) VALUE 'Ss'.
    05 FILLER                  PIC X(02) VALUE 'Tt'.
    05 FILLER                  PIC X(02) VALUE 'Uu'.
    05 FILLER                  PIC X(02) VALUE 'Vv'.
    05 FILLER                  PIC X(02) VALUE 'Ww'.
    05 FILLER                  PIC X(02) VALUE 'Xx'.
    05 FILLER                  PIC X(02) VALUE 'Yy'.
    05 FILLER                  PIC X(02) VALUE 'Zz'.
    
01 FILLER REDEFINES ALPHABET-TABLE-DATA.
    05 ALPHABET-TABLE  OCCURS 26 TIMES
            INDEXED BY C. 
        10  UPPER-CHAR   PIC X(01).
        10  LOWER-CHAR   PIC X(01).

 
01 ALPHABET-NUM         PIC 99 VALUE ZEROS.
01 ALPHABET-CHAR        PIC X.
    
01 WS-MONTH-TABLE-DATA.
   05 FILLER                  PIC X(11) VALUE '01JANUARY  '.
   05 FILLER                  PIC X(11) VALUE '02FEBRUARY '.
   05 FILLER                  PIC X(11) VALUE '03MARCH    '.
   05 FILLER                  PIC X(11) VALUE '04APRIL    '.
   05 FILLER                  PIC X(11) VALUE '05MAY      '.
   05 FILLER                  PIC X(11) VALUE '06JUNE     '.
   05 FILLER                  PIC X(11) VALUE '07JULY     '.
   05 FILLER                  PIC X(11) VALUE '08AUGUST   '.
   05 FILLER                  PIC X(11) VALUE '09SEPTEMBER'.
   05 FILLER                  PIC X(11) VALUE '10OCTOBER  '.
   05 FILLER                  PIC X(11) VALUE '11NOVEMBER '.
   05 FILLER                  PIC X(11) VALUE '12DECEMBER '.
   
01 FILLER REDEFINES WS-MONTH-TABLE-DATA.
   05 MONTH-TABLE  OCCURS 12 TIMES
        INDEXED BY M.
      10 MONTH-NUM      PIC X(02).
      10 MONTH-NAME     PIC X(09).
      
01 MONTH-SUB            PIC 99.

01 CHAR PIC XX.
    88 VALIDCHAR VALUE "A" THRU "Z", "a" THRU "z".
    
01  SWITCH              PIC X(03).
    
01 Y2KDATE.
    05  Y2KYEAR         PIC 9(04).
    05  Y2KMONTH        PIC 99.
    05  Y2KDAY          PIC 99.
    
01 FORMAT-Y2K.
    05 FORMAT-MONTH     PIC X(09).
    05 FORMAT-DAY       PIC X(02).
    05 FILLER           PIC X(02)   VALUE ' ,'.
    05 FORMAT-YEAR      PIC X(04). 
    

PROCEDURE DIVISION.


0000-DRIVER.
    PERFORM 0100-INITIALIZE.
    PERFORM 1000-CHAR-TEST.
    PERFORM 1600-MONTH-DATE.
    PERFORM 9000-CLOSE.
    GOBACK.

0100-INITIALIZE.
    ACCEPT CURRENT-DATE FROM DATE.
    MOVE CURRENT-YEAR TO WS-FORMATTED-DATE-YY.
    MOVE CURRENT-MONTH TO WS-FORMATTED-DATE-MM.
    MOVE CURRENT-DAY TO WS-FORMATTED-DATE-DD.
    DISPLAY 'HW15  RACHEL GRAHAM  ' WS-FORMATTED-DATE.
    PERFORM VARYING C FROM 1 BY 1
                    UNTIL C > 26
    DISPLAY UPPER-CHAR(C) LOWER-CHAR(C)
  
    END-PERFORM.
    DISPLAY "--".

    PERFORM 1500-ACCEPT.

1000-CHAR-TEST.
    IF CHAR = ' ' THEN
        PERFORM 1300-NO-CHAR
    ELSE
        IF  VALIDCHAR
            PERFORM 1200-VALID-CHAR
        ELSE
            PERFORM 1100-INVALID-CHAR
        END-IF    
    END-IF.    
    
1100-INVALID-CHAR.
    DISPLAY 'CHARACTER IN: ' CHAR.
    DISPLAY 'NOT A LETTER IN THE ALPHABET'.
    DISPLAY "--".

1200-VALID-CHAR.
   SET C TO 1.
   SEARCH ALPHABET-TABLE
        WHEN UPPER-CHAR(C) = CHAR OR LOWER-CHAR(C) = CHAR
        SET ALPHABET-NUM TO C
        DISPLAY 'CHARACTER IN: ' CHAR
        DISPLAY 'LETTER ' CHAR 'IS LETTER NUMBER ' 
            ALPHABET-NUM ' IN THE ALPHABET'
        DISPLAY '--'
   
   END-SEARCH. 
        
1300-NO-CHAR.
    DISPLAY 'CHARACTER IN: " "' CHAR.
    DISPLAY 'NO CHARACTER ENTERED'.
    DISPLAY "--".
    
1500-ACCEPT.
    ACCEPT CHAR.
    
1600-MONTH-DATE.
    ACCEPT  Y2KDATE FROM DATE YYYYMMDD.
    MOVE Y2KDAY TO FORMAT-DAY.
    MOVE Y2KYEAR TO FORMAT-YEAR.
    
    SET M TO 1.
    SEARCH MONTH-TABLE
        WHEN MONTH-NUM(M) = Y2KMONTH
        MOVE MONTH-NAME(M) TO FORMAT-MONTH
    END-SEARCH.
    DISPLAY 'RACHEL GRAHAM'
    DISPLAY 'TEST RUN ON: 'FORMAT-Y2K.

9000-CLOSE.
    GOBACK.
            
STOP RUN.

Advertisements
Loading...

We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.