00001 IDENTIFICATION DIVISION. 04/11/13 00002 PROGRAM-ID. DTSBU542. DTSBU542 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008 00004 DATE-WRITTEN. JULY 1994. DTSBU542 00005 DATE-COMPILED. DTSBU542 00006 SKIP3 DTSBU542 00007 ***** DTSBU542 00008 * DTSBU542 00009 * FUNCTION: MODIFY A DISTRIBUTION OCCURRENCE IN A DTSBU542 00010 * PAYMENT DISTRIBUTION (MDST) RECORD. DTSBU542 00011 * DTSBU542 00012 * DTSBU542 00013 * MODIFICATION LOG: DTSBU542 00014 * DTSBU542 00015 * 12/13/1998 REVIEWED AND MODIFIED FOR DC. DTSBU542 00016 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU542 00017 * DTSBU542 00018 * 04/05/2013 MODIFIED TO WRITE A FLAT FILE WITH AN AUDIT DTSBU542 00019 * TRAIL OF CHANGES TO PAYMENT DISTRIBUTIONS. DTSBU542 00020 * REFERENCE: TICKET 1587 PROGRAMMER: GD DTSBU542 00021 * DTSBU542 00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU542 00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU542 00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU542 00025 * DTSBU542 00026 * DTSBU542 00027 * DESCRIPTION: DTSBU542 00028 * DTSBU542 00029 * DTSBU542 00030 * MASTER FILE RECORDS READ: DTSBU542 00031 * DTSBU542 00032 * NONE DTSBU542 00033 * DTSBU542 00034 * DTSBU542 00035 * MASTER FILE RECORDS UPDATED: DTSBU542 00036 * DTSBU542 00037 * NONE DTSBU542 00038 * DTSBU542 00039 * DTSBU542 00040 * REPORT RECORDS WRITTEN: DTSBU542 00041 * DTSBU542 00042 * NONE. DTSBU542 00043 * DTSBU542 00044 * DTSBU542 00045 * MODULES CALLED: DTSBU542 00046 * DTSBU542 00047 * DTSBU549 JOURNALING/BATCH DETAIL LISTING. DTSBU542 00048 * DTSBU542 00049 * DTSBU542 00050 ***** DTSBU542 00051 SKIP3 DTSBU542 00052 ENVIRONMENT DIVISION. DTSBU542 00053 INPUT-OUTPUT SECTION. DTSBU542 00054 DTSBU542 00055 FILE-CONTROL. DTSBU542 00056 DTSBU542 00057 SELECT DST-AUDIT-FILE ASSIGN TO DSTAUDIT DTSBU542 00058 FILE STATUS IS DST-AUDIT-STATUS. DTSBU542 00059 EJECT DTSBU542 00060 DATA DIVISION. DTSBU542 00061 FILE SECTION. DTSBU542 00062 DTSBU542 00063 FD DST-AUDIT-FILE DTSBU542 00064 RECORDING MODE IS F DTSBU542 00065 BLOCK CONTAINS 0 RECORDS DTSBU542 00066 LABEL RECORDS ARE OMITTED. DTSBU542 00067 DTSBU542 00068 01 DST-AUDIT-REC PIC X(94). DTSBU542 00069 SKIP3 DTSBU542 00070 WORKING-STORAGE SECTION. DTSBU542 000705 77 PAN-VALET PICTURE X(24) VALUE '008DTSBU542 04/11/13'. DTSBU542 00071 77 PAN-VALET PICTURE X(24) VALUE '013DTSBU542 04/05/13'. DTSBU542 00072 77 PAN-VALET PICTURE X(24) VALUE '006DTSBU542 12/13/98'. DTSBU542 00073 SKIP3 DTSBU542 00074 01 WRK-AREA. DTSBU542 00075 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +542.DTSBU542 00076 DTSBU542 00077 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU542 00078 DTSBU542 00079 05 DST-AUDIT-STATUS PIC X(02). DTSBU542 00080 88 DST-AUDIT-OK-88 VALUE '00'. DTSBU542 00081 DTSBU542 00082 05 ACCT-SUB1 PIC S9(04) COMP. DTSBU542 00083 DTSBU542 00084 05 WRK-ACCT-GROUP. DTSBU542 00085 10 WRK-CR-AVAIL-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00086 10 WRK-CR-TOL-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00087 10 WRK-CR-WRITTEN-OFF-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00088 10 WRK-UI-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00089 10 WRK-SUR-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00090 10 WRK-INT-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00091 10 WRK-LATE-PEN-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00092 10 WRK-NSF-PEN-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00093 10 WRK-MISC-PEN-AMT PIC S9(09)V9(02) COMP-3. DTSBU542 00094 DTSBU542 00095 05 WRK-SEQUENCE PIC S9(07) COMP-3 DTSBU542 00096 VALUE +0. DTSBU542 00097 DTSBU542 00098 05 WRK-DOC-NO. DTSBU542 00099 20 WRK-BATCH-NO PIC S9(05) COMP-3. DTSBU542 00100 20 WRK-ITEM-NO PIC S9(03) COMP-3. DTSBU542 00101 DTSBU542 00102 01 L001-LINK-AREA. DTSBU542 00103 ++INCLUDE DTSIL001 DTSBU542 00104 DTSBU542 00105 01 L004-LINK-AREA. DTSBU542 00106 ++INCLUDE DTSIL004 DTSBU542 00107 DTSBU542 00108 01 L005-LINK-AREA. DTSBU542 00109 ++INCLUDE DTSIL005 DTSBU542 00110 DTSBU542 00111 01 L549-LINK-AREA. DTSBU542 00112 ++INCLUDE DTSIL549 DTSBU542 00113 DTSBU542 00114 01 CACT-LITERALS. DTSBU542 00115 ++INCLUDE DTSICACT DTSBU542 00116 DTSBU542 00117 01 MMAX-LITERALS. DTSBU542 00118 ++INCLUDE DTSIMMAX DTSBU542 00119 DTSBU542 00120 01 X156-REC. DTSBU542 00121 ++INCLUDE DTSIX156 DTSBU542 00122 DTSBU542 00123 LINKAGE SECTION. DTSBU542 00124 DTSBU542 00125 01 L542-LINK-AREA. DTSBU542 00126 ++INCLUDE DTSIL542 DTSBU542 00127 DTSBU542 00128 01 MPRF-REC. DTSBU542 00129 ++INCLUDE DTSIMPRF DTSBU542 00130 DTSBU542 00131 01 MDST-REC. DTSBU542 00132 ++INCLUDE DTSIMDST DTSBU542 00133 DTSBU542 00134 PROCEDURE DIVISION USING L542-LINK-AREA DTSBU542 00135 MPRF-REC DTSBU542 00136 MDST-REC. DTSBU542 00137 DTSBU542 00138 DTSBU542 00139 IF FIRST-TIME-IND = 'Y' DTSBU542 00140 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBU542 00141 MOVE 'N' TO FIRST-TIME-IND. DTSBU542 00142 DTSBU542 00143 DTSBU542 00144 IF L542-AMT NOT = 0 DTSBU542 00145 PERFORM P1000-APPLY-AMT THRU P1000-EXIT. DTSBU542 00146 DTSBU542 00147 DTSBU542 00148 PERFORM P2000-REORG-ACCT-AREA THRU P2000-EXIT. DTSBU542 00149 DTSBU542 00150 DTSBU542 00151 GOBACK. DTSBU542 00152 EJECT DTSBU542 00153 I0000-INITIATE. DTSBU542 00154 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBU542 00155 DTSBU542 00156 OPEN OUTPUT DST-AUDIT-FILE. DTSBU542 00157 IF DST-AUDIT-OK-88 DTSBU542 00158 NEXT SENTENCE DTSBU542 00159 ELSE DTSBU542 00160 DISPLAY 'CANNOT OPEN DST AUDIT FILE ' DTSBU542 00161 DST-AUDIT-STATUS DTSBU542 00162 PERFORM S999-ABEND THRU S999-EXIT DTSBU542 00163 END-IF. DTSBU542 00164 DTSBU542 00165 I0000-EXIT. DTSBU542 00166 EXIT. DTSBU542 00167 EJECT DTSBU542 00168 P1000-APPLY-AMT. DTSBU542 00169 MOVE +0 TO ACCT-SUB1. DTSBU542 00170 DTSBU542 00171 PERFORM P1100-ACCT-SCAN THRU P1100-EXIT DTSBU542 00172 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU542 00173 UNTIL (MDST-ACCT-IDX > MDST-ACCT-CNT) DTSBU542 00174 OR DTSBU542 00175 (ACCT-SUB1 NOT = +0). DTSBU542 00176 DTSBU542 00177 IF ACCT-SUB1 = +0 DTSBU542 00178 IF MDST-ACCT-CNT < MMAX-DST-ACCT-MAX DTSBU542 00179 ADD +1 TO MDST-ACCT-CNT DTSBU542 00180 MOVE MDST-ACCT-CNT TO ACCT-SUB1 DTSBU542 00181 MOVE +0 TO MDST-AMT (ACCT-SUB1) DTSBU542 00182 MOVE L542-ACCT-IND TO MDST-ACCT-IND (ACCT-SUB1) DTSBU542 00183 IF L542-ACCT-IND = CACT-ACCT-CREDIT DTSBU542 00184 PERFORM S999-ABEND THRU S999-EXIT DTSBU542 00185 ELSE DTSBU542 00186 NEXT SENTENCE DTSBU542 00187 ELSE DTSBU542 00188 PERFORM S999-ABEND THRU S999-EXIT. DTSBU542 00189 DTSBU542 00190 ADD L542-AMT TO MDST-AMT (ACCT-SUB1). DTSBU542 00191 DTSBU542 00192 IF MDST-AMT (ACCT-SUB1) < +0 DTSBU542 00193 PERFORM S999-ABEND THRU S999-EXIT. DTSBU542 00194 DTSBU542 00195 IF L542-ACCT-IND = CACT-CR-AVAIL OR CACT-CR-TOLER DTSBU542 00196 OR CACT-CR-WRITE-OFF DTSBU542 00197 PERFORM P1200-CREDIT THRU P1200-EXIT DTSBU542 00198 END-IF. DTSBU542 00199 DTSBU542 00200 PERFORM S1000-WRITE-DST-REC THRU S1000-EXIT. DTSBU542 00201 DTSBU542 00202 P1000-EXIT. DTSBU542 00203 EXIT. DTSBU542 00204 SKIP3 DTSBU542 00205 P1100-ACCT-SCAN. DTSBU542 00206 IF MDST-ACCT-IND (MDST-ACCT-IDX) = L542-ACCT-IND DTSBU542 00207 SET ACCT-SUB1 TO MDST-ACCT-IDX. DTSBU542 00208 P1100-EXIT. DTSBU542 00209 EXIT. DTSBU542 00210 SKIP3 DTSBU542 00211 P1200-CREDIT. DTSBU542 00212 IF MDST-CREDIT-REC-88 DTSBU542 00213 NEXT SENTENCE DTSBU542 00214 ELSE DTSBU542 00215 PERFORM S999-ABEND THRU S999-EXIT. DTSBU542 00216 DTSBU542 00217 IF L542-ACCT-IND = CACT-CR-AVAIL DTSBU542 00218 ADD L542-AMT TO MPRF-TOT-CREDIT-AMT DTSBU542 00219 IF MPRF-TOT-CREDIT-AMT < +0 DTSBU542 00220 PERFORM S999-ABEND THRU S999-EXIT. DTSBU542 00221 DTSBU542 00222 MOVE MDST-YRQ TO L549-DELTA-YRQ. DTSBU542 00223 DTSBU542 00224 MOVE CACT-ACCT-CREDIT TO L549-DELTA-ACCT-IND. DTSBU542 00225 DTSBU542 00226 IF L542-ACCT-IND = CACT-CR-AVAIL DTSBU542 00227 MOVE CACT-CAT-PAID TO L549-DELTA-CAT-IND DTSBU542 00228 ELSE DTSBU542 00229 IF L542-ACCT-IND = CACT-CR-TOLER DTSBU542 00230 MOVE CACT-CAT-TOLER TO L549-DELTA-CAT-IND DTSBU542 00231 ELSE DTSBU542 00232 IF L542-ACCT-IND = CACT-CR-WRITE-OFF DTSBU542 00233 MOVE CACT-CAT-WRITTEN-OFF TO L549-DELTA-CAT-IND DTSBU542 00234 ELSE DTSBU542 00235 PERFORM S999-ABEND THRU S999-EXIT. DTSBU542 00236 DTSBU542 00237 MOVE L542-AMT TO L549-DELTA-AMT. DTSBU542 00238 DTSBU542 00239 PERFORM S549-MJRN-TABLE THRU S549-EXIT. DTSBU542 00240 P1200-EXIT. DTSBU542 00241 EXIT. DTSBU542 00242 EJECT DTSBU542 00243 P2000-REORG-ACCT-AREA. DTSBU542 00244 MOVE +0 TO WRK-CR-AVAIL-AMT DTSBU542 00245 WRK-CR-TOL-AMT DTSBU542 00246 WRK-CR-WRITTEN-OFF-AMT DTSBU542 00247 WRK-UI-AMT DTSBU542 00248 WRK-SUR-AMT DTSBU542 00249 WRK-INT-AMT DTSBU542 00250 WRK-LATE-PEN-AMT DTSBU542 00251 WRK-NSF-PEN-AMT DTSBU542 00252 WRK-MISC-PEN-AMT. DTSBU542 00253 DTSBU542 00254 PERFORM P2100-ACCT-LOOP THRU P2100-EXIT DTSBU542 00255 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU542 00256 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBU542 00257 DTSBU542 00258 MOVE +0 TO MDST-ACCT-CNT. DTSBU542 00259 DTSBU542 00260 IF WRK-UI-AMT = +0 DTSBU542 00261 NEXT SENTENCE DTSBU542 00262 ELSE DTSBU542 00263 ADD +1 TO MDST-ACCT-CNT DTSBU542 00264 SET MDST-ACCT-UI-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00265 MOVE WRK-UI-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00266 DTSBU542 00267 IF WRK-SUR-AMT = +0 DTSBU542 00268 NEXT SENTENCE DTSBU542 00269 ELSE DTSBU542 00270 ADD +1 TO MDST-ACCT-CNT DTSBU542 00271 SET MDST-ACCT-SUR-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00272 MOVE WRK-SUR-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00273 DTSBU542 00274 IF WRK-INT-AMT = +0 DTSBU542 00275 NEXT SENTENCE DTSBU542 00276 ELSE DTSBU542 00277 ADD +1 TO MDST-ACCT-CNT DTSBU542 00278 SET MDST-ACCT-INT-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00279 MOVE WRK-INT-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00280 DTSBU542 00281 IF WRK-LATE-PEN-AMT = +0 DTSBU542 00282 NEXT SENTENCE DTSBU542 00283 ELSE DTSBU542 00284 ADD +1 TO MDST-ACCT-CNT DTSBU542 00285 SET MDST-ACCT-LATE-PEN-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00286 MOVE WRK-LATE-PEN-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00287 DTSBU542 00288 IF WRK-NSF-PEN-AMT = +0 DTSBU542 00289 NEXT SENTENCE DTSBU542 00290 ELSE DTSBU542 00291 ADD +1 TO MDST-ACCT-CNT DTSBU542 00292 SET MDST-ACCT-NSF-PEN-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00293 MOVE WRK-NSF-PEN-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00294 DTSBU542 00295 IF WRK-MISC-PEN-AMT = +0 DTSBU542 00296 NEXT SENTENCE DTSBU542 00297 ELSE DTSBU542 00298 ADD +1 TO MDST-ACCT-CNT DTSBU542 00299 SET MDST-ACCT-MISC-PEN-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00300 MOVE WRK-MISC-PEN-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00301 DTSBU542 00302 IF WRK-CR-AVAIL-AMT = +0 DTSBU542 00303 NEXT SENTENCE DTSBU542 00304 ELSE DTSBU542 00305 ADD +1 TO MDST-ACCT-CNT DTSBU542 00306 SET MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00307 MOVE WRK-CR-AVAIL-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00308 DTSBU542 00309 IF WRK-CR-TOL-AMT = +0 DTSBU542 00310 NEXT SENTENCE DTSBU542 00311 ELSE DTSBU542 00312 ADD +1 TO MDST-ACCT-CNT DTSBU542 00313 SET MDST-ACCT-CR-TOL-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00314 MOVE WRK-CR-TOL-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00315 DTSBU542 00316 IF WRK-CR-WRITTEN-OFF-AMT = +0 DTSBU542 00317 NEXT SENTENCE DTSBU542 00318 ELSE DTSBU542 00319 ADD +1 TO MDST-ACCT-CNT DTSBU542 00320 SET MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-CNT) TO TRUE DTSBU542 00321 MOVE WRK-CR-WRITTEN-OFF-AMT TO MDST-AMT (MDST-ACCT-CNT). DTSBU542 00322 P2000-EXIT. DTSBU542 00323 EXIT. DTSBU542 00324 SKIP3 DTSBU542 00325 P2100-ACCT-LOOP. DTSBU542 00326 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBU542 00327 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-UI-AMT DTSBU542 00328 ELSE DTSBU542 00329 IF MDST-ACCT-SUR-88 (MDST-ACCT-IDX) DTSBU542 00330 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-SUR-AMT DTSBU542 00331 ELSE DTSBU542 00332 IF MDST-ACCT-INT-88 (MDST-ACCT-IDX) DTSBU542 00333 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-INT-AMT DTSBU542 00334 ELSE DTSBU542 00335 IF MDST-ACCT-LATE-PEN-88 (MDST-ACCT-IDX) DTSBU542 00336 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-LATE-PEN-AMT DTSBU542 00337 ELSE DTSBU542 00338 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBU542 00339 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-CR-AVAIL-AMT DTSBU542 00340 ELSE DTSBU542 00341 IF MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSBU542 00342 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-CR-TOL-AMT DTSBU542 00343 ELSE DTSBU542 00344 IF MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX) DTSBU542 00345 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-CR-WRITTEN-OFF-AMT DTSBU542 00346 ELSE DTSBU542 00347 IF MDST-ACCT-NSF-PEN-88 (MDST-ACCT-IDX) DTSBU542 00348 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-NSF-PEN-AMT DTSBU542 00349 ELSE DTSBU542 00350 IF MDST-ACCT-MISC-PEN-88 (MDST-ACCT-IDX) DTSBU542 00351 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-MISC-PEN-AMT DTSBU542 00352 ELSE DTSBU542 00353 PERFORM S999-ABEND THRU S999-EXIT. DTSBU542 00354 P2100-EXIT. DTSBU542 00355 EXIT. DTSBU542 00356 DTSBU542 00357 S001-FROM-FED-8. DTSBU542 00358 SET L001-FROM-FED-8 TO TRUE. DTSBU542 00359 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBU542 00360 S001-EXIT. DTSBU542 00361 EXIT. DTSBU542 00362 DTSBU542 00363 S004-FROM-5. DTSBU542 00364 SET L004-FROM-5 TO TRUE. DTSBU542 00365 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU542 00366 S004-EXIT. DTSBU542 00367 EXIT. DTSBU542 00368 DTSBU542 00369 S005-FROM-SYS. DTSBU542 00370 SET L005-FROM-SYS TO TRUE. DTSBU542 00371 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBU542 00372 DTSBU542 00373 S005-EXIT. DTSBU542 00374 EXIT. DTSBU542 00375 DTSBU542 00376 S549-MJRN-TABLE. DTSBU542 00377 SET L549-DELTA-88 TO TRUE. DTSBU542 00378 DTSBU542 00379 MOVE L542-TRN-DOC-NO TO L549-TRN-DOC-NO. DTSBU542 00380 DTSBU542 00381 CALL 'DTSBU549' USING L549-LINK-AREA. DTSBU542 00382 S549-EXIT. DTSBU542 00383 EXIT. DTSBU542 00384 DTSBU542 00385 S1000-WRITE-DST-REC. DTSBU542 00386 IF L542-CALLED-BY = 'DTSBU590' DTSBU542 00387 GO TO S1000-EXIT DTSBU542 00388 END-IF. DTSBU542 00389 DTSBU542 00390 MOVE MDST-EMP-NO TO X156-EMP-NO. DTSBU542 00391 DTSBU542 00392 MOVE MDST-YRQ TO L004-QTR-5-9. DTSBU542 00393 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBU542 00394 IF L004-VALID-QTR DTSBU542 00395 MOVE L004-SLASH-5-QTR TO X156-QUARTER DTSBU542 00396 ELSE DTSBU542 00397 MOVE SPACES TO X156-QUARTER DTSBU542 00398 END-IF. DTSBU542 00399 DTSBU542 00400 MOVE L542-TRN-DOC-NO TO WRK-DOC-NO. DTSBU542 00401 MOVE WRK-BATCH-NO TO X156-SRC-BATCH-NO. DTSBU542 00402 MOVE WRK-ITEM-NO TO X156-SRC-ITEM-NO. DTSBU542 00403 MOVE MDST-BATCH-NO TO X156-DST-BATCH-NO. DTSBU542 00404 MOVE MDST-ITEM-NO TO X156-DST-ITEM-NO. DTSBU542 00405 MOVE L542-ACCT-IND TO X156-ACCOUNT. DTSBU542 00406 MOVE L542-AMT TO X156-AMOUNT. DTSBU542 00407 DTSBU542 00408 MOVE MDST-CHNG-DATE TO L001-FED-8-DATE-9. DTSBU542 00409 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU542 00410 IF L001-VALID-DATE DTSBU542 00411 MOVE L001-SLASH-8-DATE TO X156-MDST-DATE DTSBU542 00412 ELSE DTSBU542 00413 MOVE MDST-ESTB-DATE TO L001-FED-8-DATE-9 DTSBU542 00414 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBU542 00415 IF L001-VALID-DATE DTSBU542 00416 MOVE L001-SLASH-8-DATE TO X156-MDST-DATE DTSBU542 00417 ELSE DTSBU542 00418 MOVE SPACES TO X156-MDST-DATE DTSBU542 00419 END-IF DTSBU542 00420 END-IF. DTSBU542 00421 DTSBU542 00422 MOVE L005-DATE TO L001-FED-8-DATE-9. DTSBU542 00423 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU542 00424 MOVE L001-SLASH-8-DATE TO X156-CURR-DATE. DTSBU542 00425 DTSBU542 00426 MOVE L542-CALLED-BY TO X156-CALLED-BY. DTSBU542 00427 DTSBU542 00428 ADD +1 TO WRK-SEQUENCE. DTSBU542 00429 MOVE WRK-SEQUENCE TO X156-SEQUENCE. DTSBU542 00430 DTSBU542 00431 WRITE DST-AUDIT-REC FROM X156-REC. DTSBU542 00432 IF NOT DST-AUDIT-OK-88 DTSBU542 00433 DISPLAY 'CANNOT WRITE DST-AUDIT FILE: ' DTSBU542 00434 DST-AUDIT-STATUS ' ' MDST-EMP-NO DTSBU542 00435 PERFORM S999-ABEND THRU S999-EXIT DTSBU542 00436 END-IF. DTSBU542 00437 DTSBU542 00438 S1000-EXIT. DTSBU542 00439 EXIT. DTSBU542 00440 DTSBU542 00441 S999-ABEND. DTSBU542 00442 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU542 00443 S999-EXIT. DTSBU542 00444 EXIT. DTSBU542