TITLE ' - Day-Of-Week Utility'
IDENTIFICATION DIVISION.
PROGRAM-ID. DMUDOW.
AUTHOR. DAN MERKLING.
DATE-WRITTEN. 03/13/2007.
DATE-COMPILED.
*----------------------------------------------------------------+
* Purpose: |
* This callable sub-routine determines the day-of-week for |
* a passed-in date. |
* |
* Parameters & usage: |
* A single 19-byte parameter block is used to call this |
* routine, configured as follows: |
* |
* 01 DAY-OF-WEEK-PARMS |
* 05 DW-DT |
* 05 DW-DY-OF-WK |
* 05 DW-DY-OF-WK-NM |
* 05 DW-RSLT |
* |
* The individual parameters are defined & used as follows: |
* |
* DW-DT - INTEGER - 8 |
* This is the input date for which the day-of-week will be |
* found. It must be all digits, with no spaces. If the |
* date is not provided, the system date will be retrieved |
* & used as the input. |
* |
* Format: YYYYMMDD |
* |
* DW-DY-OF-WK - INTEGER - 1 |
* This is the numeric value for the day of the week. The |
* first day of a week is Monday & the last day of a week |
* is Sunday. Therefore, the value returned in this field |
* is 1 for Monday thru 7 for Sunday. |
* |
* Format: 9 |
* |
* DW-DY-OF-WK-NM - STRING - 9 |
* This is the alpha name of the day of the week as |
* determined by this routine. |
* |
* Format: Xxxxxxxxx |
* |
* DW-RSLT - STRING - 1 |
* This is the result code (or return code) returned by the |
* routine. It should be checked after every call to this |
* program. |
* |
* Values: - = Initialized; no processing yet performed |
* Blank = No errors or warnings; all processing |
* performed correctly |
* D = Invalid date value |
* Z = Serious unexpected error |
*----------------------------------------------------------------+
* M O D I F I C A T I O N H I S T O R Y |
*----------------------------------------------------------------+
* Programmer Date Change # Description / Remarks |
* ------------ -------- -------- ------------------------------- |
*----------------------------------------------------------------+
EJECT
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
EJECT
*----------------------------------------------------------------+
* Working Storage |
*----------------------------------------------------------------+
WORKING-STORAGE SECTION.
77 PGM-ID PIC X(08) VALUE 'DMUDOW'.
77 PGM-VER PIC X(05) VALUE '01.02'.
77 FILLER PIC X(23) VALUE
' WORKING STORAGE BEGINS'.
01 WORKING-VARIABLES.
05 WS-CUR-DT.
10 WS-CUR-YYYYMMDD.
15 WS-CUR-YYYY PIC 9(04).
15 WS-CUR-MM PIC 9(02).
15 WS-CUR-DD PIC 9(02).
10 FILLER PIC 9(08).
10 FILLER PIC X(05).
05 WS-LILIAN PIC 9(09) BINARY.
05 WS-FEEDBACK-CODE.
10 WS-FC-SEV PIC 9(04) BINARY.
10 WS-FC-MSG PIC 9(04) BINARY.
10 FILLER PIC X(08).
05 WS-DOW PIC 9(09) BINARY.
01 CHR-DT.
05 CD-LEN PIC 9(04) BINARY.
05 CD-TXT.
10 CD-CHAR PIC X(01) OCCURS 0 TO 256
DEPENDING ON CD-LEN.
01 PIC-STR.
05 PS-LEN PIC 9(04) BINARY.
05 PS-TXT.
10 PS-CHAR PIC X(01) OCCURS 0 TO 256
DEPENDING ON PS-LEN.
01 DAY-TABLE.
05 DAY-TABLE-DATA.
10 FILLER PIC X(09) VALUE 'Monday'.
10 FILLER PIC X(09) VALUE 'Tuesday'.
10 FILLER PIC X(09) VALUE 'Wednesday'.
10 FILLER PIC X(09) VALUE 'Thursday'.
10 FILLER PIC X(09) VALUE 'Friday'.
10 FILLER PIC X(09) VALUE 'Saturday'.
10 FILLER PIC X(09) VALUE 'Sunday'.
05 DAY-TABLE-ARRAY REDEFINES DAY-TABLE-DATA.
10 DAY-ENTRY OCCURS 7.
15 DAY-NAME PIC X(09).
EJECT
*----------------------------------------------------------------+
* Literals & Constants |
*----------------------------------------------------------------+
01 LITERALS-AND-CONSTANTS.
05 CEEDAYS-PGM-ID PIC X(08) VALUE 'CEEDAYS'.
05 CEEDYWK-PGM-ID PIC X(08) VALUE 'CEEDYWK'.
EJECT
*----------------------------------------------------------------+
* Linkage Section |
*----------------------------------------------------------------+
LINKAGE SECTION.
*01 DAY-OF-WEEK-PARMS
COPY DMUDOW.
EJECT
*----------------------------------------------------------------+
* 0000-MAIN-LOGIC |
* |
* Main routine logic. |
*----------------------------------------------------------------+
PROCEDURE DIVISION,
USING DAY-OF-WEEK-PARMS.
0000-MAIN-LOGIC.
MOVE ZERO TO DW-DY-OF-WK.
MOVE SPACES TO DW-DY-OF-WK-NM.
SET DW-INCOMPLETE TO TRUE.
IF DW-DT-X <= SPACES THEN
MOVE FUNCTION CURRENT-DATE TO WS-CUR-DT
MOVE WS-CUR-YYYYMMDD TO DW-DT
END-IF.
IF DW-DT NOT NUMERIC THEN
SET DW-UNEXPECTED-ERR TO TRUE
GO TO 0000-EXIT
END-IF.
MOVE 8 TO CD-LEN,
PS-LEN.
MOVE DW-DT TO CD-TXT.
MOVE 'YYYYMMDD' TO PS-TXT.
CALL CEEDAYS-PGM-ID,
USING CHR-DT,
PIC-STR,
WS-LILIAN,
WS-FEEDBACK-CODE.
IF WS-FC-SEV = 3 THEN
SET DW-INVALID-DATA-VALUE TO TRUE
GO TO 0000-EXIT
END-IF.
SET DW-OK TO TRUE.
CALL CEEDYWK-PGM-ID,
USING WS-LILIAN,
WS-DOW,
WS-FEEDBACK-CODE.
SUBTRACT 1 FROM WS-DOW.
IF WS-DOW = 0 THEN
MOVE 7 TO DW-DY-OF-WK
ELSE
MOVE WS-DOW TO DW-DY-OF-WK
END-IF.
MOVE DAY-NAME(DW-DY-OF-WK) TO DW-DY-OF-WK-NM.
0000-EXIT.
GOBACK.
END PROGRAM DMUDOW.
|
