IDENTIFICATION DIVISION. ******************************************************** * This external subprogram produces the system date in * longdate format. It uses a single parameter which is * passed back to the calling program as a 28 character * alphanumeric field. A typical call statement for this * sub program might be: CALL "LDATE.INT" USING DATE-OUT. ******************************************************* PROGRAM-ID. LONGDATE. ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. 01 CURRENT-DATE-AND-TIME. 03 THIS-DATE. 05 CURRENT-YEAR PIC 9999. 05 CURRENT-MONTH PIC 99. 05 CURRENT-DAY PIC 99. 05 CURRENT-DAY-X REDEFINES CURRENT-DAY PIC XX. 03 THIS-TIME. 05 HOURS PIC 99. 05 MINUTES PIC 99. 05 SECONDS PIC 99. 05 HUNDRETHS PIC 99. 05 OFFSET-VALUE PIC X. 05 OFFSET-HOUR PIC 99. 05 OFFSET-MINUTE PIC 99. 01 NUMERIC-DAY-OF-THE-WEEK PIC 9. 01 DATE-OUT. 05 DAY-OUT PIC X(09). 05 PIC X(01) VALUE SPACES. 05 MO-OUT PIC X(09). LINKAGE SECTION. 01 LINK-DATE PIC X(28). PROCEDURE DIVISION USING LINK-DATE. PERFORM 10-DATE-ACQUIRE PERFORM 15-DATE-EVALUATE PERFORM 20-DATE-STRING. EXIT. 10-DATE-ACQUIRE. MOVE FUNCTION CURRENT-DATE TO CURRENT-DATE-AND-TIME ACCEPT NUMERIC-DAY-OF-THE-WEEK FROM DAY-OF-WEEK. 15-DATE-EVALUATE. EVALUATE CURRENT-MONTH WHEN 1 MOVE 'JANUARY' TO MO-OUT WHEN 2 MOVE 'FEBRUARY' TO MO-OUT WHEN 3 MOVE 'MARCH' TO MO-OUT WHEN 4 MOVE 'APRIL' TO MO-OUT WHEN 5 MOVE 'MAY' TO MO-OUT WHEN 6 MOVE 'JUNE' TO MO-OUT WHEN 7 MOVE 'JULY' TO MO-OUT WHEN 8 MOVE 'AUGUST' TO MO-OUT WHEN 9 MOVE 'SEPTEMBER' TO MO-OUT WHEN 10 MOVE 'OCTOBER' TO MO-OUT WHEN 11 MOVE 'NOVEMBER' TO MO-OUT WHEN 12 MOVE 'DECEMBER' TO MO-OUT END-EVALUATE EVALUATE NUMERIC-DAY-OF-THE-WEEK WHEN 1 MOVE 'MONDAY' TO DAY-OUT WHEN 2 MOVE 'TUESDAY' TO DAY-OUT WHEN 3 MOVE 'WEDNESDAY' TO DAY-OUT WHEN 4 MOVE 'THURSDAY' TO DAY-OUT WHEN 5 MOVE 'FRIDAY' TO DAY-OUT WHEN 6 MOVE 'SATURDAY' TO DAY-OUT WHEN 7 MOVE 'SUNDAY' TO DAY-OUT END-EVALUATE. 20-DATE-STRING. INSPECT CURRENT-DAY-X REPLACING LEADING ZERO BY SPACE STRING DAY-OUT DELIMITED BY SPACE ' ' DELIMITED BY SIZE MO-OUT DELIMITED BY SPACE ' ' DELIMITED BY SIZE CURRENT-DAY-X DELIMITED BY SIZE ', ' DELIMITED BY SIZE CURRENT-YEAR DELIMITED BY SPACE INTO LINK-DATE.