00001  IDENTIFICATION DIVISION.                                         01/12/99
00002  PROGRAM-ID.             DTSBE313.                                DTSBE313
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD                   LV008
00004                          MODIFIED BY TRW S&ITG.                      CL**2
00005  DATE-WRITTEN.           AUGUST 1994.                             DTSBE313
00006  DATE-COMPILED.                                                   DTSBE313
00007      SKIP3                                                        DTSBE313
00008 *****                                                             DTSBE313
00009 *                                                                 DTSBE313
00010 *    CALLING SEQUENCE:  DTSBE313 CREATES  DTSIR313 RECORDS.          CL**6
00011 *                       DTSBD800 CALLS    DTSBR313 WHICH             CL**6
00012 *                                PRODUCES THE REPORT LIST.           CL**2
00013 *                                                                    CL**2
00014 *    FUNCTION:  SELF INSURED EMPLOYER PAST DUE LIST.                 CL**2
00015 *                                                                 DTSBE313
00016 *                                                                 DTSBE313
00017 *    MODIFICATION LOG:                                            DTSBE313
00018 *                                                                 DTSBE313
00019 *    05/22/95  MODIFY THE QUARTER PARAMETER DEFAULT.  ADD A UI    DTSBE313
00020 *              TAX BALANCE COLUMN TO THE REPORT.                  DTSBE313
00021 *              WORK ORDER: CR088                PROGRAMMER: RHC   DTSBE313
00022 *                                                                 DTSBE313
00023 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE313
00024 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE313
00025 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBE313
00026 *                                                                 DTSBE313
00027 *                                                                 DTSBE313
00028 *  DESCRIPTION:                                                   DTSBE313
00029 *                                                                 DTSBE313
00030 *                                                                 DTSBE313
00031 *    INITIATION:                                                  DTSBE313
00032 *                                                                 DTSBE313
00033 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE313
00034 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE313
00035 *                                                                 DTSBE313
00036 *      EDIT AND DEFAULT PARAMETERS.  SEE PRINTED OUTPUTS          DTSBE313
00037 *      DESCRIPTIONS AND LAYOUTS (313R1).                          DTSBE313
00038 *                                                                 DTSBE313
00039 *                                                                 DTSBE313
00040 *    PROCESSING:                                                  DTSBE313
00041 *                                                                 DTSBE313
00042 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (313R1).       DTSBE313
00043 *                                                                 DTSBE313
00044 *                                                                 DTSBE313
00045 *    TERMINATION:                                                 DTSBE313
00046 *                                                                 DTSBE313
00047 *      NONE.                                                      DTSBE313
00048 *                                                                 DTSBE313
00049 *                                                                 DTSBE313
00050 *    RECORDS READ:                                                DTSBE313
00051 *                                                                 DTSBE313
00052 *      MASTER:                                                    DTSBE313
00053 *                                                                 DTSBE313
00054 *        MQTR                                                     DTSBE313
00055 *                                                                 DTSBE313
00056 *                                                                 DTSBE313
00057 *      ALTERNATE INDEX:                                           DTSBE313
00058 *                                                                 DTSBE313
00059 *        NONE.                                                    DTSBE313
00060 *                                                                 DTSBE313
00061 *                                                                 DTSBE313
00062 *      REFERENCE:                                                 DTSBE313
00063 *                                                                 DTSBE313
00064 *        NONE.                                                    DTSBE313
00065 *                                                                 DTSBE313
00066 *                                                                 DTSBE313
00067 *    RECORDS UPDATED:                                             DTSBE313
00068 *                                                                 DTSBE313
00069 *        NONE.                                                    DTSBE313
00070 *                                                                 DTSBE313
00071 *                                                                 DTSBE313
00072 *    REPORT RECORDS WRITTEN:                                      DTSBE313
00073 *                                                                 DTSBE313
00074 *        R313 SELF INSURED EMPLOYER PAST DUE LIST.                   CL**2
00075 *                                                                 DTSBE313
00076 *                                                                 DTSBE313
00077 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE313
00078 *                                                                 DTSBE313
00079 *        NONE.                                                    DTSBE313
00080 *                                                                 DTSBE313
00081 *                                                                 DTSBE313
00082 *    MODULES CALLED:                                              DTSBE313
00083 *                                                                 DTSBE313
00084 *        DTSBU004  QUARTER CONVERSION/EDIT.                          CL**2
00085 *        DTSBU910  MASTER FILE I/O DRIVER.                           CL**2
00086 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.      CL**2
00087 *                                                                 DTSBE313
00088 *                                                                 DTSBE313
00089 *    VERMONT REFERENCE:                                           DTSBE313
00090 *                                                                 DTSBE313
00091 *        NONE.                                                    DTSBE313
00092 *                                                                 DTSBE313
00093 *****                                                             DTSBE313
00094      SKIP3                                                        DTSBE313
00095  ENVIRONMENT DIVISION.                                            DTSBE313
00096      EJECT                                                        DTSBE313
00097  DATA DIVISION.                                                   DTSBE313
00098      SKIP3                                                        DTSBE313
00099  WORKING-STORAGE SECTION.                                         DTSBE313
000995 77  PAN-VALET PICTURE X(24) VALUE '008DTSBE313  01/12/99'.       DTSBE313
00100      SKIP3                                                        DTSBE313
00101  01  WRK-AREA.                                                    DTSBE313
00102      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +313.DTSBE313
00103      SKIP1                                                        DTSBE313
00104      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE313'.   CL**2
00105      SKIP3                                                        DTSBE313
00106      05  ABEND-MSG                   PIC  X(60).                  DTSBE313
00107      SKIP3                                                        DTSBE313
00108      05  WRK-PARM-SUBJECT-YRQ        PIC S9(05)  COMP-3.          DTSBE313
00109      SKIP3                                                        DTSBE313
00110      05  WRK-UI-FND-IND              PIC  X(01).                  DTSBE313
00111          88  WRK-UI-FND-88                       VALUE 'Y'.       DTSBE313
00112          88  WRK-UI-NOT-FND-88                   VALUE 'N'.       DTSBE313
00113      SKIP3                                                        DTSBE313
00114      05  WRK-DISPLAY-AREA            PIC  9(11).                  DTSBE313
00115      05  FILLER   REDEFINES   WRK-DISPLAY-AREA.                   DTSBE313
00116          10  FILLER                  PIC  9(07).                  DTSBE313
00117          10  WRK-DISPLAY-MM          PIC  9(02).                  DTSBE313
00118          10  WRK-DISPLAY-DD          PIC  9(02).                  DTSBE313
00119      EJECT                                                        DTSBE313
00120  01  L004-LINK-AREA.                                              DTSBE313
00121  ++INCLUDE DTSIL004                                                  CL**3
00122      EJECT                                                        DTSBE313
00123  01  L910-LINK-AREA.                                              DTSBE313
00124  ++INCLUDE DTSIL910                                                  CL**3
00125      SKIP3                                                        DTSBE313
00126  01  MSKL-REC.                                                    DTSBE313
00127  ++INCLUDE DTSIMSKL                                                  CL**3
00128      SKIP3                                                        DTSBE313
00129  01  MQTR-REC.                                                    DTSBE313
00130  ++INCLUDE DTSIMQTR                                                  CL**3
00131      EJECT                                                        DTSBE313
00132  01  R313-REC.                                                    DTSBE313
00133  ++INCLUDE DTSIR313                                                  CL**3
00134      EJECT                                                        DTSBE313
00135  LINKAGE SECTION.                                                 DTSBE313
00136      SKIP3                                                        DTSBE313
00137  01  LECM-LINK-AREA.                                              DTSBE313
00138  ++INCLUDE DTSILECM                                                  CL**3
00139      SKIP3                                                        DTSBE313
00140          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE313
00141              15  LECM-PARM-SUBJECT-YRQ   PIC  X(03).              DTSBE313
00142              15  FILLER                  PIC  X(65).              DTSBE313
00143      EJECT                                                        DTSBE313
00144  01  MPRF-LINK-REC.                                               DTSBE313
00145  ++INCLUDE DTSIMPRF                                                  CL**3
00146      EJECT                                                        DTSBE313
00147 **************************************************************    DTSBE313
00148 *  PROCEDURE DIVISION FOR DTSBE313 - REIMBURSEABLE EMPLOYER          CL**2
00149 *  PAST DUE LIST STARTS HERE.                                     DTSBE313
00150 **************************************************************    DTSBE313
00151                                                                   DTSBE313
00152  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE313
00153                           MPRF-LINK-REC.                          DTSBE313
00154      SKIP2                                                        DTSBE313
00155      IF LECM-PROCESS-88                                           DTSBE313
00156          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE313
00157      ELSE                                                         DTSBE313
00158      IF LECM-INITIALIZE-88                                        DTSBE313
00159          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE313
00160      ELSE                                                         DTSBE313
00161      IF LECM-TERMINATE-88                                         DTSBE313
00162          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE313
00163      ELSE                                                         DTSBE313
00164          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE313
00165            TO ABEND-MSG                                           DTSBE313
00166          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE313
00167      SKIP2                                                        DTSBE313
00168      GOBACK.                                                      DTSBE313
00169      EJECT                                                        DTSBE313
00170 **************************************************************    DTSBE313
00171 *  THIS IS THE INITIALIZATION PARAGRAPH FOR DTSBE313.                CL**2
00172 **************************************************************    DTSBE313
00173                                                                   DTSBE313
00174  I0000-INITIALIZE.                                                DTSBE313
00175                                                                   DTSBE313
00176      MOVE LENGTH OF R313-REC TO    R313-LENGTH.                      CL**4
00177      MOVE '313'              TO  R313-REC-TYPE.                      CL**4
00178      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE313
00179      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE313
00180                                                                   DTSBE313
00181      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE313
00182      SKIP1                                                        DTSBE313
00183      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE313
00184      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE313
00185      SKIP2                                                        DTSBE313
00186  I0000-EXIT.                                                      DTSBE313
00187      EXIT.                                                        DTSBE313
00188      SKIP2                                                        DTSBE313
00189 **************************************************************    DTSBE313
00190 *  THIS PARAGRAPH CONTROLS THE EDITING OF PARMS.                  DTSBE313
00191 **************************************************************    DTSBE313
00192                                                                   DTSBE313
00193  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE313
00194                                                                   DTSBE313
00195      PERFORM I1100-SUBJECT-YRQ THRU I1100-EXIT.                   DTSBE313
00196                                                                   DTSBE313
00197  I1000-EXIT.                                                      DTSBE313
00198      EXIT.                                                        DTSBE313
00199      SKIP2                                                        DTSBE313
00200 **************************************************************    DTSBE313
00201 *  THIS PARAGRAPH EDITS THE YRQ PARM.                             DTSBE313
00202 **************************************************************    DTSBE313
00203                                                                   DTSBE313
00204  I1100-SUBJECT-YRQ.                                               DTSBE313
00205                                                                   DTSBE313
00206      IF LECM-PARM-SUBJECT-YRQ = SPACES                            DTSBE313
00207          PERFORM I1110-DEFAULT-YRQ THRU I1110-EXIT                DTSBE313
00208      ELSE                                                         DTSBE313
00209          MOVE LECM-PARM-SUBJECT-YRQ   TO  L004-QTR-3-X            DTSBE313
00210          PERFORM S004-FROM-3 THRU S004-EXIT                       DTSBE313
00211          IF L004-VALID-QTR                                        DTSBE313
00212              MOVE L004-QTR-5-9        TO  WRK-PARM-SUBJECT-YRQ    DTSBE313
00213          ELSE                                                     DTSBE313
00214              MOVE 'PARM-SUBJECT-YRQ NOT VALID'                    DTSBE313
00215                                       TO  ABEND-MSG               DTSBE313
00216              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE313
00217                                                                   DTSBE313
00218  I1100-EXIT.                                                      DTSBE313
00219      EXIT.                                                        DTSBE313
00220      EJECT                                                        DTSBE313
00221      SKIP3                                                        DTSBE313
00222  I1110-DEFAULT-YRQ.                                               DTSBE313
00223                                                                   DTSBE313
00224      MOVE LECM-PRIOR-RUN-DATE TO L004-DATE                        DTSBE313
00225                                  WRK-DISPLAY-AREA.                DTSBE313
00226      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSBE313
00227      IF WRK-DISPLAY-MM = 1 OR 4 OR 7 OR 10                        DTSBE313
00228          SUBTRACT +1 FROM L004-ABS-QTR                            DTSBE313
00229          PERFORM S004-FROM-ABS THRU S004-EXIT.                    DTSBE313
00230                                                                   DTSBE313
00231      MOVE L004-QTR-5-9 TO  WRK-PARM-SUBJECT-YRQ.                  DTSBE313
00232                                                                   DTSBE313
00233  I1110-EXIT.                                                      DTSBE313
00234      EXIT.                                                        DTSBE313
00235      EJECT                                                        DTSBE313
00236 **************************************************************    DTSBE313
00237 *  THIS IS THE PROCESS PARAGRAPH FOR DTSBE313.                       CL**2
00238 **************************************************************    DTSBE313
00239                                                                   DTSBE313
00240  P0000-PROCESS.                                                   DTSBE313
00241                                                                   DTSBE313
00242      IF MPRF-CLASS-SELF-INS-88                                       CL**8
00243          NEXT SENTENCE                                            DTSBE313
00244      ELSE                                                         DTSBE313
00245          GO TO P0000-EXIT.                                        DTSBE313
00246                                                                   DTSBE313
00247      IF MPRF-TOT-BALANCE-AMT > +0                                 DTSBE313
00248          NEXT SENTENCE                                            DTSBE313
00249      ELSE                                                         DTSBE313
00250          GO TO P0000-EXIT.                                        DTSBE313
00251                                                                   DTSBE313
00252      MOVE LOW-VALUES               TO  MQTR-KEY-AREA.             DTSBE313
00253      MOVE MPRF-EMP-NO              TO  MQTR-EMP-NO.               DTSBE313
00254      MOVE WRK-PARM-SUBJECT-YRQ     TO  MQTR-YRQ.                  DTSBE313
00255      SET MQTR-QTR-88               TO  TRUE.                      DTSBE313
00256      MOVE MQTR-KEY-AREA            TO  MSKL-KEY-AREA.             DTSBE313
00257                                                                   DTSBE313
00258      PERFORM S910-READ  THRU  S910-EXIT.                          DTSBE313
00259                                                                   DTSBE313
00260      IF L910-OK-88                                                DTSBE313
00261          MOVE MSKL-REC             TO  MQTR-REC                   DTSBE313
00262          SET WRK-UI-NOT-FND-88     TO  TRUE                       DTSBE313
00263          PERFORM P1000-CHECK-QTR                                  DTSBE313
00264            VARYING MQTR-ACCT-IDX  FROM 1 BY 1                     DTSBE313
00265              UNTIL MQTR-ACCT-IDX  GREATER THAN  MQTR-ACCT-CNT     DTSBE313
00266                    OR                                             DTSBE313
00267                    WRK-UI-FND-88.                                 DTSBE313
00268                                                                   DTSBE313
00269  P0000-EXIT.                                                      DTSBE313
00270      EXIT.                                                        DTSBE313
00271      EJECT                                                        DTSBE313
00272 **************************************************************    DTSBE313
00273 *  THIS PARAGRAPH CHECKS THE TABLE IN THE MQTR RECORD FOR         DTSBE313
00274 *  A UI BALANCE DUE.                                              DTSBE313
00275 **************************************************************    DTSBE313
00276                                                                   DTSBE313
00277  P1000-CHECK-QTR.                                                 DTSBE313
00278                                                                   DTSBE313
00279      IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                           DTSBE313
00280          IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0                 DTSBE313
00281              SET WRK-UI-FND-88     TO  TRUE                       DTSBE313
00282              PERFORM P1100-SETUP-R313  THRU  P1100-EXIT           DTSBE313
00283              PERFORM S946-WRITE-R313  THRU  S946-EXIT.            DTSBE313
00284                                                                   DTSBE313
00285  P1000-EXIT.                                                      DTSBE313
00286      EXIT.                                                        DTSBE313
00287      SKIP3                                                        DTSBE313
00288      SKIP3                                                        DTSBE313
00289 **************************************************************    DTSBE313
00290 *  THIS PARAGRAPH SETS UP THE R313 REPORT EXTRACT RECORD.         DTSBE313
00291 **************************************************************    DTSBE313
00292                                                                   DTSBE313
00293  P1100-SETUP-R313.                                                DTSBE313
00294                                                                   DTSBE313
00295      MOVE MPRF-EMP-NO              TO  R313-EMP-NO.               DTSBE313
00296      MOVE WRK-PARM-SUBJECT-YRQ     TO  R313-YRQ.                  DTSBE313
00297      MOVE MPRF-PRIMARY-NAME        TO  R313-PRIMARY-NAME.            CL**5
00298      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        DTSBE313
00299                                    TO  R313-UI-TAX-BAL.           DTSBE313
00300  P1100-EXIT.                                                      DTSBE313
00301      EXIT.                                                        DTSBE313
00302      EJECT                                                        DTSBE313
00303  T0000-TERMINATE.                                                 DTSBE313
00304      SKIP2                                                        DTSBE313
00305      SKIP2                                                        DTSBE313
00306  T0000-EXIT.                                                      DTSBE313
00307      EXIT.                                                        DTSBE313
00308      EJECT                                                        DTSBE313
00309 *S004-FROM-5.                                                     DTSBE313
00310 *    SET L004-FROM-5 TO TRUE.                                     DTSBE313
00311 *    GO TO S004-QTR.                                              DTSBE313
00312      SKIP1                                                        DTSBE313
00313  S004-FROM-DATE.                                                  DTSBE313
00314      SET L004-FROM-DATE TO TRUE.                                  DTSBE313
00315      GO TO S004-QTR.                                              DTSBE313
00316      SKIP1                                                        DTSBE313
00317  S004-FROM-ABS.                                                   DTSBE313
00318      SET L004-FROM-ABS TO TRUE.                                   DTSBE313
00319      GO TO S004-QTR.                                              DTSBE313
00320      SKIP1                                                        DTSBE313
00321  S004-FROM-3.                                                     DTSBE313
00322      SET L004-FROM-3 TO TRUE.                                     DTSBE313
00323      GO TO S004-QTR.                                              DTSBE313
00324      SKIP1                                                        DTSBE313
00325  S004-QTR.                                                        DTSBE313
00326      SKIP1                                                        DTSBE313
00327      CALL 'DTSBU004' USING L004-LINK-AREA.                           CL**2
00328      SKIP1                                                        DTSBE313
00329  S004-EXIT.                                                       DTSBE313
00330      EXIT.                                                        DTSBE313
00331      SKIP3                                                        DTSBE313
00332  S910-READ.                                                       DTSBE313
00333      SET L910-READ-88 TO TRUE.                                    DTSBE313
00334      GO TO S910-MSTR-IO.                                          DTSBE313
00335      SKIP1                                                        DTSBE313
00336 *S910-START-BROWSE.                                               DTSBE313
00337 *    SET L910-START-BROWSE-88 TO TRUE.                            DTSBE313
00338 *    GO TO S910-MSTR-IO.                                          DTSBE313
00339 *    SKIP1                                                        DTSBE313
00340 *S910-READ-NEXT.                                                  DTSBE313
00341 *    SET L910-READ-NEXT-88 TO TRUE.                               DTSBE313
00342 *    GO TO S910-MSTR-IO.                                          DTSBE313
00343 *    SKIP1                                                        DTSBE313
00344 *S910-COUNT.                                                      DTSBE313
00345 *    SET L910-COUNT-88 TO TRUE.                                   DTSBE313
00346 *    GO TO S910-MSTR-IO.                                          DTSBE313
00347      SKIP1                                                        DTSBE313
00348  S910-MSTR-IO.                                                    DTSBE313
00349      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**2
00350                            MSKL-REC.                              DTSBE313
00351  S910-EXIT.                                                       DTSBE313
00352      EXIT.                                                        DTSBE313
00353      EJECT                                                        DTSBE313
00354  S946-WRITE-R313.                                                 DTSBE313
00355      CALL 'DTSBU946' USING R313-REC.                                 CL**2
00356      GO TO S946-EXIT.                                             DTSBE313
00357      SKIP1                                                        DTSBE313
00358  S946-EXIT.                                                       DTSBE313
00359      EXIT.                                                        DTSBE313
00360      SKIP3                                                        DTSBE313
00361  S999-ABEND.                                                      DTSBE313
00362      DISPLAY '*** DTSBE313 ABENDING.  '                              CL**2
00363              ABEND-MSG.                                           DTSBE313
00364      SKIP1                                                        DTSBE313
00365      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00366  S999-EXIT.                                                       DTSBE313
00367      EXIT.                                                        DTSBE313
