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