00001  IDENTIFICATION DIVISION.                                         01/23/01
00002  PROGRAM-ID.             DTSBR729.                                DTSBR729
00003  AUTHOR.                 MT DEPT OF LABOR/UI PROGRAMMING SECTION     LV013
00004  DATE-WRITTEN.           NOVEMBER 1994.                           DTSBR729
00005  DATE-COMPILED.                                                   DTSBR729
00006                                                                   DTSBR729
00007 *****                                                             DTSBR729
00008 *                                                                 DTSBR729
00009 *    CALLING SEQUENCE:  DTSBD400 CALLS                            DTSBR729
00010 *                       DTSBE729 WHICH UPDATES DTSIR729           DTSBR729
00011 *                       DTSBR729 READS DTSIR729 RECORDS.          DTSBR729
00012 *    FUNCTION:  ACCOUNTS AVAILABLE FOR PURGE.                     DTSBR729
00013 *                                                                 DTSBR729
00014 *                                                                 DTSBR729
00015 *    MODIFICATION HISTORY:                                        DTSBR729
00016 *                                                                 DTSBR729
00017 * 11-20-94 INITIAL DEVELOPMENT                                    DTSBR729
00018 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBR729
00019 *                                                                 DTSBR729
00020 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR729
00021 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR729
00022 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR729
00023 *                                                                 DTSBR729
00024 *                                                                 DTSBR729
00025 *    DESCRIPTION:                                                 DTSBR729
00026 *                                                                 DTSBR729
00027 *        THE MODULE PRODUCES A LIST OF ACCOUNTS WHICH MEET THE    DTSBR729
00028 *        ESTABLISHED CRITERIA FOR BEING AVAILABLE FOR PURGE FROM  DTSBR729
00029 *        THE PRODUCTION MASTER FILE.                              DTSBR729
00030 *                                                                 DTSBR729
00031 *                                                                 DTSBR729
00032 *    RECORDS READ:                                                DTSBR729
00033 *                                                                 DTSBR729
00034 *        NONE.                                                    DTSBR729
00035 *                                                                 DTSBR729
00036 *                                                                 DTSBR729
00037 *    PRINTED OUTPUTS:                                             DTSBR729
00038 *                                                                 DTSBR729
00039 *        729R1  ACCOUNTS AVAILABLE FOR PURGE LIST                 DTSBR729
00040 *                                                                 DTSBR729
00041 *                                                                 DTSBR729
00042 *    RECORDS WRITTEN:                                             DTSBR729
00043 *                                                                 DTSBR729
00044 *        NONE.                                                    DTSBR729
00045 *                                                                 DTSBR729
00046 *                                                                 DTSBR729
00047 *    MODULES CALLED:                                              DTSBR729
00048 *                                                                 DTSBR729
00049 *        DTSBU001 DATE EDIT/CONVERSION MODULE                     DTSBR729
00050 *                                                                 DTSBR729
00051 *                                                                 DTSBR729
00052 *****                                                             DTSBR729
00053                                                                   DTSBR729
00054  ENVIRONMENT DIVISION.                                            DTSBR729
00055                                                                   DTSBR729
00056  CONFIGURATION SECTION.                                           DTSBR729
00057  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBR729
00058                                                                   DTSBR729
00059  INPUT-OUTPUT SECTION.                                            DTSBR729
00060                                                                   DTSBR729
00061  FILE-CONTROL.                                                    DTSBR729
00062      SELECT PRT-FILE ASSIGN TO RPT729R1.                          DTSBR729
00063                                                                   DTSBR729
00064  DATA DIVISION.                                                   DTSBR729
00065                                                                   DTSBR729
00066  FILE SECTION.                                                    DTSBR729
00067                                                                   DTSBR729
00068  FD  PRT-FILE                                                     DTSBR729
00069      RECORDING MODE IS F.                                         DTSBR729
00070  01  REPORT-LISTING1                 PIC  X(133).                 DTSBR729
00071                                                                   DTSBR729
00072  WORKING-STORAGE SECTION.                                         DTSBR729
000725 77  PAN-VALET PICTURE X(24) VALUE '013DTSBR729  01/23/01'.       DTSBR729
00073                                                                   DTSBR729
00074  01  WRK-AREA.                                                    DTSBR729
00075      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +729.DTSBR729
00076      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR729
00077      05  WS-NUMBER-ONE               PIC S9(05)  COMP-3 VALUE +0. DTSBR729
00078                                                                   DTSBR729
00079      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.  DTSBR729
00080      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.  DTSBR729
00081      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.  DTSBR729
00082                                                                   DTSBR729
00083  01  L001-LINK-AREA.                                              DTSBR729
00084  ++INCLUDE DTSIL001                                               DTSBR729
00085      EJECT                                                        DTSBR729
00086                                                                   DTSBR729
00087  01  PAGE-HEADING.                                                DTSBR729
00088      05  HDR1-LINE-1.                                             DTSBR729
00089          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR729
00090          10  FILLER                  PIC  X(05)                   DTSBR729
00091                 VALUE '729R1'.                                    DTSBR729
00092          10  FILLER                  PIC  X(34)  VALUE SPACES.    DTSBR729
00093          10  HDR1-AGY-NAME-LINE1     PIC  X(50).                  DTSBR729
00094          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR729
00095          10  FILLER                  PIC  X(05)                   DTSBR729
00096                 VALUE 'DATE:'.                                    DTSBR729
00097          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR729
00098          10  HDR1-SYS-DATE           PIC  X(08).                  DTSBR729
00099      05  HDR1-LINE-2.                                             DTSBR729
00100          10  FILLER                  PIC  X(40)  VALUE SPACES.    DTSBR729
00101          10  HDR1-AGY-NAME-LINE2     PIC  X(50).                  DTSBR729
00102          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR729
00103          10  FILLER                  PIC  X(05)                   DTSBR729
00104                 VALUE 'TIME:'.                                    DTSBR729
00105          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR729
00106          10  HDR1-SYS-TIME           PIC  X(08).                  DTSBR729
00107      05  HDR1-LINE-3.                                             DTSBR729
00108          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR729
00109          10  FILLER                  PIC  X(33)                   DTSBR729
00110                 VALUE 'ROUTE TO: CHIEF, TAX DIVISION'.            DTSBR729
00111          10  FILLER                  PIC  X(84)  VALUE SPACES.    DTSBR729
00112          10  FILLER                  PIC  X(05)                   DTSBR729
00113                 VALUE 'PAGE:'.                                    DTSBR729
00114          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR729
00115          10  HDR1-PAGE-CNT           PIC  ZZ,ZZ9.                 DTSBR729
00116      05  HDR1-LINE-4.                                             DTSBR729
00117          10  FILLER                  PIC  X(50)  VALUE SPACES.    DTSBR729
00118          10  FILLER                  PIC  X(28)                   DTSBR729
00119                VALUE 'ACCOUNTS AVAILABLE FOR PURGE'.              DTSBR729
00120      05  HDR1-LINE-5                 PIC  X(133) VALUE SPACES.    DTSBR729
00121      05  HDR1-LINE-6                 PIC  X(133) VALUE SPACES.    DTSBR729
00122      05  HDR1-LINE-7.                                             DTSBR729
00123          10  FILLER                  PIC  X(13)  VALUE SPACES.    DTSBR729
00124          10  FILLER                  PIC  X(08)                   DTSBR729
00125                 VALUE 'EMPLOYER'.                                 DTSBR729
00126          10  FILLER                  PIC  X(48)  VALUE SPACES.    DTSBR729
00127          10  FILLER                  PIC  X(40)                   DTSBR729
00128                 VALUE 'LIABILITY    INACTIVE   PURSUED   BAL   '. DTSBR729
00129          10  FILLER                  PIC  X(22)                   DTSBR729
00130                 VALUE 'CRED  WRITE  AUTOMATIC'.                   DTSBR729
00131      05  HDR1-LINE-8.                                             DTSBR729
00132          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR729
00133          10  FILLER                  PIC  X(19)                   DTSBR729
00134                 VALUE 'EMP NO        CLASS'.                      DTSBR729
00135          10  FILLER                  PIC  X(08)  VALUE SPACES.    DTSBR729
00136          10  FILLER                  PIC  X(13)                   DTSBR729
00137                 VALUE 'PRIMARY  NAME'.                            DTSBR729
00138          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR729
00139          10  FILLER                  PIC  X(40)                   DTSBR729
00140                 VALUE '   DATE        DATE     REPORTS   DUE   '. DTSBR729
00141          10  FILLER                  PIC  X(22)                   DTSBR729
00142                 VALUE 'AMT   OFF       PURGE'.                    DTSBR729
00143      05  HDR1-LINE-9                 PIC  X(133) VALUE SPACES.    DTSBR729
00144                                                                   DTSBR729
00145  01  DETAIL-LINE.                                                 DTSBR729
00146      05  DTL1-LINE-1.                                             DTSBR729
00147          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR729
00148          10  DTL1-EMP-NO             PIC  999B999.                DTSBR729
00149          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR729
00150          10  WS-EMP-CLASS-DSCR       PIC  X(13).                  DTSBR729
00151          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR729
00152          10  DTL1-PRIMARY-NAME       PIC  X(40).                  DTSBR729
00153          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR729
00154          10  WS-LIAB-DATE            PIC  X(08).                  DTSBR729
00155          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR729
00156          10  WS-INACT-DATE           PIC  X(08).                  DTSBR729
00157          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR729
00158          10  WS-PURSUED-RPT-YES      PIC  X(03).                  DTSBR729
00159          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR729
00160          10  WS-BALANCE-DUE-YES      PIC  X(03).                  DTSBR729
00161          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR729
00162          10  WS-CREDIT-BAL-YES       PIC  X(03).                  DTSBR729
00163          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR729
00164          10  WS-WRITEOFF-ACCT-YES    PIC  X(03).                  DTSBR729
00165          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR729
00166          10  WS-PURGE-ACCT-YES       PIC  X(03).                  DTSBR729
00167                                                                   DTSBR729
00168  01  CONTROL-FOOTING-FINAL.                                       DTSBR729
00169      05  CTF-LINE-3.                                              DTSBR729
00170          10  FILLER                  PIC  X(25)  VALUE SPACES.    DTSBR729
00171          10  CTF-NUMBER-ONE          PIC  ZZ,ZZ9.                 DTSBR729
00172          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR729
00173          10  FILLER                  PIC  X(28)                   DTSBR729
00174                 VALUE 'ACCOUNTS AVAILABLE FOR PURGE'.             DTSBR729
00175      05  CTF-LINE-7.                                              DTSBR729
00176          10  FILLER                  PIC  X(24)  VALUE SPACES.    DTSBR729
00177          10  FILLER                  PIC  X(17)                   DTSBR729
00178                 VALUE '*** END OF REPORT'.                        DTSBR729
00179      EJECT                                                        DTSBR729
00180  LINKAGE SECTION.                                                 DTSBR729
00181                                                                   DTSBR729
00182  01  LRCM-LINK-AREA.                                              DTSBR729
00183  ++INCLUDE DTSILRCM                                               DTSBR729
00184      EJECT                                                        DTSBR729
00185  01  R729-REC.                                                    DTSBR729
00186  ++INCLUDE DTSIR729                                               DTSBR729
00187      EJECT                                                        DTSBR729
00188  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR729
00189                           R729-REC.                               DTSBR729
00190                                                                   DTSBR729
00191      IF FIRST-TIME-IND = 'Y'                                      DTSBR729
00192          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR729
00193          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR729
00194                                                                   DTSBR729
00195      IF LRCM-EOR-88                                               DTSBR729
00196          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR729
00197      ELSE                                                         DTSBR729
00198          PERFORM P1000-PROCESS THRU P1000-EXIT.                   DTSBR729
00199                                                                   DTSBR729
00200      GOBACK.                                                      DTSBR729
00201                                                                   DTSBR729
00202  I1000-INITIATE.                                                  DTSBR729
00203                                                                   DTSBR729
00204      OPEN OUTPUT PRT-FILE.                                        DTSBR729
00205      MOVE LRCM-SYS-DATE TO HDR1-SYS-DATE.                         DTSBR729
00206      MOVE LRCM-SYS-TIME TO HDR1-SYS-TIME.                         DTSBR729
00207      MOVE LRCM-AGY-NAME-LINE1 TO HDR1-AGY-NAME-LINE1.             DTSBR729
00208      MOVE LRCM-AGY-NAME-LINE2 TO HDR1-AGY-NAME-LINE2.             DTSBR729
00209      MOVE SPACES TO REPORT-LISTING1.                              DTSBR729
00210                                                                   DTSBR729
00211  I1000-EXIT.                                                      DTSBR729
00212      EXIT.                                                        DTSBR729
00213                                                                   DTSBR729
00214  P1000-PROCESS.                                                   DTSBR729
00215                                                                   DTSBR729
00216      EVALUATE TRUE                                                DTSBR729
00217         WHEN R729-CLASS-RATED-88                                  DTSBR729
00218             MOVE 'RATED  ' TO WS-EMP-CLASS-DSCR                   DTSBR729
00219         WHEN R729-CLASS-SELF-INS-88                               DTSBR729
00220             MOVE 'SELF INSURED' TO WS-EMP-CLASS-DSCR              DTSBR729
00221         WHEN R729-CLASS-NEVER-SUB-88                              DTSBR729
00222             MOVE 'NEVER SUBJECT' TO WS-EMP-CLASS-DSCR             DTSBR729
00223      END-EVALUATE.                                                DTSBR729
00224                                                                   DTSBR729
00225      MOVE R729-LIAB-DATE TO L001-FED-8-DATE-9.                    DTSBR729
00226      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR729
00227      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR729
00228      IF L001-INVALID-DATE                                         DTSBR729
00229          MOVE SPACES TO WS-LIAB-DATE                              DTSBR729
00230      ELSE                                                         DTSBR729
00231          MOVE L001-SLASH-DATE TO WS-LIAB-DATE.                    DTSBR729
00232                                                                   DTSBR729
00233      MOVE R729-INACT-DATE TO L001-FED-8-DATE-9.                   DTSBR729
00234      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR729
00235      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR729
00236      IF L001-INVALID-DATE                                         DTSBR729
00237          MOVE SPACES TO WS-INACT-DATE                             DTSBR729
00238      ELSE                                                         DTSBR729
00239          MOVE L001-SLASH-DATE TO WS-INACT-DATE.                   DTSBR729
00240                                                                   DTSBR729
00241      IF R729-PURSUED-RPT-EXISTS-88                                DTSBR729
00242          MOVE 'YES' TO WS-PURSUED-RPT-YES                         DTSBR729
00243      ELSE                                                         DTSBR729
00244          MOVE SPACES TO WS-PURSUED-RPT-YES.                       DTSBR729
00245      IF R729-TOT-BALANCE-AMT > +0                                 DTSBR729
00246          MOVE 'YES' TO WS-BALANCE-DUE-YES                         DTSBR729
00247      ELSE                                                         DTSBR729
00248          MOVE SPACES TO WS-BALANCE-DUE-YES.                       DTSBR729
00249      IF R729-TOT-CREDIT-AMT > +0                                  DTSBR729
00250          MOVE 'YES' TO WS-CREDIT-BAL-YES                          DTSBR729
00251      ELSE                                                         DTSBR729
00252          MOVE SPACES TO WS-CREDIT-BAL-YES.                        DTSBR729
00253      IF R729-WRITE-OFF-DATE > +0                                  DTSBR729
00254          MOVE 'YES' TO WS-WRITEOFF-ACCT-YES                       DTSBR729
00255      ELSE                                                         DTSBR729
00256          MOVE SPACES TO WS-WRITEOFF-ACCT-YES.                     DTSBR729
00257      IF R729-PURGE-IND-YES-88                                     DTSBR729
00258          MOVE 'YES' TO WS-PURGE-ACCT-YES                          DTSBR729
00259      ELSE                                                         DTSBR729
00260          MOVE SPACES TO WS-PURGE-ACCT-YES.                        DTSBR729
00261                                                                   DTSBR729
00262      MOVE R729-EMP-NO       TO DTL1-EMP-NO.                       DTSBR729
00263      MOVE R729-PRIMARY-NAME TO DTL1-PRIMARY-NAME.                 DTSBR729
00264                                                                   DTSBR729
00265      PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.                  DTSBR729
00266      WRITE REPORT-LISTING1 FROM DTL1-LINE-1 AFTER 1.              DTSBR729
00267      ADD +1    TO WS-LINE-CNT2.                                   DTSBR729
00268      ADD +1    TO WS-NUMBER-ONE.                                  DTSBR729
00269                                                                   DTSBR729
00270  P1000-EXIT.                                                      DTSBR729
00271      EXIT.                                                        DTSBR729
00272                                                                   DTSBR729
00273  P2000-PRINT-HEADER.                                              DTSBR729
00274                                                                   DTSBR729
00275      IF WS-LINE-CNT GREATER 59 OR                                 DTSBR729
00276           WS-LINE-CNT2 GREATER 59                                 DTSBR729
00277         MOVE +0          TO WS-LINE-CNT                           DTSBR729
00278         MOVE +0          TO WS-LINE-CNT2                          DTSBR729
00279         ADD  +1          TO WS-PAGE-CNT                           DTSBR729
00280         MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT                         DTSBR729
00281         WRITE REPORT-LISTING1 FROM HDR1-LINE-1                    DTSBR729
00282                 AFTER TOP-OF-PAGE                                 DTSBR729
00283         WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1            DTSBR729
00284         WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1            DTSBR729
00285         WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1            DTSBR729
00286         WRITE REPORT-LISTING1 FROM HDR1-LINE-5 AFTER 1            DTSBR729
00287         WRITE REPORT-LISTING1 FROM HDR1-LINE-6 AFTER 1            DTSBR729
00288         WRITE REPORT-LISTING1 FROM HDR1-LINE-7 AFTER 1            DTSBR729
00289         WRITE REPORT-LISTING1 FROM HDR1-LINE-8 AFTER 1            DTSBR729
00290         WRITE REPORT-LISTING1 FROM HDR1-LINE-9 AFTER 1            DTSBR729
00291         ADD +9    TO WS-LINE-CNT2.                                DTSBR729
00292                                                                   DTSBR729
00293  P2000-EXIT.                                                      DTSBR729
00294      EXIT.                                                        DTSBR729
00295                                                                   DTSBR729
00296  T1000-TERMINATE.                                                 DTSBR729
00297                                                                   DTSBR729
00298      MOVE WS-NUMBER-ONE     TO CTF-NUMBER-ONE.                    DTSBR729
00299      WRITE REPORT-LISTING1 FROM CTF-LINE-3 AFTER 3.               DTSBR729
00300      WRITE REPORT-LISTING1 FROM CTF-LINE-7 AFTER 4.               DTSBR729
00301      CLOSE PRT-FILE.                                              DTSBR729
00302                                                                   DTSBR729
00303  T1000-EXIT.                                                      DTSBR729
00304      EXIT.                                                        DTSBR729
00305      EJECT                                                        DTSBR729
00306  S001-DATE.                                                       DTSBR729
00307                                                                   DTSBR729
00308      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBR729
00309                                                                   DTSBR729
00310  S001-EXIT.                                                       DTSBR729
00311      EXIT.                                                        DTSBR729
00312                                                                   DTSBR729
00313 *S999-ABEND.                                                      DTSBR729
00314 *                                                                 DTSBR729
00315 *    CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR729
00316 *                                                                 DTSBR729
00317 *S999-EXIT.                                                       DTSBR729
00318 *    EXIT.                                                        DTSBR729
