00001  IDENTIFICATION DIVISION.                                         09/25/13
00002  PROGRAM-ID.             DTSBE305.                                DTSBE305
00003  AUTHOR.                 TRW S&ITG.                                  LV014
00004  DATE-WRITTEN.           JANUARY 1999.                            DTSBE305
00005  DATE-COMPILED.                                                   DTSBE305
00006      SKIP3                                                        DTSBE305
00007 *****                                                             DTSBE305
00008 *                                                                 DTSBE305
00009 *    >>> SPECIAL VERSION FOR AUDIT  <<<                           DTSBE305
00010 *                                                                 DTSBE305
00011 *    CALLING SEQUENCE:  DTSBE305 CREATES DTSIR305 RECORDS.        DTSBE305
00012 *                       DTSBD800 CALLS DTSBR305                   DTSBE305
00013 *                                WHICH PRODUCES THE TRIAL BALANCE.DTSBE305
00014 *                                                                 DTSBE305
00015 *    FUNCTION:  TRIAL BALANCE EXTRACT.                            DTSBE305
00016 *                                                                 DTSBE305
00017 *                                                                 DTSBE305
00018 *    MODIFICATION LOG:                                            DTSBE305
00019 *                                                                 DTSBE305
00020 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE305
00021 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE305
00022 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBE305
00023 *                                                                 DTSBE305
00024 *                                                                 DTSBE305
00025 *  DESCRIPTION:                                                   DTSBE305
00026 *                                                                 DTSBE305
00027 *                                                                 DTSBE305
00028 *    INITIATION:                                                  DTSBE305
00029 *                                                                 DTSBE305
00030 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE305
00031 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE305
00032 *                                                                 DTSBE305
00033 *      NO PARAMETERS ARE INPUT.                                   DTSBE305
00034 *                                                                 DTSBE305
00035 *      INITIALIZE WRK-ACCT-TABLE.                                 DTSBE305
00036 *                                                                 DTSBE305
00037 *                                                                 DTSBE305
00038 *    PROCESSING:                                                  DTSBE305
00039 *                                                                 DTSBE305
00040 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (305R1).       DTSBE305
00041 *                                                                 DTSBE305
00042 *      SCAN MQTR RECORDS.  LOGIC WILL BE MUCH LIKE VERMONT.       DTSBE305
00043 *                                                                 DTSBE305
00044 *      DO NOT USE MPRF-TOT-CREDIT-AMT.  RATHER,                   DTSBE305
00045 *      SCAN THE MDST-CREDIT-REC-88 MDST RECORDS.  ACCUMULATE      DTSBE305
00046 *      "CREDIT" (WRK-ACCT-LINE OCCURRENCE 8) WRK-PAID-AMT,        DTSBE305
00047 *      WRK-WRITTEN-OFF-AMT AND WRK-TOLER-AMT FIELDS.              DTSBE305
00048 *                                                                 DTSBE305
00049 *                                                                 DTSBE305
00050 *    TERMINATION:                                                 DTSBE305
00051 *                                                                 DTSBE305
00052 *      USING THE INFOMATION ACCUMULATED IN WRK-ACCT-TABLE,        DTSBE305
00053 *      CONSTRUCT AND WRITE THE R305 RECORDS.  WRITE A RECORD      DTSBE305
00054 *      FOR EVERY WRK-ACCT-LINE OCCURRENCE IN THE TABLE (EVEN      DTSBE305
00055 *      IF ALL AMOUNTS IN A WRK-ACCT-LINE OCCURRENCE) ARE EQUAL    DTSBE305
00056 *      TO ZERO.                                                   DTSBE305
00057 *                                                                 DTSBE305
00058 *      MOVE LECM-PRIOR-RUN-DATE TO R305-LAST-ACCT-UPDATE-DATE.    DTSBE305
00059 *                                                                 DTSBE305
00060 *      ON THE CREDIT WRK-ACCT-LINE OCCURRENCE COMPUTE WRK-WRITTEN-DTSBE305
00061 *      = WRK-WRITTEN-OFF-AMT * -1 AND COMPUTE WRK-TOLER-AMT =     DTSBE305
00062 *      WRK-TOLER-AMT * -1.                                        DTSBE305
00063 *                                                                 DTSBE305
00064 *      R305-BALANCE-AMT = R305-CHARGED-AMT - R305-PAID-AMT        DTSBE305
00065 *        R305-WAIVED-AMT - R305-WRITTEN-OFF-AMT - R305-TOLER-AMT. DTSBE305
00066 *                                                                 DTSBE305
00067 *                                                                 DTSBE305
00068 *    RECORDS READ:                                                DTSBE305
00069 *                                                                 DTSBE305
00070 *      MASTER:                                                    DTSBE305
00071 *                                                                 DTSBE305
00072 *        MQTR                                                     DTSBE305
00073 *        MDST                                                     DTSBE305
00074 *                                                                 DTSBE305
00075 *                                                                 DTSBE305
00076 *      ALTERNATE INDEX:                                           DTSBE305
00077 *                                                                 DTSBE305
00078 *        NONE.                                                    DTSBE305
00079 *                                                                 DTSBE305
00080 *                                                                 DTSBE305
00081 *      REFERENCE:                                                 DTSBE305
00082 *                                                                 DTSBE305
00083 *        NONE.                                                    DTSBE305
00084 *                                                                 DTSBE305
00085 *                                                                 DTSBE305
00086 *    RECORDS UPDATED:                                             DTSBE305
00087 *                                                                 DTSBE305
00088 *        NONE.                                                    DTSBE305
00089 *                                                                 DTSBE305
00090 *                                                                 DTSBE305
00091 *    REPORT RECORDS WRITTEN:                                      DTSBE305
00092 *                                                                 DTSBE305
00093 *        R305  TRIAL BALANCE.                                     DTSBE305
00094 *                                                                 DTSBE305
00095 *                                                                 DTSBE305
00096 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE305
00097 *                                                                 DTSBE305
00098 *        NONE.                                                    DTSBE305
00099 *                                                                 DTSBE305
00100 *                                                                 DTSBE305
00101 *    MODULES CALLED:                                              DTSBE305
00102 *                                                                 DTSBE305
00103 *        DTSBU910  MASTER FILE I/O.                               DTSBE305
00104 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE305
00105 *                                                                 DTSBE305
00106 *                                                                 DTSBE305
00107 *    VERMONT REFERENCE:                                           DTSBE305
00108 *                                                                 DTSBE305
00109 *        TXBE331                                                  DTSBE305
00110 *                                                                 DTSBE305
00111 *****                                                             DTSBE305
00112      SKIP3                                                        DTSBE305
00113  ENVIRONMENT DIVISION.                                            DTSBE305
00114                                                                   DTSBE305
00115  INPUT-OUTPUT SECTION.                                            DTSBE305
00116                                                                   DTSBE305
00117  FILE-CONTROL.                                                    DTSBE305
00118                                                                   DTSBE305
00119      SELECT RCVBL-FILE       ASSIGN TO DTSFRCVB                   DTSBE305
00120         FILE STATUS IS RCVBL-STATUS.                              DTSBE305
00121                                                                   DTSBE305
00122  DATA DIVISION.                                                   DTSBE305
00123                                                                   DTSBE305
00124  FILE SECTION.                                                    DTSBE305
00125                                                                   DTSBE305
00126  FD  RCVBL-FILE                                                   DTSBE305
00127      RECORDING MODE IS F                                          DTSBE305
00128      BLOCK CONTAINS 0 RECORDS                                     DTSBE305
00129      LABEL RECORDS ARE OMITTED.                                   DTSBE305
00130                                                                   DTSBE305
00131  01  RCVBL-REC                       PIC X(33).                   DTSBE305
00132                                                                   DTSBE305
00133  WORKING-STORAGE SECTION.                                         DTSBE305
001335 77  PAN-VALET PICTURE X(24) VALUE '014DTSBE305  09/25/13'.       DTSBE305
00134  77  PAN-VALET PICTURE X(24) VALUE '010DTSBE305  09/20/13'.       DTSBE305
00135  77  PAN-VALET PICTURE X(24) VALUE '012DTSBE305  01/05/99'.       DTSBE305
00136      SKIP3                                                        DTSBE305
00137  01  WRK-AREA.                                                    DTSBE305
00138      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +305.DTSBE305
00139      SKIP1                                                        DTSBE305
00140      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE305'.DTSBE305
00141      SKIP3                                                        DTSBE305
00142      05  ABEND-MSG                       PIC  X(60).              DTSBE305
00143      SKIP3                                                        DTSBE305
00144      05  WRK-MQTR-ACCT-IND               PIC  X(02).              DTSBE305
00145      EJECT                                                        DTSBE305
00146  01  WRK-ACCT-VALUES.                                             DTSBE305
00147      05  WRK-CLASS-MAX               PIC S9(04)  COMP  VALUE +3.  DTSBE305
00148                                                                   DTSBE305
00149      05  WRK-ACCT-MAX                PIC S9(04)  COMP  VALUE +7.  DTSBE305
00150                                                                   DTSBE305
00151      05  WRK-ACCT-MAX-MINUS-1        PIC S9(04)  COMP  VALUE +6.  DTSBE305
00152                                                                   DTSBE305
00153      05  WRK-CLASS-SUB               PIC S9(04)  COMP.            DTSBE305
00154                                                                   DTSBE305
00155      05  WRK-ACCT-SUB                PIC S9(04)  COMP.            DTSBE305
00156      SKIP3                                                        DTSBE305
00157  01  WRK-ACCT-TABLE.                                              DTSBE305
00158      05  WRK-EMP-CLASS OCCURS 3 TIMES                             DTSBE305
00159                        INDEXED BY WRK-CLASS-IDX.                  DTSBE305
00160          10  WRK-ACCT-LINE OCCURS 7 TIMES                         DTSBE305
00161                            INDEXED BY WRK-ACCT-IDX.               DTSBE305
00162              15  WRK-CHARGED-AMT     PIC S9(11)V9(02)  COMP-3.    DTSBE305
00163              15  WRK-PAID-AMT        PIC S9(11)V9(02)  COMP-3.    DTSBE305
00164              15  WRK-WAIVED-AMT      PIC S9(11)V9(02)  COMP-3.    DTSBE305
00165              15  WRK-WRITTEN-OFF-AMT PIC S9(11)V9(02)  COMP-3.    DTSBE305
00166              15  WRK-TOLER-AMT       PIC S9(11)V9(02)  COMP-3.    DTSBE305
00167                                                                   DTSBE305
00168  01  WRK-OUTPUT-FILE-AREA.                                        DTSBE305
00169      05  RCVBL-STATUS            PIC  X(02).                      DTSBE305
00170          88 RCVBL-STATUS-OK-88       VALUE '00'.                  DTSBE305
00171                                                                   DTSBE305
00172      05  WRK-BALANCE                 PIC S9(11)V9(02)  COMP-3.    DTSBE305
00173      05  WRK-RCVBL-CNT               PIC S9(11)        COMP-3     DTSBE305
00174                                        VALUE +0.                  DTSBE305
00175      05  WRK-RCVBL-REC.                                           DTSBE305
00176          10  RCVBL-EMP-NBR           PIC 9(06).                   DTSBE305
00177          10  FILLER                  PIC X(01) VALUE ';'.         DTSBE305
00178          10  RCVBL-EMP-CLASS         PIC X(01).                   DTSBE305
00179          10  FILLER                  PIC X(01) VALUE ';'.         DTSBE305
00180          10  RCVBL-QTR               PIC X(06).                   DTSBE305
00181          10  FILLER                  PIC X(01) VALUE ';'.         DTSBE305
00182          10  RCVBL-ACCT              PIC X(02).                   DTSBE305
00183          10  FILLER                  PIC X(01) VALUE ';'.         DTSBE305
00184          10  RCVBL-AMT               PIC ----------9.99.          DTSBE305
00185                                                                   DTSBE305
00186  01  L004-LINK-AREA.                                              DTSBE305
00187  ++INCLUDE DTSIL004                                               DTSBE305
00188                                                                   DTSBE305
00189  01  L910-LINK-AREA.                                              DTSBE305
00190  ++INCLUDE DTSIL910                                               DTSBE305
00191      SKIP3                                                        DTSBE305
00192  01  MSKL-REC.                                                    DTSBE305
00193  ++INCLUDE DTSIMSKL                                               DTSBE305
00194      SKIP3                                                        DTSBE305
00195  01  MQTR-REC.                                                    DTSBE305
00196  ++INCLUDE DTSIMQTR                                               DTSBE305
00197      SKIP3                                                        DTSBE305
00198  01  MDST-REC.                                                    DTSBE305
00199  ++INCLUDE DTSIMDST                                               DTSBE305
00200      EJECT                                                        DTSBE305
00201  01  R305-REC.                                                    DTSBE305
00202  ++INCLUDE DTSIR305                                               DTSBE305
00203      EJECT                                                        DTSBE305
00204  01  CACT-REC.                                                    DTSBE305
00205  ++INCLUDE DTSICACT                                               DTSBE305
00206      EJECT                                                        DTSBE305
00207  LINKAGE SECTION.                                                 DTSBE305
00208      SKIP3                                                        DTSBE305
00209  01  LECM-LINK-AREA.                                              DTSBE305
00210  ++INCLUDE DTSILECM                                               DTSBE305
00211      EJECT                                                        DTSBE305
00212  01  MPRF-LINK-REC.                                               DTSBE305
00213  ++INCLUDE DTSIMPRF                                               DTSBE305
00214      EJECT                                                        DTSBE305
00215  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE305
00216                           MPRF-LINK-REC.                          DTSBE305
00217      SKIP2                                                        DTSBE305
00218      IF LECM-PROCESS-88                                           DTSBE305
00219          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE305
00220      ELSE                                                         DTSBE305
00221      IF LECM-INITIALIZE-88                                        DTSBE305
00222          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE305
00223      ELSE                                                         DTSBE305
00224      IF LECM-TERMINATE-88                                         DTSBE305
00225          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE305
00226      ELSE                                                         DTSBE305
00227          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE305
00228            TO ABEND-MSG                                           DTSBE305
00229          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE305
00230      SKIP2                                                        DTSBE305
00231      GOBACK.                                                      DTSBE305
00232      EJECT                                                        DTSBE305
00233  I0000-INITIALIZE.                                                DTSBE305
00234      DISPLAY 'INITIALIZE'.                                        DTSBE305
00235                                                                   DTSBE305
00236      MOVE LENGTH OF R305-REC TO R305-LENGTH.                      DTSBE305
00237      MOVE '305'              TO R305-REC-TYPE.                    DTSBE305
00238      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE305
00239      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE305
00240                                                                   DTSBE305
00241      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE305
00242      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE305
00243                                                                   DTSBE305
00244      PERFORM                                                      DTSBE305
00245        VARYING WRK-CLASS-IDX FROM 1 BY 1                          DTSBE305
00246        UNTIL WRK-CLASS-IDX > WRK-CLASS-MAX                        DTSBE305
00247          PERFORM                                                  DTSBE305
00248            VARYING WRK-ACCT-IDX FROM 1 BY 1                       DTSBE305
00249            UNTIL WRK-ACCT-IDX > WRK-ACCT-MAX                      DTSBE305
00250              MOVE +0                                              DTSBE305
00251                TO WRK-CHARGED-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)    DTSBE305
00252                   WRK-PAID-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)       DTSBE305
00253                   WRK-WAIVED-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)     DTSBE305
00254                   WRK-WRITTEN-OFF-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)DTSBE305
00255                   WRK-TOLER-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)      DTSBE305
00256          END-PERFORM                                              DTSBE305
00257      END-PERFORM.                                                 DTSBE305
00258                                                                   DTSBE305
00259      PERFORM I2000-OPEN-FILES            THRU I2000-EXIT.         DTSBE305
00260                                                                   DTSBE305
00261  I0000-EXIT.                                                      DTSBE305
00262      EXIT.                                                        DTSBE305
00263                                                                   DTSBE305
00264  I2000-OPEN-FILES.                                                DTSBE305
00265      OPEN OUTPUT   RCVBL-FILE.                                    DTSBE305
00266      IF RCVBL-STATUS-OK-88                                        DTSBE305
00267         DISPLAY 'RCVBL FILE OPEN ' RCVBL-STATUS                   DTSBE305
00268      ELSE                                                         DTSBE305
00269         DISPLAY 'CANNOT OPEN RCVBL FILE ' RCVBL-STATUS            DTSBE305
00270         GO TO I2000-EXIT                                          DTSBE305
00271      END-IF.                                                      DTSBE305
00272                                                                   DTSBE305
00273  I2000-EXIT.                                                      DTSBE305
00274      EXIT.                                                        DTSBE305
00275                                                                   DTSBE305
00276  P0000-PROCESS.                                                   DTSBE305
00277      SKIP3                                                        DTSBE305
00278 *****                                                             DTSBE305
00279 *                                                                 DTSBE305
00280 *    IT IS POSSIBLE TO ENTER PAYMENT TRANSACTIONS AGAINST         DTSBE305
00281 *    MPRF-CLASS-UNK-88 EMPLOYERS.                                 DTSBE305
00282 *                                                                 DTSBE305
00283 *    TO AVOID CONFUSING SYSTEM USERS, THE "TRIAL BALANCE" AND     DTSBE305
00284 *    "ACCOUNTING SUMMARY" REPRESENTING SUCH TRANSACTIONS IS       DTSBE305
00285 *    LUMPED WITH THE ACCOUNTING BALANCES FOR "REGULAR" EMPLOYERS. DTSBE305
00286 *                                                                 DTSBE305
00287 *    THE THREE LOCATIONS WHERE CODE RELATED TO THIS FUNCTION      DTSBE305
00288 *    RESIDES ARE:                                                 DTSBE305
00289 *                                                                 DTSBE305
00290 *      DTSCS1C    S2510                                           DTSBE305
00291 *                                                                 DTSBE305
00292 *      DTSBD510   P3100                                           DTSBE305
00293 *                                                                 DTSBE305
00294 *      DTSBE305   P0000                                           DTSBE305
00295 *                                                                 DTSBE305
00296 *    THE CODE IN DTSCS1C IS RATHER SUBTLE.  THE DTSCS1C CODE      DTSBE305
00297 *    SAYS THAT IF A PAYMENT HAS BEEN INPUT AGAINST A              DTSBE305
00298 *    MPRF-CLASS-UNK-88 EMPLOYER, THEN THE EMPLOYER MAY BE FOUND   DTSBE305
00299 *    LIABLE ONLY AS A MPRF-CLASS-REG-88 EMPLOYER.  THIS EDIT KEEPSDTSBE305
00300 *    THE "TRAIL BALANCE" AND "ACCOUNTING SUMMARY" IN BALANCE      DTSBE305
00301 *    WITHOUT REQUIRING THE SYSTEM TO GENERATE "REVERSING" JOURNAL DTSBE305
00302 *    RECORDS.                                                     DTSBE305
00303 *                                                                 DTSBE305
00304 *    BEFORE MODIFYING ANY OF THE ABOVE REFERENCED CODE, THINK     DTSBE305
00305 *    CAREFULLY ABOUT THE CONSEQUENCES OF THE MODIFICATIONS FOR    DTSBE305
00306 *    THE ACCOUNTING BALANCES.                                     DTSBE305
00307 *                                                                 DTSBE305
00308 *****                                                             DTSBE305
00309                                                                   DTSBE305
00310      IF MPRF-CLASS-RATED-88                                       DTSBE305
00311          SET WRK-CLASS-IDX TO 2                                   DTSBE305
00312      ELSE                                                         DTSBE305
00313      IF MPRF-CLASS-UNK-88                                         DTSBE305
00314          SET WRK-CLASS-IDX TO 1                                   DTSBE305
00315      ELSE                                                         DTSBE305
00316      IF MPRF-CLASS-SELF-INS-88                                    DTSBE305
00317          SET WRK-CLASS-IDX TO 3                                   DTSBE305
00318      ELSE                                                         DTSBE305
00319          SET WRK-CLASS-IDX TO 1.                                  DTSBE305
00320                                                                   DTSBE305
00321      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE305
00322      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE305
00323      SET MQTR-QTR-88 TO TRUE.                                     DTSBE305
00324      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE305
00325      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE305
00326      PERFORM P1000-MQTR-SCAN THRU P1000-EXIT                      DTSBE305
00327          UNTIL L910-NO-REC-88.                                    DTSBE305
00328                                                                   DTSBE305
00329      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBE305
00330      MOVE MPRF-EMP-NO TO MDST-EMP-NO.                             DTSBE305
00331      SET MDST-DST-88 TO TRUE.                                     DTSBE305
00332      SET MDST-CREDIT-REC-88 TO TRUE.                              DTSBE305
00333      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE305
00334      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE305
00335      PERFORM P2000-MDST-SCAN THRU P2000-EXIT                      DTSBE305
00336          UNTIL L910-NO-REC-88.                                    DTSBE305
00337  P0000-EXIT.                                                      DTSBE305
00338      EXIT.                                                        DTSBE305
00339      EJECT                                                        DTSBE305
00340  P1000-MQTR-SCAN.                                                 DTSBE305
00341      MOVE MSKL-REC TO MQTR-REC.                                   DTSBE305
00342 *****************************************************             DTSBE305
00343 * ADDED THIS TEST FOR CONSISTENCY WITH THE AGING RPT              DTSBE305
00344 *****************************************************             DTSBE305
00345      IF MQTR-YRQ > LECM-LAST-PEN-ASSESSED-YRQ                     DTSBE305
00346         PERFORM S910-READ-NEXT THRU S910-EXIT                     DTSBE305
00347         GO TO P1000-EXIT                                          DTSBE305
00348      END-IF.                                                      DTSBE305
00349                                                                   DTSBE305
00350      PERFORM                                                      DTSBE305
00351        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSBE305
00352        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBE305
00353          PERFORM P1100-SET-WRK-ACCT-SUB THRU P1100-EXIT           DTSBE305
00354          PERFORM P1200-SUM-AMT THRU P1200-EXIT                    DTSBE305
00355          PERFORM P1300-EXPORT  THRU P1300-EXIT                    DTSBE305
00356      END-PERFORM.                                                 DTSBE305
00357                                                                   DTSBE305
00358      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE305
00359  P1000-EXIT.                                                      DTSBE305
00360      EXIT.                                                        DTSBE305
00361      SKIP3                                                        DTSBE305
00362  P1100-SET-WRK-ACCT-SUB.                                          DTSBE305
00363      MOVE +0 TO WRK-ACCT-SUB.                                     DTSBE305
00364                                                                   DTSBE305
00365      MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO WRK-MQTR-ACCT-IND.     DTSBE305
00366                                                                   DTSBE305
00367      PERFORM                                                      DTSBE305
00368        VARYING CACT-ACCT-IDX FROM 1 BY 1                          DTSBE305
00369        UNTIL (CACT-ACCT-IDX > WRK-ACCT-MAX-MINUS-1)               DTSBE305
00370                  OR                                               DTSBE305
00371              (WRK-ACCT-SUB > +0)                                  DTSBE305
00372          IF WRK-MQTR-ACCT-IND = CACT-ACCT-LIT (CACT-ACCT-IDX)     DTSBE305
00373              SET WRK-ACCT-SUB TO CACT-ACCT-IDX                    DTSBE305
00374          END-IF                                                   DTSBE305
00375      END-PERFORM.                                                 DTSBE305
00376  P1100-EXIT.                                                      DTSBE305
00377      EXIT.                                                        DTSBE305
00378      SKIP3                                                        DTSBE305
00379  P1200-SUM-AMT.                                                   DTSBE305
00380      IF WRK-ACCT-SUB = +0                                         DTSBE305
00381          GO TO P1200-EXIT.                                        DTSBE305
00382                                                                   DTSBE305
00383      SET WRK-ACCT-IDX TO WRK-ACCT-SUB.                            DTSBE305
00384                                                                   DTSBE305
00385      ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                         DTSBE305
00386       TO WRK-CHARGED-AMT (WRK-CLASS-IDX WRK-ACCT-IDX).            DTSBE305
00387                                                                   DTSBE305
00388      ADD MQTR-PAID-AMT (MQTR-ACCT-IDX)                            DTSBE305
00389       TO WRK-PAID-AMT (WRK-CLASS-IDX WRK-ACCT-IDX).               DTSBE305
00390                                                                   DTSBE305
00391      ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)                          DTSBE305
00392       TO WRK-WAIVED-AMT (WRK-CLASS-IDX WRK-ACCT-IDX).             DTSBE305
00393                                                                   DTSBE305
00394      ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX)                     DTSBE305
00395       TO WRK-WRITTEN-OFF-AMT (WRK-CLASS-IDX WRK-ACCT-IDX).        DTSBE305
00396                                                                   DTSBE305
00397      ADD MQTR-TOLER-AMT (MQTR-ACCT-IDX)                           DTSBE305
00398       TO WRK-TOLER-AMT (WRK-CLASS-IDX WRK-ACCT-IDX).              DTSBE305
00399                                                                   DTSBE305
00400                                                                   DTSBE305
00401  P1200-EXIT.                                                      DTSBE305
00402      EXIT.                                                        DTSBE305
00403                                                                   DTSBE305
00404  P1300-EXPORT.                                                    DTSBE305
00405      IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) = ZERO                   DTSBE305
00406         GO TO P1300-EXIT                                          DTSBE305
00407      END-IF.                                                      DTSBE305
00408                                                                   DTSBE305
00409      MOVE MQTR-EMP-NO                 TO RCVBL-EMP-NBR.           DTSBE305
00410      MOVE MPRF-EMP-CLASS              TO RCVBL-EMP-CLASS.         DTSBE305
00411      MOVE MQTR-YRQ                    TO L004-QTR-5-9.            DTSBE305
00412      PERFORM S004-FROM-5              THRU S004-EXIT.             DTSBE305
00413      MOVE L004-SLASH-5-QTR            TO RCVBL-QTR.               DTSBE305
00414                                                                   DTSBE305
00415      MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX)  TO RCVBL-ACCT.           DTSBE305
00416                                                                   DTSBE305
00417      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        DTSBE305
00418                                       TO RCVBL-AMT.               DTSBE305
00419                                                                   DTSBE305
00420      WRITE RCVBL-REC                  FROM WRK-RCVBL-REC.         DTSBE305
00421      IF RCVBL-STATUS-OK-88                                        DTSBE305
00422         ADD +1                        TO WRK-RCVBL-CNT            DTSBE305
00423         IF MQTR-EMP-NO = 010169                                   DTSBE305
00424            DISPLAY RCVBL-QTR '  ' RCVBL-ACCT '  '                 DTSBE305
00425               RCVBL-AMT                                           DTSBE305
00426         END-IF                                                    DTSBE305
00427      ELSE                                                         DTSBE305
00428         DISPLAY 'CANNOT WRITE RCVBL REC ' RCVBL-STATUS            DTSBE305
00429            '  ' WRK-RCVBL-CNT                                     DTSBE305
00430      END-IF.                                                      DTSBE305
00431                                                                   DTSBE305
00432                                                                   DTSBE305
00433  P1300-EXIT.                                                      DTSBE305
00434      EXIT.                                                        DTSBE305
00435                                                                   DTSBE305
00436  P2000-MDST-SCAN.                                                 DTSBE305
00437      MOVE MSKL-REC TO MDST-REC.                                   DTSBE305
00438                                                                   DTSBE305
00439      IF MDST-CREDIT-REC-88                                        DTSBE305
00440          NEXT SENTENCE                                            DTSBE305
00441      ELSE                                                         DTSBE305
00442          SET L910-NO-REC-88 TO TRUE                               DTSBE305
00443          GO TO P2000-EXIT.                                        DTSBE305
00444                                                                   DTSBE305
00445      SET WRK-ACCT-IDX TO WRK-ACCT-MAX.                            DTSBE305
00446                                                                   DTSBE305
00447      PERFORM P2100-MDST-ACCT THRU P2100-EXIT                      DTSBE305
00448          VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSBE305
00449          UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                     DTSBE305
00450                                                                   DTSBE305
00451      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE305
00452  P2000-EXIT.                                                      DTSBE305
00453      EXIT.                                                        DTSBE305
00454      SKIP3                                                        DTSBE305
00455  P2100-MDST-ACCT.                                                 DTSBE305
00456      IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)                     DTSBE305
00457          ADD MDST-AMT (MDST-ACCT-IDX)                             DTSBE305
00458           TO WRK-PAID-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)            DTSBE305
00459      ELSE                                                         DTSBE305
00460      IF MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX)                 DTSBE305
00461          ADD MDST-AMT (MDST-ACCT-IDX)                             DTSBE305
00462           TO WRK-WRITTEN-OFF-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)     DTSBE305
00463      ELSE                                                         DTSBE305
00464      IF MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX)                       DTSBE305
00465          ADD MDST-AMT (MDST-ACCT-IDX)                             DTSBE305
00466           TO WRK-TOLER-AMT (WRK-CLASS-IDX WRK-ACCT-IDX).          DTSBE305
00467  P2100-EXIT.                                                      DTSBE305
00468      EXIT.                                                        DTSBE305
00469      EJECT                                                        DTSBE305
00470  T0000-TERMINATE.                                                 DTSBE305
00471      DISPLAY 'RCVBL CNT ' WRK-RCVBL-CNT.                          DTSBE305
00472                                                                   DTSBE305
00473      PERFORM                                                      DTSBE305
00474        VARYING WRK-CLASS-IDX FROM 1 BY 1                          DTSBE305
00475        UNTIL WRK-CLASS-IDX > WRK-CLASS-MAX                        DTSBE305
00476          PERFORM                                                  DTSBE305
00477            VARYING WRK-ACCT-IDX FROM 1 BY 1                       DTSBE305
00478            UNTIL WRK-ACCT-IDX > WRK-ACCT-MAX                      DTSBE305
00479              PERFORM T1000-CONSTRUCT-R305 THRU T1000-EXIT         DTSBE305
00480              PERFORM S946-WRITE-R305 THRU S946-EXIT               DTSBE305
00481          END-PERFORM                                              DTSBE305
00482      END-PERFORM.                                                 DTSBE305
00483                                                                   DTSBE305
00484      CLOSE RCVBL-FILE.                                            DTSBE305
00485                                                                   DTSBE305
00486  T0000-EXIT.                                                      DTSBE305
00487      EXIT.                                                        DTSBE305
00488      SKIP3                                                        DTSBE305
00489  T1000-CONSTRUCT-R305.                                            DTSBE305
00490      SET WRK-CLASS-SUB TO WRK-CLASS-IDX.                          DTSBE305
00491                                                                   DTSBE305
00492      IF WRK-CLASS-SUB = +1                                        DTSBE305
00493          SET R305-CLASS-UNK-88 TO TRUE                            DTSBE305
00494      ELSE                                                         DTSBE305
00495      IF WRK-CLASS-SUB = +2                                        DTSBE305
00496          SET R305-CLASS-RATED-88 TO TRUE                          DTSBE305
00497      ELSE                                                         DTSBE305
00498      IF WRK-CLASS-SUB = +3                                        DTSBE305
00499          SET R305-CLASS-SELF-INS-88 TO TRUE                       DTSBE305
00500      ELSE                                                         DTSBE305
00501          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE305
00502                                                                   DTSBE305
00503      SET R305-ACCT-SUB TO WRK-ACCT-IDX.                           DTSBE305
00504                                                                   DTSBE305
00505      MOVE CACT-ACCT-LIT (R305-ACCT-SUB) TO R305-ACCT-IND.         DTSBE305
00506                                                                   DTSBE305
00507      MOVE LECM-PRIOR-RUN-DATE TO R305-LAST-ACCT-UPDATE-DATE.      DTSBE305
00508                                                                   DTSBE305
00509      MOVE WRK-CHARGED-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)            DTSBE305
00510        TO R305-CHARGED-AMT.                                       DTSBE305
00511                                                                   DTSBE305
00512      MOVE WRK-PAID-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)               DTSBE305
00513        TO R305-PAID-AMT.                                          DTSBE305
00514                                                                   DTSBE305
00515      MOVE WRK-WAIVED-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)             DTSBE305
00516        TO R305-WAIVED-AMT.                                        DTSBE305
00517                                                                   DTSBE305
00518      MOVE WRK-WRITTEN-OFF-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)        DTSBE305
00519        TO R305-WRITTEN-OFF-AMT.                                   DTSBE305
00520                                                                   DTSBE305
00521      MOVE WRK-TOLER-AMT (WRK-CLASS-IDX WRK-ACCT-IDX)              DTSBE305
00522        TO R305-TOLER-AMT.                                         DTSBE305
00523                                                                   DTSBE305
00524      IF R305-ACCT-IND = CACT-ACCT-CREDIT                          DTSBE305
00525          ADD R305-WRITTEN-OFF-AMT TO R305-PAID-AMT                DTSBE305
00526          ADD R305-TOLER-AMT TO R305-PAID-AMT                      DTSBE305
00527          COMPUTE R305-WRITTEN-OFF-AMT = R305-WRITTEN-OFF-AMT * -1 DTSBE305
00528          COMPUTE R305-TOLER-AMT = R305-TOLER-AMT * -1.            DTSBE305
00529                                                                   DTSBE305
00530      COMPUTE R305-BALANCE-AMT                                     DTSBE305
00531                = R305-CHARGED-AMT                                 DTSBE305
00532                    - R305-PAID-AMT                                DTSBE305
00533                    - R305-WAIVED-AMT                              DTSBE305
00534                    - R305-WRITTEN-OFF-AMT                         DTSBE305
00535                    - R305-TOLER-AMT.                              DTSBE305
00536  T1000-EXIT.                                                      DTSBE305
00537      EXIT.                                                        DTSBE305
00538                                                                   DTSBE305
00539  S004-FROM-5.                                                     DTSBE305
00540      SET L004-FROM-5        TO TRUE.                              DTSBE305
00541      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE305
00542                                                                   DTSBE305
00543  S004-EXIT.                                                       DTSBE305
00544      EXIT.                                                        DTSBE305
00545                                                                   DTSBE305
00546 *S910-READ.                                                       DTSBE305
00547 *****SET L910-READ-88 TO TRUE.                                    DTSBE305
00548 *****GO TO S910-MSTR-IO.                                          DTSBE305
00549      SKIP1                                                        DTSBE305
00550  S910-START-BROWSE.                                               DTSBE305
00551      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE305
00552      GO TO S910-MSTR-IO.                                          DTSBE305
00553      SKIP1                                                        DTSBE305
00554  S910-READ-NEXT.                                                  DTSBE305
00555      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE305
00556      GO TO S910-MSTR-IO.                                          DTSBE305
00557      SKIP1                                                        DTSBE305
00558 *S910-COUNT.                                                      DTSBE305
00559 *****SET L910-COUNT-88 TO TRUE.                                   DTSBE305
00560 *****GO TO S910-MSTR-IO.                                          DTSBE305
00561      SKIP1                                                        DTSBE305
00562  S910-MSTR-IO.                                                    DTSBE305
00563      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE305
00564                            MSKL-REC.                              DTSBE305
00565  S910-EXIT.                                                       DTSBE305
00566      EXIT.                                                        DTSBE305
00567      SKIP3                                                        DTSBE305
00568  S946-WRITE-R305.                                                 DTSBE305
00569      CALL 'DTSBU946' USING R305-REC.                              DTSBE305
00570      GO TO S946-EXIT.                                             DTSBE305
00571      SKIP1                                                        DTSBE305
00572  S946-EXIT.                                                       DTSBE305
00573      EXIT.                                                        DTSBE305
00574      SKIP3                                                        DTSBE305
00575  S999-ABEND.                                                      DTSBE305
00576      DISPLAY '*** DTSBE305 ABENDING.  '                           DTSBE305
00577              ABEND-MSG.                                           DTSBE305
00578      SKIP1                                                        DTSBE305
00579      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE305
00580  S999-EXIT.                                                       DTSBE305
00581      EXIT.                                                        DTSBE305
