From 40d1fc2ed21fe641e629ecec48b3423112577957 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Wed, 17 Sep 2025 20:19:16 +0000 Subject: [PATCH 1/3] Initial plan From c1fe5f87e99aeb42e290b883b2fe11ad82987eef Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Wed, 17 Sep 2025 20:27:08 +0000 Subject: [PATCH 2/3] Implement calendar subroutine with day-of-week and holiday detection Co-authored-by: raykao <860691+raykao@users.noreply.github.com> --- AS400/QCBLLESRC/CALAPPS.CBLLE | 217 +++++++++++++++++++++++ AS400/QCBLLESRC/CALENDAR.CBLLE | 209 ++++++++++++++++++++++ AS400/QCBLLESRC/EXAMPLE.CBLLE | 70 ++++++++ AS400/QCBLLESRC/TESTCAL.CBLLE | 276 +++++++++++++++++++++++++++++ docs/CALENDAR-SUBROUTINE-README.md | 189 ++++++++++++++++++++ 5 files changed, 961 insertions(+) create mode 100644 AS400/QCBLLESRC/CALAPPS.CBLLE create mode 100644 AS400/QCBLLESRC/CALENDAR.CBLLE create mode 100644 AS400/QCBLLESRC/EXAMPLE.CBLLE create mode 100644 AS400/QCBLLESRC/TESTCAL.CBLLE create mode 100644 docs/CALENDAR-SUBROUTINE-README.md diff --git a/AS400/QCBLLESRC/CALAPPS.CBLLE b/AS400/QCBLLESRC/CALAPPS.CBLLE new file mode 100644 index 0000000..865013a --- /dev/null +++ b/AS400/QCBLLESRC/CALAPPS.CBLLE @@ -0,0 +1,217 @@ + ****************************************************************** + * Author: Copilot AI Assistant + * Date: 2025-01-21 + * Purpose: Interactive Calendar Application + * Description: Standalone application using the CALENDAR + * subroutine to provide day of week and holiday + * information for any date + ****************************************************************** + IDENTIFICATION DIVISION. + PROGRAM-ID. CALAPPS. + + DATA DIVISION. + WORKING-STORAGE SECTION. + * Input variables + 01 WS-INPUT-DATE. + 05 WS-INPUT-YEAR PIC 9(4) VALUE ZEROS. + 05 WS-INPUT-MONTH PIC 99 VALUE ZEROS. + 05 WS-INPUT-DAY PIC 99 VALUE ZEROS. + + * Current date variables + 01 WS-CURRENT-DATE. + 05 WS-CURR-YEAR PIC 9(4). + 05 WS-CURR-MONTH PIC 99. + 05 WS-CURR-DAY PIC 99. + + 01 WS-SYSTEM-DATE PIC 9(8). + + * Calendar subroutine output + 01 WS-CALENDAR-OUTPUT. + 05 WS-OUT-DAY-NAME PIC X(9). + 05 WS-OUT-HOLIDAY PIC X(20). + 05 WS-OUT-IS-HOLIDAY PIC X(1). + 05 WS-OUT-ERROR-FLAG PIC X(1). + 05 WS-OUT-ERROR-MSG PIC X(50). + + * Control variables + 01 WS-CONTINUE-FLAG PIC X(1) VALUE 'Y'. + 01 WS-MENU-CHOICE PIC X(1) VALUE SPACES. + 01 WS-USER-INPUT PIC X(10) VALUE SPACES. + + * Display formatting + 01 WS-DISPLAY-LINE PIC X(80) VALUE SPACES. + 01 WS-FORMATTED-DATE PIC X(20) VALUE SPACES. + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + PERFORM DISPLAY-WELCOME + PERFORM MAIN-MENU-LOOP + PERFORM DISPLAY-GOODBYE + STOP RUN. + + DISPLAY-WELCOME. + DISPLAY "================================================" + DISPLAY " CALENDAR APPLICATION" + DISPLAY " Day of Week and Holiday Calculator" + DISPLAY "================================================" + DISPLAY " " + DISPLAY "This application can:" + DISPLAY "1. Calculate day of week for any date" + DISPLAY "2. Check if a date is a holiday" + DISPLAY "3. Show current date information" + DISPLAY " ". + + MAIN-MENU-LOOP. + PERFORM UNTIL WS-CONTINUE-FLAG = 'N' + PERFORM DISPLAY-MENU + PERFORM GET-MENU-CHOICE + PERFORM PROCESS-MENU-CHOICE + END-PERFORM. + + DISPLAY-MENU. + DISPLAY " " + DISPLAY "================================================" + DISPLAY " MAIN MENU" + DISPLAY "================================================" + DISPLAY "1. Check specific date" + DISPLAY "2. Check current date" + DISPLAY "3. Check Canada Day for a year" + DISPLAY "4. List upcoming holidays" + DISPLAY "Q. Quit" + DISPLAY " " + DISPLAY "Enter your choice: ". + + GET-MENU-CHOICE. + ACCEPT WS-MENU-CHOICE. + + PROCESS-MENU-CHOICE. + EVALUATE WS-MENU-CHOICE + WHEN '1' + PERFORM CHECK-SPECIFIC-DATE + WHEN '2' + PERFORM CHECK-CURRENT-DATE + WHEN '3' + PERFORM CHECK-CANADA-DAY-YEAR + WHEN '4' + PERFORM LIST-HOLIDAYS + WHEN 'Q' OR 'q' + MOVE 'N' TO WS-CONTINUE-FLAG + WHEN OTHER + DISPLAY "Invalid choice. Please try again." + END-EVALUATE. + + CHECK-SPECIFIC-DATE. + DISPLAY " " + DISPLAY "Enter date to check:" + + DISPLAY "Year (1600-3000): " + ACCEPT WS-INPUT-YEAR + + DISPLAY "Month (1-12): " + ACCEPT WS-INPUT-MONTH + + DISPLAY "Day (1-31): " + ACCEPT WS-INPUT-DAY + + CALL "CALENDAR" USING WS-INPUT-DATE, WS-CALENDAR-OUTPUT + + PERFORM DISPLAY-DATE-RESULTS. + + CHECK-CURRENT-DATE. + ACCEPT WS-SYSTEM-DATE FROM DATE YYYYMMDD + + DIVIDE WS-SYSTEM-DATE BY 10000 GIVING WS-INPUT-YEAR + COMPUTE WS-INPUT-MONTH = + FUNCTION MOD(WS-SYSTEM-DATE, 10000) / 100 + COMPUTE WS-INPUT-DAY = FUNCTION MOD(WS-SYSTEM-DATE, 100) + + CALL "CALENDAR" USING WS-INPUT-DATE, WS-CALENDAR-OUTPUT + + DISPLAY " " + DISPLAY "Current Date Information:" + PERFORM DISPLAY-DATE-RESULTS. + + CHECK-CANADA-DAY-YEAR. + DISPLAY " " + DISPLAY "Enter year to check Canada Day: " + ACCEPT WS-INPUT-YEAR + + MOVE 07 TO WS-INPUT-MONTH + MOVE 01 TO WS-INPUT-DAY + + CALL "CALENDAR" USING WS-INPUT-DATE, WS-CALENDAR-OUTPUT + + DISPLAY " " + IF WS-OUT-ERROR-FLAG = 'N' THEN + DISPLAY "Canada Day " WS-INPUT-YEAR " falls on a " + WS-OUT-DAY-NAME + IF WS-OUT-DAY-NAME = "Saturday " OR + WS-OUT-DAY-NAME = "Sunday " THEN + DISPLAY "Great! Canada Day is on a weekend!" + ELSE + DISPLAY "Canada Day is on a weekday - " + "long weekend opportunity!" + END-IF + ELSE + DISPLAY "Error: " WS-OUT-ERROR-MSG + END-IF. + + LIST-HOLIDAYS. + DISPLAY " " + DISPLAY "================================================" + DISPLAY " SUPPORTED HOLIDAYS" + DISPLAY "================================================" + + * Show New Year's Day for current year + ACCEPT WS-SYSTEM-DATE FROM DATE YYYYMMDD + DIVIDE WS-SYSTEM-DATE BY 10000 GIVING WS-INPUT-YEAR + + MOVE 01 TO WS-INPUT-MONTH + MOVE 01 TO WS-INPUT-DAY + CALL "CALENDAR" USING WS-INPUT-DATE, WS-CALENDAR-OUTPUT + + DISPLAY "New Year's Day " WS-INPUT-YEAR ": " WS-OUT-DAY-NAME + + * Show Canada Day for current year + MOVE 07 TO WS-INPUT-MONTH + MOVE 01 TO WS-INPUT-DAY + CALL "CALENDAR" USING WS-INPUT-DATE, WS-CALENDAR-OUTPUT + + DISPLAY "Canada Day " WS-INPUT-YEAR ": " WS-OUT-DAY-NAME + + * Show Christmas for current year + MOVE 12 TO WS-INPUT-MONTH + MOVE 25 TO WS-INPUT-DAY + CALL "CALENDAR" USING WS-INPUT-DATE, WS-CALENDAR-OUTPUT + + DISPLAY "Christmas Day " WS-INPUT-YEAR ": " WS-OUT-DAY-NAME + DISPLAY " " + DISPLAY "Note: More holidays can be added to the system". + + DISPLAY-DATE-RESULTS. + IF WS-OUT-ERROR-FLAG = 'Y' THEN + DISPLAY "Error: " WS-OUT-ERROR-MSG + ELSE + DISPLAY " " + DISPLAY "================================================" + STRING WS-INPUT-MONTH "/" WS-INPUT-DAY "/" WS-INPUT-YEAR + DELIMITED BY SIZE INTO WS-FORMATTED-DATE + END-STRING + DISPLAY "Date: " WS-FORMATTED-DATE + DISPLAY "Day of Week: " WS-OUT-DAY-NAME + + IF WS-OUT-IS-HOLIDAY = 'Y' THEN + DISPLAY "Holiday: " WS-OUT-HOLIDAY + DISPLAY "*** This is a recognized holiday! ***" + ELSE + DISPLAY "Not a recognized holiday" + END-IF + + DISPLAY "================================================" + END-IF. + + DISPLAY-GOODBYE. + DISPLAY " " + DISPLAY "================================================" + DISPLAY " Thank you for using Calendar App!" + DISPLAY "================================================". \ No newline at end of file diff --git a/AS400/QCBLLESRC/CALENDAR.CBLLE b/AS400/QCBLLESRC/CALENDAR.CBLLE new file mode 100644 index 0000000..ccbd8d7 --- /dev/null +++ b/AS400/QCBLLESRC/CALENDAR.CBLLE @@ -0,0 +1,209 @@ + ****************************************************************** + * Author: Copilot AI Assistant + * Date: 2025-01-21 + * Purpose: Calendar Sub Function for COBOL + * Description: Determines current day of the week based on year + * and provides holiday identification + ****************************************************************** + IDENTIFICATION DIVISION. + PROGRAM-ID. CALENDAR. + + DATA DIVISION. + WORKING-STORAGE SECTION. + * Constants + 01 WS-MIN-YEAR PIC 9(4) VALUE 1600. + 01 WS-MAX-YEAR PIC 9(4) VALUE 3000. + 01 WS-CURRENT-YEAR PIC 9(4) VALUE ZEROS. + 01 WS-INPUT-YEAR PIC 9(4) VALUE ZEROS. + 01 WS-INPUT-MONTH PIC 99 VALUE ZEROS. + 01 WS-INPUT-DAY PIC 99 VALUE ZEROS. + + * Working variables for date calculations + 01 WS-DATE-WORK. + 05 WS-WORK-YEAR PIC 9(4). + 05 WS-WORK-MONTH PIC 99. + 05 WS-WORK-DAY PIC 99. + + 01 WS-DATE-INTEGER PIC 9(8) VALUE ZEROS. + 01 WS-DAY-OF-WEEK PIC 9 VALUE ZEROS. + + * Day names table + 01 WS-DAY-NAMES. + 05 FILLER PIC X(9) VALUE "Sunday ". + 05 FILLER PIC X(9) VALUE "Monday ". + 05 FILLER PIC X(9) VALUE "Tuesday ". + 05 FILLER PIC X(9) VALUE "Wednesday". + 05 FILLER PIC X(9) VALUE "Thursday ". + 05 FILLER PIC X(9) VALUE "Friday ". + 05 FILLER PIC X(9) VALUE "Saturday ". + 01 WS-DAY-TABLE REDEFINES WS-DAY-NAMES. + 05 WS-DAY-NAME PIC X(9) OCCURS 7 TIMES. + + * Holiday definitions + 01 WS-HOLIDAYS. + 05 WS-CANADA-DAY. + 10 WS-CD-MONTH PIC 99 VALUE 07. + 10 WS-CD-DAY PIC 99 VALUE 01. + 05 WS-NEW-YEAR. + 10 WS-NY-MONTH PIC 99 VALUE 01. + 10 WS-NY-DAY PIC 99 VALUE 01. + 05 WS-CHRISTMAS. + 10 WS-XM-MONTH PIC 99 VALUE 12. + 10 WS-XM-DAY PIC 99 VALUE 25. + + * Output variables + 01 WS-RESULT-DAY-NAME PIC X(9) VALUE SPACES. + 01 WS-HOLIDAY-NAME PIC X(20) VALUE SPACES. + 01 WS-IS-HOLIDAY PIC X(1) VALUE 'N'. + + * Error handling + 01 WS-ERROR-FLAG PIC X(1) VALUE 'N'. + 01 WS-ERROR-MESSAGE PIC X(50) VALUE SPACES. + + * Control flags + 01 WS-CONTINUE-FLAG PIC X(1) VALUE 'Y'. + 01 WS-FUNCTION-TYPE PIC X(1) VALUE SPACES. + * 'D' = Day of week calculation + * 'H' = Holiday check + * 'C' = Current date analysis + + LINKAGE SECTION. + * Parameters for external calling + 01 LS-INPUT-DATE. + 05 LS-YEAR PIC 9(4). + 05 LS-MONTH PIC 99. + 05 LS-DAY PIC 99. + 01 LS-OUTPUT-DATA. + 05 LS-DAY-NAME PIC X(9). + 05 LS-HOLIDAY-NAME PIC X(20). + 05 LS-IS-HOLIDAY PIC X(1). + 05 LS-ERROR-FLAG PIC X(1). + 05 LS-ERROR-MESSAGE PIC X(50). + + PROCEDURE DIVISION USING LS-INPUT-DATE, LS-OUTPUT-DATA. + MAIN-PROCEDURE. + PERFORM INITIALIZE-PROGRAM + PERFORM VALIDATE-INPUT-DATE + IF WS-ERROR-FLAG = 'N' THEN + PERFORM CALCULATE-DAY-OF-WEEK + PERFORM CHECK-HOLIDAY + PERFORM PREPARE-OUTPUT + END-IF + PERFORM CLEANUP-PROGRAM + GOBACK. + + INITIALIZE-PROGRAM. + * Initialize working storage variables + MOVE ZEROS TO WS-DATE-INTEGER + MOVE ZEROS TO WS-DAY-OF-WEEK + MOVE SPACES TO WS-RESULT-DAY-NAME + MOVE SPACES TO WS-HOLIDAY-NAME + MOVE 'N' TO WS-IS-HOLIDAY + MOVE 'N' TO WS-ERROR-FLAG + MOVE SPACES TO WS-ERROR-MESSAGE + + * Get input from linkage section + MOVE LS-YEAR TO WS-INPUT-YEAR + MOVE LS-MONTH TO WS-INPUT-MONTH + MOVE LS-DAY TO WS-INPUT-DAY. + + VALIDATE-INPUT-DATE. + * Validate year range + IF WS-INPUT-YEAR < WS-MIN-YEAR OR + WS-INPUT-YEAR > WS-MAX-YEAR THEN + MOVE 'Y' TO WS-ERROR-FLAG + STRING "Year must be between " WS-MIN-YEAR + " and " WS-MAX-YEAR DELIMITED BY SIZE + INTO WS-ERROR-MESSAGE + END-STRING + EXIT PARAGRAPH + END-IF + + * Validate month + IF WS-INPUT-MONTH < 1 OR WS-INPUT-MONTH > 12 THEN + MOVE 'Y' TO WS-ERROR-FLAG + MOVE "Month must be between 1 and 12" TO WS-ERROR-MESSAGE + EXIT PARAGRAPH + END-IF + + * Validate day (basic validation) + IF WS-INPUT-DAY < 1 OR WS-INPUT-DAY > 31 THEN + MOVE 'Y' TO WS-ERROR-FLAG + MOVE "Day must be between 1 and 31" TO WS-ERROR-MESSAGE + EXIT PARAGRAPH + END-IF + + * Additional day validation for specific months + EVALUATE WS-INPUT-MONTH + WHEN 2 + IF WS-INPUT-DAY > 29 THEN + MOVE 'Y' TO WS-ERROR-FLAG + MOVE "February cannot have more than 29 days" + TO WS-ERROR-MESSAGE + END-IF + WHEN 4 OR 6 OR 9 OR 11 + IF WS-INPUT-DAY > 30 THEN + MOVE 'Y' TO WS-ERROR-FLAG + MOVE "This month cannot have more than 30 days" + TO WS-ERROR-MESSAGE + END-IF + END-EVALUATE. + + CALCULATE-DAY-OF-WEEK. + * Build date for calculation in YYYYMMDD format + COMPUTE WS-DATE-INTEGER = WS-INPUT-YEAR * 10000 + + WS-INPUT-MONTH * 100 + WS-INPUT-DAY + + * Use COBOL intrinsic function to get integer date + COMPUTE WS-DATE-INTEGER = + FUNCTION INTEGER-OF-DATE(WS-DATE-INTEGER) + + * Calculate day of week (0=Sunday, 1=Monday, etc.) + COMPUTE WS-DAY-OF-WEEK = + FUNCTION MOD(WS-DATE-INTEGER, 7) + + * Adjust for table index (1-based) + ADD 1 TO WS-DAY-OF-WEEK + + * Get day name from table + MOVE WS-DAY-NAME(WS-DAY-OF-WEEK) TO WS-RESULT-DAY-NAME. + + CHECK-HOLIDAY. + * Check if the date matches any known holidays + MOVE 'N' TO WS-IS-HOLIDAY + MOVE SPACES TO WS-HOLIDAY-NAME + + * Check Canada Day + IF WS-INPUT-MONTH = WS-CD-MONTH AND + WS-INPUT-DAY = WS-CD-DAY THEN + MOVE 'Y' TO WS-IS-HOLIDAY + MOVE "Canada Day" TO WS-HOLIDAY-NAME + EXIT PARAGRAPH + END-IF + + * Check New Year's Day + IF WS-INPUT-MONTH = WS-NY-MONTH AND + WS-INPUT-DAY = WS-NY-DAY THEN + MOVE 'Y' TO WS-IS-HOLIDAY + MOVE "New Year's Day" TO WS-HOLIDAY-NAME + EXIT PARAGRAPH + END-IF + + * Check Christmas Day + IF WS-INPUT-MONTH = WS-XM-MONTH AND + WS-INPUT-DAY = WS-XM-DAY THEN + MOVE 'Y' TO WS-IS-HOLIDAY + MOVE "Christmas Day" TO WS-HOLIDAY-NAME + END-IF. + + PREPARE-OUTPUT. + * Move results to linkage section + MOVE WS-RESULT-DAY-NAME TO LS-DAY-NAME + MOVE WS-HOLIDAY-NAME TO LS-HOLIDAY-NAME + MOVE WS-IS-HOLIDAY TO LS-IS-HOLIDAY + MOVE WS-ERROR-FLAG TO LS-ERROR-FLAG + MOVE WS-ERROR-MESSAGE TO LS-ERROR-MESSAGE. + + CLEANUP-PROGRAM. + * Cleanup and exit + CONTINUE. \ No newline at end of file diff --git a/AS400/QCBLLESRC/EXAMPLE.CBLLE b/AS400/QCBLLESRC/EXAMPLE.CBLLE new file mode 100644 index 0000000..df6a56c --- /dev/null +++ b/AS400/QCBLLESRC/EXAMPLE.CBLLE @@ -0,0 +1,70 @@ + ****************************************************************** + * Author: Copilot AI Assistant + * Date: 2025-01-21 + * Purpose: Simple Example using Calendar Subroutine + * Description: Demonstrates basic usage of the CALENDAR function + ****************************************************************** + IDENTIFICATION DIVISION. + PROGRAM-ID. EXAMPLE. + + DATA DIVISION. + WORKING-STORAGE SECTION. + * Input date structure + 01 WS-DATE-INPUT. + 05 WS-YEAR PIC 9(4) VALUE 2025. + 05 WS-MONTH PIC 99 VALUE 07. + 05 WS-DAY PIC 99 VALUE 01. + + * Output from calendar subroutine + 01 WS-CALENDAR-RESULT. + 05 WS-DAY-NAME PIC X(9). + 05 WS-HOLIDAY-NAME PIC X(20). + 05 WS-IS-HOLIDAY PIC X(1). + 05 WS-ERROR-FLAG PIC X(1). + 05 WS-ERROR-MESSAGE PIC X(50). + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + DISPLAY "Calendar Subroutine Example" + DISPLAY "==========================" + DISPLAY " " + + * Test Canada Day 2025 + DISPLAY "Checking Canada Day 2025..." + CALL "CALENDAR" USING WS-DATE-INPUT, WS-CALENDAR-RESULT + + IF WS-ERROR-FLAG = 'N' THEN + DISPLAY "Date: July 1, 2025" + DISPLAY "Day of Week: " WS-DAY-NAME + IF WS-IS-HOLIDAY = 'Y' THEN + DISPLAY "Holiday: " WS-HOLIDAY-NAME + ELSE + DISPLAY "Not a holiday" + END-IF + ELSE + DISPLAY "Error: " WS-ERROR-MESSAGE + END-IF + + DISPLAY " " + + * Test a regular day + MOVE 15 TO WS-DAY + DISPLAY "Checking July 15, 2025..." + CALL "CALENDAR" USING WS-DATE-INPUT, WS-CALENDAR-RESULT + + IF WS-ERROR-FLAG = 'N' THEN + DISPLAY "Date: July 15, 2025" + DISPLAY "Day of Week: " WS-DAY-NAME + IF WS-IS-HOLIDAY = 'Y' THEN + DISPLAY "Holiday: " WS-HOLIDAY-NAME + ELSE + DISPLAY "Not a holiday" + END-IF + ELSE + DISPLAY "Error: " WS-ERROR-MESSAGE + END-IF + + DISPLAY " " + DISPLAY "Example completed." + + STOP RUN. \ No newline at end of file diff --git a/AS400/QCBLLESRC/TESTCAL.CBLLE b/AS400/QCBLLESRC/TESTCAL.CBLLE new file mode 100644 index 0000000..0e31bb0 --- /dev/null +++ b/AS400/QCBLLESRC/TESTCAL.CBLLE @@ -0,0 +1,276 @@ + ****************************************************************** + * Author: Copilot AI Assistant + * Date: 2025-01-21 + * Purpose: Test Program for Calendar Sub Function + * Description: Tests the CALENDAR subroutine with various dates + * and validates day of week and holiday detection + ****************************************************************** + IDENTIFICATION DIVISION. + PROGRAM-ID. TESTCAL. + + DATA DIVISION. + WORKING-STORAGE SECTION. + * Test control variables + 01 WS-TEST-COUNTER PIC 99 VALUE ZEROS. + 01 WS-PASSED-TESTS PIC 99 VALUE ZEROS. + 01 WS-FAILED-TESTS PIC 99 VALUE ZEROS. + 01 WS-CONTINUE-FLAG PIC X(1) VALUE 'Y'. + + * Test data structures + 01 WS-TEST-DATE. + 05 WS-TEST-YEAR PIC 9(4). + 05 WS-TEST-MONTH PIC 99. + 05 WS-TEST-DAY PIC 99. + + 01 WS-EXPECTED-RESULTS. + 05 WS-EXPECTED-DAY PIC X(9). + 05 WS-EXPECTED-HOLIDAY PIC X(20). + 05 WS-EXPECTED-IS-HOLIDAY PIC X(1). + + 01 WS-CALENDAR-OUTPUT. + 05 WS-OUT-DAY-NAME PIC X(9). + 05 WS-OUT-HOLIDAY PIC X(20). + 05 WS-OUT-IS-HOLIDAY PIC X(1). + 05 WS-OUT-ERROR-FLAG PIC X(1). + 05 WS-OUT-ERROR-MSG PIC X(50). + + * Display variables + 01 WS-DISPLAY-LINE PIC X(80) VALUE SPACES. + 01 WS-USER-INPUT PIC X(1) VALUE SPACES. + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + PERFORM DISPLAY-HEADER + PERFORM RUN-AUTOMATED-TESTS + PERFORM INTERACTIVE-TESTING + PERFORM DISPLAY-SUMMARY + STOP RUN. + + DISPLAY-HEADER. + DISPLAY "================================================" + DISPLAY " CALENDAR SUBROUTINE TEST PROGRAM" + DISPLAY " Testing Day of Week and Holiday Detection" + DISPLAY "================================================" + DISPLAY " ". + + RUN-AUTOMATED-TESTS. + DISPLAY "Running Automated Tests..." + DISPLAY " " + + * Test 1: Canada Day 2025 (known to be Tuesday) + PERFORM TEST-CANADA-DAY-2025 + + * Test 2: New Year's Day 2025 (known to be Wednesday) + PERFORM TEST-NEW-YEAR-2025 + + * Test 3: Christmas Day 2024 (known to be Wednesday) + PERFORM TEST-CHRISTMAS-2024 + + * Test 4: Regular day (July 15, 2025 - Tuesday) + PERFORM TEST-REGULAR-DAY + + * Test 5: Invalid year (too low) + PERFORM TEST-INVALID-YEAR-LOW + + * Test 6: Invalid month + PERFORM TEST-INVALID-MONTH + + DISPLAY " " + DISPLAY "Automated tests completed." + DISPLAY " ". + + TEST-CANADA-DAY-2025. + ADD 1 TO WS-TEST-COUNTER + MOVE 2025 TO WS-TEST-YEAR + MOVE 07 TO WS-TEST-MONTH + MOVE 01 TO WS-TEST-DAY + + MOVE "Tuesday " TO WS-EXPECTED-DAY + MOVE "Canada Day" TO WS-EXPECTED-HOLIDAY + MOVE "Y" TO WS-EXPECTED-IS-HOLIDAY + + CALL "CALENDAR" USING WS-TEST-DATE, WS-CALENDAR-OUTPUT + + IF WS-OUT-ERROR-FLAG = 'N' AND + WS-OUT-DAY-NAME = WS-EXPECTED-DAY AND + WS-OUT-IS-HOLIDAY = WS-EXPECTED-IS-HOLIDAY THEN + ADD 1 TO WS-PASSED-TESTS + DISPLAY "TEST 1 PASSED: Canada Day 2025 = " + WS-OUT-DAY-NAME " (Holiday: " WS-OUT-HOLIDAY ")" + ELSE + ADD 1 TO WS-FAILED-TESTS + DISPLAY "TEST 1 FAILED: Expected " WS-EXPECTED-DAY + ", Got " WS-OUT-DAY-NAME + IF WS-OUT-ERROR-FLAG = 'Y' THEN + DISPLAY " Error: " WS-OUT-ERROR-MSG + END-IF + END-IF. + + TEST-NEW-YEAR-2025. + ADD 1 TO WS-TEST-COUNTER + MOVE 2025 TO WS-TEST-YEAR + MOVE 01 TO WS-TEST-MONTH + MOVE 01 TO WS-TEST-DAY + + MOVE "Wednesday" TO WS-EXPECTED-DAY + MOVE "New Year's Day" TO WS-EXPECTED-HOLIDAY + MOVE "Y" TO WS-EXPECTED-IS-HOLIDAY + + CALL "CALENDAR" USING WS-TEST-DATE, WS-CALENDAR-OUTPUT + + IF WS-OUT-ERROR-FLAG = 'N' AND + WS-OUT-IS-HOLIDAY = WS-EXPECTED-IS-HOLIDAY THEN + ADD 1 TO WS-PASSED-TESTS + DISPLAY "TEST 2 PASSED: New Year 2025 = " + WS-OUT-DAY-NAME " (Holiday: " WS-OUT-HOLIDAY ")" + ELSE + ADD 1 TO WS-FAILED-TESTS + DISPLAY "TEST 2 FAILED: Expected holiday, Got " + WS-OUT-IS-HOLIDAY + IF WS-OUT-ERROR-FLAG = 'Y' THEN + DISPLAY " Error: " WS-OUT-ERROR-MSG + END-IF + END-IF. + + TEST-CHRISTMAS-2024. + ADD 1 TO WS-TEST-COUNTER + MOVE 2024 TO WS-TEST-YEAR + MOVE 12 TO WS-TEST-MONTH + MOVE 25 TO WS-TEST-DAY + + MOVE "Christmas Day" TO WS-EXPECTED-HOLIDAY + MOVE "Y" TO WS-EXPECTED-IS-HOLIDAY + + CALL "CALENDAR" USING WS-TEST-DATE, WS-CALENDAR-OUTPUT + + IF WS-OUT-ERROR-FLAG = 'N' AND + WS-OUT-IS-HOLIDAY = WS-EXPECTED-IS-HOLIDAY THEN + ADD 1 TO WS-PASSED-TESTS + DISPLAY "TEST 3 PASSED: Christmas 2024 = " + WS-OUT-DAY-NAME " (Holiday: " WS-OUT-HOLIDAY ")" + ELSE + ADD 1 TO WS-FAILED-TESTS + DISPLAY "TEST 3 FAILED: Expected holiday, Got " + WS-OUT-IS-HOLIDAY + IF WS-OUT-ERROR-FLAG = 'Y' THEN + DISPLAY " Error: " WS-OUT-ERROR-MSG + END-IF + END-IF. + + TEST-REGULAR-DAY. + ADD 1 TO WS-TEST-COUNTER + MOVE 2025 TO WS-TEST-YEAR + MOVE 07 TO WS-TEST-MONTH + MOVE 15 TO WS-TEST-DAY + + MOVE "N" TO WS-EXPECTED-IS-HOLIDAY + + CALL "CALENDAR" USING WS-TEST-DATE, WS-CALENDAR-OUTPUT + + IF WS-OUT-ERROR-FLAG = 'N' AND + WS-OUT-IS-HOLIDAY = WS-EXPECTED-IS-HOLIDAY THEN + ADD 1 TO WS-PASSED-TESTS + DISPLAY "TEST 4 PASSED: Regular day July 15, 2025 = " + WS-OUT-DAY-NAME " (Not a holiday)" + ELSE + ADD 1 TO WS-FAILED-TESTS + DISPLAY "TEST 4 FAILED: Expected non-holiday, Got " + WS-OUT-IS-HOLIDAY + IF WS-OUT-ERROR-FLAG = 'Y' THEN + DISPLAY " Error: " WS-OUT-ERROR-MSG + END-IF + END-IF. + + TEST-INVALID-YEAR-LOW. + ADD 1 TO WS-TEST-COUNTER + MOVE 1500 TO WS-TEST-YEAR + MOVE 01 TO WS-TEST-MONTH + MOVE 01 TO WS-TEST-DAY + + CALL "CALENDAR" USING WS-TEST-DATE, WS-CALENDAR-OUTPUT + + IF WS-OUT-ERROR-FLAG = 'Y' THEN + ADD 1 TO WS-PASSED-TESTS + DISPLAY "TEST 5 PASSED: Invalid year 1500 correctly rejected" + ELSE + ADD 1 TO WS-FAILED-TESTS + DISPLAY "TEST 5 FAILED: Should have rejected year 1500" + END-IF. + + TEST-INVALID-MONTH. + ADD 1 TO WS-TEST-COUNTER + MOVE 2025 TO WS-TEST-YEAR + MOVE 13 TO WS-TEST-MONTH + MOVE 01 TO WS-TEST-DAY + + CALL "CALENDAR" USING WS-TEST-DATE, WS-CALENDAR-OUTPUT + + IF WS-OUT-ERROR-FLAG = 'Y' THEN + ADD 1 TO WS-PASSED-TESTS + DISPLAY "TEST 6 PASSED: Invalid month 13 correctly rejected" + ELSE + ADD 1 TO WS-FAILED-TESTS + DISPLAY "TEST 6 FAILED: Should have rejected month 13" + END-IF. + + INTERACTIVE-TESTING. + DISPLAY "Would you like to test specific dates? (Y/N): " + ACCEPT WS-USER-INPUT + + IF WS-USER-INPUT = 'Y' OR WS-USER-INPUT = 'y' THEN + PERFORM UNTIL WS-CONTINUE-FLAG = 'N' + PERFORM GET-USER-DATE + PERFORM CALL-CALENDAR-FUNCTION + PERFORM DISPLAY-RESULTS + DISPLAY " " + DISPLAY "Test another date? (Y/N): " + ACCEPT WS-USER-INPUT + IF WS-USER-INPUT = 'N' OR WS-USER-INPUT = 'n' THEN + MOVE 'N' TO WS-CONTINUE-FLAG + END-IF + END-PERFORM + END-IF. + + GET-USER-DATE. + DISPLAY "Enter year (1600-3000): " + ACCEPT WS-TEST-YEAR + + DISPLAY "Enter month (1-12): " + ACCEPT WS-TEST-MONTH + + DISPLAY "Enter day (1-31): " + ACCEPT WS-TEST-DAY. + + CALL-CALENDAR-FUNCTION. + CALL "CALENDAR" USING WS-TEST-DATE, WS-CALENDAR-OUTPUT. + + DISPLAY-RESULTS. + IF WS-OUT-ERROR-FLAG = 'Y' THEN + DISPLAY "Error: " WS-OUT-ERROR-MSG + ELSE + DISPLAY "Date: " WS-TEST-MONTH "/" WS-TEST-DAY + "/" WS-TEST-YEAR + DISPLAY "Day of Week: " WS-OUT-DAY-NAME + IF WS-OUT-IS-HOLIDAY = 'Y' THEN + DISPLAY "Holiday: " WS-OUT-HOLIDAY + ELSE + DISPLAY "Not a holiday" + END-IF + END-IF. + + DISPLAY-SUMMARY. + DISPLAY " " + DISPLAY "================================================" + DISPLAY " TEST SUMMARY" + DISPLAY "================================================" + DISPLAY "Total Tests Run: " WS-TEST-COUNTER + DISPLAY "Tests Passed: " WS-PASSED-TESTS + DISPLAY "Tests Failed: " WS-FAILED-TESTS + + IF WS-FAILED-TESTS = 0 THEN + DISPLAY "All tests PASSED!" + ELSE + DISPLAY "Some tests FAILED - review results above" + END-IF + + DISPLAY "================================================". \ No newline at end of file diff --git a/docs/CALENDAR-SUBROUTINE-README.md b/docs/CALENDAR-SUBROUTINE-README.md new file mode 100644 index 0000000..46b1c85 --- /dev/null +++ b/docs/CALENDAR-SUBROUTINE-README.md @@ -0,0 +1,189 @@ +# Calendar Subroutine for AS400 COBOL + +## Overview +The Calendar Subroutine is a comprehensive COBOL function designed to determine the day of the week for any given date and identify if that date corresponds to a recognized holiday. This subroutine provides essential calendar functionality for AS400 COBOL applications. + +## Programs Included + +### CALENDAR.CBLLE +**Main Calendar Subroutine** + +A callable subroutine that provides: +- Day of week calculation for any date (1600-3000) +- Holiday identification (Canada Day, New Year's Day, Christmas) +- Input validation and error handling +- Linkage section interface for external calling + +### CALAPPS.CBLLE +**Interactive Calendar Application** + +A standalone interactive program that uses the CALENDAR subroutine to provide: +- Menu-driven interface for date checking +- Current date analysis +- Canada Day calculator for specific years +- Holiday listing functionality + +### TESTCAL.CBLLE +**Test Program** + +Comprehensive test suite that validates: +- Automated testing of known date/day combinations +- Holiday detection accuracy +- Input validation and error handling +- Interactive testing capability + +## Technical Features + +### Date Calculation Algorithm +The subroutine uses COBOL intrinsic functions for accurate date calculations: +- `FUNCTION INTEGER-OF-DATE` - Converts YYYYMMDD format to integer days +- `FUNCTION MOD` - Calculates day of week using modulo 7 arithmetic + +### Supported Date Range +- **Minimum Year**: 1600 +- **Maximum Year**: 3000 +- **Full Calendar**: All months and valid days within range + +### Holiday Support +Currently recognizes these holidays: +- **Canada Day**: July 1st +- **New Year's Day**: January 1st +- **Christmas Day**: December 25th + +Additional holidays can be easily added to the holiday checking logic. + +## Usage Examples + +### Calling the Subroutine +```cobol +DATA DIVISION. +WORKING-STORAGE SECTION. +01 WS-INPUT-DATE. + 05 WS-YEAR PIC 9(4) VALUE 2025. + 05 WS-MONTH PIC 99 VALUE 07. + 05 WS-DAY PIC 99 VALUE 01. + +01 WS-OUTPUT-DATA. + 05 WS-DAY-NAME PIC X(9). + 05 WS-HOLIDAY-NAME PIC X(20). + 05 WS-IS-HOLIDAY PIC X(1). + 05 WS-ERROR-FLAG PIC X(1). + 05 WS-ERROR-MESSAGE PIC X(50). + +PROCEDURE DIVISION. + CALL "CALENDAR" USING WS-INPUT-DATE, WS-OUTPUT-DATA. + + IF WS-ERROR-FLAG = 'N' THEN + DISPLAY "Day: " WS-DAY-NAME + IF WS-IS-HOLIDAY = 'Y' THEN + DISPLAY "Holiday: " WS-HOLIDAY-NAME + END-IF + ELSE + DISPLAY "Error: " WS-ERROR-MESSAGE + END-IF. +``` + +### Sample Output +``` +================================================ + CALENDAR APPLICATION + Day of Week and Holiday Calculator +================================================ + +Date: 7/1/2025 +Day of Week: Tuesday +Holiday: Canada Day +*** This is a recognized holiday! *** +================================================ +``` + +## Input Parameters + +### LS-INPUT-DATE +- **LS-YEAR** (PIC 9(4)): Year to check (1600-3000) +- **LS-MONTH** (PIC 99): Month (1-12) +- **LS-DAY** (PIC 99): Day of month (1-31) + +## Output Parameters + +### LS-OUTPUT-DATA +- **LS-DAY-NAME** (PIC X(9)): Full day name (e.g., "Monday ", "Tuesday ") +- **LS-HOLIDAY-NAME** (PIC X(20)): Holiday name if applicable +- **LS-IS-HOLIDAY** (PIC X(1)): 'Y' if holiday, 'N' if not +- **LS-ERROR-FLAG** (PIC X(1)): 'Y' if error occurred, 'N' if successful +- **LS-ERROR-MESSAGE** (PIC X(50)): Error description if error occurred + +## Error Handling + +The subroutine validates: +- **Year Range**: Must be between 1600 and 3000 +- **Month Range**: Must be between 1 and 12 +- **Day Range**: Must be between 1 and 31, with additional validation for: + - February: Maximum 29 days + - April, June, September, November: Maximum 30 days + +## Compilation + +### AS400 Environment +``` +CRTCBLPGM PGM(MYLIB/CALENDAR) SRCFILE(MYLIB/QCBLLESRC) +CRTCBLPGM PGM(MYLIB/CALAPPS) SRCFILE(MYLIB/QCBLLESRC) +CRTCBLPGM PGM(MYLIB/TESTCAL) SRCFILE(MYLIB/QCBLLESRC) +``` + +### OpenCOBOL Environment +```bash +cobc -x CALENDAR.CBLLE +cobc -x CALAPPS.CBLLE +cobc -x TESTCAL.CBLLE +``` + +## Testing + +Run the test program to validate functionality: +``` +CALL TESTCAL +``` + +The test program will: +1. Run automated tests on known dates +2. Validate holiday detection +3. Test error handling for invalid inputs +4. Provide interactive testing interface + +Expected test results: +- Canada Day 2025: Tuesday (Holiday) +- New Year 2025: Wednesday (Holiday) +- Christmas 2024: Wednesday (Holiday) +- Regular dates: Correct day calculation +- Invalid inputs: Proper error messages + +## Integration + +This subroutine can be integrated into existing COBOL applications by: + +1. **Including the CALENDAR program** in your library +2. **Adding CALL statements** where date calculations are needed +3. **Handling the output parameters** appropriately in your application logic +4. **Extending holiday definitions** as needed for your specific requirements + +## Future Enhancements + +Potential improvements could include: +- **Additional Holidays**: Provincial holidays, international holidays +- **Leap Year Logic**: Enhanced February validation +- **Date Arithmetic**: Add/subtract days from dates +- **Week Number Calculation**: ISO week numbers +- **Business Day Logic**: Skip weekends and holidays +- **Localization**: Multiple language support for day names + +## Dependencies +- No external files or copybooks required +- Uses standard COBOL intrinsic functions +- Self-contained subroutine with comprehensive error handling + +--- +**Created**: January 21, 2025 +**Author**: Copilot AI Assistant +**Version**: 1.0 +**Compatible**: AS400 COBOL, OpenCOBOL \ No newline at end of file From c7fd8074005d4b893c211810782c67b4fd0b0265 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Wed, 17 Sep 2025 20:28:24 +0000 Subject: [PATCH 3/3] Update README to document new calendar subroutine functionality Co-authored-by: raykao <860691+raykao@users.noreply.github.com> --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index adf1521..972af3a 100755 --- a/README.md +++ b/README.md @@ -10,12 +10,14 @@ Project COBOL * Physical files * Logical files * Display files + * **Calendar Subroutine** - Day of week and holiday detection ### OpenCOBOL/GNUCobol * Hello Cobol * Conditions * Database * Date + * Calendar functions * Games * Loops * Memory