00001 IDENTIFICATION DIVISION. 01/29/02 00002 PROGRAM-ID. DTSBD317. DTSBD317 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. OCTOBER 2001. DTSBD317 00005 DATE-COMPILED. DTSBD317 00006 SKIP3 DTSBD317 00007 ***** DTSBD317 00008 * DTSBD317 00009 * FUNCTION: CREATE REPORT RECORDS FOR HOUSEHOLD NOTICES DTSBD317 00010 * DTSBD317 00011 * DTSBD317 00012 * MODIFICATION LOG: DTSBD317 00013 * DTSBD317 00014 * 10/31/2001 INITIAL DEVELOPMENT. DTSBD317 00015 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD317 00016 * DTSBD317 00017 * DTSBD317 00018 * DESCRIPTION: DTSBD317 00019 * DTSBD317 00020 * IF, FOR A GIVEN EMP-NO, DTSBD317 IS CALLED MORE THAN ONCE, DTSBD317 00021 * THEN BYPASS PROCESSING ON ALL CALLS OTHER THAN THE FIRST. DTSBD317 00022 * DTSBD317 00023 * PLEASE SEE PRINTED OUTPUTS DESCRIPTIONS AND LAYOUTS DTSBD317 00024 * FOR FURTHER INFORMATION. DTSBD317 00025 * DTSBD317 00026 * DTSBD317 00027 * MASTER FILE RECORDS READ: DTSBD317 00028 * DTSBD317 00029 * MFSC DTSBD317 00030 * DTSBD317 00031 * DTSBD317 00032 * MASTER FILE RECORDS UPDATED: DTSBD317 00033 * DTSBD317 00034 * MFSC (REWRITE) DTSBD317 00035 * DTSBD317 00036 * DTSBD317 00037 * REPORT RECORDS WRITTEN: DTSBD317 00038 * DTSBD317 00039 * R131 HOUSEHOLD NOTICES: DTSBD317 00040 * POTENTIAL HOUSEHOLD SCHEDULE SELECTION DTSBD317 00041 * EMPLOYER REQUEST SCHEDULE SELECTION DTSBD317 00042 * QUARTERLY CONFIRMATION DTSBD317 00043 * ANNUAL CONFIRMATION DTSBD317 00044 * DTSBD317 00045 * R901 LABEL. DTSBD317 00046 * DTSBD317 00047 * DTSBD317 00048 * MODULES CALLED: DTSBD317 00049 * DTSBD317 00050 * DTSBU111 ADDRESS LOOKUP. DTSBD317 00051 * DTSBU112 FORMAT ADDRESS FOR MAILING. DTSBD317 00052 * DTSBU910 MASTER FILE I/O. DTSBD317 00053 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD317 00054 * DTSBD317 00055 ***** DTSBD317 00056 SKIP3 DTSBD317 00057 ENVIRONMENT DIVISION. DTSBD317 00058 EJECT DTSBD317 00059 DATA DIVISION. DTSBD317 00060 SKIP3 DTSBD317 00061 WORKING-STORAGE SECTION. DTSBD317 000615 77 PAN-VALET PICTURE X(24) VALUE '001DTSBD317 01/29/02'. DTSBD317 00062 SKIP3 DTSBD317 00063 01 WRK-AREA. DTSBD317 00064 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +317.DTSBD317 00065 DTSBD317 00066 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD317'.DTSBD317 00067 DTSBD317 00068 DTSBD317 00069 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD317 00070 DTSBD317 00071 DTSBD317 00072 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD317 00073 DTSBD317 00074 DTSBD317 00075 05 WRK-MAILING-ADDRESS. DTSBD317 00076 10 FILLER OCCURS 5 PIC X(40). DTSBD317 00077 DTSBD317 00078 05 WRK-ZIP PIC X(10). DTSBD317 00079 DTSBD317 00080 05 WRK-ADVANCED-BARCODE PIC X(14). DTSBD317 00081 DTSBD317 00082 DTSBD317 00083 DTSBD317 00084 EJECT DTSBD317 00085 01 L111-LINK-AREA. DTSBD317 00086 ++INCLUDE DTSIL111 DTSBD317 00087 EJECT DTSBD317 00088 01 L112-LINK-AREA. DTSBD317 00089 ++INCLUDE DTSIL112 DTSBD317 00090 EJECT DTSBD317 00091 01 L910-LINK-AREA. DTSBD317 00092 ++INCLUDE DTSIL910 DTSBD317 00093 EJECT DTSBD317 00094 01 MSKL-REC. DTSBD317 00095 ++INCLUDE DTSIMSKL DTSBD317 00096 EJECT DTSBD317 00097 01 MFSC-REC. DTSBD317 00098 ++INCLUDE DTSIMFSC DTSBD317 00099 EJECT DTSBD317 00100 01 RSKL-REC. DTSBD317 00101 ++INCLUDE DTSIRSK1 DTSBD317 00102 EJECT DTSBD317 00103 01 R131-REC. DTSBD317 00104 ++INCLUDE DTSIR131 DTSBD317 00105 EJECT DTSBD317 00106 LINKAGE SECTION. DTSBD317 00107 SKIP3 DTSBD317 00108 01 LBCM-LINK-AREA. DTSBD317 00109 ++INCLUDE DTSILBCM DTSBD317 00110 EJECT DTSBD317 00111 01 MPRF-REC. DTSBD317 00112 ++INCLUDE DTSIMPRF DTSBD317 00113 EJECT DTSBD317 00114 01 T001-REC. DTSBD317 00115 ++INCLUDE DTSIT001 DTSBD317 00116 EJECT DTSBD317 00117 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD317 00118 MPRF-REC DTSBD317 00119 T001-REC. DTSBD317 00120 DTSBD317 00121 IF FIRST-TIME-IND = 'Y' DTSBD317 00122 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBD317 00123 MOVE 'N' TO FIRST-TIME-IND. DTSBD317 00124 DTSBD317 00125 DTSBD317 00126 IF MPRF-EMP-NO NOT = WRK-EMP-NO DTSBD317 00127 MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBD317 00128 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD317 00129 DTSBD317 00130 DTSBD317 00131 GOBACK. DTSBD317 00132 EJECT DTSBD317 00133 I0000-INITIATE. DTSBD317 00134 MOVE +0 TO WRK-EMP-NO. DTSBD317 00135 DTSBD317 00136 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBD317 00137 DTSBD317 00138 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD317 00139 DTSBD317 00140 DTSBD317 00141 MOVE LENGTH OF R131-REC TO R131-LENGTH. DTSBD317 00142 DTSBD317 00143 I0000-EXIT. EXIT. DTSBD317 00144 EJECT DTSBD317 00145 P0000-PROCESS. DTSBD317 00146 PERFORM P1000-FIND-ADDRESS THRU P1000-EXIT. DTSBD317 00147 DTSBD317 00148 IF T001-HH-POT-HOUSEHOLD-88 DTSBD317 00149 OR T001-HH-EMP-REQUEST-88 DTSBD317 00150 PERFORM P2000-INIT-NOTICE THRU P2000-EXIT DTSBD317 00151 ELSE DTSBD317 00152 IF T001-HH-CONFIRM-QTR-88 DTSBD317 00153 OR T001-HH-CONFIRM-ANN-88 DTSBD317 00154 PERFORM P3000-CONF-NOTICE THRU P3000-EXIT. DTSBD317 00155 DTSBD317 00156 P0000-EXIT. EXIT. DTSBD317 00157 EJECT DTSBD317 00158 P1000-FIND-ADDRESS. DTSBD317 00159 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSBD317 00160 DTSBD317 00161 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBD317 00162 DTSBD317 00163 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBD317 00164 DTSBD317 00165 PERFORM S111-LOOKUP-ADDRESS THRU S111-EXIT. DTSBD317 00166 DTSBD317 00167 IF L111-ADDR-FOUND-88 DTSBD317 00168 SET L112-TAD-ADDR-88 TO TRUE DTSBD317 00169 SET L112-ANCHOR-LAST-88 TO TRUE DTSBD317 00170 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSBD317 00171 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBD317 00172 PERFORM S112-FORMAT-ADDRESS THRU S112-EXIT DTSBD317 00173 ELSE DTSBD317 00174 MOVE ALL '?' TO L112-NAME-ADDRESS-AREA. DTSBD317 00175 DTSBD317 00176 MOVE L112-MAILING-ADDRESS TO WRK-MAILING-ADDRESS. DTSBD317 00177 DTSBD317 00178 MOVE L112-ZIP TO WRK-ZIP. DTSBD317 00179 DTSBD317 00180 MOVE L112-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE. DTSBD317 00181 DTSBD317 00182 P1000-EXIT. DTSBD317 00183 EXIT. DTSBD317 00184 DTSBD317 00185 P2000-INIT-NOTICE. DTSBD317 00186 PERFORM P2100-R131-REC THRU P2100-EXIT. DTSBD317 00187 DTSBD317 00188 PERFORM P2300-UPD-MFSC THRU P2300-EXIT. DTSBD317 00189 DTSBD317 00190 P2000-EXIT. EXIT. DTSBD317 00191 EJECT DTSBD317 00192 P2100-R131-REC. DTSBD317 00193 MOVE T001-RESP-OP-ID TO R131-OP-ID. DTSBD317 00194 DTSBD317 00195 MOVE WRK-EMP-NO TO R131-EMP-NO. DTSBD317 00196 DTSBD317 00197 INITIALIZE R131-DATA-AREA. DTSBD317 00198 DTSBD317 00199 IF T001-HH-POT-HOUSEHOLD-88 DTSBD317 00200 SET R131-POT-HOUSEHOLD-88 TO TRUE DTSBD317 00201 ELSE DTSBD317 00202 IF T001-HH-EMP-REQUEST-88 DTSBD317 00203 SET R131-EMP-REQUEST-88 TO TRUE DTSBD317 00204 ELSE DTSBD317 00205 GO TO P2100-EXIT. DTSBD317 00206 DTSBD317 00207 MOVE LBCM-CURR-RUN-DATE TO R131-RUN-DATE. DTSBD317 00208 DTSBD317 00209 MOVE WRK-MAILING-ADDRESS TO R131-FMT-ADDR. DTSBD317 00210 DTSBD317 00211 MOVE WRK-ZIP TO R131-ZIP. DTSBD317 00212 DTSBD317 00213 MOVE WRK-ADVANCED-BARCODE TO R131-ADVANCED-BARCODE. DTSBD317 00214 DTSBD317 00215 MOVE T001-HH-START-YRQ TO R131-FILE-SCHED-START. DTSBD317 00216 DTSBD317 00217 MOVE R131-REC TO RSKL-REC. DTSBD317 00218 DTSBD317 00219 PERFORM S946-RPT-O THRU S946-EXIT. DTSBD317 00220 P2100-EXIT. EXIT. DTSBD317 00221 SKIP3 DTSBD317 00222 P2300-UPD-MFSC. DTSBD317 00223 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSBD317 00224 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSBD317 00225 SET MFSC-FSC-88 TO TRUE. DTSBD317 00226 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSBD317 00227 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD317 00228 IF L910-NO-REC-88 DTSBD317 00229 GO TO P2300-EXIT DTSBD317 00230 ELSE DTSBD317 00231 PERFORM P2310-ADD-MAIL-DATE THRU P2310-EXIT DTSBD317 00232 UNTIL L910-NO-REC-88. DTSBD317 00233 DTSBD317 00234 P2300-EXIT. DTSBD317 00235 EXIT. DTSBD317 00236 DTSBD317 00237 P2310-ADD-MAIL-DATE. DTSBD317 00238 MOVE MSKL-REC TO MFSC-REC. DTSBD317 00239 DTSBD317 00240 IF MFSC-STATUS-PENDING-88 DTSBD317 00241 IF MFSC-INITIAL-MAIL-DATE = ZERO DTSBD317 00242 MOVE LBCM-CURR-MAIL-DATE TO MFSC-INITIAL-MAIL-DATE DTSBD317 00243 IF T001-HH-POT-HOUSEHOLD-88 DTSBD317 00244 SET MFSC-INIT-1A-88 TO TRUE DTSBD317 00245 ELSE DTSBD317 00246 IF T001-HH-EMP-REQUEST-88 DTSBD317 00247 SET MFSC-INIT-REQUEST-88 TO TRUE DTSBD317 00248 ELSE DTSBD317 00249 NEXT SENTENCE DTSBD317 00250 END-IF DTSBD317 00251 END-IF DTSBD317 00252 MOVE MFSC-REC TO MSKL-REC DTSBD317 00253 PERFORM S910-REWRITE THRU S910-EXIT DTSBD317 00254 END-IF DTSBD317 00255 END-IF. DTSBD317 00256 DTSBD317 00257 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD317 00258 DTSBD317 00259 P2310-EXIT. DTSBD317 00260 EXIT. DTSBD317 00261 DTSBD317 00262 P3000-CONF-NOTICE. DTSBD317 00263 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSBD317 00264 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSBD317 00265 SET MFSC-FSC-88 TO TRUE. DTSBD317 00266 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSBD317 00267 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD317 00268 IF L910-NO-REC-88 DTSBD317 00269 GO TO P3000-EXIT DTSBD317 00270 ELSE DTSBD317 00271 PERFORM P3100-FIND-MFSC THRU P3100-EXIT DTSBD317 00272 UNTIL L910-NO-REC-88. DTSBD317 00273 DTSBD317 00274 P3000-EXIT. DTSBD317 00275 EXIT. DTSBD317 00276 DTSBD317 00277 P3100-FIND-MFSC. DTSBD317 00278 MOVE MSKL-REC TO MFSC-REC. DTSBD317 00279 DTSBD317 00280 IF MFSC-STATUS-OPEN-88 DTSBD317 00281 IF MFSC-CONFIRM-MAIL-DATE = ZERO DTSBD317 00282 AND T001-HH-START-YRQ = MFSC-START-YRQ DTSBD317 00283 MOVE LBCM-CURR-MAIL-DATE TO MFSC-CONFIRM-MAIL-DATE DTSBD317 00284 IF T001-HH-CONFIRM-QTR-88 DTSBD317 00285 SET MFSC-CONFIRM-QTR-88 TO TRUE DTSBD317 00286 MOVE MFSC-REC TO MSKL-REC DTSBD317 00287 PERFORM S910-REWRITE THRU S910-EXIT DTSBD317 00288 PERFORM P3110-ADD-R131 THRU P3110-EXIT DTSBD317 00289 ELSE DTSBD317 00290 IF T001-HH-CONFIRM-ANN-88 DTSBD317 00291 SET MFSC-CONFIRM-ANN-88 TO TRUE DTSBD317 00292 MOVE MFSC-REC TO MSKL-REC DTSBD317 00293 PERFORM S910-REWRITE THRU S910-EXIT DTSBD317 00294 PERFORM P3110-ADD-R131 THRU P3110-EXIT DTSBD317 00295 END-IF DTSBD317 00296 END-IF DTSBD317 00297 END-IF DTSBD317 00298 END-IF. DTSBD317 00299 DTSBD317 00300 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD317 00301 DTSBD317 00302 P3100-EXIT. DTSBD317 00303 EXIT. DTSBD317 00304 DTSBD317 00305 P3110-ADD-R131. DTSBD317 00306 MOVE T001-RESP-OP-ID TO R131-OP-ID. DTSBD317 00307 DTSBD317 00308 MOVE WRK-EMP-NO TO R131-EMP-NO. DTSBD317 00309 DTSBD317 00310 INITIALIZE R131-DATA-AREA. DTSBD317 00311 DTSBD317 00312 IF T001-HH-CONFIRM-QTR-88 DTSBD317 00313 SET R131-CONFIRM-QTR-88 TO TRUE DTSBD317 00314 ELSE DTSBD317 00315 IF T001-HH-CONFIRM-ANN-88 DTSBD317 00316 SET R131-CONFIRM-ANN-88 TO TRUE DTSBD317 00317 ELSE DTSBD317 00318 GO TO P3110-EXIT. DTSBD317 00319 DTSBD317 00320 MOVE LBCM-CURR-RUN-DATE TO R131-RUN-DATE. DTSBD317 00321 DTSBD317 00322 MOVE WRK-MAILING-ADDRESS TO R131-FMT-ADDR. DTSBD317 00323 DTSBD317 00324 MOVE WRK-ZIP TO R131-ZIP. DTSBD317 00325 DTSBD317 00326 MOVE WRK-ADVANCED-BARCODE TO R131-ADVANCED-BARCODE. DTSBD317 00327 DTSBD317 00328 MOVE T001-HH-START-YRQ TO R131-FILE-SCHED-START. DTSBD317 00329 DTSBD317 00330 MOVE R131-REC TO RSKL-REC. DTSBD317 00331 DTSBD317 00332 PERFORM S946-RPT-O THRU S946-EXIT. DTSBD317 00333 DTSBD317 00334 P3110-EXIT. DTSBD317 00335 EXIT. DTSBD317 00336 DTSBD317 00337 S111-LOOKUP-ADDRESS. DTSBD317 00338 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBD317 00339 S111-EXIT. EXIT. DTSBD317 00340 SKIP3 DTSBD317 00341 S112-FORMAT-ADDRESS. DTSBD317 00342 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBD317 00343 S112-EXIT. EXIT. DTSBD317 00344 SKIP3 DTSBD317 00345 S910-READ. DTSBD317 00346 SET L910-READ-88 TO TRUE. DTSBD317 00347 GO TO S910-MSTR-IO. DTSBD317 00348 DTSBD317 00349 S910-START-BROWSE. DTSBD317 00350 SET L910-START-BROWSE-88 TO TRUE. DTSBD317 00351 GO TO S910-MSTR-IO. DTSBD317 00352 DTSBD317 00353 S910-READ-NEXT. DTSBD317 00354 SET L910-READ-NEXT-88 TO TRUE. DTSBD317 00355 GO TO S910-MSTR-IO. DTSBD317 00356 DTSBD317 00357 *S910-COUNT. DTSBD317 00358 *****SET L910-COUNT-88 TO TRUE. DTSBD317 00359 *****GO TO S910-MSTR-IO. DTSBD317 00360 DTSBD317 00361 *S910-WRITE. DTSBD317 00362 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD317 00363 *****SET L910-WRITE-88 TO TRUE. DTSBD317 00364 *****GO TO S910-MSTR-IO. DTSBD317 00365 DTSBD317 00366 S910-REWRITE. DTSBD317 00367 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD317 00368 SET L910-REWRITE-88 TO TRUE. DTSBD317 00369 GO TO S910-MSTR-IO. DTSBD317 00370 DTSBD317 00371 *S910-DELETE. DTSBD317 00372 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD317 00373 *****SET L910-DELETE-88 TO TRUE. DTSBD317 00374 *****GO TO S910-MSTR-IO. DTSBD317 00375 DTSBD317 00376 S910-MSTR-IO. DTSBD317 00377 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD317 00378 MSKL-REC. DTSBD317 00379 S910-EXIT. EXIT. DTSBD317 00380 SKIP3 DTSBD317 00381 S946-RPT-O. DTSBD317 00382 CALL 'DTSBU946' USING RSKL-REC. DTSBD317 00383 S946-EXIT. EXIT. DTSBD317 00384 EJECT DTSBD317