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
