00001  IDENTIFICATION DIVISION.                                         10/04/06
00002  PROGRAM-ID.             DTSBD800.                                DTSBD800
00003  AUTHOR.                 MT DEPT OF LABOR/UI PROGRAMMING SECTION     LV025
00004  DATE-WRITTEN.           JULY 1994.                               DTSBD800
00005  DATE-COMPILED.                                                   DTSBD800
00006                                                                   DTSBD800
00007 *****                                                             DTSBD800
00008 *                                                                 DTSBD800
00009 *    FUNCTION:  REPORT DRIVER MODULE.                             DTSBD800
00010 *                                                                 DTSBD800
00011 *                                                                 DTSBD800
00012 *    MODIFICATION HISTORY:                                        DTSBD800
00013 *                                                                 DTSBD800
00014 * 03/07/2000  ENLARGE TO HANDLE DTSBR980.                         DTSBD800
00015 *             REFERENCE: NEEDED FOR OPS BY CLIENT         : JHP   DTSBD800
00016 *                                                                 DTSBD800
00017 * 07-18-94 INITIAL DEVELOPMENT                                    DTSBD800
00018 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBD800
00019 *                                                                 DTSBD800
00020 * 11-05-97 MODIFY LITERAL PLACED IN LRCM-AGY-NAME-LINE2 TO        DTSBD800
00021 *          REFLECT MOVE OF UI TAX SYSTEM FROM DLI TO DOR.         DTSBD800
00022 *          REFERENCE RFP #TCL 208         AUTHOR OF CHANGE - EHH  DTSBD800
00023 *                                                                 DTSBD800
00024 * 10/06/1998  REVIEWED AND MODIFIED FOR DC.                       DTSBD800
00025 *             REFERENCE: DC DEVELOPMENT         PROGRAMMER: EHH   DTSBD800
00026 *                                                                 DTSBD800
00027 * 07/14/1999  INITIALIZE LRCM-PICKUP-DIR.                         DTSBD800
00028 *             REFERENCE: PICKUP DIR             PROGRAMMER: DVS   DTSBD800
00029 *                                                                 DTSBD800
00030 * 08/21/2006  MODIFIED TO OPEN AND CLOSE TAX MASTER FILE.         DTSBD800
00031 *             BOTH DTSBR319 AND DTSBR325 NEED TO READ THE         DTSBD800
00032 *             MASTER FILE.                                        DTSBD800
00033 *             REFERENCE:                        PROGRAMMER:       DTSBD800
00034 *                                                                 DTSBD800
00035 * MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD800
00036 *             XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD800
00037 *             REFERENCE: XXXXXXXXXXXXXXX        PROGRAMMER: XXX   DTSBD800
00038 *                                                                 DTSBD800
00039 *                                                                 DTSBD800
00040 *  DESCRIPTION:                                                   DTSBD800
00041 *                                                                 DTSBD800
00042 *      THE FUNCTION OF DTSBD800 IS TO READ THE SORTED INCOMING    DTSBD800
00043 *      REPORT RECORD FILE AND CALL THE APPROPRIATE MODULE TO      DTSBD800
00044 *      PROCESS EACH REPORT RECORD. THE RECORD TYPE IS APPENDED    DTSBD800
00045 *      TO THE CONSTANT 'DTSBR' TO FORM THE LOAD MODULE NAME       DTSBD800
00046 *      ASSOCIATED WITH THE RECORD.                                DTSBD800
00047 *                                                                 DTSBD800
00048 *      TWO TYPES OF PARAMETER FILES ARE INPUT:                    DTSBD800
00049 *                                                                 DTSBD800
00050 *   -  ONE PARAMETER FILE (CALLED PARM-FILE) SPECIFIES WHICH OF   DTSBD800
00051 *      THE INCOMING REPORT RECORD TYPES ARE TO BE PROCESSED, THIS DTSBD800
00052 *      IS DONE BY EITHER SPECIFYING:                              DTSBD800
00053 *         A: REPORT RECORD TYPES TO BE INCLUDED (PROCESSED)       DTSBD800
00054 *                    OR                                           DTSBD800
00055 *         B: REPORT RECORD TYPES TO BE EXCLUDED (NOT PROCESSED).  DTSBD800
00056 *                                                                 DTSBD800
00057 *   -  THE OTHER PARAMETER FILE (CALLED ATLEAST-ONCE-FILE)        DTSBD800
00058 *      SPECIFIES THE REPORT RECORD TYPES CORRESPONDING TO ALL     DTSBD800
00059 *      REPORT MODULES WHICH MUST BE EXECUTED AT LEAST ONCE.       DTSBD800
00060 *                                                                 DTSBD800
00061 *                                                                 DTSBD800
00062 *   -  THE TABLE INTRODUCED FOR DTSBR980 IS 999 ENTRIES LONG      DTSBD800
00063 *      TO HANDLE EVERY POSSIBLE REPORT PROGRAM                    DTSBD800
00064 *      (DTSBR001 TO DTSBR999).                                    DTSBD800
00065 *                                                                 DTSBD800
00066 *                                                                 DTSBD800
00067 *    MODULES CALLED:                                              DTSBD800
00068 *                                                                 DTSBD800
00069 *        DTSBR980  REPORT CONTROL LIST                            DTSBD800
00070 *        DTSBU001  DATE MODULE                                    DTSBD800
00071 *        DTSBU119  AGENCY FACTS MODULE                            DTSBD800
00072 *        DTSBU931  REFERENCE FILE I-O MODULE                      DTSBD800
00073 *        DTSBU941  REPORT FILE SEQUENTIAL INPUT MODULE            DTSBD800
00074 *        DTSBU999  ABEND MODULE                                   DTSBD800
00075 *                                                                 DTSBD800
00076 *****                                                             DTSBD800
00077      EJECT                                                        DTSBD800
00078  ENVIRONMENT DIVISION.                                            DTSBD800
00079                                                                   DTSBD800
00080  INPUT-OUTPUT SECTION.                                            DTSBD800
00081                                                                   DTSBD800
00082  FILE-CONTROL.                                                    DTSBD800
00083      SELECT PARM-FILE ASSIGN TO PARMIN.                           DTSBD800
00084      SELECT ATLEAST-ONCE-FILE ASSIGN TO ATLSTIN.                  DTSBD800
00085                                                                   DTSBD800
00086  DATA DIVISION.                                                   DTSBD800
00087                                                                   DTSBD800
00088  FILE SECTION.                                                    DTSBD800
00089                                                                   DTSBD800
00090  FD  PARM-FILE                                                    DTSBD800
00091      LABEL RECORDS ARE STANDARD.                                  DTSBD800
00092                                                                   DTSBD800
00093  01  PARM-REC.                                                    DTSBD800
00094      05  PARM-MOD-NAME               PIC  X(08).                  DTSBD800
00095      05  FILLER                      PIC  X(01).                  DTSBD800
00096      05  PARM-CONTROL-TYPE           PIC  X(03).                  DTSBD800
00097      05  PARM-RPT-TYPE-AREA OCCURS 15 TIMES                       DTSBD800
00098                             INDEXED BY PARM-RPT-IDX.              DTSBD800
00099          10  FILLER                  PIC  X(01).                  DTSBD800
00100          10  PARM-RPT-TYPE           PIC  X(03).                  DTSBD800
00101      05  FILLER                      PIC  X(08).                  DTSBD800
00102                                                                   DTSBD800
00103                                                                   DTSBD800
00104                                                                   DTSBD800
00105  FD  ATLEAST-ONCE-FILE                                            DTSBD800
00106      LABEL RECORDS ARE STANDARD.                                  DTSBD800
00107                                                                   DTSBD800
00108  01  ATLEAST-ONCE-REC.                                            DTSBD800
00109      05  ATLEAST-ONCE-MOD-NAME       PIC  X(08).                  DTSBD800
00110      05  ATLEAST-ONCE-RPT-TYPE-AREA OCCURS 15 TIMES               DTSBD800
00111                             INDEXED BY ATLEAST-ONCE-RPT-IDX.      DTSBD800
00112          10  FILLER                  PIC  X(01).                  DTSBD800
00113          10  ATLEAST-ONCE-RPT-TYPE   PIC  X(03).                  DTSBD800
00114      05  FILLER                      PIC  X(12).                  DTSBD800
00115      EJECT                                                        DTSBD800
00116  WORKING-STORAGE SECTION.                                         DTSBD800
001165 77  PAN-VALET PICTURE X(24) VALUE '025DTSBD800  10/04/06'.       DTSBD800
00117                                                                   DTSBD800
00118  01  WRK-AREA.                                                    DTSBD800
00119      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +800.DTSBD800
00120                                                                   DTSBD800
00121      05  ABEND-MSG                   PIC  X(50).                  DTSBD800
00122                                                                   DTSBD800
00123      05  INCLUDE-REC-CNT             PIC S9(07)  COMP-3.          DTSBD800
00124                                                                   DTSBD800
00125      05  EXCLUDE-REC-CNT             PIC S9(07)  COMP-3.          DTSBD800
00126                                                                   DTSBD800
00127      05  PARM-REC-CNT                PIC S9(04)  COMP.            DTSBD800
00128                                                                   DTSBD800
00129      05  PARM-EOF-IND                PIC  X(01).                  DTSBD800
00130                                                                   DTSBD800
00131      05  ATLEAST-ONCE-REC-CNT        PIC S9(04)  COMP.            DTSBD800
00132                                                                   DTSBD800
00133      05  ATLEAST-ONCE-EOF-IND        PIC  X(01).                  DTSBD800
00134                                                                   DTSBD800
00135      05  NDX-1                       PIC S9(04)  COMP.            DTSBD800
00136                                                                   DTSBD800
00137      05  SYS-TIME.                                                DTSBD800
00138          10  SYS-H                   PIC  X(02).                  DTSBD800
00139          10  SYS-M                   PIC  X(02).                  DTSBD800
00140          10  SYS-S                   PIC  X(02).                  DTSBD800
00141          10  FILLER                  PIC  X(02).                  DTSBD800
00142                                                                   DTSBD800
00143      05  DISP-TIME.                                               DTSBD800
00144          10  DISP-H                  PIC  X(02).                  DTSBD800
00145          10  FILLER                  PIC  X(01)  VALUE '.'.       DTSBD800
00146          10  DISP-M                  PIC  X(02).                  DTSBD800
00147          10  FILLER                  PIC  X(01)  VALUE '.'.       DTSBD800
00148          10  DISP-S                  PIC  X(02).                  DTSBD800
00149      EJECT                                                        DTSBD800
00150      05  WRK-CONTROL-CNT             PIC S9(04)  COMP.            DTSBD800
00151                                                                   DTSBD800
00152      05  WRK-CONTROL-TYPE            PIC  X(03).                  DTSBD800
00153          88  WRK-INCLUDE-88                      VALUE 'INC'.     DTSBD800
00154          88  WRK-EXCLUDE-88                      VALUE 'EXC'.     DTSBD800
00155                                                                   DTSBD800
00156      05  WRK-CONTROL-REC-TYPE OCCURS 15 TIMES                     DTSBD800
00157                           INDEXED BY WRK-CONTROL-REC-IDX          DTSBD800
00158                                      PIC  X(03).                  DTSBD800
00159                                                                   DTSBD800
00160                                                                   DTSBD800
00161                                                                   DTSBD800
00162      05  WRK-SELECT-IND              PIC  X(01).                  DTSBD800
00163                                                                   DTSBD800
00164                                                                   DTSBD800
00165                                                                   DTSBD800
00166      05  WRK-ATLEAST-ONCE-CNT        PIC S9(04)  COMP.            DTSBD800
00167                                                                   DTSBD800
00168      05  WRK-ATLEAST-ONCE-OCCURS OCCURS 15 TIMES                  DTSBD800
00169                           INDEXED BY WRK-ATLEAST-ONCE-IDX.        DTSBD800
00170          10  WRK-ATLEAST-ONCE-REC-TYPE                            DTSBD800
00171                                      PIC  X(03).                  DTSBD800
00172          10  WRK-ATLEAST-ONCE-CALLED-IND                          DTSBD800
00173                                      PIC  X(01).                  DTSBD800
00174              88  WRK-ATLEAST-ONCE-CALLED-88      VALUE 'Y'.       DTSBD800
00175                                                                   DTSBD800
00176                                                                   DTSBD800
00177                                                                   DTSBD800
00178      05  HOLD-REC-TYPE               PIC  X(03)  VALUE ZEROES.    DTSBD800
00179      05  HOLD-REC-TYPE-9   REDEFINES   HOLD-REC-TYPE              DTSBD800
00180                                      PIC  9(03).                  DTSBD800
00181                                                                   DTSBD800
00182      05  HOLD-REC-CNT                PIC S9(07)  COMP-3.          DTSBD800
00183                                                                   DTSBD800
00184      05  PRINT-MODULE.                                            DTSBD800
00185          10  FILLER                  PIC  X(05)  VALUE 'DTSBR'.   DTSBD800
00186          10  PRINT-TYPE              PIC  X(03)  VALUE SPACES.    DTSBD800
00187      EJECT                                                        DTSBD800
00188  01  L001-LINK-AREA.                                              DTSBD800
00189  ++INCLUDE DTSIL001                                               DTSBD800
00190      EJECT                                                        DTSBD800
00191  01  L119-LINK-AREA.                                              DTSBD800
00192  ++INCLUDE DTSIL119                                               DTSBD800
00193      EJECT                                                        DTSBD800
00194  01  L931-LINK-AREA.                                              DTSBD800
00195  ++INCLUDE DTSIL931                                               DTSBD800
00196      EJECT                                                        DTSBD800
00197  01  L941-LINK-AREA.                                              DTSBD800
00198  ++INCLUDE DTSIL941                                               DTSBD800
00199      EJECT                                                        DTSBD800
00200  01  L980-LINK-AREA.                                              DTSBD800
00201  ++INCLUDE DTSIL980                                               DTSBD800
00202      EJECT                                                        DTSBD800
00203  01  RSK3-REC.                                                    DTSBD800
00204  ++INCLUDE DTSIRSK3                                               DTSBD800
00205      EJECT                                                        DTSBD800
00206  01  L910-LINK-AREA.                                              DTSBD800
00207  ++INCLUDE DTSIL910                                               DTSBD800
00208                                                                   DTSBD800
00209  01  MSKL-REC.                                                    DTSBD800
00210  ++INCLUDE DTSIMSKL                                               DTSBD800
00211      EJECT                                                        DTSBD800
00212  01  LRCM-LINK-AREA.                                              DTSBD800
00213  ++INCLUDE DTSILRCM                                               DTSBD800
00214      EJECT                                                        DTSBD800
00215  01  FSKL-REC.                                                    DTSBD800
00216  ++INCLUDE DTSIFSKL                                               DTSBD800
00217      EJECT                                                        DTSBD800
00218  PROCEDURE DIVISION.                                              DTSBD800
00219                                                                   DTSBD800
00220      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD800
00221                                                                   DTSBD800
00222      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD800
00223                                                                   DTSBD800
00224      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD800
00225                                                                   DTSBD800
00226      GOBACK.                                                      DTSBD800
00227      EJECT                                                        DTSBD800
00228  I0000-INITIATE.                                                  DTSBD800
00229      PERFORM I1000-OPEN-FILES THRU I1000-EXIT.                    DTSBD800
00230                                                                   DTSBD800
00231      PERFORM I2000-PARM THRU I2000-EXIT.                          DTSBD800
00232                                                                   DTSBD800
00233      PERFORM I3000-ATLEAST-ONCE THRU I3000-EXIT.                  DTSBD800
00234                                                                   DTSBD800
00235      PERFORM I4000-INIT-LRCM THRU I4000-EXIT.                     DTSBD800
00236  I0000-EXIT.                                                      DTSBD800
00237      EXIT.                                                        DTSBD800
00238                                                                   DTSBD800
00239                                                                   DTSBD800
00240                                                                   DTSBD800
00241  I1000-OPEN-FILES.                                                DTSBD800
00242      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD800
00243                                                                   DTSBD800
00244      PERFORM S931-REF-IO THRU S931-EXIT.                          DTSBD800
00245                                                                   DTSBD800
00246      SET L941-OPEN-READ-88 TO TRUE.                               DTSBD800
00247                                                                   DTSBD800
00248      PERFORM S941-RPT-I THRU S941-EXIT.                           DTSBD800
00249                                                                   DTSBD800
00250      PERFORM S910-OPEN-READ   THRU S910-EXIT.                     DTSBD800
00251                                                                   DTSBD800
00252  I1000-EXIT.                                                      DTSBD800
00253      EXIT.                                                        DTSBD800
00254                                                                   DTSBD800
00255                                                                   DTSBD800
00256                                                                   DTSBD800
00257  I2000-PARM.                                                      DTSBD800
00258      OPEN INPUT PARM-FILE.                                        DTSBD800
00259                                                                   DTSBD800
00260      MOVE 'N' TO PARM-EOF-IND.                                    DTSBD800
00261                                                                   DTSBD800
00262      MOVE +0 TO PARM-REC-CNT.                                     DTSBD800
00263                                                                   DTSBD800
00264      DISPLAY ' '.                                                 DTSBD800
00265                                                                   DTSBD800
00266      DISPLAY '*** DTSBD800 PARAMETERS'.                           DTSBD800
00267                                                                   DTSBD800
00268      PERFORM I2100-READ-PARM THRU I2100-EXIT                      DTSBD800
00269         UNTIL PARM-EOF-IND = 'Y'.                                 DTSBD800
00270                                                                   DTSBD800
00271      IF PARM-REC-CNT = +0                                         DTSBD800
00272          SET WRK-EXCLUDE-88 TO TRUE                               DTSBD800
00273          MOVE +0 TO WRK-CONTROL-CNT                               DTSBD800
00274          DISPLAY '            (NONE)'                             DTSBD800
00275      ELSE                                                         DTSBD800
00276      IF PARM-REC-CNT > +1                                         DTSBD800
00277          MOVE 'NO MORE THAN ONE PARM RECORD ALLOWED'              DTSBD800
00278             TO ABEND-MSG                                          DTSBD800
00279          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD800
00280                                                                   DTSBD800
00281      DISPLAY ' '.                                                 DTSBD800
00282                                                                   DTSBD800
00283      CLOSE PARM-FILE.                                             DTSBD800
00284  I2000-EXIT.                                                      DTSBD800
00285      EXIT.                                                        DTSBD800
00286                                                                   DTSBD800
00287                                                                   DTSBD800
00288                                                                   DTSBD800
00289  I2100-READ-PARM.                                                 DTSBD800
00290      READ PARM-FILE                                               DTSBD800
00291         AT END                                                    DTSBD800
00292             MOVE 'Y' TO PARM-EOF-IND                              DTSBD800
00293             GO TO I2100-EXIT.                                     DTSBD800
00294                                                                   DTSBD800
00295      DISPLAY '*** ' PARM-REC.                                     DTSBD800
00296                                                                   DTSBD800
00297      ADD +1 TO PARM-REC-CNT.                                      DTSBD800
00298                                                                   DTSBD800
00299      IF PARM-MOD-NAME NOT = 'DTSBD800'                            DTSBD800
00300          MOVE 'INVALID PARM MODULE NAME' TO ABEND-MSG             DTSBD800
00301          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD800
00302                                                                   DTSBD800
00303      MOVE PARM-CONTROL-TYPE TO WRK-CONTROL-TYPE.                  DTSBD800
00304                                                                   DTSBD800
00305      IF WRK-INCLUDE-88 OR WRK-EXCLUDE-88                          DTSBD800
00306          NEXT SENTENCE                                            DTSBD800
00307      ELSE                                                         DTSBD800
00308          MOVE 'INVALID PARM CONTROL TYPE' TO ABEND-MSG            DTSBD800
00309          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD800
00310                                                                   DTSBD800
00311      MOVE +0 TO WRK-CONTROL-CNT.                                  DTSBD800
00312                                                                   DTSBD800
00313      PERFORM I2110-RPT-TYPE-LOOP THRU I2110-EXIT                  DTSBD800
00314         VARYING PARM-RPT-IDX FROM 1 BY 1                          DTSBD800
00315         UNTIL PARM-RPT-IDX > 15.                                  DTSBD800
00316                                                                   DTSBD800
00317      IF (WRK-INCLUDE-88) AND (WRK-CONTROL-CNT = +0)               DTSBD800
00318          MOVE 'AT LEAST ONE PARM REC TYPE REQUIRED FOR INCLUDING' DTSBD800
00319             TO ABEND-MSG                                          DTSBD800
00320          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD800
00321  I2100-EXIT.                                                      DTSBD800
00322      EXIT.                                                        DTSBD800
00323                                                                   DTSBD800
00324                                                                   DTSBD800
00325                                                                   DTSBD800
00326  I2110-RPT-TYPE-LOOP.                                             DTSBD800
00327      IF PARM-RPT-TYPE (PARM-RPT-IDX) = SPACES                     DTSBD800
00328          NEXT SENTENCE                                            DTSBD800
00329      ELSE                                                         DTSBD800
00330          ADD +1 TO WRK-CONTROL-CNT                                DTSBD800
00331          MOVE PARM-RPT-TYPE (PARM-RPT-IDX)                        DTSBD800
00332             TO WRK-CONTROL-REC-TYPE (WRK-CONTROL-CNT).            DTSBD800
00333  I2110-EXIT.                                                      DTSBD800
00334      EXIT.                                                        DTSBD800
00335      EJECT                                                        DTSBD800
00336  I3000-ATLEAST-ONCE.                                              DTSBD800
00337      OPEN INPUT ATLEAST-ONCE-FILE.                                DTSBD800
00338                                                                   DTSBD800
00339      MOVE 'N' TO ATLEAST-ONCE-EOF-IND.                            DTSBD800
00340                                                                   DTSBD800
00341      MOVE +0 TO ATLEAST-ONCE-REC-CNT.                             DTSBD800
00342                                                                   DTSBD800
00343      DISPLAY ' '.                                                 DTSBD800
00344                                                                   DTSBD800
00345      DISPLAY '*** DTSBD800 AT LEAST ONCE PARAMETERS'.             DTSBD800
00346                                                                   DTSBD800
00347      PERFORM I3100-READ-ATLEAST-ONCE-FILE THRU I3100-EXIT         DTSBD800
00348         UNTIL ATLEAST-ONCE-EOF-IND = 'Y'.                         DTSBD800
00349                                                                   DTSBD800
00350      IF ATLEAST-ONCE-REC-CNT = +0                                 DTSBD800
00351          MOVE +0 TO WRK-ATLEAST-ONCE-CNT                          DTSBD800
00352          DISPLAY '            (NONE)'                             DTSBD800
00353      ELSE                                                         DTSBD800
00354      IF ATLEAST-ONCE-REC-CNT > +1                                 DTSBD800
00355          MOVE 'NO MORE THAN ONE AT LEAST ONCE RECORD ALLOWED'     DTSBD800
00356             TO ABEND-MSG                                          DTSBD800
00357          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD800
00358                                                                   DTSBD800
00359      DISPLAY ' '.                                                 DTSBD800
00360                                                                   DTSBD800
00361      CLOSE ATLEAST-ONCE-FILE.                                     DTSBD800
00362  I3000-EXIT.                                                      DTSBD800
00363      EXIT.                                                        DTSBD800
00364                                                                   DTSBD800
00365                                                                   DTSBD800
00366                                                                   DTSBD800
00367  I3100-READ-ATLEAST-ONCE-FILE.                                    DTSBD800
00368      READ ATLEAST-ONCE-FILE                                       DTSBD800
00369         AT END                                                    DTSBD800
00370             MOVE 'Y' TO ATLEAST-ONCE-EOF-IND                      DTSBD800
00371             GO TO I3100-EXIT.                                     DTSBD800
00372                                                                   DTSBD800
00373      DISPLAY '*** ' ATLEAST-ONCE-REC.                             DTSBD800
00374                                                                   DTSBD800
00375      ADD +1 TO ATLEAST-ONCE-REC-CNT.                              DTSBD800
00376                                                                   DTSBD800
00377      IF ATLEAST-ONCE-MOD-NAME NOT = 'DTSBD800'                    DTSBD800
00378          MOVE 'INVALID AT LEAST ONCE MODULE NAME' TO ABEND-MSG    DTSBD800
00379          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD800
00380                                                                   DTSBD800
00381      MOVE +0 TO WRK-ATLEAST-ONCE-CNT.                             DTSBD800
00382                                                                   DTSBD800
00383      PERFORM I3110-RPT-TYPE-LOOP                                  DTSBD800
00384         THRU I3110-EXIT                                           DTSBD800
00385           VARYING ATLEAST-ONCE-RPT-IDX FROM 1 BY 1                DTSBD800
00386             UNTIL ATLEAST-ONCE-RPT-IDX > 15.                      DTSBD800
00387  I3100-EXIT.                                                      DTSBD800
00388      EXIT.                                                        DTSBD800
00389                                                                   DTSBD800
00390                                                                   DTSBD800
00391                                                                   DTSBD800
00392  I3110-RPT-TYPE-LOOP.                                             DTSBD800
00393      IF ATLEAST-ONCE-RPT-TYPE (ATLEAST-ONCE-RPT-IDX) NOT = SPACES DTSBD800
00394          ADD +1 TO WRK-ATLEAST-ONCE-CNT                           DTSBD800
00395          MOVE ATLEAST-ONCE-RPT-TYPE (ATLEAST-ONCE-RPT-IDX)        DTSBD800
00396            TO WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-CNT)    DTSBD800
00397          MOVE 'N'                                                 DTSBD800
00398            TO WRK-ATLEAST-ONCE-CALLED-IND (WRK-ATLEAST-ONCE-CNT). DTSBD800
00399  I3110-EXIT.                                                      DTSBD800
00400      EXIT.                                                        DTSBD800
00401      EJECT                                                        DTSBD800
00402  I4000-INIT-LRCM.                                                 DTSBD800
00403      MOVE SPACES TO LRCM-LINK-AREA.                               DTSBD800
00404                                                                   DTSBD800
00405      PERFORM I4010-INIT-L980 THRU I4010-EXIT                      DTSBD800
00406          VARYING NDX-1 FROM 1 BY 1                                DTSBD800
00407              UNTIL NDX-1 > 999.                                   DTSBD800
00408                                                                   DTSBD800
00409      SET L001-FROM-FED-6 TO TRUE.                                 DTSBD800
00410                                                                   DTSBD800
00411      ACCEPT L001-FED-6-DATE-9 FROM DATE.                          DTSBD800
00412                                                                   DTSBD800
00413      PERFORM S001-CONVERT-DATE THRU S001-EXIT.                    DTSBD800
00414                                                                   DTSBD800
00415      MOVE L001-SLASH-DATE TO LRCM-SYS-DATE.                       DTSBD800
00416                                                                   DTSBD800
00417      MOVE L001-SLASH-8-DATE TO LRCM-SYS-8-DATE.                   DTSBD800
00418                                                                   DTSBD800
00419                                                                   DTSBD800
00420      SET L119-REQ-MIXED-88 TO TRUE.                               DTSBD800
00421                                                                   DTSBD800
00422      SET L119-REQ-NO-UNIT-88 TO TRUE.                             DTSBD800
00423                                                                   DTSBD800
00424      PERFORM S119-AGENCY-FACTS THRU S119-EXIT.                    DTSBD800
00425                                                                   DTSBD800
00426      MOVE L119-UC-OFFICE-NAME TO LRCM-DEFAULT-NAME.               DTSBD800
00427                                                                   DTSBD800
00428      MOVE L119-UC-OFFICE-VOICE TO LRCM-DEFAULT-VOICE.             DTSBD800
00429                                                                   DTSBD800
00430                                                                   DTSBD800
00431      ACCEPT SYS-TIME FROM TIME.                                   DTSBD800
00432                                                                   DTSBD800
00433      MOVE SYS-H TO DISP-H.                                        DTSBD800
00434                                                                   DTSBD800
00435      MOVE SYS-M TO DISP-M.                                        DTSBD800
00436                                                                   DTSBD800
00437      MOVE SYS-S TO DISP-S.                                        DTSBD800
00438                                                                   DTSBD800
00439      MOVE DISP-TIME TO LRCM-SYS-TIME.                             DTSBD800
00440                                                                   DTSBD800
00441      MOVE +19924 TO LRCM-PICKUP-YRQ.                              DTSBD800
00442                                                                   DTSBD800
00443                                                                   DTSBD800
00444      MOVE '               DISTRICT OF COLUMBIA               '    DTSBD800
00445         TO LRCM-AGY-NAME-LINE1.                                   DTSBD800
00446                                                                   DTSBD800
00447      MOVE '                   TAX DIVISION                   '    DTSBD800
00448         TO LRCM-AGY-NAME-LINE2.                                   DTSBD800
00449  I4000-EXIT.                                                      DTSBD800
00450      EXIT.                                                        DTSBD800
00451  I4010-INIT-L980.                                                 DTSBD800
00452      MOVE ZERO TO L980-REC-CNT (NDX-1).                           DTSBD800
00453  I4010-EXIT.                                                      DTSBD800
00454      EXIT.                                                        DTSBD800
00455      EJECT                                                        DTSBD800
00456  P0000-PROCESS.                                                   DTSBD800
00457      MOVE +0 TO INCLUDE-REC-CNT                                   DTSBD800
00458                 EXCLUDE-REC-CNT.                                  DTSBD800
00459                                                                   DTSBD800
00460      DISPLAY ' '.                                                 DTSBD800
00461                                                                   DTSBD800
00462      DISPLAY '*** DTSBD800 STATISTICS'.                           DTSBD800
00463                                                                   DTSBD800
00464      SET L941-READ-NEXT-88 TO TRUE.                               DTSBD800
00465                                                                   DTSBD800
00466      PERFORM S941-RPT-I THRU S941-EXIT.                           DTSBD800
00467                                                                   DTSBD800
00468      IF L941-NO-REC-88                                            DTSBD800
00469          GO TO P0000-EXIT.                                        DTSBD800
00470                                                                   DTSBD800
00471                                                                   DTSBD800
00472      PERFORM P1000-PROCESS-RETURN THRU P1000-EXIT                 DTSBD800
00473         UNTIL L941-NO-REC-88.                                     DTSBD800
00474                                                                   DTSBD800
00475                                                                   DTSBD800
00476      IF WRK-SELECT-IND = 'I'                                      DTSBD800
00477          PERFORM P1500-TERM-REC-TYPE THRU P1500-EXIT.             DTSBD800
00478  P0000-EXIT.                                                      DTSBD800
00479      EXIT.                                                        DTSBD800
00480                                                                   DTSBD800
00481                                                                   DTSBD800
00482                                                                   DTSBD800
00483  P1000-PROCESS-RETURN.                                            DTSBD800
00484      IF RSK3-REC-TYPE NOT = HOLD-REC-TYPE                         DTSBD800
00485          IF HOLD-REC-TYPE = SPACES                                DTSBD800
00486              PERFORM P1100-INIT-REC-TYPE THRU P1100-EXIT          DTSBD800
00487          ELSE                                                     DTSBD800
00488              IF WRK-SELECT-IND = 'I'                              DTSBD800
00489                  PERFORM P1500-TERM-REC-TYPE THRU P1500-EXIT      DTSBD800
00490              ELSE                                                 DTSBD800
00491                  CONTINUE                                         DTSBD800
00492              END-IF                                               DTSBD800
00493              PERFORM P1100-INIT-REC-TYPE THRU P1100-EXIT.         DTSBD800
00494                                                                   DTSBD800
00495      IF WRK-SELECT-IND = 'I'                                      DTSBD800
00496          ADD +1 TO INCLUDE-REC-CNT                                DTSBD800
00497                    HOLD-REC-CNT                                   DTSBD800
00498          PERFORM S1000-CALL-R-MOD THRU S1000-EXIT                 DTSBD800
00499      ELSE                                                         DTSBD800
00500          ADD +1 TO EXCLUDE-REC-CNT.                               DTSBD800
00501                                                                   DTSBD800
00502      SET L941-READ-NEXT-88 TO TRUE.                               DTSBD800
00503                                                                   DTSBD800
00504      PERFORM S941-RPT-I THRU S941-EXIT.                           DTSBD800
00505  P1000-EXIT.                                                      DTSBD800
00506      EXIT.                                                        DTSBD800
00507      EJECT                                                        DTSBD800
00508  P1100-INIT-REC-TYPE.                                             DTSBD800
00509      MOVE RSK3-REC-TYPE TO HOLD-REC-TYPE.                         DTSBD800
00510                                                                   DTSBD800
00511      IF WRK-EXCLUDE-88                                            DTSBD800
00512          IF WRK-CONTROL-CNT = +0                                  DTSBD800
00513              MOVE 'I' TO WRK-SELECT-IND                           DTSBD800
00514          ELSE                                                     DTSBD800
00515              MOVE 'I' TO WRK-SELECT-IND                           DTSBD800
00516              PERFORM P1110-EXCLUDE THRU P1110-EXIT                DTSBD800
00517                 VARYING WRK-CONTROL-REC-IDX FROM 1 BY 1           DTSBD800
00518                 UNTIL (WRK-CONTROL-REC-IDX > WRK-CONTROL-CNT)     DTSBD800
00519                            OR                                     DTSBD800
00520                       (WRK-SELECT-IND = 'E')                      DTSBD800
00521      ELSE                                                         DTSBD800
00522          MOVE 'E' TO WRK-SELECT-IND                               DTSBD800
00523          PERFORM P1120-INCLUDE THRU P1120-EXIT                    DTSBD800
00524             VARYING WRK-CONTROL-REC-IDX FROM 1 BY 1               DTSBD800
00525             UNTIL (WRK-CONTROL-REC-IDX > WRK-CONTROL-CNT)         DTSBD800
00526                          OR                                       DTSBD800
00527                   (WRK-SELECT-IND = 'I').                         DTSBD800
00528                                                                   DTSBD800
00529      IF WRK-SELECT-IND = 'E'                                      DTSBD800
00530          GO TO P1100-EXIT.                                        DTSBD800
00531                                                                   DTSBD800
00532      IF WRK-ATLEAST-ONCE-CNT = +0                                 DTSBD800
00533          NEXT SENTENCE                                            DTSBD800
00534      ELSE                                                         DTSBD800
00535          PERFORM P1130-UPDT-ATLEAST-ONCE-CALLED THRU P1130-EXIT   DTSBD800
00536             VARYING WRK-ATLEAST-ONCE-IDX FROM 1 BY 1              DTSBD800
00537             UNTIL (WRK-ATLEAST-ONCE-IDX > WRK-ATLEAST-ONCE-CNT).  DTSBD800
00538                                                                   DTSBD800
00539      MOVE HOLD-REC-TYPE TO PRINT-TYPE.                            DTSBD800
00540                                                                   DTSBD800
00541      MOVE +0 TO HOLD-REC-CNT.                                     DTSBD800
00542                                                                   DTSBD800
00543      MOVE 'N' TO LRCM-EOR-IND.                                    DTSBD800
00544  P1100-EXIT.                                                      DTSBD800
00545      EXIT.                                                        DTSBD800
00546                                                                   DTSBD800
00547                                                                   DTSBD800
00548                                                                   DTSBD800
00549  P1110-EXCLUDE.                                                   DTSBD800
00550      IF RSK3-REC-TYPE = WRK-CONTROL-REC-TYPE (WRK-CONTROL-REC-IDX)DTSBD800
00551          MOVE 'E' TO WRK-SELECT-IND.                              DTSBD800
00552  P1110-EXIT.                                                      DTSBD800
00553      EXIT.                                                        DTSBD800
00554                                                                   DTSBD800
00555                                                                   DTSBD800
00556                                                                   DTSBD800
00557  P1120-INCLUDE.                                                   DTSBD800
00558      IF RSK3-REC-TYPE = WRK-CONTROL-REC-TYPE (WRK-CONTROL-REC-IDX)DTSBD800
00559          MOVE 'I' TO WRK-SELECT-IND.                              DTSBD800
00560  P1120-EXIT.                                                      DTSBD800
00561      EXIT.                                                        DTSBD800
00562                                                                   DTSBD800
00563                                                                   DTSBD800
00564                                                                   DTSBD800
00565  P1130-UPDT-ATLEAST-ONCE-CALLED.                                  DTSBD800
00566      IF RSK3-REC-TYPE                                             DTSBD800
00567             = WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-IDX)    DTSBD800
00568          MOVE 'Y'                                                 DTSBD800
00569             TO WRK-ATLEAST-ONCE-CALLED-IND (WRK-ATLEAST-ONCE-IDX) DTSBD800
00570          SET WRK-ATLEAST-ONCE-IDX TO WRK-ATLEAST-ONCE-CNT.        DTSBD800
00571  P1130-EXIT.                                                      DTSBD800
00572      EXIT.                                                        DTSBD800
00573      EJECT                                                        DTSBD800
00574  P1500-TERM-REC-TYPE.                                             DTSBD800
00575      MOVE 'Y' TO LRCM-EOR-IND.                                    DTSBD800
00576                                                                   DTSBD800
00577      PERFORM S1000-CALL-R-MOD THRU S1000-EXIT.                    DTSBD800
00578                                                                   DTSBD800
00579      DISPLAY HOLD-REC-CNT                                         DTSBD800
00580              ' RECORD TYPE '                                      DTSBD800
00581              HOLD-REC-TYPE                                        DTSBD800
00582              ' RECORDS PROCESSED'.                                DTSBD800
00583                                                                   DTSBD800
00584      MOVE HOLD-REC-CNT TO L980-REC-CNT (HOLD-REC-TYPE-9).         DTSBD800
00585                                                                   DTSBD800
00586      CANCEL PRINT-MODULE.                                         DTSBD800
00587  P1500-EXIT.                                                      DTSBD800
00588      EXIT.                                                        DTSBD800
00589      EJECT                                                        DTSBD800
00590  T0000-TERMINATE.                                                 DTSBD800
00591      DISPLAY ' '.                                                 DTSBD800
00592                                                                   DTSBD800
00593      DISPLAY '*** DTSBD800 TERMINATION STATISTICS'.               DTSBD800
00594                                                                   DTSBD800
00595      DISPLAY INCLUDE-REC-CNT                                      DTSBD800
00596              ' RECORDS INCLUDED'.                                 DTSBD800
00597                                                                   DTSBD800
00598      DISPLAY EXCLUDE-REC-CNT                                      DTSBD800
00599              ' RECORDS EXCLUDED'.                                 DTSBD800
00600                                                                   DTSBD800
00601                                                                   DTSBD800
00602      IF WRK-ATLEAST-ONCE-CNT = +0                                 DTSBD800
00603          NEXT SENTENCE                                            DTSBD800
00604      ELSE                                                         DTSBD800
00605          PERFORM T1000-CHK-ATLEAST-ONCE-CALLED THRU T1000-EXIT    DTSBD800
00606             VARYING WRK-ATLEAST-ONCE-IDX FROM 1 BY 1              DTSBD800
00607             UNTIL (WRK-ATLEAST-ONCE-IDX > WRK-ATLEAST-ONCE-CNT).  DTSBD800
00608                                                                   DTSBD800
00609                                                                   DTSBD800
00610      SET L931-CLOSE-88 TO TRUE.                                   DTSBD800
00611                                                                   DTSBD800
00612      PERFORM S931-REF-IO THRU S931-EXIT.                          DTSBD800
00613                                                                   DTSBD800
00614      SET L941-CLOSE-88 TO TRUE.                                   DTSBD800
00615                                                                   DTSBD800
00616      PERFORM S941-RPT-I THRU S941-EXIT.                           DTSBD800
00617                                                                   DTSBD800
00618      PERFORM S980-CTRL-RPT-O THRU S980-EXIT.                      DTSBD800
00619                                                                   DTSBD800
00620      PERFORM S910-CLOSE  THRU S910-EXIT.                          DTSBD800
00621                                                                   DTSBD800
00622  T0000-EXIT.                                                      DTSBD800
00623      EXIT.                                                        DTSBD800
00624                                                                   DTSBD800
00625                                                                   DTSBD800
00626  T1000-CHK-ATLEAST-ONCE-CALLED.                                   DTSBD800
00627      IF WRK-ATLEAST-ONCE-CALLED-88 (WRK-ATLEAST-ONCE-IDX)         DTSBD800
00628          NEXT SENTENCE                                            DTSBD800
00629      ELSE                                                         DTSBD800
00630          MOVE WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-IDX)    DTSBD800
00631             TO PRINT-TYPE                                         DTSBD800
00632          MOVE 'Y' TO LRCM-EOR-IND                                 DTSBD800
00633          PERFORM S1000-CALL-R-MOD THRU S1000-EXIT                 DTSBD800
00634          CANCEL PRINT-MODULE.                                     DTSBD800
00635  T1000-EXIT.                                                      DTSBD800
00636      EXIT.                                                        DTSBD800
00637      EJECT                                                        DTSBD800
00638  S1000-CALL-R-MOD.                                                DTSBD800
00639      CALL PRINT-MODULE USING LRCM-LINK-AREA                       DTSBD800
00640                              RSK3-REC.                            DTSBD800
00641  S1000-EXIT.                                                      DTSBD800
00642      EXIT.                                                        DTSBD800
00643      EJECT                                                        DTSBD800
00644  S001-CONVERT-DATE.                                               DTSBD800
00645      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD800
00646  S001-EXIT.                                                       DTSBD800
00647      EXIT.                                                        DTSBD800
00648                                                                   DTSBD800
00649                                                                   DTSBD800
00650  S119-AGENCY-FACTS.                                               DTSBD800
00651      CALL 'DTSBU119' USING L119-LINK-AREA.                        DTSBD800
00652  S119-EXIT.                                                       DTSBD800
00653      EXIT.                                                        DTSBD800
00654                                                                   DTSBD800
00655                                                                   DTSBD800
00656  S931-REF-IO.                                                     DTSBD800
00657      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD800
00658                            FSKL-REC.                              DTSBD800
00659  S931-EXIT.                                                       DTSBD800
00660      EXIT.                                                        DTSBD800
00661                                                                   DTSBD800
00662                                                                   DTSBD800
00663  S941-RPT-I.                                                      DTSBD800
00664      CALL 'DTSBU941' USING L941-LINK-AREA                         DTSBD800
00665                            RSK3-REC.                              DTSBD800
00666  S941-EXIT.                                                       DTSBD800
00667      EXIT.                                                        DTSBD800
00668                                                                   DTSBD800
00669                                                                   DTSBD800
00670  S980-CTRL-RPT-O.                                                 DTSBD800
00671      CALL 'DTSBR980' USING LRCM-LINK-AREA,                        DTSBD800
00672                            L980-LINK-AREA.                        DTSBD800
00673  S980-EXIT.                                                       DTSBD800
00674      EXIT.                                                        DTSBD800
00675                                                                   DTSBD800
00676  S910-OPEN-READ.                                                  DTSBD800
00677      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD800
00678      GO TO S910-MSTR-IO.                                          DTSBD800
00679                                                                   DTSBD800
00680  S910-CLOSE.                                                      DTSBD800
00681      SET L910-CLOSE-88 TO TRUE                                    DTSBD800
00682      GO TO S910-MSTR-IO.                                          DTSBD800
00683  S910-MSTR-IO.                                                    DTSBD800
00684       CALL 'DTSBU910' USING L910-LINK-AREA                        DTSBD800
00685                       MSKL-REC.                                   DTSBD800
00686  S910-EXIT.                                                       DTSBD800
00687       EXIT.                                                       DTSBD800
00688                                                                   DTSBD800
00689  S999-ABEND.                                                      DTSBD800
00690      DISPLAY '*** DTSBD800 ABENDING - ' ABEND-MSG.                DTSBD800
00691                                                                   DTSBD800
00692      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD800
00693  S999-EXIT.                                                       DTSBD800
00694      EXIT.                                                        DTSBD800
