| 1 | ****************************************************************** |
| 2 | ***** CALL TO CEEDAYS ******* |
| 3 | ****************************************************************** |
| 4 | * Copyright Amazon.com, Inc. or its affiliates. |
| 5 | * All Rights Reserved. |
| 6 | * |
| 7 | * Licensed under the Apache License, Version 2.0 (the "License"). |
| 8 | * You may not use this file except in compliance with the License. |
| 9 | * You may obtain a copy of the License at |
| 10 | * |
| 11 | * http://www.apache.org/licenses/LICENSE-2.0 |
| 12 | * |
| 13 | * Unless required by applicable law or agreed to in writing, |
| 14 | * software distributed under the License is distributed on an |
| 15 | * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, |
| 16 | * either express or implied. See the License for the specific |
| 17 | * language governing permissions and limitations under the License |
| 18 | ****************************************************************** |
| 19 | IDENTIFICATION DIVISION. |
| 20 | PROGRAM-ID. CSUTLDTC. |
| 21 | DATA DIVISION. |
| 22 | WORKING-STORAGE SECTION. |
| 23 | |
| 24 | **** Date passed to CEEDAYS API |
| 25 | 01 WS-DATE-TO-TEST. |
| 26 | 02 Vstring-length PIC S9(4) BINARY. |
| 27 | 02 Vstring-text. |
| 28 | 03 Vstring-char PIC X |
| 29 | OCCURS 0 TO 256 TIMES |
| 30 | DEPENDING ON Vstring-length |
| 31 | of WS-DATE-TO-TEST. |
| 32 | **** DATE FORMAT PASSED TO CEEDAYS API |
| 33 | 01 WS-DATE-FORMAT. |
| 34 | 02 Vstring-length PIC S9(4) BINARY. |
| 35 | 02 Vstring-text. |
| 36 | 03 Vstring-char PIC X |
| 37 | OCCURS 0 TO 256 TIMES |
| 38 | DEPENDING ON Vstring-length |
| 39 | of WS-DATE-FORMAT. |
| 40 | **** OUTPUT from CEEDAYS - LILLIAN DATE FORMAT |
| 41 | 01 OUTPUT-LILLIAN PIC S9(9) USAGE IS BINARY. |
| 42 | 01 WS-MESSAGE. |
| 43 | 02 WS-SEVERITY PIC X(04). |
| 44 | 02 WS-SEVERITY-N REDEFINES WS-SEVERITY PIC 9(4). |
| 45 | 02 FILLER PIC X(11) VALUE 'Mesg Code:'. |
| 46 | 02 WS-MSG-NO PIC X(04). |
| 47 | 02 WS-MSG-NO-N REDEFINES WS-MSG-NO PIC 9(4). |
| 48 | 02 FILLER PIC X(01) VALUE SPACE. |
| 49 | 02 WS-RESULT PIC X(15). |
| 50 | 02 FILLER PIC X(01) VALUE SPACE. |
| 51 | 02 FILLER PIC X(09) VALUE 'TstDate:'. |
| 52 | 02 WS-DATE PIC X(10) VALUE SPACES. |
| 53 | 02 FILLER PIC X(01) VALUE SPACE. |
| 54 | 02 FILLER PIC X(10) VALUE 'Mask used:'. |
| 55 | 02 WS-DATE-FMT PIC X(10). |
| 56 | 02 FILLER PIC X(01) VALUE SPACE. |
| 57 | 02 FILLER PIC X(03) VALUE SPACES. |
| 58 | |
| 59 | * CEEDAYS API FEEDBACK CODE |
| 60 | 01 FEEDBACK-CODE. |
| 61 | 02 FEEDBACK-TOKEN-VALUE. |
| 62 | 88 FC-INVALID-DATE VALUE X'0000000000000000'. |
| 63 | 88 FC-INSUFFICIENT-DATA VALUE X'000309CB59C3C5C5'. |
| 64 | 88 FC-BAD-DATE-VALUE VALUE X'000309CC59C3C5C5'. |
| 65 | 88 FC-INVALID-ERA VALUE X'000309CD59C3C5C5'. |
| 66 | 88 FC-UNSUPP-RANGE VALUE X'000309D159C3C5C5'. |
| 67 | 88 FC-INVALID-MONTH VALUE X'000309D559C3C5C5'. |
| 68 | 88 FC-BAD-PIC-STRING VALUE X'000309D659C3C5C5'. |
| 69 | 88 FC-NON-NUMERIC-DATA VALUE X'000309D859C3C5C5'. |
| 70 | 88 FC-YEAR-IN-ERA-ZERO VALUE X'000309D959C3C5C5'. |
| 71 | 03 CASE-1-CONDITION-ID. |
| 72 | 04 SEVERITY PIC S9(4) BINARY. |
| 73 | 04 MSG-NO PIC S9(4) BINARY. |
| 74 | 03 CASE-2-CONDITION-ID |
| 75 | REDEFINES CASE-1-CONDITION-ID. |
| 76 | 04 CLASS-CODE PIC S9(4) BINARY. |
| 77 | 04 CAUSE-CODE PIC S9(4) BINARY. |
| 78 | 03 CASE-SEV-CTL PIC X. |
| 79 | 03 FACILITY-ID PIC XXX. |
| 80 | 02 I-S-INFO PIC S9(9) BINARY. |
| 81 | |
| 82 | |
| 83 | LINKAGE SECTION. |
| 84 | 01 LS-DATE PIC X(10). |
| 85 | 01 LS-DATE-FORMAT PIC X(10). |
| 86 | 01 LS-RESULT PIC X(80). |
| 87 | |
| 88 | PROCEDURE DIVISION USING LS-DATE, LS-DATE-FORMAT, LS-RESULT. |
| 89 | |
| 90 | INITIALIZE WS-MESSAGE |
| 91 | MOVE SPACES TO WS-DATE |
| 92 | |
| 93 | PERFORM A000-MAIN |
| 94 | THRU A000-MAIN-EXIT |
| 95 | |
| 96 | * DISPLAY WS-MESSAGE |
| 97 | MOVE WS-MESSAGE TO LS-RESULT |
| 98 | MOVE WS-SEVERITY-N TO RETURN-CODE |
| 99 | |
| 100 | EXIT PROGRAM |
| 101 | * GOBACK |
| 102 | . |
| 103 | A000-MAIN. |
| 104 | |
| 105 | MOVE LENGTH OF LS-DATE |
| 106 | TO VSTRING-LENGTH OF WS-DATE-TO-TEST |
| 107 | MOVE LS-DATE TO VSTRING-TEXT OF WS-DATE-TO-TEST |
| 108 | WS-DATE |
| 109 | MOVE LENGTH OF LS-DATE-FORMAT |
| 110 | TO VSTRING-LENGTH OF WS-DATE-FORMAT |
| 111 | MOVE LS-DATE-FORMAT |
| 112 | TO VSTRING-TEXT OF WS-DATE-FORMAT |
| 113 | WS-DATE-FMT |
| 114 | MOVE 0 TO OUTPUT-LILLIAN |
| 115 | |
| 116 | CALL "CEEDAYS" USING |
| 117 | WS-DATE-TO-TEST, |
| 118 | WS-DATE-FORMAT, |
| 119 | OUTPUT-LILLIAN, |
| 120 | FEEDBACK-CODE |
| 121 | |
| 122 | MOVE WS-DATE-TO-TEST TO WS-DATE |
| 123 | MOVE SEVERITY OF FEEDBACK-CODE TO WS-SEVERITY-N |
| 124 | MOVE MSG-NO OF FEEDBACK-CODE TO WS-MSG-NO-N |
| 125 | |
| 126 | * WS-RESULT IS 15 CHARACTERS |
| 127 | * 123456789012345' |
| 128 | EVALUATE TRUE |
| 129 | WHEN FC-INVALID-DATE |
| 130 | MOVE 'Date is valid' TO WS-RESULT |
| 131 | WHEN FC-INSUFFICIENT-DATA |
| 132 | MOVE 'Insufficient' TO WS-RESULT |
| 133 | WHEN FC-BAD-DATE-VALUE |
| 134 | MOVE 'Datevalue error' TO WS-RESULT |
| 135 | WHEN FC-INVALID-ERA |
| 136 | MOVE 'Invalid Era ' TO WS-RESULT |
| 137 | WHEN FC-UNSUPP-RANGE |
| 138 | MOVE 'Unsupp. Range ' TO WS-RESULT |
| 139 | WHEN FC-INVALID-MONTH |
| 140 | MOVE 'Invalid month ' TO WS-RESULT |
| 141 | WHEN FC-BAD-PIC-STRING |
| 142 | MOVE 'Bad Pic String ' TO WS-RESULT |
| 143 | WHEN FC-NON-NUMERIC-DATA |
| 144 | MOVE 'Nonnumeric data' TO WS-RESULT |
| 145 | WHEN FC-YEAR-IN-ERA-ZERO |
| 146 | MOVE 'YearInEra is 0 ' TO WS-RESULT |
| 147 | WHEN OTHER |
| 148 | MOVE 'Date is invalid' TO WS-RESULT |
| 149 | END-EVALUATE |
| 150 | |
| 151 | . |
| 152 | A000-MAIN-EXIT. |
| 153 | EXIT |
| 154 | . |
| 155 | * |
| 156 | * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:35 CDT |
| 157 | * |