IDENTIFICATION DIVISION.
PROGRAM-ID. BIRTHDAY-CARD.
AUTHOR. MARTIN O'SULLIVAN.
*PROGRAM TO TAKE IN A PERSON'S NAME AND YEAR OF BIRTH USING
*SCREENS AND TO REDISPLAY THE NAME AND AGE.
DATE-WRITTEN. 14 OCTOBER 1998.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SCREEN-FILE
ASSIGN TO WORKSTATION-BIRTHDAY
ORGANIZATION IS TRANSACTION
FILE STATUS IS WA-SCREEN-STAT WA-RETURN-CODE
CONTROL-AREA IS WA-CONTROL-AREA.
*
DATA DIVISION.
FILE SECTION.
FD SCREEN-FILE
LABEL RECORDS ARE OMITTED.
01 SCREEN-REC PIC X(500).
WORKING-STORAGE SECTION.
01 WA-SCREEN-CONTROL.
03 WA-SCREEN-STAT PIC X(2).
88 SUCCESSFUL-READ VALUE "00".
03 WA-RETURN-CODE PIC X(4).
03 WA-CONTROL-AREA.
05 WA-AID-BYTE PIC S99 VALUE ZEROES.
88 END-OF-JOB VALUE 3.
88 ENTER-KEY VALUE 0.
05 WA-SESSION-ID PIC X(2).
05 FILLER PIC X(8).
01 THE-DATE.
03 YEAR-IN PIC 9(2).
03 DAY-IN PIC 9(2).
03 MONTH-IN PIC 9(2).
01 TODAY-YEAR PIC 9(4).
01 VARIOUS-BUFFERS.
03 WHOLE-SPACE.
05 FIRST-SPACE.
07 NAME PIC A(50).
07 YEAR-BIRTH PIC 9(4).
05 SECOND-SPACE.
07 AGE-THIS-YEAR PIC 9(4).
PROCEDURE DIVISION.
DECLARATIVES.
SCREEN-ERROR SECTION.
USE AFTER STANDARD EXCEPTION PROCEDURE ON I-O.
SCREEN-ERROR-PARA.
DISPLAY "ATTENTION !!!!! ERROR IN I-O ", WA-SCREEN-CONTROL.
END DECLARATIVES.
MAIN-PROCESSING SECTION.
TOP-LEVEL-PARA.
PERFORM START-UP.
PERFORM PROMPT-GO.
PERFORM ALL-THE-CARDS UNTIL END-OF-JOB.
PERFORM CLOSING-GREETING.
PERFORM CLOSE-DOWN.
STOP RUN.
START-UP.
PERFORM GET-DATE.
PERFORM OPEN-FILES.
GET-DATE.
ACCEPT THE-DATE FROM DATE.
ADD 1900 TO YEAR-IN GIVING TODAY-YEAR.
OPEN-FILES.
OPEN I-O SCREEN-FILE.
PROMPT-GO.
WRITE SCREEN-REC FORMAT IS "WELCOME".
READ SCREEN-FILE.
ALL-THE-CARDS.
PERFORM DO-CARD-ONCE-AND-PROMPT.
CLOSING-GREETING.
WRITE SCREEN-REC FORMAT IS "GOODBY".
READ SCREEN-FILE.
CLOSE-DOWN.
CLOSE SCREEN-FILE.
DO-CARD-ONCE-AND-PROMPT.
PERFORM DO-ONE-CARD.
PERFORM PROMPT-AGAIN.
DO-ONE-CARD.
PERFORM GET-INPUT-DATA.
PERFORM CALCULATE-AGE-THIS-YEAR.
PERFORM DISPLAY-INPUT.
PERFORM POSSIBLE-3-WAY-OVERLAY.
GET-INPUT-DATA.
MOVE SPACES TO FIRST-SPACE.
WRITE SCREEN-REC FROM FIRST-SPACE FORMAT IS "DETAILS".
READ SCREEN-FILE INTO FIRST-SPACE.
CALCULATE-AGE-THIS-YEAR.
SUBTRACT YEAR-BIRTH FROM TODAY-YEAR GIVING AGE-THIS-YEAR.
DISPLAY-INPUT.
WRITE SCREEN-REC FROM FIRST-SPACE FORMAT IS "REDISPLAY".
READ SCREEN-FILE.
POSSIBLE-3-WAY-OVERLAY.
IF YEAR-BIRTH < TODAY-YEAR
PERFORM YOB-BEFORE-THIS-YEAR
ELSE
IF YEAR-BIRTH = TODAY-YEAR
PERFORM YOB-IN-THIS-YEAR
ELSE
PERFORM YOB-AFTER-THIS-YEAR.
YOB-BEFORE-THIS-YEAR.
WRITE SCREEN-REC FROM SECOND-SPACE FORMAT IS "LONGBORN".
READ SCREEN-FILE.
YOB-IN-THIS-YEAR.
WRITE SCREEN-REC FROM SECOND-SPACE FORMAT IS "JUSTBORN".
READ SCREEN-FILE.
YOB-AFTER-THIS-YEAR.
WRITE SCREEN-REC FROM SECOND-SPACE FORMAT IS "NOTBORN".
READ SCREEN-FILE.
PROMPT-AGAIN.
WRITE SCREEN-REC FORMAT IS "AGAIN".
READ SCREEN-FILE.
Link back to cobol page