00001 IDENTIFICATION DIVISION. 09/29/98 00002 PROGRAM-ID. DTSCU001. DTSCU001 00003 AUTHOR. PROGRAM RESOURCES. LV010 00004 SKIP2 DTSCU001 00005 ***** DTSCU001 00006 * DTSCU001 00007 * NAME: DTSCU001 CL**2 00008 * DTSCU001 00009 * FUNCTION: DATE CONVERSION MODULE DTSCU001 00010 * DTSCU001 00011 * MODIFICATION LOG: DTSCU001 00012 * DTSCU001 00013 * 7/31/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU001. CL**2 00014 * WORK ORDER: PROGRAMMER: ZL1. CL**6 00015 * CL**9 00016 * 09/29/1998 ADDED L001-SLASH-8-DATE RELATED CODE. CL**9 00017 * REFERENCE: DC DEVELPMENT PROGRAMMER: EHH CL**9 00018 * DTSCU001 00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**9 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**9 00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**9 00022 * DTSCU001 00023 * DTSCU001 00024 * DESCRIPTION: DTSCU001 00025 * DTSCU001 00026 * THE FUNCTION OF DTSCU001 IS TO VALIDATE DATES CL**2 00027 * AND CONVERT AMONG VARIOUS DATE REPRESENTATIONS. DTSCU001 00028 * DTSCU001 00029 * DTSCU001 00030 * EVERY CALL RETURNS THE FOLLOWING. DTSCU001 00031 * DTSCU001 00032 * 1. CALENDAR 8 DATE - MMDDYYYY DTSCU001 00033 * 2. FEDERAL 8 DATE - YYYYMMDD DTSCU001 00034 * 3. CALENDAR 6 DATE - MMDDYY DTSCU001 00035 * 4. FEDERAL 6 DATE - YYMMDD DTSCU001 00036 * 5. JULIAN DATE - YYYYDDD DTSCU001 00037 * 6. DAY OF WEEK DTSCU001 00038 * 7. SLASHED CALENDAR DATE - MM/DD/YY CL**9 00039 * 8. JULIAN DAY NUMBER - DAYS SINCE 4500 BC DTSCU001 00040 * 9. NINES COMPLEMENT OF FEDERAL 8 DATE. DTSCU001 00041 * 10. SLASHED-CALENDAR DATE - MM/DD/YYYY CL**9 00042 * CL**9 00043 * IF THE CALENDAR OR FEDERAL DATE SUPPLIED IS DTSCU001 00044 * NOT VALID, THE DAY OF WEEK IS RETURNED AS ZERO. DTSCU001 00045 * DTSCU001 00046 * DTSCU001 00047 * ABEND CODES: DTSCU001 00048 * DTSCU001 00049 * U001 - INVALID DATE OPTION SPECIFIED. DTSCU001 00050 * DTSCU001 00051 * DTSCU001 00052 ***** DTSCU001 00053 EJECT DTSCU001 00054 ******************************************************************DTSCU001 00055 * WORKING STORAGE *DTSCU001 00056 ******************************************************************DTSCU001 00057 ENVIRONMENT DIVISION. DTSCU001 00058 DATA DIVISION. DTSCU001 00059 WORKING-STORAGE SECTION. DTSCU001 000595 77 PAN-VALET PICTURE X(24) VALUE '010DTSCU001 09/29/98'. DTSCU001 00060 SKIP2 DTSCU001 00061 01 WS-MISC-VARIABLES. DTSCU001 00062 05 WS-ABEND-CODE PIC X(4). CL**4 00063 05 WS-L001-JUL-DATE PIC 9(7). DTSCU001 00064 05 FILLER REDEFINES WS-L001-JUL-DATE. DTSCU001 00065 10 WS-JULIAN-YR PIC 9(4). DTSCU001 00066 10 WS-JULIAN-DAYS PIC 9(3). DTSCU001 00067 05 DATE-CN PIC S9(8) COMP. DTSCU001 00068 05 DATE-YR PIC S9(8) COMP. DTSCU001 00069 05 DATE-MO PIC S9(8) COMP. DTSCU001 00070 05 DATE-DA PIC S9(8) COMP. DTSCU001 00071 05 JDATE PIC S9(8) COMP. DTSCU001 00072 05 WS-JDATE PIC S9(8) COMP. DTSCU001 00073 EJECT DTSCU001 00074 LINKAGE SECTION. DTSCU001 00075 SKIP1 DTSCU001 00076 01 DFHCOMMAREA. CL**7 00077 ++INCLUDE DTSIL001 CL**7 00078 EJECT CL**7 00079 PROCEDURE DIVISION. DTSCU001 00080 SKIP2 DTSCU001 00081 ***** DTSCU001 00082 * INITIATE PROCESSING DTSCU001 00083 ***** DTSCU001 00084 INIT0100-INITIATE-PROCESSING. DTSCU001 00085 IF L001-FROM-CAL-8 DTSCU001 00086 PERFORM PROC0100-FROM-CALENDAR THRU CL**2 00087 PROC0100-FROM-CALENDAR-EXIT CL**2 00088 ELSE DTSCU001 00089 IF L001-FROM-FED-8 DTSCU001 00090 PERFORM PROC0200-FROM-FEDERAL THRU CL**2 00091 PROC0200-FROM-FEDERAL-EXIT CL**2 00092 ELSE DTSCU001 00093 IF L001-FROM-JUL DTSCU001 00094 PERFORM PROC0300-FROM-JULIAN THRU CL**2 00095 PROC0300-FROM-JULIAN-EXIT CL**2 00096 ELSE DTSCU001 00097 IF L001-FROM-ABS-DAY DTSCU001 00098 PERFORM PROC0400-FROM-JULIAN-DAY-NMBR THRU CL**2 00099 PROC0400-FROM-JULIAN-DAY-EXIT CL**8 00100 ELSE DTSCU001 00101 IF L001-FROM-CAL-6 DTSCU001 00102 PERFORM PROC0500-FROM-CALENDAR-6 THRU CL**2 00103 PROC0500-FROM-CALENDAR-6-EXIT CL**2 00104 ELSE DTSCU001 00105 IF L001-FROM-FED-6 DTSCU001 00106 PERFORM PROC0600-FROM-FEDERAL-6 THRU CL**2 00107 PROC0600-FROM-FEDERAL-6-EXIT CL**2 00108 ELSE DTSCU001 00109 IF L001-FROM-NINES-COMPLEMENT DTSCU001 00110 PERFORM PROC0700-FROM-COMP THRU CL**2 00111 PROC0700-FROM-COMP-EXIT CL**2 00112 ELSE DTSCU001 00113 MOVE 'U001' TO WS-ABEND-CODE DTSCU001 00114 EXEC CICS ABEND ABCODE (WS-ABEND-CODE) END-EXEC CL**3 00115 STOP RUN. CL**3 00116 INIT0199-GOBACK. DTSCU001 00117 EXEC CICS DTSCU001 00118 RETURN DTSCU001 00119 END-EXEC. DTSCU001 00120 SKIP2 DTSCU001 00121 ***** DTSCU001 00122 * CONVERT FROM CALENDAR DATE DTSCU001 00123 ***** DTSCU001 00124 PROC0100-FROM-CALENDAR. DTSCU001 00125 IF L001-CAL-8-MO NOT NUMERIC DTSCU001 00126 OR L001-CAL-8-DA NOT NUMERIC DTSCU001 00127 OR L001-CAL-8-YR NOT NUMERIC DTSCU001 00128 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00129 SERV1000-CLEAR-DWA-EXIT CL**2 00130 GO TO PROC0100-FROM-CALENDAR-EXIT. CL**2 00131 MOVE L001-CAL-8-MO TO L001-CAL-6-MO. DTSCU001 00132 MOVE L001-CAL-8-DA TO L001-CAL-6-DA. DTSCU001 00133 MOVE L001-CAL-8-YR TO L001-CAL-6-YR L001-FED-6-YR. DTSCU001 00134 MOVE L001-CAL-8-MO TO DATE-MO. DTSCU001 00135 MOVE L001-CAL-8-DA TO DATE-DA. DTSCU001 00136 MOVE L001-CAL-8-YR TO DATE-YR L001-FED-8-YR. DTSCU001 00137 PERFORM PROC1000-DATE-JDAY THRU CL**2 00138 PROC1000-DATE-JDAY-EXIT. CL**2 00139 MOVE JDATE TO L001-JUL-ABS-DAY WS-JDATE. DTSCU001 00140 PERFORM PROC2000-DATE-JDATE THRU CL**2 00141 PROC2000-DATE-JDATE-EXIT. CL**2 00142 IF L001-CAL-8-DA NOT EQUAL DATE-DA DTSCU001 00143 OR L001-CAL-8-MO NOT EQUAL DATE-MO DTSCU001 00144 PERFORM SERV1000-CLEAR-DWA THRU CL**8 00145 SERV1000-CLEAR-DWA-EXIT CL**2 00146 GO TO PROC0100-FROM-CALENDAR-EXIT. CL**2 00147 MOVE 01 TO DATE-DA DATE-MO. DTSCU001 00148 PERFORM PROC1000-DATE-JDAY THRU CL**2 00149 PROC1000-DATE-JDAY-EXIT. CL**2 00150 SUBTRACT L001-JUL-ABS-DAY FROM JDATE. DTSCU001 00151 COMPUTE L001-JUL-DATE EQUAL 1000 * L001-CAL-8-YR - JDATE + 1.DTSCU001 00152 PERFORM PROC3000-DAY-OF-WEEK THRU CL**2 00153 PROC3000-DAY-OF-WEEK-EXIT. CL**2 00154 PERFORM PROC4000-L001-SLASH-DATE THRU CL**2 00155 PROC4000-L001-SLASH-DATE-EXIT. CL**2 00156 PERFORM PROC5000-COMP-DATE THRU CL**2 00157 PROC5000-COMP-DATE-EXIT. CL**2 00158 PERFORM PROC6000-CHECK-YR THRU CL**2 00159 PROC6000-CHECK-YR-EXIT. CL**2 00160 PROC0100-FROM-CALENDAR-EXIT. EXIT. CL**2 00161 SKIP2 DTSCU001 00162 ***** DTSCU001 00163 * CONVERT FROM FEDERAL DATE DTSCU001 00164 ***** DTSCU001 00165 PROC0200-FROM-FEDERAL. DTSCU001 00166 IF L001-FED-8-YR NOT NUMERIC DTSCU001 00167 OR L001-FED-8-MO NOT NUMERIC DTSCU001 00168 OR L001-FED-8-DA NOT NUMERIC DTSCU001 00169 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00170 SERV1000-CLEAR-DWA-EXIT CL**2 00171 GO TO PROC0200-FROM-FEDERAL-EXIT. CL**2 00172 MOVE L001-FED-8-YR TO L001-FED-6-YR L001-CAL-6-YR. DTSCU001 00173 MOVE L001-FED-8-MO TO L001-FED-6-MO. DTSCU001 00174 MOVE L001-FED-8-DA TO L001-FED-6-DA. DTSCU001 00175 MOVE L001-FED-8-YR TO DATE-YR L001-CAL-8-YR. DTSCU001 00176 MOVE L001-FED-8-MO TO DATE-MO. DTSCU001 00177 MOVE L001-FED-8-DA TO DATE-DA. DTSCU001 00178 PERFORM PROC1000-DATE-JDAY THRU CL**2 00179 PROC1000-DATE-JDAY-EXIT. CL**2 00180 MOVE JDATE TO L001-JUL-ABS-DAY WS-JDATE. DTSCU001 00181 PERFORM PROC2000-DATE-JDATE THRU CL**2 00182 PROC2000-DATE-JDATE-EXIT. CL**2 00183 IF L001-FED-8-DA NOT EQUAL DATE-DA DTSCU001 00184 OR L001-FED-8-MO NOT EQUAL DATE-MO DTSCU001 00185 PERFORM SERV1000-CLEAR-DWA THRU CL**8 00186 SERV1000-CLEAR-DWA-EXIT CL**2 00187 GO TO PROC0200-FROM-FEDERAL-EXIT. CL**2 00188 MOVE 01 TO DATE-DA DATE-MO. DTSCU001 00189 PERFORM PROC1000-DATE-JDAY THRU CL**2 00190 PROC1000-DATE-JDAY-EXIT. CL**2 00191 SUBTRACT L001-JUL-ABS-DAY FROM JDATE. DTSCU001 00192 COMPUTE L001-JUL-DATE EQUAL 1000 * L001-CAL-8-YR - JDATE + 1.DTSCU001 00193 PERFORM PROC3000-DAY-OF-WEEK THRU CL**2 00194 PROC3000-DAY-OF-WEEK-EXIT. CL**2 00195 PERFORM PROC4000-L001-SLASH-DATE THRU CL**2 00196 PROC4000-L001-SLASH-DATE-EXIT. CL**2 00197 PERFORM PROC5000-COMP-DATE THRU CL**2 00198 PROC5000-COMP-DATE-EXIT. CL**2 00199 PERFORM PROC6000-CHECK-YR THRU CL**2 00200 PROC6000-CHECK-YR-EXIT. CL**2 00201 PROC0200-FROM-FEDERAL-EXIT. EXIT. CL**2 00202 SKIP2 DTSCU001 00203 ***** DTSCU001 00204 * CONVERT FROM JULIAN DATE DTSCU001 00205 ***** DTSCU001 00206 PROC0300-FROM-JULIAN. DTSCU001 00207 IF (L001-JUL-DATE NOT NUMERIC) DTSCU001 00208 OR DTSCU001 00209 (L001-JUL-DATE NOT GREATER THAN ZERO) DTSCU001 00210 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00211 SERV1000-CLEAR-DWA-EXIT CL**2 00212 GO TO PROC0300-FROM-JULIAN-EXIT. CL**2 00213 MOVE L001-JUL-DATE TO WS-L001-JUL-DATE. DTSCU001 00214 DIVIDE 4 INTO WS-JULIAN-YR DTSCU001 00215 GIVING DATE-YR REMAINDER DATE-CN. DTSCU001 00216 IF DATE-CN EQUAL ZERO DTSCU001 00217 IF WS-JULIAN-DAYS GREATER THAN 366 DTSCU001 00218 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00219 SERV1000-CLEAR-DWA-EXIT CL**2 00220 GO TO PROC0300-FROM-JULIAN-EXIT CL**2 00221 ELSE DTSCU001 00222 NEXT SENTENCE DTSCU001 00223 ELSE DTSCU001 00224 IF WS-JULIAN-DAYS GREATER THAN 365 DTSCU001 00225 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00226 SERV1000-CLEAR-DWA-EXIT CL**2 00227 GO TO PROC0300-FROM-JULIAN-EXIT. CL**2 00228 MOVE 01 TO DATE-DA DATE-MO. DTSCU001 00229 MOVE WS-JULIAN-YR TO DATE-YR. DTSCU001 00230 PERFORM PROC1000-DATE-JDAY THRU CL**2 00231 PROC1000-DATE-JDAY-EXIT. CL**2 00232 COMPUTE L001-JUL-ABS-DAY EQUAL JDATE + WS-JULIAN-DAYS - 1. DTSCU001 00233 MOVE L001-JUL-ABS-DAY TO JDATE WS-JDATE. DTSCU001 00234 PERFORM PROC2000-DATE-JDATE THRU CL**2 00235 PROC2000-DATE-JDATE-EXIT. CL**2 00236 MOVE DATE-MO TO L001-FED-8-MO. CL**5 00237 MOVE DATE-DA TO L001-FED-8-DA. CL**5 00238 MOVE DATE-YR TO L001-FED-8-YR L001-CAL-8-YR. CL**5 00239 MOVE L001-FED-8-YR TO L001-FED-6-YR L001-CAL-6-YR. DTSCU001 00240 MOVE L001-FED-8-MO TO L001-FED-6-MO. DTSCU001 00241 MOVE L001-FED-8-DA TO L001-FED-6-DA. DTSCU001 00242 PERFORM PROC3000-DAY-OF-WEEK THRU CL**2 00243 PROC3000-DAY-OF-WEEK-EXIT. CL**2 00244 PERFORM PROC4000-L001-SLASH-DATE THRU CL**2 00245 PROC4000-L001-SLASH-DATE-EXIT. CL**2 00246 PERFORM PROC5000-COMP-DATE THRU CL**2 00247 PROC5000-COMP-DATE-EXIT. CL**2 00248 PERFORM PROC6000-CHECK-YR THRU CL**2 00249 PROC6000-CHECK-YR-EXIT. CL**2 00250 PROC0300-FROM-JULIAN-EXIT. EXIT. CL**2 00251 SKIP2 DTSCU001 00252 ***** DTSCU001 00253 * CONVERT FROM JULIAN DAY NUMBER DTSCU001 00254 ***** DTSCU001 00255 PROC0400-FROM-JULIAN-DAY-NMBR. DTSCU001 00256 IF L001-JUL-ABS-DAY NOT GREATER THAN ZERO DTSCU001 00257 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00258 SERV1000-CLEAR-DWA-EXIT CL**2 00259 GO TO PROC0400-FROM-JULIAN-DAY-EXIT. CL**8 00260 MOVE L001-JUL-ABS-DAY TO JDATE WS-JDATE. DTSCU001 00261 PERFORM PROC2000-DATE-JDATE THRU CL**2 00262 PROC2000-DATE-JDATE-EXIT. CL**2 00263 MOVE DATE-MO TO L001-CAL-8-MO. CL**5 00264 MOVE DATE-DA TO L001-CAL-8-DA. CL**5 00265 MOVE DATE-YR TO L001-FED-8-YR L001-CAL-8-YR. CL**5 00266 MOVE L001-CAL-8-MO TO L001-CAL-6-MO. DTSCU001 00267 MOVE L001-CAL-8-DA TO L001-CAL-6-DA. DTSCU001 00268 MOVE L001-CAL-8-YR TO L001-CAL-6-YR L001-FED-6-YR. DTSCU001 00269 MOVE 01 TO DATE-DA DATE-MO. DTSCU001 00270 PERFORM PROC1000-DATE-JDAY THRU CL**2 00271 PROC1000-DATE-JDAY-EXIT. CL**2 00272 SUBTRACT L001-JUL-ABS-DAY FROM JDATE. DTSCU001 00273 COMPUTE L001-JUL-DATE EQUAL 1000 * L001-CAL-8-YR - JDATE + 1.DTSCU001 00274 PERFORM PROC3000-DAY-OF-WEEK THRU CL**2 00275 PROC3000-DAY-OF-WEEK-EXIT. CL**2 00276 PERFORM PROC4000-L001-SLASH-DATE THRU CL**2 00277 PROC4000-L001-SLASH-DATE-EXIT. CL**2 00278 PERFORM PROC5000-COMP-DATE THRU CL**2 00279 PROC5000-COMP-DATE-EXIT. CL**2 00280 PERFORM PROC6000-CHECK-YR THRU CL**2 00281 PROC6000-CHECK-YR-EXIT. CL**2 00282 PROC0400-FROM-JULIAN-DAY-EXIT. EXIT . CL**8 00283 SKIP2 DTSCU001 00284 ***** DTSCU001 00285 * CONVERT FROM SIX DIGIT CALENDAR DATE DTSCU001 00286 ***** DTSCU001 00287 PROC0500-FROM-CALENDAR-6. DTSCU001 00288 IF L001-CAL-6-MO NOT NUMERIC DTSCU001 00289 OR L001-CAL-6-DA NOT NUMERIC DTSCU001 00290 OR L001-CAL-6-YR NOT NUMERIC DTSCU001 00291 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00292 SERV1000-CLEAR-DWA-EXIT CL**2 00293 GO TO PROC0500-FROM-CALENDAR-6-EXIT. CL**2 00294 MOVE L001-CAL-6-YR TO L001-FED-6-YR. DTSCU001 00295 MOVE L001-CAL-6-MO TO L001-CAL-8-MO. DTSCU001 00296 MOVE L001-CAL-6-DA TO L001-CAL-8-DA. DTSCU001 00297 IF L001-CAL-6-YR < 30 DTSCU001 00298 ADD L001-CAL-6-YR 2000 GIVING L001-CAL-8-YR DTSCU001 00299 ELSE DTSCU001 00300 ADD L001-CAL-6-YR 1900 GIVING L001-CAL-8-YR. DTSCU001 00301 MOVE L001-CAL-8-MO TO DATE-MO. DTSCU001 00302 MOVE L001-CAL-8-DA TO DATE-DA. DTSCU001 00303 MOVE L001-CAL-8-YR TO DATE-YR L001-FED-8-YR. DTSCU001 00304 PERFORM PROC1000-DATE-JDAY THRU CL**2 00305 PROC1000-DATE-JDAY-EXIT. CL**2 00306 MOVE JDATE TO L001-JUL-ABS-DAY WS-JDATE. DTSCU001 00307 PERFORM PROC2000-DATE-JDATE THRU CL**2 00308 PROC2000-DATE-JDATE-EXIT. CL**2 00309 IF L001-CAL-8-DA NOT EQUAL DATE-DA DTSCU001 00310 OR L001-CAL-8-MO NOT EQUAL DATE-MO DTSCU001 00311 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00312 SERV1000-CLEAR-DWA-EXIT CL**2 00313 GO TO PROC0500-FROM-CALENDAR-6-EXIT. CL**2 00314 MOVE 01 TO DATE-DA DATE-MO. DTSCU001 00315 PERFORM PROC1000-DATE-JDAY THRU CL**2 00316 PROC1000-DATE-JDAY-EXIT. CL**2 00317 SUBTRACT L001-JUL-ABS-DAY FROM JDATE. DTSCU001 00318 COMPUTE L001-JUL-DATE EQUAL 1000 * L001-CAL-8-YR - JDATE + 1.DTSCU001 00319 PERFORM PROC3000-DAY-OF-WEEK THRU CL**2 00320 PROC3000-DAY-OF-WEEK-EXIT. CL**2 00321 PERFORM PROC4000-L001-SLASH-DATE THRU CL**2 00322 PROC4000-L001-SLASH-DATE-EXIT. CL**2 00323 PERFORM PROC5000-COMP-DATE THRU CL**2 00324 PROC5000-COMP-DATE-EXIT. CL**2 00325 PROC0500-FROM-CALENDAR-6-EXIT. EXIT. CL**2 00326 SKIP2 DTSCU001 00327 ***** DTSCU001 00328 * CONVERT FROM SIX DIGIT FEDERAL DATE DTSCU001 00329 ***** DTSCU001 00330 PROC0600-FROM-FEDERAL-6. DTSCU001 00331 IF L001-FED-6-YR NOT NUMERIC DTSCU001 00332 OR L001-FED-6-MO NOT NUMERIC DTSCU001 00333 OR L001-FED-6-DA NOT NUMERIC DTSCU001 00334 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00335 SERV1000-CLEAR-DWA-EXIT CL**2 00336 GO TO PROC0600-FROM-FEDERAL-6-EXIT. CL**2 00337 MOVE L001-FED-6-YR TO L001-CAL-6-YR. DTSCU001 00338 IF L001-FED-6-YR < 30 DTSCU001 00339 ADD L001-CAL-6-YR 2000 GIVING L001-FED-8-YR DTSCU001 00340 ELSE DTSCU001 00341 ADD L001-CAL-6-YR 1900 GIVING L001-FED-8-YR. DTSCU001 00342 MOVE L001-FED-6-MO TO L001-FED-8-MO. DTSCU001 00343 MOVE L001-FED-6-DA TO L001-FED-8-DA. DTSCU001 00344 MOVE L001-FED-8-YR TO DATE-YR L001-CAL-8-YR. DTSCU001 00345 MOVE L001-FED-8-MO TO DATE-MO. DTSCU001 00346 MOVE L001-FED-8-DA TO DATE-DA. DTSCU001 00347 PERFORM PROC1000-DATE-JDAY THRU CL**2 00348 PROC1000-DATE-JDAY-EXIT. CL**2 00349 MOVE JDATE TO L001-JUL-ABS-DAY WS-JDATE. DTSCU001 00350 PERFORM PROC2000-DATE-JDATE THRU CL**2 00351 PROC2000-DATE-JDATE-EXIT. CL**2 00352 IF L001-FED-8-DA NOT EQUAL DATE-DA DTSCU001 00353 OR L001-FED-8-MO NOT EQUAL DATE-MO DTSCU001 00354 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00355 SERV1000-CLEAR-DWA-EXIT CL**2 00356 GO TO PROC0600-FROM-FEDERAL-6-EXIT. CL**2 00357 MOVE 01 TO DATE-DA DATE-MO. DTSCU001 00358 PERFORM PROC1000-DATE-JDAY THRU CL**2 00359 PROC1000-DATE-JDAY-EXIT. CL**2 00360 SUBTRACT L001-JUL-ABS-DAY FROM JDATE. DTSCU001 00361 COMPUTE L001-JUL-DATE EQUAL 1000 * L001-CAL-8-YR - JDATE + 1.DTSCU001 00362 PERFORM PROC3000-DAY-OF-WEEK THRU CL**2 00363 PROC3000-DAY-OF-WEEK-EXIT. CL**2 00364 PERFORM PROC4000-L001-SLASH-DATE THRU CL**2 00365 PROC4000-L001-SLASH-DATE-EXIT. CL**2 00366 PERFORM PROC5000-COMP-DATE THRU CL**2 00367 PROC5000-COMP-DATE-EXIT. CL**2 00368 PROC0600-FROM-FEDERAL-6-EXIT. EXIT. CL**2 00369 SKIP3 DTSCU001 00370 PROC0700-FROM-COMP. DTSCU001 00371 IF (L001-NINES-COMPLEMENT-DATE NOT NUMERIC) DTSCU001 00372 OR DTSCU001 00373 (L001-NINES-COMPLEMENT-DATE NOT > 0) DTSCU001 00374 PERFORM SERV1000-CLEAR-DWA THRU CL**2 00375 SERV1000-CLEAR-DWA-EXIT CL**2 00376 GO TO PROC0700-FROM-COMP-EXIT. CL**2 00377 COMPUTE L001-FED-8-DATE-9 DTSCU001 00378 = 999999999 - L001-NINES-COMPLEMENT-DATE. DTSCU001 00379 PERFORM PROC0200-FROM-FEDERAL THRU CL**2 00380 PROC0200-FROM-FEDERAL-EXIT. CL**2 00381 PROC0700-FROM-COMP-EXIT. EXIT. CL**2 00382 SKIP2 DTSCU001 00383 ***** DTSCU001 00384 * COMPUTE JULIAN DAY NUMBER FROM A GREGORIAN DATE DTSCU001 00385 ***** DTSCU001 00386 PROC1000-DATE-JDAY. DTSCU001 00387 IF DATE-MO GREATER THAN 2 DTSCU001 00388 SUBTRACT 3 FROM DATE-MO DTSCU001 00389 ELSE DTSCU001 00390 ADD 9 TO DATE-MO DTSCU001 00391 SUBTRACT 1 FROM DATE-YR. DTSCU001 00392 DIVIDE 100 INTO DATE-YR GIVING DATE-CN REMAINDER DATE-YR. DTSCU001 00393 COMPUTE JDATE EQUAL (146097 * DATE-CN) / 4. DTSCU001 00394 COMPUTE JDATE EQUAL (1461 * DATE-YR) / 4 + JDATE. DTSCU001 00395 COMPUTE JDATE EQUAL (153 * DATE-MO + 2) / 5 + JDATE. DTSCU001 00396 COMPUTE JDATE EQUAL 1721119 + DATE-DA + JDATE. DTSCU001 00397 PROC1000-DATE-JDAY-EXIT. EXIT. CL**2 00398 SKIP2 DTSCU001 00399 ***** DTSCU001 00400 * COMPUTE GREGORIAN DATE FROM JULIAN DAY NUMBER DTSCU001 00401 ***** DTSCU001 00402 PROC2000-DATE-JDATE. DTSCU001 00403 SUBTRACT 1721119 FROM JDATE. DTSCU001 00404 COMPUTE DATE-YR EQUAL (4 * JDATE - 1) / 146097. DTSCU001 00405 COMPUTE JDATE EQUAL 4 * JDATE - 1 - 146097 * DATE-YR. DTSCU001 00406 COMPUTE DATE-DA EQUAL JDATE / 4. DTSCU001 00407 COMPUTE JDATE EQUAL (4 * DATE-DA + 3) / 1461. DTSCU001 00408 COMPUTE DATE-DA EQUAL 4 * DATE-DA + 3 - 1461 * JDATE. DTSCU001 00409 COMPUTE DATE-DA EQUAL (DATE-DA + 4) / 4. DTSCU001 00410 COMPUTE DATE-MO EQUAL (5 * DATE-DA - 3) / 153. DTSCU001 00411 COMPUTE DATE-DA EQUAL 5 * DATE-DA - 3 - 153 * DATE-MO. DTSCU001 00412 COMPUTE DATE-DA EQUAL (DATE-DA + 5) / 5. DTSCU001 00413 COMPUTE DATE-YR EQUAL 100 * DATE-YR + JDATE. DTSCU001 00414 IF DATE-MO LESS THAN 10 DTSCU001 00415 ADD 3 TO DATE-MO DTSCU001 00416 ELSE DTSCU001 00417 SUBTRACT 9 FROM DATE-MO DTSCU001 00418 ADD 1 TO DATE-YR. DTSCU001 00419 PROC2000-DATE-JDATE-EXIT. EXIT. CL**2 00420 SKIP2 DTSCU001 00421 ***** DTSCU001 00422 * COMPUTE DAY OF WEEK DTSCU001 00423 ***** DTSCU001 00424 PROC3000-DAY-OF-WEEK. DTSCU001 00425 DIVIDE 7 INTO WS-JDATE DTSCU001 00426 GIVING DATE-CN REMAINDER L001-DAY-OF-WEEK. DTSCU001 00427 IF L001-DAY-OF-WEEK LESS THAN 6 DTSCU001 00428 ADD 2 TO L001-DAY-OF-WEEK DTSCU001 00429 ELSE DTSCU001 00430 SUBTRACT 5 FROM L001-DAY-OF-WEEK. DTSCU001 00431 PROC3000-DAY-OF-WEEK-EXIT. EXIT. CL**2 00432 SKIP2 DTSCU001 00433 ***** DTSCU001 00434 * FORMAT SLASHED DATE DTSCU001 00435 ***** DTSCU001 00436 PROC4000-L001-SLASH-DATE. DTSCU001 00437 MOVE ' / / ' TO L001-SLASH-DATE. DTSCU001 00438 MOVE L001-CAL-8-YR TO L001-SLASH-YR. DTSCU001 00439 MOVE L001-CAL-8-MO TO L001-SLASH-MO. DTSCU001 00440 MOVE L001-CAL-8-DA TO L001-SLASH-DA. DTSCU001 00441 CL**9 00442 MOVE ' / / ' TO L001-SLASH-8-DATE. CL**9 00443 MOVE L001-CAL-8-YR TO L001-SLASH-8-YR. CL**9 00444 MOVE L001-CAL-8-MO TO L001-SLASH-8-MO. CL**9 00445 MOVE L001-CAL-8-DA TO L001-SLASH-8-DA. CL**9 00446 PROC4000-L001-SLASH-DATE-EXIT. EXIT. CL**2 00447 SKIP3 DTSCU001 00448 PROC5000-COMP-DATE. DTSCU001 00449 COMPUTE L001-NINES-COMPLEMENT-DATE DTSCU001 00450 = 999999999 - L001-FED-8-DATE-9. DTSCU001 00451 PROC5000-COMP-DATE-EXIT. EXIT. CL**2 00452 SKIP3 DTSCU001 00453 PROC6000-CHECK-YR. DTSCU001 00454 IF (L001-FED-8-YR < 1930) DTSCU001 00455 OR DTSCU001 00456 (L001-FED-8-YR > 2029) DTSCU001 00457 PERFORM SERV1000-CLEAR-DWA THRU CL**4 00458 SERV1000-CLEAR-DWA-EXIT. CL**4 00459 PROC6000-CHECK-YR-EXIT. EXIT. CL**2 00460 SKIP2 DTSCU001 00461 ***** DTSCU001 00462 * CLEAR DATE WORK AREA DTSCU001 00463 ***** DTSCU001 00464 SERV1000-CLEAR-DWA. DTSCU001 00465 MOVE ZERO DTSCU001 00466 TO L001-FED-8-DATE-9 DTSCU001 00467 L001-CAL-8-DATE-9 DTSCU001 00468 L001-FED-6-DATE-9 DTSCU001 00469 L001-CAL-6-DATE-9 DTSCU001 00470 L001-SLASH-DATE DTSCU001 00471 L001-SLASH-8-DATE CL*10 00472 L001-JUL-DATE DTSCU001 00473 L001-NINES-COMPLEMENT-DATE DTSCU001 00474 L001-DAY-OF-WEEK. DTSCU001 00475 SERV1000-CLEAR-DWA-EXIT. EXIT. CL**2 00476 SKIP2 DTSCU001