00001 IDENTIFICATION DIVISION. 12/13/98 00002 PROGRAM-ID. DTSBU530. DTSBU530 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. JANUARY 1991. CL**2 00005 DATE-COMPILED. CL**2 00006 SKIP3 CL**2 00007 ***** CL**2 00008 * CL**2 00009 * FUNCTION: WRITE OFF/REVERSE WRITE OFF PROCESSING. CL**3 00010 * CL**2 00011 * CL**2 00012 * MODIFICATION LOG: CL**2 00013 * CL**2 00014 * 01/26/92 INITIAL DEVELOPMENT. CL**2 00015 * WORK ORDER: PROGRAMMER: TCL CL**2 00016 * CL**2 00017 * 06/13/95 CHANGE TO CREDIT TOLERANCE LOGIC REMOVES IT FROM CL**2 00018 * THIS PROGRAM. CL**2 00019 * WORK ORDER: CR094 PROGRAMMER: RHC CL**2 00020 * CL**2 00021 * 12/13/1998 REVIEWED AND MODIFIED FOR DC. CL**3 00022 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**3 00023 * CL**3 00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**3 00027 * CL**2 00028 * CL**2 00029 * DESCRIPTION: CL**2 00030 * CL**2 00031 * IF L530-WRITE-OFF-88 CL**3 00032 * IF MONEY IS DUE OR REPORTS ARE PURSUED OR CREDITS EXIST CL**2 00033 * WRITE OFF COLLECTIONS CL**3 00034 * ELSE CL**2 00035 * CONTINUE CL**2 00036 * ELSE CL**2 00037 * IF L530-REVERSE-WRITE-OFF-88 CL**3 00038 * REVERSE THE WRITE OFF OF COLLECTIONS. CL**3 00039 * CL**2 00040 * CL**2 00041 * IN DC, CREDITS ARE WRITTEN OFF! CL**3 00042 * CL**2 00043 * CL**2 00044 * MASTER FILE RECORDS READ: CL**2 00045 * CL**2 00046 * MQTR CL**2 00047 * MDST CL**2 00048 * CL**2 00049 * CL**2 00050 * MASTER FILE RECORDS UPDATED: CL**2 00051 * CL**2 00052 * MQTR (REWRITE) CL**2 00053 * MDST (REWRITE) CL**2 00054 * CL**2 00055 * CL**2 00056 * REPORT RECORDS WRITTEN: CL**2 00057 * CL**2 00058 * NONE. CL**2 00059 * CL**2 00060 * CL**2 00061 * MODULES CALLED: CL**2 00062 * CL**2 00063 * DTSBU541 MODIFY A SPECIFIED CHARGED, WAIVED, TOLERATED, CL**3 00064 * OR WRITTEN OFF AMOUNT. CL**3 00065 * DTSBU542 MDST MAINTENANCE. CL**3 00066 * DTSBU590 EMPLOYER CLEANUP. CL**3 00067 * DTSBU910 MASTER FILE I/O DRIVER. CL**3 00068 * CL**2 00069 ***** CL**2 00070 SKIP3 CL**2 00071 ENVIRONMENT DIVISION. CL**2 00072 EJECT CL**2 00073 DATA DIVISION. CL**2 00074 SKIP3 CL**2 00075 WORKING-STORAGE SECTION. CL**2 000755 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU530 12/13/98'. CL**2 00076 SKIP3 CL**2 00077 01 WRK-AREA. CL**2 00078 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +530. CL**2 00079 CL**2 00080 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU530'. CL**3 00081 CL**2 00082 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. CL**2 00083 CL**2 00084 05 WRK-NULL-DOC-NO. CL**2 00085 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. CL**2 00086 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. CL**2 00087 CL**2 00088 CL**3 00089 05 WRITTEN-OFF-BALANCE-AMT PIC S9(09)V9(02) COMP-3. CL**3 00090 CL**3 00091 05 WRITTEN-OFF-CREDIT-AMT PIC S9(09)V9(02) COMP-3. CL**3 00092 CL**3 00093 05 WRITTEN-OFF-PURSUED-RPT-CNT PIC S9(04) COMP. CL**3 00094 CL**2 00095 05 WRK-BALANCE-AMT PIC S9(09)V9(02) COMP-3. CL**2 00096 CL**2 00097 05 WRK-PURSUED-RPT-IND PIC X(01). CL**2 00098 EJECT CL**2 00099 01 L910-LINK-AREA. CL**2 00100 ++INCLUDE DTSIL910 CL**3 00101 SKIP3 CL**2 00102 01 MSKL-REC. CL**2 00103 ++INCLUDE DTSIMSKL CL**3 00104 SKIP3 CL**2 00105 01 MQTR-REC. CL**2 00106 ++INCLUDE DTSIMQTR CL**3 00107 SKIP3 CL**2 00108 01 MDST-REC. CL**2 00109 ++INCLUDE DTSIMDST CL**3 00110 EJECT CL**2 00111 01 L541-LINK-AREA. CL**2 00112 ++INCLUDE DTSIL541 CL**3 00113 SKIP3 CL**2 00114 01 L542-LINK-AREA. CL**2 00115 ++INCLUDE DTSIL542 CL**3 00116 SKIP3 CL**2 00117 01 L590-LINK-AREA. CL**2 00118 ++INCLUDE DTSIL590 CL**3 00119 EJECT CL**2 00120 01 CACT-LITERALS. CL**2 00121 ++INCLUDE DTSICACT CL**3 00122 EJECT CL**2 00123 LINKAGE SECTION. CL**2 00124 SKIP3 CL**2 00125 01 L530-LINK-AREA. CL**2 00126 ++INCLUDE DTSIL530 CL**3 00127 SKIP3 CL**2 00128 01 LBCM-LINK-AREA. CL**2 00129 ++INCLUDE DTSILBCM CL**3 00130 SKIP3 CL**2 00131 01 MPRF-REC. CL**2 00132 ++INCLUDE DTSIMPRF CL**3 00133 EJECT CL**2 00134 PROCEDURE DIVISION USING L530-LINK-AREA CL**2 00135 LBCM-LINK-AREA CL**2 00136 MPRF-REC. CL**2 00137 CL**3 00138 CL**3 00139 IF FIRST-TIME-IND = 'Y' CL**2 00140 PERFORM I0000-FIRST-TIME THRU I0000-EXIT CL**2 00141 MOVE 'N' TO FIRST-TIME-IND. CL**2 00142 CL**3 00143 CL**3 00144 PERFORM P0000-PROCESS THRU P0000-EXIT. CL**2 00145 CL**3 00146 CL**3 00147 GOBACK. CL**2 00148 EJECT CL**2 00149 I0000-FIRST-TIME. CL**2 00150 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. CL**2 00151 CL**3 00152 MOVE 'DTSBU530' TO L910-MOD-NAME. CL**3 00153 CL**3 00154 MOVE +0 TO WRK-NULL-BATCH-NO CL**3 00155 WRK-NULL-ITEM-NO. CL**3 00156 I0000-EXIT. CL**2 00157 EXIT. CL**2 00158 EJECT CL**2 00159 P0000-PROCESS. CL**2 00160 SET L530-NO-UPDATE-88 TO TRUE. CL**2 00161 CL**2 00162 MOVE +0 TO WRITTEN-OFF-BALANCE-AMT CL**3 00163 WRITTEN-OFF-CREDIT-AMT CL**3 00164 WRITTEN-OFF-PURSUED-RPT-CNT. CL**3 00165 CL**2 00166 CL**2 00167 MOVE LOW-VALUES TO MQTR-KEY-AREA. CL**2 00168 CL**3 00169 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. CL**2 00170 CL**3 00171 SET MQTR-QTR-88 TO TRUE. CL**2 00172 CL**3 00173 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL**2 00174 CL**3 00175 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**2 00176 CL**2 00177 PERFORM P1000-MQTR-SCAN THRU P1000-EXIT CL**2 00178 UNTIL L910-NO-REC-88. CL**2 00179 CL**2 00180 CL**2 00181 MOVE LOW-VALUES TO MDST-KEY-AREA. CL**2 00182 CL**3 00183 MOVE MPRF-EMP-NO TO MDST-EMP-NO. CL**2 00184 CL**3 00185 SET MDST-DST-88 TO TRUE. CL**2 00186 CL**3 00187 SET MDST-CREDIT-REC-88 TO TRUE. CL**2 00188 CL**3 00189 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. CL**2 00190 CL**3 00191 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**2 00192 CL**2 00193 PERFORM P2000-MDST-SCAN THRU P2000-EXIT CL**2 00194 UNTIL L910-NO-REC-88. CL**2 00195 CL**2 00196 CL**2 00197 IF (WRITTEN-OFF-BALANCE-AMT > +0) CL**3 00198 OR CL**2 00199 (WRITTEN-OFF-CREDIT-AMT > +0) CL**3 00200 OR CL**2 00201 (WRITTEN-OFF-PURSUED-RPT-CNT > +0) CL**3 00202 IF MPRF-NOT-WRITTEN-OFF-88 CL**3 00203 MOVE L530-WRITE-OFF-DATE TO MPRF-WRITE-OFF-DATE CL**3 00204 SET L530-UPDATE-88 TO TRUE CL**2 00205 SET LBCM-EMP-UPDATE-YES-88 TO TRUE CL**2 00206 ELSE CL**2 00207 NEXT SENTENCE CL**2 00208 ELSE CL**2 00209 IF MPRF-NOT-WRITTEN-OFF-88 CL**3 00210 NEXT SENTENCE CL**2 00211 ELSE CL**2 00212 MOVE +0 TO MPRF-WRITE-OFF-DATE CL**3 00213 SET L530-UPDATE-88 TO TRUE CL**2 00214 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL**2 00215 SKIP2 CL**2 00216 P0000-EXIT. CL**2 00217 EXIT. CL**2 00218 EJECT CL**2 00219 P1000-MQTR-SCAN. CL**2 00220 MOVE MSKL-REC TO MQTR-REC. CL**2 00221 CL**2 00222 MOVE +0 TO WRK-BALANCE-AMT. CL**2 00223 CL**2 00224 PERFORM P1100-MQTR-ACCT-SCAN THRU P1100-EXIT CL**2 00225 VARYING MQTR-ACCT-IDX FROM 1 BY 1 CL**2 00226 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. CL**2 00227 CL**2 00228 IF (WRK-BALANCE-AMT = +0) CL**2 00229 OR CL**2 00230 (WRK-BALANCE-AMT > LBCM-QTR-TOL-MAX) CL**2 00231 NEXT SENTENCE CL**2 00232 ELSE CL**2 00233 PERFORM S590-QTR-TOL THRU S590-EXIT. CL**2 00234 CL**2 00235 PERFORM P1200-PURSUED-RPT-IND THRU P1200-EXIT. CL**2 00236 CL**2 00237 CL**2 00238 MOVE MQTR-REC TO MSKL-REC. CL**2 00239 CL**2 00240 PERFORM S910-REWRITE THRU S910-EXIT. CL**2 00241 CL**2 00242 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**2 00243 P1000-EXIT. CL**2 00244 EXIT. CL**2 00245 SKIP3 CL**2 00246 P1100-MQTR-ACCT-SCAN. CL**2 00247 MOVE +0 TO L541-AMT. CL**2 00248 CL**3 00249 IF L530-WRITE-OFF-88 CL**3 00250 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO L541-AMT CL**2 00251 ELSE CL**2 00252 COMPUTE L541-AMT CL**2 00253 = MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) * -1. CL**3 00254 CL**2 00255 IF L541-AMT NOT = +0 CL**2 00256 SET L541-ACCT-SUB TO MQTR-ACCT-IDX CL**2 00257 MOVE CACT-CAT-WRITTEN-OFF TO L541-CAT-IND CL**3 00258 PERFORM S541-MODIFY-AMT THRU S541-EXIT CL**2 00259 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE CL**2 00260 SET L530-UPDATE-88 TO TRUE. CL**2 00261 CL**2 00262 COMPUTE WRITTEN-OFF-BALANCE-AMT CL**3 00263 = WRITTEN-OFF-BALANCE-AMT CL**3 00264 + MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX). CL**3 00265 CL**2 00266 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-BALANCE-AMT. CL**2 00267 P1100-EXIT. CL**2 00268 EXIT. CL**2 00269 SKIP3 CL**2 00270 P1200-PURSUED-RPT-IND. CL**2 00271 MOVE MQTR-PURSUED-RPT-IND TO WRK-PURSUED-RPT-IND. CL**2 00272 CL**2 00273 IF MQTR-RPT-IS-PURSUED-88 CL**2 00274 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT. CL**2 00275 CL**2 00276 IF L530-WRITE-OFF-88 CL**3 00277 PERFORM P1210-WRITE-OFF THRU P1210-EXIT CL**3 00278 ELSE CL**2 00279 PERFORM P1220-REVERSE THRU P1220-EXIT. CL**2 00280 CL**2 00281 IF MQTR-RPT-IS-PURSUED-88 CL**2 00282 ADD +1 TO MPRF-PURSUED-RPT-CNT. CL**2 00283 CL**2 00284 IF WRK-PURSUED-RPT-IND = MQTR-PURSUED-RPT-IND CL**2 00285 NEXT SENTENCE CL**2 00286 ELSE CL**2 00287 SET L530-UPDATE-88 TO TRUE CL**2 00288 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. CL**2 00289 CL**2 00290 IF (WRK-PURSUED-RPT-IND = 'N') CL**2 00291 AND CL**2 00292 (MQTR-RPT-IS-PURSUED-88) CL**2 00293 PERFORM S590-QTR-PURSUED THRU S590-EXIT. CL**2 00294 P1200-EXIT. CL**2 00295 EXIT. CL**2 00296 SKIP3 CL**2 00297 P1210-WRITE-OFF. CL**3 00298 IF (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88) CL**2 00299 AND CL**2 00300 (MQTR-YRQ NOT < LBCM-FIRST-PURSUED-RPT-YRQ) CL**2 00301 ADD +1 TO WRITTEN-OFF-PURSUED-RPT-CNT. CL**3 00302 CL**2 00303 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE. CL**2 00304 P1210-EXIT. CL**2 00305 EXIT. CL**2 00306 SKIP3 CL**2 00307 P1220-REVERSE. CL**2 00308 IF (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88) CL**2 00309 AND CL**2 00310 (MQTR-YRQ NOT < LBCM-FIRST-PURSUED-RPT-YRQ) CL**2 00311 SET MQTR-RPT-IS-PURSUED-88 TO TRUE CL**2 00312 ELSE CL**2 00313 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE. CL**2 00314 P1220-EXIT. CL**2 00315 EXIT. CL**2 00316 EJECT CL**2 00317 P2000-MDST-SCAN. CL**2 00318 MOVE MSKL-REC TO MDST-REC. CL**2 00319 CL**2 00320 IF MDST-CREDIT-REC-88 CL**2 00321 NEXT SENTENCE CL**2 00322 ELSE CL**2 00323 SET L910-NO-REC-88 TO TRUE CL**2 00324 GO TO P2000-EXIT. CL**2 00325 CL**2 00326 IF L530-WRITE-OFF-88 CL**3 00327 PERFORM P2100-WRITE-OFF THRU P2100-EXIT CL**3 00328 VARYING MDST-ACCT-IDX FROM 1 BY 1 CL**2 00329 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT CL**2 00330 ELSE CL**2 00331 PERFORM P2200-REVERSE THRU P2200-EXIT CL**2 00332 VARYING MDST-ACCT-IDX FROM 1 BY 1 CL**2 00333 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. CL**2 00334 CL**2 00335 *****PERFORM P2300-TOLERANCE THRU P2300-EXIT CL**3 00336 *********VARYING MDST-ACCT-IDX FROM 1 BY 1 CL**3 00337 *********UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. CL**3 00338 CL**2 00339 MOVE MDST-REC TO MSKL-REC. CL**2 00340 CL**2 00341 PERFORM S910-REWRITE THRU S910-EXIT. CL**2 00342 CL**2 00343 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**2 00344 P2000-EXIT. CL**2 00345 EXIT. CL**2 00346 SKIP3 CL**2 00347 P2100-WRITE-OFF. CL**3 00348 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) CL**2 00349 NEXT SENTENCE CL**2 00350 ELSE CL**2 00351 GO TO P2100-EXIT. CL**2 00352 CL**2 00353 ADD MDST-AMT (MDST-ACCT-IDX) TO WRITTEN-OFF-CREDIT-AMT. CL**3 00354 CL**2 00355 MOVE MDST-AMT (MDST-ACCT-IDX) TO L542-AMT. CL**2 00356 CL**3 00357 MOVE CACT-CR-WRITE-OFF TO L542-ACCT-IND. CL**3 00358 CL**3 00359 PERFORM S542-MODIFY-MDST THRU S542-EXIT. CL**2 00360 CL**2 00361 COMPUTE L542-AMT = L542-AMT * -1. CL**2 00362 CL**3 00363 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. CL**2 00364 CL**3 00365 PERFORM S542-MODIFY-MDST THRU S542-EXIT. CL**2 00366 CL**2 00367 SET L530-UPDATE-88 TO TRUE. CL**2 00368 CL**3 00369 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. CL**2 00370 CL**2 00371 SET MDST-ACCT-IDX TO MDST-ACCT-CNT. CL**2 00372 P2100-EXIT. CL**2 00373 EXIT. CL**2 00374 SKIP3 CL**2 00375 P2200-REVERSE. CL**2 00376 IF MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX) CL**3 00377 NEXT SENTENCE CL**2 00378 ELSE CL**2 00379 GO TO P2200-EXIT. CL**2 00380 CL**2 00381 MOVE MDST-AMT (MDST-ACCT-IDX) TO L542-AMT. CL**2 00382 CL**3 00383 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. CL**2 00384 CL**3 00385 PERFORM S542-MODIFY-MDST THRU S542-EXIT. CL**2 00386 CL**2 00387 COMPUTE L542-AMT = L542-AMT * -1. CL**2 00388 CL**3 00389 MOVE CACT-CR-WRITE-OFF TO L542-ACCT-IND. CL**3 00390 CL**3 00391 PERFORM S542-MODIFY-MDST THRU S542-EXIT. CL**2 00392 CL**2 00393 SET L530-UPDATE-88 TO TRUE. CL**2 00394 CL**3 00395 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. CL**2 00396 CL**2 00397 SET MDST-ACCT-IDX TO MDST-ACCT-CNT. CL**2 00398 P2200-EXIT. CL**2 00399 EXIT. CL**2 00400 SKIP3 CL**2 00401 *P2300-TOLERANCE. CL**2 00402 *****IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) CL**3 00403 *********NEXT SENTENCE CL**3 00404 *****ELSE CL**3 00405 *********GO TO P2300-EXIT. CL**3 00406 CL**3 00407 *****IF (MDST-AMT (MDST-ACCT-IDX) = +0) CL**3 00408 ***********OR CL**3 00409 ********(MDST-AMT (MDST-ACCT-IDX) > LBCM-CR-TOL-MAX) CL**3 00410 *********NEXT SENTENCE CL**3 00411 *****ELSE CL**3 00412 *********PERFORM S590-CR-TOL THRU S590-EXIT. CL**3 00413 *P2300-EXIT. CL**2 00414 *****EXIT. CL**3 00415 EJECT CL**2 00416 S541-MODIFY-AMT. CL**2 00417 MOVE LBCM-TRN-DOC-NO TO L541-TRN-DOC-NO. CL**2 00418 CL**2 00419 CALL 'DTSBU541' USING L541-LINK-AREA CL**3 00420 MPRF-REC CL**2 00421 MQTR-REC. CL**2 00422 S541-EXIT. CL**2 00423 EXIT. CL**2 00424 SKIP3 CL**2 00425 S542-MODIFY-MDST. CL**2 00426 MOVE LBCM-TRN-DOC-NO TO L542-TRN-DOC-NO. CL**2 00427 CL**2 00428 CALL 'DTSBU542' USING L542-LINK-AREA CL**3 00429 MPRF-REC CL**2 00430 MDST-REC. CL**2 00431 S542-EXIT. CL**2 00432 EXIT. CL**2 00433 SKIP3 CL**2 00434 S590-QTR-PURSUED. CL**2 00435 SET L590-QTR-PURSUED-88 TO TRUE. CL**2 00436 MOVE MQTR-YRQ TO L590-YRQ. CL**2 00437 MOVE WRK-NULL-DOC-NO TO L590-PAY-DOC-NO. CL**2 00438 GO TO S590-EMPLOYER-CLEANUP. CL**2 00439 CL**2 00440 S590-QTR-TOL. CL**2 00441 SET L590-QTR-TOL-88 TO TRUE. CL**2 00442 MOVE MQTR-YRQ TO L590-YRQ. CL**2 00443 MOVE WRK-NULL-DOC-NO TO L590-PAY-DOC-NO. CL**2 00444 GO TO S590-EMPLOYER-CLEANUP. CL**2 00445 CL**2 00446 *S590-CR-TOL. CL**2 00447 *****SET L590-CR-TOL-88 TO TRUE. CL**3 00448 *****MOVE +0 TO L590-YRQ. CL**3 00449 *****MOVE MDST-DOC-NO TO L590-PAY-DOC-NO. CL**3 00450 *****GO TO S590-EMPLOYER-CLEANUP. CL**3 00451 CL**2 00452 S590-EMPLOYER-CLEANUP. CL**2 00453 MOVE LBCM-TRN-DOC-NO TO L590-TOL-DOC-NO. CL**2 00454 CL**2 00455 CALL 'DTSBU590' USING L590-LINK-AREA CL**3 00456 LBCM-LINK-AREA CL**2 00457 MPRF-REC. CL**2 00458 S590-EXIT. CL**2 00459 EXIT. CL**2 00460 SKIP3 CL**2 00461 *S910-READ. CL**2 00462 *****SET L910-READ-88 TO TRUE. CL**2 00463 *****GO TO S910-MSTR-IO. CL**2 00464 CL**3 00465 S910-START-BROWSE. CL**2 00466 SET L910-START-BROWSE-88 TO TRUE. CL**2 00467 GO TO S910-MSTR-IO. CL**2 00468 CL**3 00469 S910-READ-NEXT. CL**2 00470 SET L910-READ-NEXT-88 TO TRUE. CL**2 00471 GO TO S910-MSTR-IO. CL**2 00472 CL**3 00473 *S910-COUNT. CL**2 00474 *****SET L910-COUNT-88 TO TRUE. CL**2 00475 *****GO TO S910-MSTR-IO. CL**2 00476 CL**3 00477 *S910-WRITE. CL**2 00478 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL**2 00479 *****SET L910-WRITE-88 TO TRUE. CL**2 00480 *****GO TO S910-MSTR-IO. CL**2 00481 CL**3 00482 S910-REWRITE. CL**2 00483 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL**2 00484 SET L910-REWRITE-88 TO TRUE. CL**2 00485 GO TO S910-MSTR-IO. CL**2 00486 CL**3 00487 *S910-DELETE. CL**2 00488 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL**2 00489 *****SET L910-DELETE-88 TO TRUE. CL**2 00490 *****GO TO S910-MSTR-IO. CL**2 00491 CL**3 00492 S910-MSTR-IO. CL**2 00493 CALL 'DTSBU910' USING L910-LINK-AREA CL**3 00494 MSKL-REC. CL**2 00495 S910-EXIT. CL**2 00496 EXIT. CL**2 00497 SKIP3 CL**2 00498 S999-ABEND. CL**2 00499 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**3 00500 S999-EXIT. CL**2 00501 EXIT. CL**2