00001  IDENTIFICATION DIVISION.                                         05/07/13
00002  PROGRAM-ID.             DTSBE722.                                DTSBE722
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV022
00004                          MODIFIED BY TRW/BDM OCT. 1998.           DTSBE722
00005  DATE-WRITTEN.           SEPTEMBER 1994.                          DTSBE722
00006  DATE-COMPILED.                                                   DTSBE722
00007      SKIP3                                                        DTSBE722
00008 *****                                                             DTSBE722
00009 *    CALLING SEQUENCE:  DTSBD400 CALLS                            DTSBE722
00010 *                       DTSBE722 WHICH UPDATES DTSIR722           DTSBE722
00011 *                       DTSBR722 READS DTSIR722 RECORDS.          DTSBE722
00012 *                                                                 DTSBE722
00013 *    FUNCTION:  RQC CREDITS/REFUNDS CONTRIBUTORY EMPLOYERS        DTSBE722
00014 *               UNIVERSE RECORDS EXTRACT.                         DTSBE722
00015 *                                                                 DTSBE722
00016 *                                                                 DTSBE722
00017 *    MODIFICATION LOG:                                            DTSBE722
00018 *                                                                 DTSBE722
00019 *    11/15/2004  PROGRAM REWRITTEN TO COMPLY WITH REQUIREMENTS    DTSBE722
00020 *                WORK ORDER:                      PROGRAMMER: GD  DTSBE722
00021 *                                                                 DTSBE722
00022 *    04/20/2009  SELECTION PROCESS MODIFIED. TPS APPENDIX A REQUIRDTSBE722
00023 *                THAT ONLY CREDITS STILL OUTSTANDING AT THE END OFDTSBE722
00024 *                THE REPORTING PERIOD MAY BE INCLUDED.            DTSBE722
00025 *                WORK ORDER:                      PROGRAMMER: GD  DTSBE722
00026 *                                                                 DTSBE722
00027 *    06/23/2010  MODIFIED TO EXCLUDE REFUND REVERSALS. IT IS NOT  DTSBE722
00028 *                EXPECTED THAT A NEW CREDIT MEMO WILL BE ISSUED INDTSBE722
00029 *                THIS SITUATION, SINCE THE CREDIT MEMO WOULD HAVE DTSBE722
00030 *                BEEN SENT WHEN THE CREDIT WAS ORIGINALLY         DTSBE722
00031 *                ESTABLISHED.                                     DTSBE722
00032 *                MODIFIED TO EXCLUDE DELINQUENT EMPLOYERS, SINCE  DTSBE722
00033 *                THE CREDIT CANNOT BE REFUNDED.                   DTSBE722
00034 *                WORK ORDER:                      PROGRAMMER: GD  DTSBE722
00035 *                                                                 DTSBE722
00036 *    06/24/2010  CHANGED WRK-MIN-CREDIT FROM $10.00 TO $100.00.   DTSBE722
00037 *                WORK ORDER:                      PROGRAMMER: GD  DTSBE722
00038 *                                                                 DTSBE722
00039 *    05/07/2013  CHANGED TO EXCLUDE DUMMY ACCT #010 010 - NON     DTSBE722
00040 *                DOES CHECK ACCOUNT               PROGRAMMER: ZL1 DTSBE722
00041 *                                                                 DTSBE722
00042 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE722
00043 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE722
00044 *                WORK ORDER:                      PROGRAMMER: XXX DTSBE722
00045 *                                                                 DTSBE722
00046 *                                                                 DTSBE722
00047 *  DESCRIPTION:                                                   DTSBE722
00048 *                                                                 DTSBE722
00049 *                                                                 DTSBE722
00050 *    INITIATION:                                                  DTSBE722
00051 *                                                                 DTSBE722
00052 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE722
00053 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE722
00054 *                                                                 DTSBE722
00055 *      EDIT AND DEFAULT PARAMETERS.                               DTSBE722
00056 *                                                                 DTSBE722
00057 *                                                                 DTSBE722
00058 *    PROCESSING:                                                  DTSBE722
00059 *                                                                 DTSBE722
00060 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (722R1).       DTSBE722
00061 *                                                                 DTSBE722
00062 *                                                                 DTSBE722
00063 *    TERMINATION:                                                 DTSBE722
00064 *                                                                 DTSBE722
00065 *      NONE.                                                      DTSBE722
00066 *                                                                 DTSBE722
00067 *                                                                 DTSBE722
00068 *    RECORDS READ:                                                DTSBE722
00069 *                                                                 DTSBE722
00070 *      MASTER:                                                    DTSBE722
00071 *                                                                 DTSBE722
00072 *        MJRN                                                     DTSBE722
00073 *                                                                 DTSBE722
00074 *                                                                 DTSBE722
00075 *      ALTERNATE INDEX:                                           DTSBE722
00076 *                                                                 DTSBE722
00077 *        NONE.                                                    DTSBE722
00078 *                                                                 DTSBE722
00079 *                                                                 DTSBE722
00080 *      REFERENCE:                                                 DTSBE722
00081 *                                                                 DTSBE722
00082 *        NONE.                                                    DTSBE722
00083 *                                                                 DTSBE722
00084 *                                                                 DTSBE722
00085 *    RECORDS UPDATED:                                             DTSBE722
00086 *                                                                 DTSBE722
00087 *        NONE.                                                    DTSBE722
00088 *                                                                 DTSBE722
00089 *                                                                 DTSBE722
00090 *    REPORT RECORDS WRITTEN:                                      DTSBE722
00091 *                                                                 DTSBE722
00092 *        R722 RQC CREDITS/REFUNDS CONTRIBTORY EMPLOYERS           DTSBE722
00093 *             UNIVERSE RECORDS.                                   DTSBE722
00094 *                                                                 DTSBE722
00095 *                                                                 DTSBE722
00096 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE722
00097 *                                                                 DTSBE722
00098 *        NONE.                                                    DTSBE722
00099 *                                                                 DTSBE722
00100 *                                                                 DTSBE722
00101 *    MODULES CALLED:                                              DTSBE722
00102 *                                                                 DTSBE722
00103 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBE722
00104 *        DTSBU910  MASTER FILE I/O.                               DTSBE722
00105 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE722
00106 *                                                                 DTSBE722
00107 *                                                                 DTSBE722
00108 *    VERMONT REFERENCE:                                           DTSBE722
00109 *                                                                 DTSBE722
00110 *        NONE.                                                    DTSBE722
00111 *                                                                 DTSBE722
00112 *****                                                             DTSBE722
00113      SKIP3                                                        DTSBE722
00114  ENVIRONMENT DIVISION.                                            DTSBE722
00115      EJECT                                                        DTSBE722
00116  DATA DIVISION.                                                   DTSBE722
00117      SKIP3                                                        DTSBE722
00118  WORKING-STORAGE SECTION.                                         DTSBE722
001185 77  PAN-VALET PICTURE X(24) VALUE '022DTSBE722  05/07/13'.       DTSBE722
00119  77  PAN-VALET PICTURE X(24) VALUE '002DTSBE722  05/07/13'.       DTSBE722
00120  77  PAN-VALET PICTURE X(24) VALUE '020DTSBE722  06/24/10'.       DTSBE722
00121      SKIP3                                                        DTSBE722
00122  01  WRK-AREA.                                                    DTSBE722
00123      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +722.DTSBE722
00124      SKIP1                                                        DTSBE722
00125      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE722'.DTSBE722
00126      SKIP3                                                        DTSBE722
00127      05  ABEND-MSG                   PIC  X(60).                  DTSBE722
00128      SKIP3                                                        DTSBE722
00129      05  WRK-PARM-PERIOD-START-DATE  PIC S9(09)  COMP-3.          DTSBE722
00130                                                                   DTSBE722
00131      05  WRK-PARM-PERIOD-END-DATE    PIC S9(09)  COMP-3.          DTSBE722
00132                                                                   DTSBE722
00133      05  WRK-ABSTIME                 PIC S9(15)  COMP-3.          DTSBE722
00134                                                                   DTSBE722
00135      05  WRK-MIN-CREDIT              PIC S9(09)V9(02)  COMP-3     DTSBE722
00136                                       VALUE +100.                 DTSBE722
00137      05  WRK-TOT-CREDIT              PIC S9(09)V9(02)  COMP-3     DTSBE722
00138                                       VALUE +0.                   DTSBE722
00139      05  WRK-UI-PAID                 PIC S9(09)V9(02)  COMP-3     DTSBE722
00140                                       VALUE +0.                   DTSBE722
00141      05  WRK-CREDIT-BATCHES.                                      DTSBE722
00142          10  CSUB                    PIC S9(04) COMP VALUE +0.    DTSBE722
00143          10  CTBL-LAST               PIC S9(04) COMP VALUE +0.    DTSBE722
00144          10  CTBL-MAX                PIC S9(04) COMP VALUE +100.  DTSBE722
00145          10  WRK-CR-TABLE  OCCURS 100 TIMES.                      DTSBE722
00146              15  CR-BATCH            PIC S9(05) COMP-3.           DTSBE722
00147              15  CR-ITEM             PIC S9(03) COMP-3.           DTSBE722
00148              15  CR-ESTB-DT          PIC S9(09) COMP-3.           DTSBE722
00149                                                                   DTSBE722
00150      05  WRK-JRN-FOUND-IND           PIC  X(01).                  DTSBE722
00151          88  WRK-JRN-FOUND-YES-88     VALUE 'Y'.                  DTSBE722
00152          88  WRK-JRN-FOUND-NO-88      VALUE 'N'.                  DTSBE722
00153                                                                   DTSBE722
00154 **   05  WRK-TOT-CHARGE              PIC S9(09)V9(02)  COMP-3.    DTSBE722
00155 *                                                                 DTSBE722
00156 *    05  WRK-TRN-CREDIT              PIC S9(09)V9(02)  COMP-3.    DTSBE722
00157 *    05  WRK-TRN-CHARGE              PIC S9(09)V9(02)  COMP-3.    DTSBE722
00158 *                                                                 DTSBE722
00159 *    05  WRK-TRN-TABLE-AREA.                                      DTSBE722
00160 *        10  TRN-SUB                 PIC S9(04)        COMP.      DTSBE722
00161 *        10  TRN-LAST                PIC S9(04) COMP.             DTSBE722
00162 *        10  TRN-MAX                 PIC S9(04) COMP VALUE +100.  DTSBE722
00163 *    05  WRK-TRN-TABLE OCCURS 100 TIMES.                          DTSBE722
00164 *        10  TRN-YRQ                 PIC S9(05)        COMP-3.    DTSBE722
00165 *                                                                 DTSBE722
00166 *    05  WRK-QTR-FOUND-IND           PIC  X(01).                  DTSBE722
00167 *        88  WRK-QTR-FOUND-YES-88     VALUE 'Y'.                  DTSBE722
00168 **       88  WRK-QTR-FOUND-NO-88      VALUE 'N'.                  DTSBE722
00169                                                                   DTSBE722
00170      05  AMT-DISP1                   PIC ---------9.99.           DTSBE722
00171      05  AMT-DISP2                   PIC ---------9.99.           DTSBE722
00172      05  AMT-DISP3                   PIC ---------9.99.           DTSBE722
00173      05  AMT-DISP4                   PIC ---------9.99.           DTSBE722
00174      EJECT                                                        DTSBE722
00175  01  L001-LINK-AREA.                                              DTSBE722
00176  ++INCLUDE  DTSIL001                                              DTSBE722
00177      EJECT                                                        DTSBE722
00178  01  L005-LINK-AREA.                                              DTSBE722
00179  ++INCLUDE  DTSIL005                                              DTSBE722
00180      EJECT                                                        DTSBE722
00181  01  L910-LINK-AREA.                                              DTSBE722
00182  ++INCLUDE  DTSIL910                                              DTSBE722
00183      SKIP3                                                        DTSBE722
00184  01  MSKL-REC.                                                    DTSBE722
00185  ++INCLUDE  DTSIMSKL                                              DTSBE722
00186      SKIP3                                                        DTSBE722
00187  01  MDST-REC.                                                    DTSBE722
00188  ++INCLUDE  DTSIMDST                                              DTSBE722
00189                                                                   DTSBE722
00190  01  MJRN-REC.                                                    DTSBE722
00191  ++INCLUDE  DTSIMJRN                                              DTSBE722
00192                                                                   DTSBE722
00193  01  MPAY-REC.                                                    DTSBE722
00194  ++INCLUDE  DTSIMPAY                                              DTSBE722
00195      EJECT                                                        DTSBE722
00196  01  R722-REC.                                                    DTSBE722
00197  ++INCLUDE  DTSIR722                                              DTSBE722
00198      EJECT                                                        DTSBE722
00199  LINKAGE SECTION.                                                 DTSBE722
00200      SKIP3                                                        DTSBE722
00201  01  LECM-LINK-AREA.                                              DTSBE722
00202  ++INCLUDE  DTSILECM                                              DTSBE722
00203      SKIP3                                                        DTSBE722
00204          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE722
00205              15  LECM-PARM-PERIOD-START-DATE  PIC  X(06).         DTSBE722
00206              15  FILLER                       PIC  X(01).         DTSBE722
00207              15  LECM-PARM-PERIOD-END-DATE    PIC  X(06).         DTSBE722
00208              15  FILLER                       PIC  X(55).         DTSBE722
00209      EJECT                                                        DTSBE722
00210  01  MPRF-LINK-REC.                                               DTSBE722
00211  ++INCLUDE  DTSIMPRF                                              DTSBE722
00212      EJECT                                                        DTSBE722
00213  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE722
00214                           MPRF-LINK-REC.                          DTSBE722
00215      SKIP2                                                        DTSBE722
00216      MOVE LENGTH OF R722-REC TO R722-LENGTH.                      DTSBE722
00217      MOVE '722'              TO R722-REC-TYPE.                    DTSBE722
00218      SKIP2                                                        DTSBE722
00219      IF LECM-PROCESS-88                                           DTSBE722
00220          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE722
00221      ELSE                                                         DTSBE722
00222      IF LECM-INITIALIZE-88                                        DTSBE722
00223          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE722
00224      ELSE                                                         DTSBE722
00225      IF LECM-TERMINATE-88                                         DTSBE722
00226          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE722
00227      ELSE                                                         DTSBE722
00228          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE722
00229            TO ABEND-MSG                                           DTSBE722
00230          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE722
00231      SKIP2                                                        DTSBE722
00232      GOBACK.                                                      DTSBE722
00233      EJECT                                                        DTSBE722
00234  I0000-INITIALIZE.                                                DTSBE722
00235      SKIP2                                                        DTSBE722
00236      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE722
00237      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE722
00238                                                                   DTSBE722
00239      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE722
00240                                                                   DTSBE722
00241      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE722
00242      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE722
00243      SKIP2                                                        DTSBE722
00244  I0000-EXIT.                                                      DTSBE722
00245      EXIT.                                                        DTSBE722
00246      SKIP3                                                        DTSBE722
00247  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE722
00248      PERFORM I1100-PERIOD-START-DATE THRU I1100-EXIT.             DTSBE722
00249                                                                   DTSBE722
00250      PERFORM I1200-PERIOD-END-DATE THRU I1200-EXIT.               DTSBE722
00251  I1000-EXIT.                                                      DTSBE722
00252      EXIT.                                                        DTSBE722
00253      SKIP3                                                        DTSBE722
00254  I1100-PERIOD-START-DATE.                                         DTSBE722
00255      IF LECM-PARM-PERIOD-START-DATE = SPACES                      DTSBE722
00256          MOVE 'LECM-PARM-PERIOD-START-DATE IS MISSING'            DTSBE722
00257            TO ABEND-MSG                                           DTSBE722
00258          PERFORM S999-ABEND THRU S999-EXIT                        DTSBE722
00259      ELSE                                                         DTSBE722
00260          MOVE LECM-PARM-PERIOD-START-DATE TO L001-CAL-6-DATE-X    DTSBE722
00261          PERFORM S001-FROM-CAL-6 THRU S001-EXIT                   DTSBE722
00262          IF L001-VALID-DATE                                       DTSBE722
00263              MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE722
00264          ELSE                                                     DTSBE722
00265              MOVE 'LECM-PARM-PERIOD-START-DATE NOT VALID'         DTSBE722
00266                TO ABEND-MSG                                       DTSBE722
00267              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE722
00268                                                                   DTSBE722
00269      IF WRK-PARM-PERIOD-START-DATE > LECM-LAST-MJRN-PURGE-DATE    DTSBE722
00270          NEXT SENTENCE                                            DTSBE722
00271      ELSE                                                         DTSBE722
00272          MOVE                                                     DTSBE722
00273      'PERIOD-START-DATE NOT GREATER THAN LAST-MJRN-PURGE-DATE'    DTSBE722
00274            TO ABEND-MSG                                           DTSBE722
00275          PERFORM S999-ABEND THRU S999-EXIT                        DTSBE722
00276      END-IF.                                                      DTSBE722
00277                                                                   DTSBE722
00278      MOVE WRK-PARM-PERIOD-START-DATE  TO L005-DATE.               DTSBE722
00279      MOVE ZERO                        TO L005-TIME.               DTSBE722
00280      PERFORM S005-FROM-DATE-TIME      THRU S005-EXIT.             DTSBE722
00281      MOVE L005-ABSTIME                TO WRK-ABSTIME.             DTSBE722
00282                                                                   DTSBE722
00283      DISPLAY 'ABSTIME ' WRK-ABSTIME.                              DTSBE722
00284                                                                   DTSBE722
00285  I1100-EXIT.                                                      DTSBE722
00286      EXIT.                                                        DTSBE722
00287      SKIP3                                                        DTSBE722
00288  I1200-PERIOD-END-DATE.                                           DTSBE722
00289      IF LECM-PARM-PERIOD-END-DATE = SPACES                        DTSBE722
00290          MOVE 'LECM-PARM-PERIOD-END-DATE IS MISSING'              DTSBE722
00291            TO ABEND-MSG                                           DTSBE722
00292          PERFORM S999-ABEND THRU S999-EXIT                        DTSBE722
00293      ELSE                                                         DTSBE722
00294          MOVE LECM-PARM-PERIOD-END-DATE TO L001-CAL-6-DATE-X      DTSBE722
00295          PERFORM S001-FROM-CAL-6 THRU S001-EXIT                   DTSBE722
00296          IF L001-VALID-DATE                                       DTSBE722
00297              MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-END-DATE   DTSBE722
00298          ELSE                                                     DTSBE722
00299              MOVE 'LECM-PARM-PERIOD-END-DATE NOT VALID'           DTSBE722
00300                TO ABEND-MSG                                       DTSBE722
00301              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE722
00302                                                                   DTSBE722
00303      IF WRK-PARM-PERIOD-END-DATE < WRK-PARM-PERIOD-START-DATE     DTSBE722
00304          MOVE                                                     DTSBE722
00305            'PERIOD-END-DATE IS LESS THAN PERIOD-START-DATE'       DTSBE722
00306            TO ABEND-MSG                                           DTSBE722
00307          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE722
00308  I1200-EXIT.                                                      DTSBE722
00309      EXIT.                                                        DTSBE722
00310      EJECT                                                        DTSBE722
00311  P0000-PROCESS.                                                   DTSBE722
00312      IF MPRF-EMP-NO = 010010                                      DTSBE722
00313          GO TO P0000-EXIT.                                        DTSBE722
00314                                                                   DTSBE722
00315      IF MPRF-CLASS-SELF-INS-88                                    DTSBE722
00316          GO TO P0000-EXIT.                                        DTSBE722
00317                                                                   DTSBE722
00318      IF MPRF-TOT-CREDIT-AMT = ZERO                                DTSBE722
00319          GO TO P0000-EXIT.                                        DTSBE722
00320                                                                   DTSBE722
00321      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSBE722
00322         NEXT SENTENCE                                             DTSBE722
00323      ELSE                                                         DTSBE722
00324          GO TO P0000-EXIT.                                        DTSBE722
00325                                                                   DTSBE722
00326      IF MPRF-PURSUED-RPT-CNT > ZERO                               DTSBE722
00327          GO TO P0000-EXIT                                         DTSBE722
00328      END-IF.                                                      DTSBE722
00329                                                                   DTSBE722
00330      MOVE +0 TO WRK-TOT-CREDIT                                    DTSBE722
00331                 WRK-UI-PAID                                       DTSBE722
00332                 CTBL-LAST.                                        DTSBE722
00333                                                                   DTSBE722
00334      PERFORM                                                      DTSBE722
00335        VARYING CSUB FROM +1 BY +1                                 DTSBE722
00336        UNTIL CSUB > CTBL-MAX                                      DTSBE722
00337          MOVE ZEROS                     TO CR-BATCH (CSUB)        DTSBE722
00338                                            CR-ITEM (CSUB)         DTSBE722
00339                                            CR-ESTB-DT (CSUB)      DTSBE722
00340      END-PERFORM.                                                 DTSBE722
00341                                                                   DTSBE722
00342 ************************************************************      DTSBE722
00343 * FIND ALL OUTSTANDING CREDITS ESTABLISHED WITHIN THE             DTSBE722
00344 * REPORTING PERIOD.  BUILD A TABLE CONTAINING THE BATCH           DTSBE722
00345 * AND ITEM NUMBERS OF EACH CREDIT FOUND.  A SECOND PROCESS        DTSBE722
00346 * (P2000-TPS-DATA) WILL FIND THE AMOUNTS DISTRIBUTED              DTSBE722
00347 * TO UI TAX FOR EACH PAYMENT SELECTED.                            DTSBE722
00348 ************************************************************      DTSBE722
00349      MOVE LOW-VALUES                    TO MDST-KEY-AREA.         DTSBE722
00350      MOVE MPRF-EMP-NO                   TO MDST-EMP-NO.           DTSBE722
00351      SET MDST-DST-88                    TO TRUE.                  DTSBE722
00352      MOVE ZEROS                         TO MDST-BATCH-NO          DTSBE722
00353                                            MDST-ITEM-NO.          DTSBE722
00354      MOVE MDST-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBE722
00355      PERFORM S910-START-BROWSE          THRU S910-EXIT.           DTSBE722
00356                                                                   DTSBE722
00357      PERFORM UNTIL L910-NO-REC-88                                 DTSBE722
00358        MOVE MSKL-REC                    TO MDST-REC               DTSBE722
00359        IF MDST-CREDIT-REC-88                                      DTSBE722
00360        AND MDST-ESTB-DATE >= WRK-PARM-PERIOD-START-DATE           DTSBE722
00361        AND MDST-ESTB-DATE <= WRK-PARM-PERIOD-END-DATE             DTSBE722
00362          PERFORM P1000-CHECK-MJRN       THRU P1000-EXIT           DTSBE722
00363          IF WRK-JRN-FOUND-YES-88                                  DTSBE722
00364             PERFORM P1100-ADD-TO-TABLE  THRU P1100-EXIT           DTSBE722
00365           END-IF                                                  DTSBE722
00366        END-IF                                                     DTSBE722
00367        MOVE MDST-REC                    TO MSKL-REC               DTSBE722
00368        PERFORM S910-READ-NEXT           THRU S910-EXIT            DTSBE722
00369      END-PERFORM.                                                 DTSBE722
00370                                                                   DTSBE722
00371      IF CTBL-LAST > ZERO                                          DTSBE722
00372 **      DISPLAY 'P0000 ' MPRF-EMP-NO '  ' CTBL-LAST               DTSBE722
00373 **        '  ' CR-BATCH (1) ' ' CR-ITEM (1)                       DTSBE722
00374         PERFORM P2000-TPS-DATA          THRU P2000-EXIT           DTSBE722
00375      END-IF.                                                      DTSBE722
00376                                                                   DTSBE722
00377 **   MOVE +0 TO WRK-TOT-CREDIT                                    DTSBE722
00378 *               WRK-TOT-CHARGE.                                   DTSBE722
00379 *                                                                 DTSBE722
00380 *    MOVE LOW-VALUES TO MJRN-KEY-AREA.                            DTSBE722
00381 *    MOVE MPRF-EMP-NO TO MJRN-EMP-NO.                             DTSBE722
00382 *    MOVE WRK-ABSTIME TO MJRN-ESTB-ABSTIME.                       DTSBE722
00383 *    SET MJRN-JRN-88 TO TRUE.                                     DTSBE722
00384 *    MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE722
00385 *    PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE722
00386 *    PERFORM P1000-SCAN-MJRN THRU P1000-EXIT                      DTSBE722
00387 *        UNTIL L910-NO-REC-88.                                    DTSBE722
00388 *                                                                 DTSBE722
00389 *    IF WRK-TOT-CREDIT > ZERO                                     DTSBE722
00390 *        NEXT SENTENCE                                            DTSBE722
00391 *    ELSE                                                         DTSBE722
00392 *        GO TO P0000-EXIT.                                        DTSBE722
00393 *                                                                 DTSBE722
00394 *    MOVE MPRF-EMP-NO TO R722-EMP-NO.                             DTSBE722
00395 *    MOVE LECM-PRIOR-RUN-DATE TO R722-RUN-DATE.                   DTSBE722
00396 *    MOVE WRK-TOT-CHARGE      TO R722-TAX-DUE.                    DTSBE722
00397 *    COMPUTE R722-TAX-PAID =                                      DTSBE722
00398 *       (WRK-TOT-CHARGE + WRK-TOT-CREDIT).                        DTSBE722
00399 *                                                                 DTSBE722
00400 **   PERFORM S946-WRITE-R722 THRU S946-EXIT.                      DTSBE722
00401  P0000-EXIT.                                                      DTSBE722
00402      EXIT.                                                        DTSBE722
00403                                                                   DTSBE722
00404  P1000-CHECK-MJRN.                                                DTSBE722
00405      SET WRK-JRN-FOUND-NO-88            TO TRUE.                  DTSBE722
00406                                                                   DTSBE722
00407      MOVE MDST-ESTB-DATE                TO L005-DATE.             DTSBE722
00408      MOVE ZEROS                         TO L005-TIME.             DTSBE722
00409      PERFORM S005-FROM-DATE-TIME        THRU S005-EXIT.           DTSBE722
00410                                                                   DTSBE722
00411      MOVE LOW-VALUES                    TO MJRN-KEY-AREA.         DTSBE722
00412      MOVE MPRF-EMP-NO                   TO MJRN-EMP-NO.           DTSBE722
00413      MOVE L005-ABSTIME                  TO MJRN-ESTB-ABSTIME.     DTSBE722
00414      SET MJRN-JRN-88                    TO TRUE.                  DTSBE722
00415      MOVE MJRN-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBE722
00416      PERFORM S910-START-BROWSE          THRU S910-EXIT.           DTSBE722
00417      PERFORM                                                      DTSBE722
00418        UNTIL L910-NO-REC-88                                       DTSBE722
00419        OR WRK-JRN-FOUND-YES-88                                    DTSBE722
00420          MOVE MSKL-REC                  TO MJRN-REC               DTSBE722
00421          IF MJRN-ESTB-DATE = MDST-ESTB-DATE                       DTSBE722
00422            PERFORM                                                DTSBE722
00423              VARYING MJRN-OCC-IDX FROM 1 BY 1                     DTSBE722
00424              UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT                    DTSBE722
00425                IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX)               DTSBE722
00426                AND MJRN-COL-PAID-88 (MJRN-OCC-IDX)                DTSBE722
00427                AND MJRN-AMT (MJRN-OCC-IDX) > ZERO                 DTSBE722
00428                AND NOT MJRN-REF-REV-PAY-88                        DTSBE722
00429                  SET WRK-JRN-FOUND-YES-88  TO TRUE                DTSBE722
00430                  DISPLAY 'JRN ' MJRN-EMP-NO '  ' MJRN-BATCH-NO    DTSBE722
00431                    ' ' MJRN-ITEM-NO                               DTSBE722
00432                  DISPLAY 'DST ' MDST-BATCH-NO ' ' MDST-ITEM-NO    DTSBE722
00433                END-IF                                             DTSBE722
00434            END-PERFORM                                            DTSBE722
00435          END-IF                                                   DTSBE722
00436          PERFORM S910-READ-NEXT              THRU S910-EXIT       DTSBE722
00437      END-PERFORM.                                                 DTSBE722
00438                                                                   DTSBE722
00439  P1000-EXIT.                                                      DTSBE722
00440      EXIT.                                                        DTSBE722
00441                                                                   DTSBE722
00442  P1100-ADD-TO-TABLE.                                              DTSBE722
00443      PERFORM                                                      DTSBE722
00444        VARYING MDST-ACCT-IDX FROM +1 BY +1                        DTSBE722
00445        UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT                        DTSBE722
00446          IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)                 DTSBE722
00447          AND MDST-AMT (MDST-ACCT-IDX) > WRK-MIN-CREDIT            DTSBE722
00448            IF CTBL-LAST < CTBL-MAX                                DTSBE722
00449              ADD +1                     TO CTBL-LAST              DTSBE722
00450              MOVE CTBL-LAST             TO CSUB                   DTSBE722
00451              MOVE MDST-BATCH-NO         TO CR-BATCH (CSUB)        DTSBE722
00452              MOVE MDST-ITEM-NO          TO CR-ITEM (CSUB)         DTSBE722
00453              MOVE MDST-ESTB-DATE        TO CR-ESTB-DT (CSUB)      DTSBE722
00454            ELSE                                                   DTSBE722
00455              DISPLAY 'P1100 TBL LENGTH EXCEEDED ' MPRF-EMP-NO     DTSBE722
00456            END-IF                                                 DTSBE722
00457          END-IF                                                   DTSBE722
00458      END-PERFORM.                                                 DTSBE722
00459                                                                   DTSBE722
00460  P1100-EXIT.                                                      DTSBE722
00461      EXIT.                                                        DTSBE722
00462                                                                   DTSBE722
00463                                                                   DTSBE722
00464  P2000-TPS-DATA.                                                  DTSBE722
00465      PERFORM                                                      DTSBE722
00466        VARYING CSUB FROM +1 BY +1                                 DTSBE722
00467        UNTIL CSUB > CTBL-LAST                                     DTSBE722
00468           PERFORM P2100-MDST-DATA       THRU P2100-EXIT           DTSBE722
00469      END-PERFORM.                                                 DTSBE722
00470                                                                   DTSBE722
00471  P2000-EXIT.                                                      DTSBE722
00472      EXIT.                                                        DTSBE722
00473                                                                   DTSBE722
00474  P2100-MDST-DATA.                                                 DTSBE722
00475      IF MPRF-EMP-NO = 036703                                      DTSBE722
00476      DISPLAY 'P2100 ' MPRF-EMP-NO '  ' CR-BATCH (CSUB)            DTSBE722
00477         '  ' CR-ITEM (CSUB) '  ' CR-ESTB-DT (CSUB)                DTSBE722
00478      END-IF.                                                      DTSBE722
00479      MOVE ZERO                            TO WRK-TOT-CREDIT       DTSBE722
00480                                              WRK-UI-PAID.         DTSBE722
00481                                                                   DTSBE722
00482      MOVE LOW-VALUES                          TO MDST-KEY-AREA.   DTSBE722
00483      MOVE MPRF-EMP-NO                         TO MDST-EMP-NO.     DTSBE722
00484      SET MDST-DST-88                          TO TRUE.            DTSBE722
00485      MOVE ZERO                                TO MDST-YRQ         DTSBE722
00486                                                  MDST-BATCH-NO    DTSBE722
00487                                                  MDST-ITEM-NO.    DTSBE722
00488      MOVE MDST-KEY-AREA                       TO MSKL-KEY-AREA.   DTSBE722
00489      PERFORM S910-START-BROWSE                THRU S910-EXIT.     DTSBE722
00490                                                                   DTSBE722
00491      PERFORM UNTIL L910-NO-REC-88                                 DTSBE722
00492        MOVE MSKL-REC                          TO MDST-REC         DTSBE722
00493        IF MDST-BATCH-NO = CR-BATCH (CSUB)                         DTSBE722
00494        AND MDST-ITEM-NO = CR-ITEM (CSUB)                          DTSBE722
00495          PERFORM                                                  DTSBE722
00496            VARYING MDST-ACCT-IDX FROM +1 BY +1                    DTSBE722
00497            UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT                    DTSBE722
00498              IF MDST-ACCT-UI-88 (MDST-ACCT-IDX)                   DTSBE722
00499                ADD MDST-AMT (MDST-ACCT-IDX)                       DTSBE722
00500                                          TO WRK-UI-PAID           DTSBE722
00501              ELSE                                                 DTSBE722
00502                IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)           DTSBE722
00503                  ADD MDST-AMT (MDST-ACCT-IDX)                     DTSBE722
00504                                          TO WRK-TOT-CREDIT        DTSBE722
00505                END-IF                                             DTSBE722
00506              END-IF                                               DTSBE722
00507          END-PERFORM                                              DTSBE722
00508        END-IF                                                     DTSBE722
00509        PERFORM S910-READ-NEXT            THRU S910-EXIT           DTSBE722
00510      END-PERFORM.                                                 DTSBE722
00511                                                                   DTSBE722
00512      PERFORM P2300-WRITE-R722            THRU P2300-EXIT.         DTSBE722
00513                                                                   DTSBE722
00514 **   IF MPRF-EMP-NO = 036703                                      DTSBE722
00515 *       MOVE WRK-TOT-CREDIT         TO AMT-DISP1                  DTSBE722
00516 *       MOVE WRK-UI-PAID            TO AMT-DISP2                  DTSBE722
00517 *       DISPLAY 'P2100 CR ' AMT-DISP1 '  PD ' AMT-DISP2           DTSBE722
00518 **   END-IF.                                                      DTSBE722
00519                                                                   DTSBE722
00520  P2100-EXIT.                                                      DTSBE722
00521      EXIT.                                                        DTSBE722
00522                                                                   DTSBE722
00523 *P2200-MPAY-DATA.                                                 DTSBE722
00524 *    DISPLAY 'P2200 ' MPRF-EMP-NO '  ' CR-BATCH (CSUB)            DTSBE722
00525 *       '  ' CR-ITEM (CSUB).                                      DTSBE722
00526 *                                                                 DTSBE722
00527 *    MOVE LOW-VALUES                    TO MPAY-KEY-AREA.         DTSBE722
00528 *    MOVE MPRF-EMP-NO                   TO MPAY-EMP-NO.           DTSBE722
00529 *    SET MPAY-PAY-88                    TO TRUE.                  DTSBE722
00530 *    MOVE CR-BATCH (CSUB)               TO MPAY-BATCH-NO          DTSBE722
00531 *    MOVE CR-ITEM (CSUB)                TO MPAY-ITEM-NO.          DTSBE722
00532 *    MOVE MPAY-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBE722
00533 *    PERFORM S910-READ                  THRU S910-EXIT.           DTSBE722
00534 *    IF L910-NO-REC-88                                            DTSBE722
00535 *       DISPLAY 'MPAY NOT FOUND ' MPRF-EMP-NO                     DTSBE722
00536 *          '  ' MDST-BATCH-NO '  ' MDST-ITEM-NO                   DTSBE722
00537 *       PERFORM S999-ABEND              THRU S999-EXIT            DTSBE722
00538 *    ELSE                                                         DTSBE722
00539 *       MOVE MSKL-REC                   TO MPAY-REC               DTSBE722
00540 *       MOVE MPAY-REMIT-AMT             TO WRK-REMIT-AMT          DTSBE722
00541 *    END-IF.                                                      DTSBE722
00542 *P2200-EXIT.                                                      DTSBE722
00543 *    EXIT.                                                        DTSBE722
00544                                                                   DTSBE722
00545  P2300-WRITE-R722.                                                DTSBE722
00546      IF WRK-TOT-CREDIT > ZERO                                     DTSBE722
00547         NEXT SENTENCE                                             DTSBE722
00548      ELSE                                                         DTSBE722
00549         GO TO P2300-EXIT                                          DTSBE722
00550      END-IF.                                                      DTSBE722
00551                                                                   DTSBE722
00552      MOVE MPRF-EMP-NO            TO R722-EMP-NO.                  DTSBE722
00553      MOVE CR-ESTB-DT (CSUB)      TO R722-RUN-DATE.                DTSBE722
00554 ***  MOVE LECM-PRIOR-RUN-DATE    TO R722-RUN-DATE.                DTSBE722
00555      MOVE WRK-UI-PAID            TO R722-TAX-DUE.                 DTSBE722
00556      COMPUTE R722-TAX-PAID =                                      DTSBE722
00557         (WRK-UI-PAID + WRK-TOT-CREDIT).                           DTSBE722
00558                                                                   DTSBE722
00559      PERFORM S946-WRITE-R722     THRU S946-EXIT.                  DTSBE722
00560                                                                   DTSBE722
00561      MOVE WRK-TOT-CREDIT         TO AMT-DISP1.                    DTSBE722
00562      MOVE WRK-UI-PAID            TO AMT-DISP2.                    DTSBE722
00563      MOVE R722-TAX-PAID          TO AMT-DISP3.                    DTSBE722
00564      DISPLAY MPRF-EMP-NO '  ' CR-BATCH (CSUB)                     DTSBE722
00565         ' ' CR-ITEM (CSUB)                                        DTSBE722
00566         '  CR ' AMT-DISP1                                         DTSBE722
00567         '  PD ' AMT-DISP2                                         DTSBE722
00568         '  R722 ' AMT-DISP3.                                      DTSBE722
00569  P2300-EXIT.                                                      DTSBE722
00570      EXIT.                                                        DTSBE722
00571                                                                   DTSBE722
00572 *P1000-SCAN-MJRN.                                                 DTSBE722
00573 *    MOVE +0 TO WRK-TRN-CREDIT                                    DTSBE722
00574 *               TRN-LAST.                                         DTSBE722
00575 *                                                                 DTSBE722
00576 *    PERFORM                                                      DTSBE722
00577 *       VARYING TRN-SUB FROM +1 BY +1                             DTSBE722
00578 *       UNTIL TRN-SUB > TRN-MAX                                   DTSBE722
00579 *          MOVE ZERO      TO TRN-YRQ (TRN-SUB)                    DTSBE722
00580 *    END-PERFORM.                                                 DTSBE722
00581 *                                                                 DTSBE722
00582 *    MOVE MSKL-REC TO MJRN-REC.                                   DTSBE722
00583 *                                                                 DTSBE722
00584 *    IF MJRN-TRAN-CNVR-88                                         DTSBE722
00585 *        NEXT SENTENCE                                            DTSBE722
00586 *    ELSE                                                         DTSBE722
00587 *       IF MJRN-ESTB-DATE < WRK-PARM-PERIOD-START-DATE            DTSBE722
00588 *       OR MJRN-ESTB-DATE > WRK-PARM-PERIOD-END-DATE              DTSBE722
00589 *          NEXT SENTENCE                                          DTSBE722
00590 *       ELSE                                                      DTSBE722
00591 *          PERFORM P1100-ACCT-GROUP-SCAN THRU P1100-EXIT          DTSBE722
00592 *             VARYING MJRN-OCC-IDX FROM 1 BY 1                    DTSBE722
00593 *             UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT                   DTSBE722
00594 *       END-IF                                                    DTSBE722
00595 *       IF WRK-TRN-CREDIT > ZERO                                  DTSBE722
00596 *          PERFORM P1200-GET-UI-CHARGE THRU P1200-EXIT            DTSBE722
00597 *          ADD WRK-TRN-CREDIT          TO WRK-TOT-CREDIT          DTSBE722
00598 *       END-IF                                                    DTSBE722
00599 *    END-IF.                                                      DTSBE722
00600 *                                                                 DTSBE722
00601 *    MOVE MJRN-REC          TO MSKL-REC.                          DTSBE722
00602 *    PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE722
00603 *P1000-EXIT.                                                      DTSBE722
00604 *    EXIT.                                                        DTSBE722
00605 *    SKIP3                                                        DTSBE722
00606 *P1100-ACCT-GROUP-SCAN.                                           DTSBE722
00607 *    IF MJRN-ROW-UI-88 (MJRN-OCC-IDX)                             DTSBE722
00608 *       PERFORM P1110-UI-TAX THRU P1110-EXIT                      DTSBE722
00609 *    ELSE                                                         DTSBE722
00610 *       IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX)                      DTSBE722
00611 *          PERFORM P1120-CREDIT THRU P1120-EXIT                   DTSBE722
00612 *       END-IF                                                    DTSBE722
00613 *    END-IF.                                                      DTSBE722
00614 *                                                                 DTSBE722
00615 *P1100-EXIT.                                                      DTSBE722
00616 *    EXIT.                                                        DTSBE722
00617 *    SKIP3                                                        DTSBE722
00618 *P1110-UI-TAX.                                                    DTSBE722
00619 *    SET WRK-QTR-FOUND-NO-88  TO TRUE.                            DTSBE722
00620 *    PERFORM                                                      DTSBE722
00621 *      VARYING TRN-SUB FROM +1 BY +1                              DTSBE722
00622 *      UNTIL TRN-SUB > TRN-LAST                                   DTSBE722
00623 *      OR WRK-QTR-FOUND-YES-88                                    DTSBE722
00624 *         IF MJRN-YRQ (MJRN-OCC-IDX) = TRN-YRQ (TRN-SUB)          DTSBE722
00625 *            SET WRK-QTR-FOUND-YES-88  TO TRUE                    DTSBE722
00626 *         END-IF                                                  DTSBE722
00627 *    END-PERFORM.                                                 DTSBE722
00628 *                                                                 DTSBE722
00629 *    IF WRK-QTR-FOUND-YES-88                                      DTSBE722
00630 *       GO TO P1110-EXIT                                          DTSBE722
00631 *    ELSE                                                         DTSBE722
00632 *       IF TRN-LAST < TRN-MAX                                     DTSBE722
00633 *          ADD +1        TO TRN-LAST                              DTSBE722
00634 *          MOVE MJRN-YRQ (MJRN-OCC-IDX)  TO TRN-YRQ (TRN-LAST)    DTSBE722
00635 *       ELSE                                                      DTSBE722
00636 *          DISPLAY 'TRN-TABLE LENGTH EXCEEDED '                   DTSBE722
00637 *             MPRF-EMP-NO '  ' MJRN-BATCH-NO '  ' MJRN-ITEM-NO    DTSBE722
00638 *          PERFORM S999-ABEND    THRU S999-EXIT                   DTSBE722
00639 *       END-IF                                                    DTSBE722
00640 *    END-IF.                                                      DTSBE722
00641 *                                                                 DTSBE722
00642 *P1110-EXIT.                                                      DTSBE722
00643 *    EXIT.                                                        DTSBE722
00644 *                                                                 DTSBE722
00645 *P1120-CREDIT.                                                    DTSBE722
00646 *    ADD MJRN-AMT (MJRN-OCC-IDX) TO WRK-TRN-CREDIT.               DTSBE722
00647 *                                                                 DTSBE722
00648 *    MOVE MJRN-AMT (MJRN-OCC-IDX) TO AMT-DISP1.                   DTSBE722
00649 *    MOVE WRK-TRN-CREDIT          TO AMT-DISP2.                   DTSBE722
00650 *P1120-EXIT.                                                      DTSBE722
00651 *    EXIT.                                                        DTSBE722
00652 *                                                                 DTSBE722
00653 *P1200-GET-UI-CHARGE.                                             DTSBE722
00654 *    PERFORM                                                      DTSBE722
00655 *       VARYING TRN-SUB FROM +1 BY +1                             DTSBE722
00656 *       UNTIL TRN-SUB > TRN-LAST                                  DTSBE722
00657 *          PERFORM P1210-READ-QTR       THRU P1210-EXIT           DTSBE722
00658 *    END-PERFORM.                                                 DTSBE722
00659 *                                                                 DTSBE722
00660 *P1200-EXIT.                                                      DTSBE722
00661 *    EXIT.                                                        DTSBE722
00662 *                                                                 DTSBE722
00663 *P1210-READ-QTR.                                                  DTSBE722
00664 *    MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE722
00665 *                                                                 DTSBE722
00666 *    MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE722
00667 *    SET MQTR-QTR-88 TO TRUE.                                     DTSBE722
00668 *    MOVE TRN-YRQ (TRN-SUB) TO MQTR-YRQ.                          DTSBE722
00669 *    MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE722
00670 *    PERFORM S910-READ          THRU S910-EXIT.                   DTSBE722
00671 *    IF L910-OK-88                                                DTSBE722
00672 *       MOVE MSKL-REC           TO MQTR-REC                       DTSBE722
00673 *       PERFORM                                                   DTSBE722
00674 *         VARYING MQTR-ACCT-IDX FROM +1 BY +1                     DTSBE722
00675 *         UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                     DTSBE722
00676 *           IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                    DTSBE722
00677 *              ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)               DTSBE722
00678 *               TO WRK-TOT-CHARGE                                 DTSBE722
00679 *           END-IF                                                DTSBE722
00680 *       END-PERFORM.                                              DTSBE722
00681 *                                                                 DTSBE722
00682 *P1210-EXIT.                                                      DTSBE722
00683 **   EXIT.                                                        DTSBE722
00684                                                                   DTSBE722
00685  T0000-TERMINATE.                                                 DTSBE722
00686      SKIP2                                                        DTSBE722
00687      SKIP2                                                        DTSBE722
00688  T0000-EXIT.                                                      DTSBE722
00689      EXIT.                                                        DTSBE722
00690      EJECT                                                        DTSBE722
00691  S001-FROM-FED-8.                                                 DTSBE722
00692      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE722
00693      GO TO S001-DATE.                                             DTSBE722
00694      SKIP1                                                        DTSBE722
00695  S001-FROM-ABS-DAY.                                               DTSBE722
00696      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE722
00697      GO TO S001-DATE.                                             DTSBE722
00698      SKIP1                                                        DTSBE722
00699  S001-FROM-CAL-6.                                                 DTSBE722
00700      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE722
00701      GO TO S001-DATE.                                             DTSBE722
00702      SKIP1                                                        DTSBE722
00703  S001-DATE.                                                       DTSBE722
00704      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE722
00705  S001-EXIT.                                                       DTSBE722
00706      EXIT.                                                        DTSBE722
00707      SKIP3                                                        DTSBE722
00708  S005-FROM-DATE-TIME.                                             DTSBE722
00709      SET L005-FROM-DATE-TIME TO TRUE.                             DTSBE722
00710      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBE722
00711  S005-EXIT.                                                       DTSBE722
00712      EXIT.                                                        DTSBE722
00713                                                                   DTSBE722
00714  S910-READ.                                                       DTSBE722
00715      SET L910-READ-88 TO TRUE.                                    DTSBE722
00716      GO TO S910-MSTR-IO.                                          DTSBE722
00717      SKIP1                                                        DTSBE722
00718  S910-START-BROWSE.                                               DTSBE722
00719      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE722
00720      GO TO S910-MSTR-IO.                                          DTSBE722
00721      SKIP1                                                        DTSBE722
00722  S910-READ-NEXT.                                                  DTSBE722
00723      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE722
00724      GO TO S910-MSTR-IO.                                          DTSBE722
00725      SKIP1                                                        DTSBE722
00726  S910-COUNT.                                                      DTSBE722
00727      SET L910-COUNT-88 TO TRUE.                                   DTSBE722
00728      GO TO S910-MSTR-IO.                                          DTSBE722
00729      SKIP1                                                        DTSBE722
00730  S910-MSTR-IO.                                                    DTSBE722
00731      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE722
00732                            MSKL-REC.                              DTSBE722
00733  S910-EXIT.                                                       DTSBE722
00734      EXIT.                                                        DTSBE722
00735      SKIP3                                                        DTSBE722
00736  S946-WRITE-R722.                                                 DTSBE722
00737      CALL 'DTSBU946' USING R722-REC.                              DTSBE722
00738      GO TO S946-EXIT.                                             DTSBE722
00739      SKIP1                                                        DTSBE722
00740  S946-EXIT.                                                       DTSBE722
00741      EXIT.                                                        DTSBE722
00742      SKIP3                                                        DTSBE722
00743  S999-ABEND.                                                      DTSBE722
00744      DISPLAY '*** DTSBE722 ABENDING.  '                           DTSBE722
00745              ABEND-MSG.                                           DTSBE722
00746      SKIP1                                                        DTSBE722
00747      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE722
00748  S999-EXIT.                                                       DTSBE722
00749      EXIT.                                                        DTSBE722
