00001  IDENTIFICATION DIVISION.                                         03/14/16
00002  PROGRAM-ID.             DTSBD140.                                DTSBD140
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV024
00004  DATE-WRITTEN.           MARCH   1992.                            DTSBD140
00005  DATE-COMPILED.                                                   DTSBD140
00006      SKIP3                                                        DTSBD140
00007 *****                                                             DTSBD140
00008 *                                                                 DTSBD140
00009 *    FUNCTION:  BATCH TRANSACTION COLLECTION FILE SCAN.           DTSBD140
00010 *                                                                 DTSBD140
00011 *                                                                 DTSBD140
00012 *    MODIFICATION LOG:                                            DTSBD140
00013 *                                                                 DTSBD140
00014 *    01/06/92  INITIAL DEVELOPMENT.                               DTSBD140
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD140
00016 *                                                                 DTSBD140
00017 *    05/09/95  AHDR-*-ITEM-CNT  WERE CHANGED TO  AHDR-*-TRAN-CNT. DTSBD140
00018 *              THEY NO LONGER INCLUDE THE CHECKS IN THE COUNTS.   DTSBD140
00019 *              WORK ORDER: CR076                PROGRAMMER: RHC   DTSBD140
00020 *                                                                 DTSBD140
00021 *    06/14/95  TRANSFER REPORTS AND PAYMENT BETWEEN EMPLOYERS.    DTSBD140
00022 *              P5000 ADDED.                                       DTSBD140
00023 *              WORK ORDER: CR066                PROGRAMMER: EHH   DTSBD140
00024 *                                                                 DTSBD140
00025 *    11/13/95  JOINT REGISTRATION PROCESSING.  T002 RECORD        DTSBD140
00026 *              PROCESSING. USE IWHO RECORDS TO FINE THE EMP-NO    DTSBD140
00027 *              ASSOCIATED WITH THE T002-WH-OFLT-SEIN AND STORE THEDTSBD140
00028 *              EMP-NO IN T002-EMP-NO.                             DTSBD140
00029 *              WORK ORDER: JR                   PROGRAMMER: RPA   DTSBD140
00030 *                                                                 DTSBD140
00031 *    04/01/96  ELECTRONIC FILE PROCESSING.  T027 RECORD.          DTSBD140
00032 *              PLEASE NOTE THAT DTSBD140 ASSUMES T027 RECORDS     DTSBD140
00033 *              WILL ARRIVE IN A CLUMP AND THE T027 RECORDS WILL   DTSBD140
00034 *              ARRIVE IN ASCENDING ORDER BY T027-PSEUDO-ITEM-NO   DTSBD140
00035 *              WITHIN T027-PSEUDO-BATCH-NO SEQUENCE.              DTSBD140
00036 *              WORK ORDER: MTS001 - ELF         PROGRAMMER: EHH   DTSBD140
00037 *                                                                 DTSBD140
00038 *    12/31/96  ADDED 88 LEVEL TO DTSIAHDR FOR ELECTRONIC FILER    DTSBD140
00039 *              BATCHES AND SET IT TO TRUE EACH TIME A NEW BATCH   DTSBD140
00040 *              WAS INITIATED IN P7000-ELF-RPT.                    DTSBD140
00041 *              WORK ORDER: WARP II              PROGRAMMER: MJA   DTSBD140
00042 *                                                                 DTSBD140
00043 *    10/07/1998  REVIEWED AND MODIFIED FOR DC.                    DTSBD140
00044 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD140
00045 *                                                                 DTSBD140
00046 *    10/08/1999  ADDED T026-TOLERANCE PROCESSING.  RECOVERY       DTSBD140
00047 *                FROM PROBLEMS GENERATED DURING THE CONVERSION    DTSBD140
00048 *                TO DUTAS.                                        DTSBD140
00049 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD140
00050 *                                                                 DTSBD140
00051 *    10/26/1999  ADDED REFERENCE FILE OPEN/CLOSE.  REFERENCE      DTSBD140
00052 *                FILE USED IN DTSBU516.  FIX OF PRODUCTION        DTSBD140
00053 *                ABEND.                                           DTSBD140
00054 *                REFERENCE: DC PRODUCTION       PROGRAMMER: EHH   DTSBD140
00055 *                                                                 DTSBD140
00056 *    08/14/2002  RECOMPILED TO GET NEW VERSION OF DTSIL516        DTSBD140
00057 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBD140
00058 *                                                                 DTSBD140
00059 *    04/07/2003  MODIFIED FOR ELECTRONIC PAYMENT PROCESS.         DTSBD140
00060 *                ADDED P7000 AND ASSOCIATED CODE.                 DTSBD140
00061 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBD140
00062 *                                                                 DTSBD140
00063 *    12/14/2004  MODIFIED FOR COMPROMISE SETTLEMENTS -            DTSBD140
00064 *                INITIALIZE AADJ-CMP-ESTB-ABSTIME IN              DTSBD140
00065 *                P2400, P5193.                                    DTSBD140
00066 *                REFERENCE: COMPROMISE          PROGRAMMER: GD    DTSBD140
00067 *                                                                 DTSBD140
00068 *    01/20/2005  REMOVED DISPLAYS                                 DTSBD140
00069 *                REFERENCE: COMPROMISE          PROGRAMMER: GD    DTSBD140
00070 *                                                                 DTSBD140
00071 *    01/25/2005  INITILIZED NEW FIELD(APAY-NSF-MNTE-ABSTIME)      DTSBD140
00072 *                NEW FIELD WILL REFERENCE NSF RECORD ON THE       DTSBD140
00073 *                MNTE FILE.                                       DTSBD140
00074 *                REFERENCE: REFUND              PROGRAMMER: ZL1   DTSBD140
00075 *                                                                 DTSBD140
00076 *    02/09/2005  MODIFIED S1000 SET SET AHDR-ESTB-OP-ID TO        DTSBD140
00077 *                T027-RESPPONSIBLE-OP-ID WHEN CREATING A          DTSBD140
00078 *                BATCH WITH T027 TRANSACTIONS.                    DTSBD140
00079 *                THIS WILL ENSURE THAT THE OP-ID ON THE 301       DTSBD140
00080 *                REPORT RECORDS = 'MAG UC30' OR 'WEB UC30'.       DTSBD140
00081 *                CHANGED MAX RECORDS IN BATCH FROM 100 TO 50.     DTSBD140
00082 *                REFERENCE: ICESA               PROGRAMMER: GD    DTSBD140
00083 *                                                                 DTSBD140
00084 *    09/02/2005  ADDED P8200 TO WRITE BATCH AUDIT RECORDS         DTSBD140
00085 *                TO MATCH PSEUDO-BATCH AND ITEM NUMBERS           DTSBD140
00086 *                TO THE TAX SYSTEM BATCH AND ITEM NUMBERS         DTSBD140
00087 *                ASSIGNED IN THIS PROGRAM.                        DTSBD140
00088 *                REFERENCE: ICESA               PROGRAMMER: GD    DTSBD140
00089 *                                                                 DTSBD140
00090 *    09/26/2005  MODIFIED P7000 FOR REFUND TRANSACTIONS GENERATED DTSBD140
00091 *                BY WEB CREDIT/DEBIT VERIFICATION APPLICATION.    DTSBD140
00092 *                REFERENCE: CREDIT/DEBIT        PROGRAMMER: GD    DTSBD140
00093 *                                                                 DTSBD140
00094 *    10/07/2005  MODIFIED P5191 AND P8100 TO INITIALIZE           DTSBD140
00095 *                ARPT-WAGE-RPT-IND AND ARPT-STATUS-CHNG-IND.      DTSBD140
00096 *                REFERENCE: CREDIT/DEBIT        PROGRAMMER: GD    DTSBD140
00097 *                                                                 DTSBD140
00098 *    11/04/2005  MODIFIED P8200 TO CALL BU001 TO FORMAT           DTSBD140
00099 *                DATE IN X214 OUTPUT RECORD.                      DTSBD140
00100 *                REFERENCE: CREDIT/DEBIT        PROGRAMMER: GD    DTSBD140
00101 *                                                                 DTSBD140
00102 *    12/19/2005  INITIALIZE BANK BATCH NUMBER TO ZERO IN          DTSBD140
00103 *                S1000.                                           DTSBD140
00104 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00105 *                                                                 DTSBD140
00106 *    02/21/2006  MODIFIED TO PROCESS T026 TRANSACTIONS FOR        DTSBD140
00107 *                ADMINISTRATIVE ASSESSMENT. P2300, P2400,         DTSBD140
00108 *                P2500.                                           DTSBD140
00109 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00110 *                                                                 DTSBD140
00111 *    09/25/2006  ADDED P2540 AND FOLLOWING TO HANDLE NEGATIVE     DTSBD140
00112 *                CHARGE ADJUSTMENTS TO ADMINISTRATIVE ASSESSMENT. DTSBD140
00113 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00114 *                                                                 DTSBD140
00115 *    11/02/2006  MODIFIED P8200 TO MOVE SLASHED DATE TO X214      DTSBD140
00116 *                BATCH CROSS-REF RECORD.  IT WAS MOVING AN        DTSBD140
00117 *                UNSLASHED FEDERAL DATE.                          DTSBD140
00118 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00119 *                                                                 DTSBD140
00120 *    07/26/2007  MODIFIED FOR WEB REGISTRATION. ADDED P9000       DTSBD140
00121 *                AND CALLS TO DTSBD142 TO ADD MPRF AND MERA       DTSBD140
00122 *                RECORDS.                                         DTSBD140
00123 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00124 *                                                                 DTSBD140
00125 *    03/06/2009  MODIFIED TO WRITE A DUMMY RECORD TO THE          DTSBD140
00126 *                BATCH-AUDIT-FILE WHEN THERE ARE NO ICESA         DTSBD140
00127 *                REPORTS TO PROCESS.                              DTSBD140
00128 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00129 *                                                                 DTSBD140
00130 *    04/19/2011  MODIFIED TO INCLUDE THE LOG NUMBER IN THE        DTSBD140
00131 *                X214 CROSS-REFERENCE RECORD - P8200.             DTSBD140
00132 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00133 *                                                                 DTSBD140
00134 *    04/10/2012  MODIFIED FOR NEW VERSION OF T027 RECORD. IT      DTSBD140
00135 *                HAS BEEN RENAMED T028, AND THE SORT ORDER        DTSBD140
00136 *                CHANGED TO GROUP REPORTS FROM THE SAME ICESA     DTSBD140
00137 *                SUBMITTER TOGETHER. AMENDED REPORTS WILL ALSO    DTSBD140
00138 *                ALSO BE SORTED IN SEPARATE BATCHES.              DTSBD140
00139 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00140 *                                                                 DTSBD140
00141 *    09/13/2012  RECOMPILED AND ADDED A DISPLAY OF THE BX214      DTSBD140
00142 *                RECORD COUNTER. PARAGRAPH P8200 WAS NOT BEING    DTSBD140
00143 *                EXECUTED.                                        DTSBD140
00144 *                REFERENCE:                     PROGRAMMER: GD    DTSBD140
00145 *                                                                 DTSBD140
00146 *    01/13/2016  MODIFY PROGRAM TO CALL NEW BATCH NO PROGRAM         CL**2
00147 *                TO GET THE LAST BATCH NUMBER USER. BATCH NUMBER     CL**2
00148 *                IS RUNNING OUT, NEED TO START REUSING OLD NUMBERS   CL**2
00149 *                REFERENCE: BATCH NO ISSUE      PROGRAMMER: ZL1      CL**2
00150 *                                                                    CL**2
00151 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD140
00152 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD140
00153 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD140
00154 *                                                                 DTSBD140
00155 *                                                                 DTSBD140
00156 *  DESCRIPTION:                                                   DTSBD140
00157 *                                                                 DTSBD140
00158 *    READ THE BATCH TRANSACTION COLLECTION FILE.  IF INPUT        DTSBD140
00159 *    REC-TYPE = '026', THEN GENERATE ACCOUNTING ADJUSTMENT        DTSBD140
00160 *    TRANSACTION(S).  IF INPUT REC-TYPE NOT = '026, THEN WRITE    DTSBD140
00161 *    THE INPUT RECORD TO A SEQUENTIAL TRANSACTION FILE.           DTSBD140
00162 *                                                                 DTSBD140
00163 *                                                                 DTSBD140
00164 *    INITIATION:                                                  DTSBD140
00165 *                                                                 DTSBD140
00166 *      OPEN MASTER FILE (L910-UPDATE-HDR-88).                     DTSBD140
00167 *      OPEN ACCOUNTING TRANSACTION COLLECTION FILE                DTSBD140
00168 *        (L923-OPEN-UPDATE-88).                                   DTSBD140
00169 *      OPEN BATCH TRANSACTION COLLECTION INPUT FILE               DTSBD140
00170 *        (L926-OPEN-READ-88).                                     DTSBD140
00171 *                                                                 DTSBD140
00172 *      READ THE MHDR RECORD.                                      DTSBD140
00173 *      IF L910-NO-REC-88                                          DTSBD140
00174 *          ABEND THE MODULE.                                      DTSBD140
00175 *                                                                 DTSBD140
00176 *      INITIALIZE THE CONTROL COUNTS (WRK-BTC-REC-CNT THRU        DTSBD140
00177 *      WRK-ATC-TRAN-CNT).                                         DTSBD140
00178 *                                                                 DTSBD140
00179 *                                                                 DTSBD140
00180 *    PROCESSING:                                                  DTSBD140
00181 *                                                                 DTSBD140
00182 *      READ ALL BATCH TRANSACTION COLLECTION FILE RECORDS.        DTSBD140
00183 *      FOR EACH BATCH TRANSACTION COLLECTION RECORD READ:         DTSBD140
00184 *                                                                 DTSBD140
00185 *        IF RSK3-REC-TYPE = '026'                                 DTSBD140
00186 *            PERFORM GENERATE-AADJ-RECS                           DTSBD140
00187 *        ELSE                                                     DTSBD140
00188 *            WRITE THE BTC RECORD TO THE S946-TRN-REC-O FILE.     DTSBD140
00189 *                                                                 DTSBD140
00190 *                                                                 DTSBD140
00191 *      GENERATE-AADJ-RECS.                                        DTSBD140
00192 *                                                                 DTSBD140
00193 *        IF T026-REIMB-CHG                                        DTSBD140
00194 *            GENERATE ONE OR MORE AADJ-CHARGE-88 AADJ RECORDS     DTSBD140
00195 *            (WHEN T026-AMT IS LESS THAN ZERO SPECIAL PROCESSING  DTSBD140
00196 *            IS REQUIRED)                                         DTSBD140
00197 *        ELSE                                                     DTSBD140
00198 *            WRITE AN R907 RECORD.                                DTSBD140
00199 *                                                                 DTSBD140
00200 *                                                                 DTSBD140
00201 *    TERMINATION:                                                 DTSBD140
00202 *                                                                 DTSBD140
00203 *      BREAK THE LAST GENERATED BATCH (INCREMENT MHDR-LAST-USED-  DTSBD140
00204 *      BATCH-NO, AND WRITE AHDR RECORD).                          DTSBD140
00205 *                                                                 DTSBD140
00206 *      REWRITE THE MHDR RECORD.                                   DTSBD140
00207 *                                                                 DTSBD140
00208 *      DISPLAY TERMINATION STATISTICS (MHDR-CURR-RUN-DATE,        DTSBD140
00209 *      MHDR-LAST-USED-BATCH-NO, WRK-BTC-REC-CNT THRU              DTSBD140
00210 *      WRK-ATC-TRAN-CNT.                                          DTSBD140
00211 *                                                                 DTSBD140
00212 *      CLOSE THE MASTER FILE, ACCOUNTING TRANSACTION COLLECTION   DTSBD140
00213 *      FILE, BATCH TRANSACTION COLLECTION FILE, REPORT RECORD     DTSBD140
00214 *      FILE, AND TRANSACTION RECORD FILE.                         DTSBD140
00215 *                                                                 DTSBD140
00216 *                                                                 DTSBD140
00217 *****                                                             DTSBD140
00218      SKIP3                                                        DTSBD140
00219  ENVIRONMENT DIVISION.                                            DTSBD140
00220  INPUT-OUTPUT SECTION.                                            DTSBD140
00221                                                                   DTSBD140
00222  FILE-CONTROL.                                                    DTSBD140
00223                                                                   DTSBD140
00224      SELECT BATCH-AUDIT-FILE ASSIGN TO DTSBX214                   DTSBD140
00225         FILE STATUS IS BATCH-AUDIT-STATUS.                        DTSBD140
00226      SKIP3                                                        DTSBD140
00227  DATA DIVISION.                                                   DTSBD140
00228  FILE SECTION.                                                    DTSBD140
00229                                                                   DTSBD140
00230  FD  BATCH-AUDIT-FILE                                             DTSBD140
00231      RECORDING MODE IS F                                          DTSBD140
00232      BLOCK CONTAINS 0 RECORDS                                     DTSBD140
00233      LABEL RECORDS ARE OMITTED.                                   DTSBD140
00234                                                                   DTSBD140
00235  01  BATCH-AUDIT-REC                    PIC X(30).                DTSBD140
00236                                                                   DTSBD140
00237      SKIP3                                                        DTSBD140
00238  WORKING-STORAGE SECTION.                                         DTSBD140
002385 77  PAN-VALET PICTURE X(24) VALUE '024DTSBD140  03/14/16'.       DTSBD140
00239  77  PAN-VALET PICTURE X(24) VALUE '060DTSBD140  12/16/15'.       DTSBD140
00240  77  PAN-VALET PICTURE X(24) VALUE '002DTSBD140  11/20/15'.       DTSBD140
00241  77  PAN-VALET PICTURE X(24) VALUE '058DTSBD140  06/10/15'.       DTSBD140
00242  77  PAN-VALET PICTURE X(24) VALUE '002DTSBD140  04/28/15'.       DTSBD140
00243  77  PAN-VALET PICTURE X(24) VALUE '056DTSBD140  09/13/12'.       DTSBD140
00244  77  PAN-VALET PICTURE X(24) VALUE '006DTSBD140  09/13/12'.       DTSBD140
00245  77  PAN-VALET PICTURE X(24) VALUE '054DTSBD140  05/02/12'.       DTSBD140
00246      SKIP3                                                        DTSBD140
00247  01  WRK-AREA.                                                    DTSBD140
00248      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +140.DTSBD140
00249                                                                   DTSBD140
00250      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD140'.DTSBD140
00251                                                                   DTSBD140
00252      05  BATCH-AUDIT-STATUS          PIC  X(02).                  DTSBD140
00253          88  BATCH-AUDIT-OK-88        VALUE '00'.                 DTSBD140
00254                                                                   DTSBD140
00255      05  WRK-CURR-REC-TYPE           PIC  X(03)  VALUE SPACES.    DTSBD140
00256                                                                   DTSBD140
00257      05  WRK-CURR-KEY                PIC  X(04)  VALUE SPACES.    DTSBD140
00258                                                                   DTSBD140
00259      05  TRANSFER-RESPONSIBLE-ACTIVITY                            DTSBD140
00260                                      PIC  X(03)  VALUE 'TRN'.     DTSBD140
00261                                                                   DTSBD140
00262      05  TRANSFER-RESPONSIBLE-OP-ID  PIC  X(08)  VALUE 'TRANSFER'.DTSBD140
00263                                                                   DTSBD140
00264      05  WRK-BTC-REC-CNT                 PIC S9(07)       COMP-3. DTSBD140
00265      05  WRK-AHDR-ITEM-NO                PIC S9(03)       COMP-3.    CL*16
00266                                                                   DTSBD140
00267      05  WRK-BTC-TRAN-CNT                PIC S9(07)       COMP-3. DTSBD140
00268                                                                   DTSBD140
00269      05  WRK-ATC-BATCH-CNT               PIC S9(07)       COMP-3. DTSBD140
00270                                                                   DTSBD140
00271      05  WRK-ATC-TRAN-CNT                PIC S9(07)       COMP-3. DTSBD140
00272                                                                   DTSBD140
00273      05  WRK-T002-CNT                    PIC S9(07)       COMP-3. DTSBD140
00274                                                                   DTSBD140
00275      05  WRK-BX214-CNT                   PIC S9(07)       COMP-3. DTSBD140
00276                                                                   DTSBD140
00277      05  WRK-R907-REC-CNT                PIC S9(07)       COMP-3. DTSBD140
00278                                                                   DTSBD140
00279      05  WRK-MSG-TEXT.                                            DTSBD140
00280          10  WRK-MSG-TEXT-1              PIC  X(30).              DTSBD140
00281          10  WRK-MSG-TEXT-2              PIC  X(70).              DTSBD140
00282                                                                   DTSBD140
00283      05  WS-AMT-X                        PIC  ZZZ,ZZZ,ZZ9.99-.    DTSBD140
00284      05  AMT-DISP1                       PIC  ----------9.99.     DTSBD140
00285      05  AMT-DISP2                       PIC  ----------9.99.     DTSBD140
00286                                                                   DTSBD140
00287      05  START-ABS-QTR                   PIC  S9(04)   COMP.      DTSBD140
00288                                                                   DTSBD140
00289      05  END-ABS-QTR                     PIC  S9(04)   COMP.      DTSBD140
00290                                                                   DTSBD140
00291      05  HOLD-T026-AMT                   PIC  S9(09)V9(02) COMP-3.DTSBD140
00292                                                                   DTSBD140
00293                                                                   DTSBD140
00294      05  HOLD-EMP-NO                     PIC S9(07)  COMP-3.      DTSBD140
00295                                                                   DTSBD140
00296      05  HOLD-CREDIT-MSG-WRITTEN-IND     PIC  X(01).              DTSBD140
00297                                                                   DTSBD140
00298      05  HOLD-YRQ-MAX                    PIC S9(04)  COMP         DTSBD140
00299                                                      VALUE +400.  DTSBD140
00300                                                                   DTSBD140
00301      05  HOLD-YRQ-SUB                    PIC S9(04)  COMP.        DTSBD140
00302                                                                   DTSBD140
00303      05  HOLD-YRQ-CNT                    PIC S9(04)  COMP.        DTSBD140
00304                                                                   DTSBD140
00305      05  HOLD-TRANSFERRED-YRQ OCCURS 400 TIMES                    DTSBD140
00306                               INDEXED BY HOLD-YRQ-IDX             DTSBD140
00307                                          PIC S9(05)  COMP-3.      DTSBD140
00308                                                                   DTSBD140
00309      05  TRANSFER-FROM-EMP-CLASS         PIC  X(01).              DTSBD140
00310          88  TRANSFER-FROM-EMP-SELF-INS-88      VALUE 'S'.        DTSBD140
00311                                                                   DTSBD140
00312      05  TRANSFER-FROM-NAME-CHECK        PIC  X(04).              DTSBD140
00313                                                                   DTSBD140
00314      05  TRANSFER-FROM-TOT-CREDIT-AMT    PIC S9(09)V9(02)  COMP-3.DTSBD140
00315                                                                   DTSBD140
00316      05  TRANSFER-TO-NAME-CHECK          PIC  X(04).              DTSBD140
00317                                                                   DTSBD140
00318                                                                   DTSBD140
00319      05  RECENT-RECEIVED-DATE            PIC S9(09)  COMP-3.      DTSBD140
00320                                                                   DTSBD140
00321                                                                   DTSBD140
00322      05  TRANSFER-YRQ                    PIC S9(05)  COMP-3.      DTSBD140
00323                                                                   DTSBD140
00324                                                                   DTSBD140
00325      05  TRANSFER-TOT-WAGE               PIC S9(11)V9(02)  COMP-3.DTSBD140
00326                                                                   DTSBD140
00327      05  TRANSFER-EXCESS-WAGE            PIC S9(11)V9(02)  COMP-3.DTSBD140
00328                                                                   DTSBD140
00329      05  TRANSFER-TAX-WAGE               PIC S9(11)V9(02)  COMP-3.DTSBD140
00330                                                                   DTSBD140
00331      05  TRANSFER-WAGE-RPT-IND           PIC  X(01).              DTSBD140
00332          88  TRANSFER-WAGE-RPT-YES-88            VALUE 'Y'.       DTSBD140
00333                                                                   DTSBD140
00334      05  TRANSFER-LATE-PEN-CHARGED       PIC S9(09)V9(02)  COMP-3.DTSBD140
00335                                                                   DTSBD140
00336      05  TRANSFER-LATE-PEN-WAIVED        PIC S9(09)V9(02)  COMP-3.DTSBD140
00337                                                                   DTSBD140
00338      05  TRANSFER-1ST-MTH-EMPL-CNT       PIC S9(07)        COMP-3.DTSBD140
00339                                                                   DTSBD140
00340      05  TRANSFER-2ND-MTH-EMPL-CNT       PIC S9(07)        COMP-3.DTSBD140
00341                                                                   DTSBD140
00342      05  TRANSFER-3RD-MTH-EMPL-CNT       PIC S9(07)        COMP-3.DTSBD140
00343                                                                   DTSBD140
00344                                                                   DTSBD140
00345      05  PRIOR-PSEUDO-BATCH-NO           PIC S9(05)  COMP-3.      DTSBD140
00346                                                                   DTSBD140
00347 **   05  FIRST-TIME-T025-IND             PIC  X(01).              DTSBD140
00348 *        88  FIRST-TIME-T025-YES-88       VALUE 'Y'.              DTSBD140
00349 *        88  FIRST-TIME-T025-NO-88        VALUE 'N'.              DTSBD140
00350 *                                                                 DTSBD140
00351 *    05  FIRST-TIME-T026-IND             PIC  X(01).              DTSBD140
00352 *        88  FIRST-TIME-T026-YES-88       VALUE 'Y'.              DTSBD140
00353 *        88  FIRST-TIME-T026-NO-88        VALUE 'N'.              DTSBD140
00354 *                                                                 DTSBD140
00355 *    05  FIRST-TIME-T027-IND             PIC  X(01).              DTSBD140
00356 *        88  FIRST-TIME-T027-YES-88       VALUE 'Y'.              DTSBD140
00357 **       88  FIRST-TIME-T027-NO-88        VALUE 'N'.              DTSBD140
00358                                                                   DTSBD140
00359                                                                   DTSBD140
00360  01  TRANSFER-MESSAGES.                                           DTSBD140
00361      05  MSG387-AREA.                                             DTSBD140
00362          10  MSG387-ID                   PIC  X(03)  VALUE '387'. DTSBD140
00363          10  MSG387-TEXT.                                         DTSBD140
00364              15  FILLER                  PIC  X(25)               DTSBD140
00365                    VALUE 'REPORT NOT TRANSFERRED.  '.             DTSBD140
00366              15  FILLER                  PIC  X(38)               DTSBD140
00367                VALUE 'REPORT ALREADY RECORDED.  SOURCE EMP: '.    DTSBD140
00368              15  MSG387-SOURCE-EMP-NO    PIC  999B999.            DTSBD140
00369              15  FILLER                  PIC  X(14)               DTSBD140
00370                    VALUE '  TARGET EMP: '.                        DTSBD140
00371              15  MSG387-TARGET-EMP-NO    PIC  999B999.            DTSBD140
00372              15  FILLER                  PIC  X(07)               DTSBD140
00373                    VALUE '  QTR: '.                               DTSBD140
00374              15  MSG387-SLASH-QTR        PIC  X(40).              DTSBD140
00375                                                                   DTSBD140
00376      05  MSG388-AREA.                                             DTSBD140
00377          10  MSG388-ID                   PIC  X(03)  VALUE '388'. DTSBD140
00378          10  MSG388-TEXT.                                         DTSBD140
00379              15  FILLER                  PIC  X(25)               DTSBD140
00380                    VALUE 'REPORTS TRANSFERRED FROM '.             DTSBD140
00381              15  FILLER                  PIC  X(38)               DTSBD140
00382                VALUE 'AN EMPLOYER WITH A CREDIT.  CREDIT NOT'.    DTSBD140
00383              15  FILLER                  PIC  X(14)               DTSBD140
00384                    VALUE ' TRANSFERRED. '.                        DTSBD140
00385      EJECT                                                        DTSBD140
00386  01  L001-LINK-AREA.                                              DTSBD140
00387  ++INCLUDE DTSIL001                                               DTSBD140
00388      EJECT                                                        DTSBD140
00389  01  L004-LINK-AREA.                                              DTSBD140
00390  ++INCLUDE DTSIL004                                               DTSBD140
00391      EJECT                                                        DTSBD140
00392  01  L142-LINK-AREA.                                              DTSBD140
00393  ++INCLUDE DTSIL142                                               DTSBD140
00394      EJECT                                                        DTSBD140
00395  01  T002-REC.                                                    DTSBD140
00396  ++INCLUDE DTSIT002                                               DTSBD140
00397      EJECT                                                        DTSBD140
00398  01  Y104-REC.                                                    DTSBD140
00399  ++INCLUDE DTSIY104                                               DTSBD140
00400      EJECT                                                        DTSBD140
00401  01  L516-LINK-AREA.                                              DTSBD140
00402  ++INCLUDE DTSIL516                                               DTSBD140
00403      EJECT                                                        DTSBD140
00404  01  L910-LINK-AREA.                                              DTSBD140
00405  ++INCLUDE DTSIL910                                               DTSBD140
00406      EJECT                                                        DTSBD140
00407  01  MSKL-REC.                                                    DTSBD140
00408  ++INCLUDE DTSIMSKL                                               DTSBD140
00409      EJECT                                                        DTSBD140
00410  01  MHDR-REC.                                                    DTSBD140
00411  ++INCLUDE DTSIMHDR                                               DTSBD140
00412      EJECT                                                        DTSBD140
00413  01  MPRF-REC.                                                    DTSBD140
00414  ++INCLUDE DTSIMPRF                                               DTSBD140
00415      EJECT                                                        DTSBD140
00416  01  MQTR-REC.                                                    DTSBD140
00417  ++INCLUDE DTSIMQTR                                               DTSBD140
00418      EJECT                                                        DTSBD140
00419  01  MRPT-REC.                                                    DTSBD140
00420  ++INCLUDE DTSIMRPT                                               DTSBD140
00421      EJECT                                                        DTSBD140
00422  01  MDST-REC.                                                    DTSBD140
00423  ++INCLUDE DTSIMDST                                               DTSBD140
00424      EJECT                                                        DTSBD140
00425  01  L921-LINK-AREA.                                              DTSBD140
00426  ++INCLUDE DTSIL921                                               DTSBD140
00427      EJECT                                                        DTSBD140
00428  01  ISKL-REC.                                                    DTSBD140
00429  ++INCLUDE DTSIISKL                                               DTSBD140
00430      EJECT                                                        DTSBD140
00431  01  L923-LINK-AREA.                                              DTSBD140
00432  ++INCLUDE DTSIL923                                               DTSBD140
00433      EJECT                                                        DTSBD140
00434  01  ASKL-REC.                                                    DTSBD140
00435  ++INCLUDE DTSIASKL                                               DTSBD140
00436      EJECT                                                        DTSBD140
00437  01  AHDR-REC.                                                    DTSBD140
00438  ++INCLUDE DTSIAHDR                                               DTSBD140
00439      EJECT                                                        DTSBD140
00440  01  ARPT-REC.                                                    DTSBD140
00441  ++INCLUDE DTSIARPT                                               DTSBD140
00442      EJECT                                                        DTSBD140
00443  01  APAY-REC.                                                    DTSBD140
00444  ++INCLUDE DTSIAPAY                                               DTSBD140
00445      EJECT                                                        DTSBD140
00446  01  AADJ-REC.                                                    DTSBD140
00447  ++INCLUDE DTSIAADJ                                               DTSBD140
00448      EJECT                                                        DTSBD140
00449  01  L926-LINK-AREA.                                              DTSBD140
00450  ++INCLUDE DTSIL926                                               DTSBD140
00451      EJECT                                                        DTSBD140
00452  01  RSKL-REC.                                                    DTSBD140
00453  ++INCLUDE DTSIRSK5                                               DTSBD140
00454      EJECT                                                        DTSBD140
00455  01  T025-REC.                                                    DTSBD140
00456  ++INCLUDE DTSIT025                                               DTSBD140
00457      EJECT                                                        DTSBD140
00458  01  T026-REC.                                                    DTSBD140
00459  ++INCLUDE DTSIT026                                               DTSBD140
00460      EJECT                                                        DTSBD140
00461  01  T028-REC.                                                    DTSBD140
00462  ++INCLUDE DTSIT028                                               DTSBD140
00463      EJECT                                                        DTSBD140
00464  01  T027-REC.                                                    DTSBD140
00465  ++INCLUDE DTSIT027                                               DTSBD140
00466      EJECT                                                        DTSBD140
00467  01  T031-REC.                                                    DTSBD140
00468  ++INCLUDE DTSIT031                                               DTSBD140
00469      EJECT                                                        DTSBD140
00470  01  L931-LINK-AREA.                                              DTSBD140
00471  ++INCLUDE DTSIL931                                               DTSBD140
00472      EJECT                                                        DTSBD140
00473  01  FSKL-REC.                                                    DTSBD140
00474  ++INCLUDE DTSIFSKL                                               DTSBD140
00475      EJECT                                                        DTSBD140
00476  01  R907-REC.                                                    DTSBD140
00477  ++INCLUDE DTSIR907                                               DTSBD140
00478      EJECT                                                        DTSBD140
00479  01  WRK-BATCH-AUDIT-REC.                                         DTSBD140
00480  ++INCLUDE DTSIX214                                               DTSBD140
00481      EJECT                                                        DTSBD140
00482                                                                      CL**2
00483  01  L985-LINK-AREA.                                                 CL**2
00484  ++INCLUDE DTSIL985                                                  CL**2
00485  01  LINK-REC.                                                       CL**2
00486  ++INCLUDE DTSIWBAT                                                  CL**2
00487                                                                      CL**2
00488  PROCEDURE DIVISION.                                              DTSBD140
00489                                                                   DTSBD140
00490      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD140
00491                                                                   DTSBD140
00492      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD140
00493                                                                   DTSBD140
00494      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD140
00495                                                                   DTSBD140
00496                                                                   DTSBD140
00497      GOBACK.                                                      DTSBD140
00498      EJECT                                                        DTSBD140
00499  I0000-INITIATE.                                                  DTSBD140
00500      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DTSBD140
00501                                                                   DTSBD140
00502      PERFORM I2000-INITIALIZE-WRK      THRU I2000-EXIT.           DTSBD140
00503  I0000-EXIT.                                                      DTSBD140
00504      EXIT.                                                        DTSBD140
00505      EJECT                                                        DTSBD140
00506  I1000-OPEN-FILES.                                                DTSBD140
00507      MOVE 'N' TO L910-TRACE-IND                                   DTSBD140
00508                  L923-TRACE-IND                                   DTSBD140
00509                  L926-TRACE-IND                                   DTSBD140
00510                  L931-TRACE-IND                                   DTSBD140
00511                  L985-TRACE-IND                                      CL*12
00512                  L516-TRACE-IND.                                  DTSBD140
00513                                                                   DTSBD140
00514                                                                   DTSBD140
00515      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBD140
00516                           L923-MOD-NAME                           DTSBD140
00517                           L926-MOD-NAME                           DTSBD140
00518                           L985-MOD-NAME                              CL*12
00519                           L931-MOD-NAME.                          DTSBD140
00520                                                                   DTSBD140
00521                                                                   DTSBD140
00522 ***  PERFORM S910-OPEN-UPDATE-HDR THRU S910-EXIT.                 DTSBD140
00523      PERFORM S910-OPEN-UPDATE     THRU S910-EXIT.                 DTSBD140
00524                                                                   DTSBD140
00525      PERFORM S921-OPEN-UPDATE THRU S921-EXIT.                     DTSBD140
00526                                                                   DTSBD140
00527      PERFORM S923-OPEN-UPDATE THRU S923-EXIT.                     DTSBD140
00528                                                                   DTSBD140
00529      PERFORM S926-OPEN-READ   THRU S926-EXIT.                     DTSBD140
00530                                                                   DTSBD140
00531      PERFORM S931-OPEN-READ   THRU S931-EXIT.                     DTSBD140
00532                                                                      CL**3
00533      PERFORM S985-OPEN THRU S985-EXIT.                               CL**3
00534                                                                   DTSBD140
00535      OPEN OUTPUT   BATCH-AUDIT-FILE.                              DTSBD140
00536      IF BATCH-AUDIT-OK-88                                         DTSBD140
00537         NEXT SENTENCE                                             DTSBD140
00538      ELSE                                                         DTSBD140
00539         DISPLAY 'CANNOT OPEN BATCH AUDIT FILE '                   DTSBD140
00540            BATCH-AUDIT-STATUS                                     DTSBD140
00541         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD140
00542      END-IF.                                                      DTSBD140
00543                                                                   DTSBD140
00544      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      DTSBD140
00545  I1000-EXIT.                                                      DTSBD140
00546      EXIT.                                                        DTSBD140
00547      EJECT                                                        DTSBD140
00548  I2000-INITIALIZE-WRK.                                            DTSBD140
00549      MOVE +0 TO WRK-BTC-REC-CNT                                   DTSBD140
00550                 WRK-BTC-TRAN-CNT                                  DTSBD140
00551                 WRK-ATC-BATCH-CNT                                 DTSBD140
00552                 WRK-AHDR-ITEM-NO                                     CL*18
00553                 WRK-ATC-TRAN-CNT                                  DTSBD140
00554                 WRK-T002-CNT                                      DTSBD140
00555                 WRK-BX214-CNT                                     DTSBD140
00556                 WRK-R907-REC-CNT.                                 DTSBD140
00557                                                                   DTSBD140
00558      MOVE SPACES     TO RSK5-REC-TYPE.                            DTSBD140
00559                                                                   DTSBD140
00560      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBD140
00561                                                                   DTSBD140
00562      MOVE +0 TO MHDR-EMP-NO.                                      DTSBD140
00563                                                                   DTSBD140
00564      SET MHDR-HDR-88 TO TRUE.                                     DTSBD140
00565                                                                   DTSBD140
00566      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
00567                                                                   DTSBD140
00568      PERFORM S910-READ THRU S910-EXIT.                            DTSBD140
00569                                                                   DTSBD140
00570      IF L910-OK-88                                                DTSBD140
00571         MOVE MSKL-REC TO MHDR-REC                                 DTSBD140
00572      ELSE                                                         DTSBD140
00573         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD140
00574                                                                   DTSBD140
00575                                                                   DTSBD140
00576      PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT.                 DTSBD140
00577                                                                   DTSBD140
00578                                                                   DTSBD140
00579      MOVE +0 TO HOLD-EMP-NO                                       DTSBD140
00580                 HOLD-YRQ-CNT.                                     DTSBD140
00581                                                                   DTSBD140
00582                                                                   DTSBD140
00583      MOVE +0 TO PRIOR-PSEUDO-BATCH-NO.                            DTSBD140
00584                                                                   DTSBD140
00585 *    SET FIRST-TIME-T025-YES-88  TO TRUE.                         DTSBD140
00586 *    SET FIRST-TIME-T026-YES-88  TO TRUE.                         DTSBD140
00587 *    SET FIRST-TIME-T027-YES-88  TO TRUE.                         DTSBD140
00588                                                                   DTSBD140
00589      SET L142-INITIATE-88        TO TRUE.                         DTSBD140
00590      MOVE MHDR-CURR-RUN-DATE     TO L142-CURR-RUN-DATE.           DTSBD140
00591      PERFORM S142-NEW-EMP        THRU S142-EXIT.                  DTSBD140
00592                                                                   DTSBD140
00593  I2000-EXIT.                                                      DTSBD140
00594      EXIT.                                                        DTSBD140
00595      EJECT                                                        DTSBD140
00596  P0000-PROCESS.                                                   DTSBD140
00597      PERFORM P1000-BTC-FILE THRU P1000-EXIT                       DTSBD140
00598         UNTIL L926-NO-REC-88.                                     DTSBD140
00599  P0000-EXIT.                                                      DTSBD140
00600      EXIT.                                                        DTSBD140
00601      EJECT                                                        DTSBD140
00602  P1000-BTC-FILE.                                                  DTSBD140
00603      PERFORM S926-READ-NEXT THRU S926-EXIT.                       DTSBD140
00604                                                                   DTSBD140
00605      IF L926-NO-REC-88                                            DTSBD140
00606         GO TO P1000-EXIT.                                         DTSBD140
00607                                                                   DTSBD140
00608                                                                   DTSBD140
00609      ADD +1 TO WRK-BTC-REC-CNT.                                   DTSBD140
00610                                                                   DTSBD140
00611 *&                                                                DTSBD140
00612      DISPLAY 'DTSBD140 P1000 ' RSK5-REC-TYPE.                     DTSBD140
00613 *&                                                                DTSBD140
00614      EVALUATE TRUE                                                DTSBD140
00615        WHEN RSK5-REC-TYPE = '002'                                 DTSBD140
00616          PERFORM P9000-ADD-PROFILE   THRU P9000-EXIT              DTSBD140
00617                                                                   DTSBD140
00618        WHEN RSK5-REC-TYPE = '026'                                 DTSBD140
00619          PERFORM P2000-GENERATE-ADJ  THRU P2000-EXIT              DTSBD140
00620                                                                   DTSBD140
00621        WHEN RSK5-REC-TYPE = '031'                                 DTSBD140
00622          PERFORM P5000-TRANSFER      THRU P5000-EXIT              DTSBD140
00623                                                                   DTSBD140
00624        WHEN RSK5-REC-TYPE = '025'                                 DTSBD140
00625          PERFORM P7000-GENERATE-PAY  THRU P7000-EXIT              DTSBD140
00626                                                                   DTSBD140
00627        WHEN RSK5-REC-TYPE = '028'                                 DTSBD140
00628          PERFORM P8000-GENERATE-RPT  THRU P8000-EXIT              DTSBD140
00629                                                                   DTSBD140
00630        WHEN OTHER                                                 DTSBD140
00631          PERFORM P3000-GENERATE-TRAN THRU P3000-EXIT              DTSBD140
00632                                                                   DTSBD140
00633      END-EVALUATE.                                                DTSBD140
00634  P1000-EXIT.                                                      DTSBD140
00635      EXIT.                                                        DTSBD140
00636                                                                   DTSBD140
00637  P2000-GENERATE-ADJ.                                              DTSBD140
00638 *****                                                             DTSBD140
00639 *  IF T026 RECORDS HAVE BEEN PROCESSED, THEN (BECAUSE IF A GIVEN  DTSBD140
00640 *  BATCH INCLUDES T026 GENERATED AADJ RECOPRDS, THE BATCH MAY     DTSBD140
00641 *  INCLUDE ONLY T026 GENERATED AADJ RECORDS) TERMINATE THE OPEN   DTSBD140
00642 *  BATCH AND INITIATE A NEW BATCH.                                DTSBD140
00643 *****                                                             DTSBD140
00644 *&                                                                DTSBD140
00645      DISPLAY 'DTSBD140 P2000 T026 FIRST TIME '                    DTSBD140
00646         '  ' AHDR-BATCH-NO.                                       DTSBD140
00647 *&                                                                DTSBD140
00648 **   IF FIRST-TIME-T027-NO-88                                     DTSBD140
00649 *        PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
00650 *        PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
00651 *        SET FIRST-TIME-T027-YES-88 TO TRUE.                      DTSBD140
00652 *                                                                 DTSBD140
00653 *    IF FIRST-TIME-T025-NO-88                                     DTSBD140
00654 *        PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
00655 *        PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
00656 **       SET FIRST-TIME-T025-YES-88 TO TRUE.                      DTSBD140
00657                                                                   DTSBD140
00658      IF WRK-CURR-REC-TYPE NOT = '026'                             DTSBD140
00659         MOVE RSK5-REC-TYPE            TO WRK-CURR-REC-TYPE        DTSBD140
00660         IF AHDR-ATC-FILE-TRAN-CNT > 0                             DTSBD140
00661            PERFORM S2000-TERMINATE-AHDR  THRU S2000-EXIT          DTSBD140
00662            PERFORM S1000-INITIATE-AHDR   THRU S1000-EXIT          DTSBD140
00663         END-IF                                                    DTSBD140
00664      END-IF.                                                      DTSBD140
00665                                                                   DTSBD140
00666      IF AHDR-ATC-FILE-TRAN-CNT NOT < +475                            CL**4
00667          PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
00668          PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT.             DTSBD140
00669                                                                   DTSBD140
00670      IF RSK5-REC-TYPE = '026'                                     DTSBD140
00671          MOVE RSKL-REC TO T026-REC                                DTSBD140
00672          PERFORM P2300-ATC-ADJUSTMENT THRU P2300-EXIT             DTSBD140
00673      ELSE                                                         DTSBD140
00674          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD140
00675       SKIP2                                                       DTSBD140
00676  P2000-EXIT.                                                      DTSBD140
00677      EXIT.                                                        DTSBD140
00678      EJECT                                                        DTSBD140
00679  P2300-ATC-ADJUSTMENT.                                            DTSBD140
00680      PERFORM P2400-GEN-ATC-TRAN-FORMAT THRU P2400-EXIT.           DTSBD140
00681                                                                   DTSBD140
00682      IF T026-REIMB-CHG                                            DTSBD140
00683      OR T026-ADM-ASSESSMNT                                        DTSBD140
00684         PERFORM P2500-REIMB-CHG THRU P2500-EXIT                   DTSBD140
00685      ELSE                                                         DTSBD140
00686      IF T026-LATE-PEN-CHG OR T026-LATE-PEN-WAIVE                  DTSBD140
00687         PERFORM P4300-WRITE-AADJ THRU P4300-EXIT                  DTSBD140
00688      ELSE                                                         DTSBD140
00689      IF T026-TOLERANCE                                            DTSBD140
00690         PERFORM P4300-WRITE-AADJ THRU P4300-EXIT                  DTSBD140
00691      ELSE                                                         DTSBD140
00692         MOVE '331' TO R907-MSG-ID                                 DTSBD140
00693         MOVE 'T026-TRN-CD NOT VALID       : '                     DTSBD140
00694                              TO WRK-MSG-TEXT-1                    DTSBD140
00695         MOVE T026-TRN-CD     TO WRK-MSG-TEXT-2                    DTSBD140
00696         PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT.          DTSBD140
00697      SKIP2                                                        DTSBD140
00698  P2300-EXIT.                                                      DTSBD140
00699      EXIT.                                                        DTSBD140
00700      EJECT                                                        DTSBD140
00701  P2400-GEN-ATC-TRAN-FORMAT.                                       DTSBD140
00702      MOVE LOW-VALUES TO AADJ-REC.                                 DTSBD140
00703                                                                   DTSBD140
00704      MOVE AHDR-BATCH-NO TO AADJ-BATCH-NO.                         DTSBD140
00705                                                                   DTSBD140
00706      MOVE +0 TO AADJ-ITEM-NO.                                        CL**6
00707                                                                   DTSBD140
00708      SET AADJ-ADJ-88 TO TRUE.                                     DTSBD140
00709                                                                   DTSBD140
00710      MOVE T026-NAME-CHECK TO AADJ-NAME-CHECK.                     DTSBD140
00711                                                                   DTSBD140
00712      MOVE T026-EMP-NO TO AADJ-EMP-NO.                             DTSBD140
00713                                                                   DTSBD140
00714      IF T026-REIMB-CHG                                            DTSBD140
00715      OR T026-ADM-ASSESSMNT                                        DTSBD140
00716          SET AADJ-CHARGE-88 TO TRUE                               DTSBD140
00717      ELSE                                                         DTSBD140
00718      IF T026-LATE-PEN-CHG                                         DTSBD140
00719          SET AADJ-CHARGE-88 TO TRUE                               DTSBD140
00720      ELSE                                                         DTSBD140
00721      IF T026-LATE-PEN-WAIVE                                       DTSBD140
00722          SET AADJ-WAIVE-88 TO TRUE                                DTSBD140
00723      ELSE                                                         DTSBD140
00724      IF T026-TOLERANCE                                            DTSBD140
00725          SET AADJ-TOLER-88 TO TRUE                                DTSBD140
00726      ELSE                                                         DTSBD140
00727          MOVE SPACE TO AADJ-ADJ-TYPE.                             DTSBD140
00728                                                                   DTSBD140
00729      IF T026-AMT NUMERIC                                          DTSBD140
00730          MOVE T026-AMT TO AADJ-AMT                                DTSBD140
00731      ELSE                                                         DTSBD140
00732          MOVE +0 TO AADJ-AMT.                                     DTSBD140
00733                                                                   DTSBD140
00734      IF T026-RECEIVED-DATE NUMERIC                                DTSBD140
00735          MOVE T026-RECEIVED-DATE TO AADJ-RECEIVED-DATE            DTSBD140
00736      ELSE                                                         DTSBD140
00737          MOVE +0 TO AADJ-RECEIVED-DATE.                           DTSBD140
00738                                                                   DTSBD140
00739      MOVE +0 TO AADJ-DEPOSIT-DATE.                                DTSBD140
00740                                                                   DTSBD140
00741      IF T026-APPLIC-YRQ NUMERIC                                   DTSBD140
00742          MOVE T026-APPLIC-YRQ TO AADJ-APPLIC-YRQ                  DTSBD140
00743      ELSE                                                         DTSBD140
00744          MOVE +0 TO AADJ-APPLIC-YRQ.                              DTSBD140
00745                                                                   DTSBD140
00746      MOVE T026-APPLIC-IND TO AADJ-APPLIC-IND.                     DTSBD140
00747                                                                   DTSBD140
00748      IF (T026-APPLIC-BATCH-NO NUMERIC)                            DTSBD140
00749              AND                                                  DTSBD140
00750         (T026-APPLIC-ITEM-NO NUMERIC)                             DTSBD140
00751          MOVE T026-APPLIC-DOC-NO TO AADJ-APPLIC-DOC-NO            DTSBD140
00752      ELSE                                                         DTSBD140
00753          MOVE +0 TO AADJ-APPLIC-BATCH-NO                          DTSBD140
00754                     AADJ-APPLIC-ITEM-NO.                          DTSBD140
00755                                                                   DTSBD140
00756      IF T026-DATE-1 NUMERIC                                       DTSBD140
00757          MOVE T026-DATE-1 TO AADJ-DATE-1                          DTSBD140
00758      ELSE                                                         DTSBD140
00759          MOVE +0 TO AADJ-DATE-1.                                  DTSBD140
00760                                                                   DTSBD140
00761      IF T026-DATE-2 NUMERIC                                       DTSBD140
00762          MOVE T026-DATE-2 TO AADJ-DATE-2                          DTSBD140
00763      ELSE                                                         DTSBD140
00764          MOVE +0 TO AADJ-DATE-2.                                  DTSBD140
00765                                                                   DTSBD140
00766      MOVE T026-INT-SPAN-IND TO AADJ-INT-SPAN-IND.                 DTSBD140
00767                                                                   DTSBD140
00768      IF T026-INT-RATE NUMERIC                                     DTSBD140
00769          MOVE T026-INT-RATE TO AADJ-INT-RATE                      DTSBD140
00770      ELSE                                                         DTSBD140
00771          SET MQTR-NO-UI-RATE-88 TO TRUE                           DTSBD140
00772          MOVE MQTR-UI-RATE TO AADJ-INT-RATE.                      DTSBD140
00773                                                                   DTSBD140
00774      MOVE 'N' TO AADJ-DISREGARD-EDITS-IND.                        DTSBD140
00775                                                                   DTSBD140
00776      MOVE T026-RESPONSIBLE-ACTIVITY                               DTSBD140
00777        TO AADJ-RESPONSIBLE-ACTIVITY.                              DTSBD140
00778                                                                   DTSBD140
00779      MOVE T026-RESPONSIBLE-OP-ID TO AADJ-RESPONSIBLE-OP-ID.       DTSBD140
00780                                                                   DTSBD140
00781      MOVE +0                   TO AADJ-CMP-ESTB-ABSTIME.          DTSBD140
00782                                                                   DTSBD140
00783      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSBD140
00784  P2400-EXIT.                                                      DTSBD140
00785      EXIT.                                                        DTSBD140
00786      EJECT                                                        DTSBD140
00787  P2500-REIMB-CHG.                                                 DTSBD140
00788      IF T026-REIMB-CHG                                            DTSBD140
00789         SET AADJ-UI-88 TO TRUE                                    DTSBD140
00790      ELSE                                                         DTSBD140
00791         IF T026-ADM-ASSESSMNT                                     DTSBD140
00792            SET AADJ-SUR-88 TO TRUE                                DTSBD140
00793         ELSE                                                      DTSBD140
00794             MOVE '336' TO R907-MSG-ID                             DTSBD140
00795             MOVE 'T026-TRN-CD (REIMB CHG) NOT VALID'              DTSBD140
00796               TO WRK-MSG-TEXT                                     DTSBD140
00797             PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT       DTSBD140
00798             GO TO P2500-EXIT.                                     DTSBD140
00799                                                                   DTSBD140
00800      MOVE +0                                                      DTSBD140
00801        TO AADJ-APPLIC-BATCH-NO                                    DTSBD140
00802           AADJ-APPLIC-ITEM-NO                                     DTSBD140
00803           AADJ-DATE-1                                             DTSBD140
00804           AADJ-DATE-2.                                            DTSBD140
00805                                                                   DTSBD140
00806      MOVE SPACE TO AADJ-INT-SPAN-IND.                             DTSBD140
00807                                                                   DTSBD140
00808      SET MQTR-NO-UI-RATE-88 TO TRUE.                              DTSBD140
00809                                                                   DTSBD140
00810      MOVE MQTR-UI-RATE TO AADJ-INT-RATE.                          DTSBD140
00811                                                                   DTSBD140
00812      MOVE AADJ-APPLIC-YRQ TO L004-QTR-5-9.                        DTSBD140
00813                                                                   DTSBD140
00814      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD140
00815                                                                   DTSBD140
00816      IF L004-INVALID-QTR                                          DTSBD140
00817          MOVE '332' TO R907-MSG-ID                                DTSBD140
00818          MOVE 'T026-APPLIC-YRQ (REIMB CHG) NOT VALID'             DTSBD140
00819            TO WRK-MSG-TEXT                                        DTSBD140
00820          PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT          DTSBD140
00821          GO TO P2500-EXIT.                                        DTSBD140
00822                                                                   DTSBD140
00823      IF AADJ-AMT > +0                                             DTSBD140
00824         PERFORM P4300-WRITE-AADJ THRU P4300-EXIT                  DTSBD140
00825         GO TO P2500-EXIT.                                         DTSBD140
00826                                                                   DTSBD140
00827      IF AADJ-AMT = +0                                             DTSBD140
00828         MOVE '333' TO R907-MSG-ID                                 DTSBD140
00829         MOVE 'T026-AMT NOT VALID (REIMB CHG) : '                  DTSBD140
00830           TO WRK-MSG-TEXT-1                                       DTSBD140
00831         MOVE AADJ-AMT TO WS-AMT-X                                 DTSBD140
00832         MOVE WS-AMT-X TO WRK-MSG-TEXT-2                           DTSBD140
00833         PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT           DTSBD140
00834         GO TO P2500-EXIT.                                         DTSBD140
00835                                                                   DTSBD140
00836 *********************************************************         DTSBD140
00837 *  HANDLE NEGATIVE CHARGE ADJUSTMENTS FOR ADMINISTRATIVE          DTSBD140
00838 *  ASSESSMENT IN P2540.                                           DTSBD140
00839 *********************************************************         DTSBD140
00840      IF T026-ADM-ASSESSMNT                                        DTSBD140
00841         PERFORM P2540-ADM-ASSESS-ADJ   THRU P2540-EXIT            DTSBD140
00842         GO TO P2500-EXIT                                          DTSBD140
00843      END-IF.                                                      DTSBD140
00844                                                                   DTSBD140
00845      MOVE +0 TO START-ABS-QTR                                     DTSBD140
00846                 END-ABS-QTR.                                      DTSBD140
00847                                                                   DTSBD140
00848      PERFORM P2510-CALC-START-END-QTR THRU P2510-EXIT.            DTSBD140
00849                                                                   DTSBD140
00850      IF START-ABS-QTR = 0                                         DTSBD140
00851          GO TO P2500-EXIT.                                        DTSBD140
00852                                                                   DTSBD140
00853      MOVE AADJ-AMT TO T026-AMT.                                   DTSBD140
00854                                                                   DTSBD140
00855      PERFORM P2520-READ-QTR THRU P2520-EXIT                       DTSBD140
00856         UNTIL START-ABS-QTR > END-ABS-QTR OR                      DTSBD140
00857               T026-AMT NOT < +0.                                  DTSBD140
00858                                                                   DTSBD140
00859      IF T026-AMT NOT = +0                                         DTSBD140
00860         MOVE '334' TO R907-MSG-ID                                 DTSBD140
00861         MOVE 'REIMB CHARGE AMT NOT ALLOCATED : '                  DTSBD140
00862           TO WRK-MSG-TEXT-1                                       DTSBD140
00863         MOVE T026-AMT TO WS-AMT-X                                 DTSBD140
00864         MOVE WS-AMT-X TO WRK-MSG-TEXT-2                           DTSBD140
00865         PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT.          DTSBD140
00866  P2500-EXIT.                                                      DTSBD140
00867      EXIT.                                                        DTSBD140
00868      EJECT                                                        DTSBD140
00869  P2510-CALC-START-END-QTR.                                        DTSBD140
00870      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSBD140
00871                                                                   DTSBD140
00872      MOVE AADJ-EMP-NO TO MPRF-EMP-NO.                             DTSBD140
00873                                                                   DTSBD140
00874      SET MPRF-PRF-88 TO TRUE.                                     DTSBD140
00875                                                                   DTSBD140
00876      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
00877                                                                   DTSBD140
00878      PERFORM S910-READ THRU S910-EXIT.                            DTSBD140
00879                                                                   DTSBD140
00880      IF L910-OK-88                                                DTSBD140
00881         MOVE MSKL-REC TO MPRF-REC                                 DTSBD140
00882      ELSE                                                         DTSBD140
00883         MOVE '334' TO R907-MSG-ID                                 DTSBD140
00884         MOVE 'REIMB CHARGE AMT NOT ALLOCATED : '                  DTSBD140
00885           TO WRK-MSG-TEXT-1                                       DTSBD140
00886         MOVE AADJ-AMT TO WS-AMT-X                                 DTSBD140
00887         MOVE WS-AMT-X TO WRK-MSG-TEXT-2                           DTSBD140
00888         PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT           DTSBD140
00889         GO TO P2510-EXIT.                                         DTSBD140
00890                                                                   DTSBD140
00891                                                                   DTSBD140
00892      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD140
00893                                                                   DTSBD140
00894      MOVE AADJ-EMP-NO TO MQTR-EMP-NO.                             DTSBD140
00895                                                                   DTSBD140
00896      SET MQTR-QTR-88 TO TRUE.                                     DTSBD140
00897                                                                   DTSBD140
00898      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
00899                                                                   DTSBD140
00900      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD140
00901                                                                   DTSBD140
00902      IF L910-OK-88                                                DTSBD140
00903         MOVE MSKL-REC TO MQTR-REC                                 DTSBD140
00904      ELSE                                                         DTSBD140
00905         MOVE '334' TO R907-MSG-ID                                 DTSBD140
00906         MOVE 'REIMB CHARGE AMT NOT ALLOCATED : '                  DTSBD140
00907           TO WRK-MSG-TEXT-1                                       DTSBD140
00908         MOVE AADJ-AMT TO WS-AMT-X                                 DTSBD140
00909         MOVE WS-AMT-X TO WRK-MSG-TEXT-2                           DTSBD140
00910         PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT           DTSBD140
00911         GO TO P2510-EXIT.                                         DTSBD140
00912                                                                   DTSBD140
00913                                                                   DTSBD140
00914      MOVE MQTR-YRQ TO L004-QTR-5-9.                               DTSBD140
00915                                                                   DTSBD140
00916      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD140
00917                                                                   DTSBD140
00918      IF L004-INVALID-QTR                                          DTSBD140
00919         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD140
00920                                                                   DTSBD140
00921      MOVE L004-ABS-QTR TO START-ABS-QTR.                          DTSBD140
00922                                                                   DTSBD140
00923                                                                   DTSBD140
00924      MOVE T026-APPLIC-YRQ TO L004-QTR-5-9.                        DTSBD140
00925                                                                   DTSBD140
00926      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD140
00927                                                                   DTSBD140
00928      IF L004-INVALID-QTR                                          DTSBD140
00929         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD140
00930                                                                   DTSBD140
00931      MOVE L004-ABS-QTR TO END-ABS-QTR.                            DTSBD140
00932                                                                   DTSBD140
00933                                                                   DTSBD140
00934      IF START-ABS-QTR > END-ABS-QTR                               DTSBD140
00935         MOVE END-ABS-QTR TO START-ABS-QTR.                        DTSBD140
00936  P2510-EXIT.                                                      DTSBD140
00937      EXIT.                                                        DTSBD140
00938      EJECT                                                        DTSBD140
00939  P2520-READ-QTR.                                                  DTSBD140
00940      MOVE END-ABS-QTR TO L004-ABS-QTR.                            DTSBD140
00941                                                                   DTSBD140
00942      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBD140
00943                                                                   DTSBD140
00944      IF L004-INVALID-QTR                                          DTSBD140
00945         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD140
00946                                                                   DTSBD140
00947                                                                   DTSBD140
00948      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD140
00949                                                                   DTSBD140
00950      MOVE AADJ-EMP-NO TO MQTR-EMP-NO.                             DTSBD140
00951                                                                   DTSBD140
00952      SET MQTR-QTR-88 TO TRUE.                                     DTSBD140
00953                                                                   DTSBD140
00954      MOVE L004-QTR-5-9 TO MQTR-YRQ.                               DTSBD140
00955                                                                   DTSBD140
00956      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
00957                                                                   DTSBD140
00958      PERFORM S910-READ      THRU S910-EXIT.                       DTSBD140
00959                                                                   DTSBD140
00960      SUBTRACT +1 FROM END-ABS-QTR.                                DTSBD140
00961                                                                   DTSBD140
00962      IF L910-OK-88                                                DTSBD140
00963         MOVE MSKL-REC TO MQTR-REC                                 DTSBD140
00964         PERFORM P2530-SCAN-QTR-ACCTS THRU P2530-EXIT              DTSBD140
00965            VARYING MQTR-ACCT-IDX FROM 1 BY 1                      DTSBD140
00966            UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                   DTSBD140
00967  P2520-EXIT.                                                      DTSBD140
00968      EXIT.                                                        DTSBD140
00969      EJECT                                                        DTSBD140
00970  P2530-SCAN-QTR-ACCTS.                                            DTSBD140
00971      IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)  AND                      DTSBD140
00972         MQTR-CHARGED-AMT(MQTR-ACCT-IDX)  > +0                     DTSBD140
00973         NEXT SENTENCE                                             DTSBD140
00974      ELSE                                                         DTSBD140
00975         GO TO P2530-EXIT.                                         DTSBD140
00976                                                                   DTSBD140
00977      ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) T026-AMT                DTSBD140
00978         GIVING HOLD-T026-AMT.                                     DTSBD140
00979                                                                   DTSBD140
00980      IF HOLD-T026-AMT < +0                                        DTSBD140
00981         MULTIPLY MQTR-CHARGED-AMT (MQTR-ACCT-IDX) BY -1           DTSBD140
00982            GIVING AADJ-AMT                                        DTSBD140
00983         MOVE HOLD-T026-AMT TO T026-AMT                            DTSBD140
00984      ELSE                                                         DTSBD140
00985         MOVE T026-AMT TO AADJ-AMT                                 DTSBD140
00986         MOVE +0 TO T026-AMT.                                      DTSBD140
00987                                                                   DTSBD140
00988      MOVE MQTR-YRQ TO AADJ-APPLIC-YRQ.                            DTSBD140
00989                                                                   DTSBD140
00990      PERFORM P4300-WRITE-AADJ THRU P4300-EXIT.                    DTSBD140
00991                                                                   DTSBD140
00992 *****MOVE '335' TO R907-MSG-ID.                                   DTSBD140
00993 *****MOVE 'REIMB CHARGE AMT ALLOCATED     : '                     DTSBD140
00994 *****  TO WRK-MSG-TEXT-1.                                         DTSBD140
00995 *****MOVE AADJ-AMT TO WS-AMT-X.                                   DTSBD140
00996 *****MOVE WS-AMT-X TO WRK-MSG-TEXT-2.                             DTSBD140
00997 *****PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT.             DTSBD140
00998  P2530-EXIT.                                                      DTSBD140
00999      EXIT.                                                        DTSBD140
01000                                                                   DTSBD140
01001  P2540-ADM-ASSESS-ADJ.                                            DTSBD140
01002 *&                                                                DTSBD140
01003 *    MOVE T026-AMT           TO AMT-DISP1.                        DTSBD140
01004 *    DISPLAY 'DTSBD140 P2540 ' T026-EMP-NO '  ' T026-APPLIC-YRQ   DTSBD140
01005 *       '  ' AMT-DISP1.                                           DTSBD140
01006 *&                                                                DTSBD140
01007      MOVE T026-APPLIC-YRQ    TO L004-QTR-5-9.                     DTSBD140
01008      PERFORM S004-FROM-5     THRU S004-EXIT.                      DTSBD140
01009      IF L004-INVALID-QTR                                          DTSBD140
01010         PERFORM S999-ABEND   THRU S999-EXIT                       DTSBD140
01011      END-IF.                                                      DTSBD140
01012                                                                   DTSBD140
01013      MOVE LOW-VALUES         TO MQTR-KEY-AREA.                    DTSBD140
01014                                                                   DTSBD140
01015      MOVE AADJ-EMP-NO        TO MQTR-EMP-NO.                      DTSBD140
01016                                                                   DTSBD140
01017      SET MQTR-QTR-88         TO TRUE.                             DTSBD140
01018                                                                   DTSBD140
01019      MOVE T026-APPLIC-YRQ    TO MQTR-YRQ.                         DTSBD140
01020                                                                   DTSBD140
01021      MOVE MQTR-KEY-AREA      TO MSKL-KEY-AREA.                    DTSBD140
01022                                                                   DTSBD140
01023      PERFORM S910-READ       THRU S910-EXIT.                      DTSBD140
01024      IF L910-OK-88                                                DTSBD140
01025         MOVE MSKL-REC TO MQTR-REC                                 DTSBD140
01026         PERFORM P2541-SCAN-QTR-ACCTS THRU P2541-EXIT              DTSBD140
01027           VARYING MQTR-ACCT-IDX FROM 1 BY 1                       DTSBD140
01028           UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                     DTSBD140
01029      END-IF.                                                      DTSBD140
01030                                                                   DTSBD140
01031  P2540-EXIT.                                                      DTSBD140
01032      EXIT.                                                        DTSBD140
01033                                                                   DTSBD140
01034  P2541-SCAN-QTR-ACCTS.                                            DTSBD140
01035      IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)  AND                     DTSBD140
01036         MQTR-CHARGED-AMT(MQTR-ACCT-IDX)  > +0                     DTSBD140
01037         NEXT SENTENCE                                             DTSBD140
01038      ELSE                                                         DTSBD140
01039         GO TO P2541-EXIT                                          DTSBD140
01040      END-IF.                                                      DTSBD140
01041                                                                   DTSBD140
01042      ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) T026-AMT                DTSBD140
01043         GIVING HOLD-T026-AMT.                                     DTSBD140
01044                                                                   DTSBD140
01045      IF HOLD-T026-AMT < +0                                        DTSBD140
01046         MULTIPLY MQTR-CHARGED-AMT (MQTR-ACCT-IDX) BY -1           DTSBD140
01047            GIVING AADJ-AMT                                        DTSBD140
01048         MOVE HOLD-T026-AMT TO T026-AMT                            DTSBD140
01049      ELSE                                                         DTSBD140
01050         MOVE T026-AMT TO AADJ-AMT                                 DTSBD140
01051         MOVE +0 TO T026-AMT                                       DTSBD140
01052      END-IF.                                                      DTSBD140
01053                                                                   DTSBD140
01054      MOVE T026-APPLIC-YRQ TO AADJ-APPLIC-YRQ.                     DTSBD140
01055                                                                   DTSBD140
01056 *&                                                                DTSBD140
01057 *    MOVE AADJ-AMT           TO AMT-DISP1.                        DTSBD140
01058 *    DISPLAY 'DTSBD140 P2541 ' T026-EMP-NO '  ' T026-APPLIC-YRQ   DTSBD140
01059 *       '  ' AMT-DISP1.                                           DTSBD140
01060 *&                                                                DTSBD140
01061      PERFORM P4300-WRITE-AADJ THRU P4300-EXIT.                    DTSBD140
01062                                                                   DTSBD140
01063      IF T026-AMT NOT = +0                                         DTSBD140
01064         MOVE '334' TO R907-MSG-ID                                 DTSBD140
01065         MOVE 'REIMB CHARGE AMT NOT ALLOCATED : '                  DTSBD140
01066           TO WRK-MSG-TEXT-1                                       DTSBD140
01067         MOVE T026-AMT TO WS-AMT-X                                 DTSBD140
01068         MOVE WS-AMT-X TO WRK-MSG-TEXT-2                           DTSBD140
01069         PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT           DTSBD140
01070      END-IF.                                                      DTSBD140
01071                                                                   DTSBD140
01072  P2541-EXIT.                                                      DTSBD140
01073      EXIT.                                                        DTSBD140
01074                                                                   DTSBD140
01075  P2800-GENERATE-R907-REC.                                         DTSBD140
01076      MOVE T026-EMP-NO TO R907-EMP-NO.                             DTSBD140
01077                                                                   DTSBD140
01078      MOVE WRK-MSG-TEXT TO R907-MSG-TEXT.                          DTSBD140
01079                                                                   DTSBD140
01080      MOVE WRK-MOD-NAME TO R907-MODULE-NAME.                       DTSBD140
01081                                                                   DTSBD140
01082      PERFORM S947-R907-WRITE THRU S947-EXIT.                      DTSBD140
01083                                                                   DTSBD140
01084      ADD +1 TO WRK-R907-REC-CNT.                                  DTSBD140
01085  P2800-EXIT.                                                      DTSBD140
01086      EXIT.                                                        DTSBD140
01087      EJECT                                                        DTSBD140
01088  P3000-GENERATE-TRAN.                                             DTSBD140
01089 *&                                                                DTSBD140
01090      IF RSK5-REC-TYPE = '002'                                     DTSBD140
01091      DISPLAY 'DTSBD140 P3000 ' T002-EMP-NO '  ' T002-TRN-CD.      DTSBD140
01092 *&                                                                DTSBD140
01093      PERFORM S946-TRN-REC-O THRU S946-EXIT.                       DTSBD140
01094                                                                   DTSBD140
01095      ADD +1 TO WRK-BTC-TRAN-CNT.                                  DTSBD140
01096  P3000-EXIT.                                                      DTSBD140
01097      EXIT.                                                        DTSBD140
01098      EJECT                                                        DTSBD140
01099  P4100-WRITE-ARPT.                                                DTSBD140
01100      IF AHDR-ATC-FILE-TRAN-CNT < +475                                CL**4
01101          NEXT SENTENCE                                            DTSBD140
01102      ELSE                                                         DTSBD140
01103          PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
01104          PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
01105          MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO.                     DTSBD140
01106                                                                   DTSBD140
01107      ADD +1 TO AHDR-ATC-FILE-TRAN-CNT                                CL**4
01108            WRK-AHDR-ITEM-NO.                                         CL*16
01109                                                                      CL**4
01110      MOVE WRK-AHDR-ITEM-NO TO ARPT-ITEM-NO.                          CL*16
01111                                                                   DTSBD140
01112      MOVE ARPT-REC TO ASKL-REC.                                   DTSBD140
01113                                                                   DTSBD140
01114      PERFORM S923-WRITE THRU S923-EXIT.                           DTSBD140
01115 *&                                                                   CL*16
01116      DISPLAY 'DTSBD140 P4100 ' ARPT-EMP-NO '  ' ARPT-BATCH-NO        CL*16
01117         '  ' ARPT-ITEM-NO.                                           CL*16
01118 *&                                                                   CL*16
01119                                                                   DTSBD140
01120      ADD +1 TO WRK-ATC-TRAN-CNT.                                  DTSBD140
01121  P4100-EXIT.                                                      DTSBD140
01122      EXIT.                                                        DTSBD140
01123      SKIP3                                                        DTSBD140
01124  P4200-WRITE-APAY.                                                DTSBD140
01125      IF AHDR-ATC-FILE-TRAN-CNT < +475                                CL**4
01126          NEXT SENTENCE                                            DTSBD140
01127      ELSE                                                         DTSBD140
01128          PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
01129          PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
01130          MOVE AHDR-BATCH-NO TO APAY-BATCH-NO.                     DTSBD140
01131                                                                   DTSBD140
01132      ADD +1 TO AHDR-ATC-FILE-TRAN-CNT                                CL**4
01133            WRK-AHDR-ITEM-NO.                                         CL*16
01134                                                                      CL**4
01135      MOVE WRK-AHDR-ITEM-NO       TO APAY-ITEM-NO.                    CL*16
01136                                                                   DTSBD140
01137      MOVE APAY-REC TO ASKL-REC.                                   DTSBD140
01138                                                                   DTSBD140
01139      PERFORM S923-WRITE THRU S923-EXIT.                           DTSBD140
01140                                                                   DTSBD140
01141 *&                                                                DTSBD140
01142      DISPLAY 'DTSBD140 P4200 ' APAY-EMP-NO '  ' APAY-BATCH-NO        CL*16
01143         '  ' APAY-ITEM-NO.                                           CL*16
01144 *&                                                                DTSBD140
01145      ADD +1 TO WRK-ATC-TRAN-CNT.                                  DTSBD140
01146  P4200-EXIT.                                                      DTSBD140
01147      EXIT.                                                        DTSBD140
01148      SKIP3                                                        DTSBD140
01149  P4300-WRITE-AADJ.                                                DTSBD140
01150      IF AHDR-ATC-FILE-TRAN-CNT < +475                                CL**4
01151          NEXT SENTENCE                                            DTSBD140
01152      ELSE                                                         DTSBD140
01153          PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
01154          PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
01155          MOVE AHDR-BATCH-NO TO AADJ-BATCH-NO.                     DTSBD140
01156                                                                   DTSBD140
01157      ADD +1 TO AHDR-ATC-FILE-TRAN-CNT                                CL**4
01158            WRK-AHDR-ITEM-NO.                                         CL*16
01159                                                                      CL**4
01160      MOVE WRK-AHDR-ITEM-NO TO AADJ-ITEM-NO.                          CL*16
01161                                                                   DTSBD140
01162      MOVE AADJ-REC TO ASKL-REC.                                   DTSBD140
01163                                                                   DTSBD140
01164      PERFORM S923-WRITE THRU S923-EXIT.                           DTSBD140
01165                                                                   DTSBD140
01166 *&                                                                   CL*16
01167      DISPLAY 'DTSBD140 P4300 ' AADJ-EMP-NO '  ' AADJ-BATCH-NO        CL*16
01168         '  ' AADJ-ITEM-NO.                                           CL*16
01169 *&                                                                   CL*16
01170      ADD +1 TO WRK-ATC-TRAN-CNT.                                  DTSBD140
01171  P4300-EXIT.                                                      DTSBD140
01172      EXIT.                                                        DTSBD140
01173      EJECT                                                        DTSBD140
01174  P5000-TRANSFER.                                                  DTSBD140
01175      PERFORM P3000-GENERATE-TRAN THRU P3000-EXIT.                 DTSBD140
01176                                                                   DTSBD140
01177      MOVE RSKL-REC TO T031-REC.                                   DTSBD140
01178                                                                   DTSBD140
01179      IF T031-TRANSFER-YES-88                                      DTSBD140
01180          NEXT SENTENCE                                            DTSBD140
01181      ELSE                                                         DTSBD140
01182          GO TO P5000-EXIT.                                        DTSBD140
01183                                                                   DTSBD140
01184 *****                                                             DTSBD140
01185 *  IF T027 RECORDS HAVE BEEN PROCESSED, THEN (BECAUSE IF A GIVEN  DTSBD140
01186 *  BATCH INCLUDES T027 GENERATED ARPT RECORDS, THE BATCH MAY      DTSBD140
01187 *  INCLUDE ONLY T027 GENERATED ARPT RECORDS) TERMINATE THE OPEN   DTSBD140
01188 *  BATCH AND INITIATE A NEW BATCH.                                DTSBD140
01189 *****                                                             DTSBD140
01190 *&                                                                DTSBD140
01191 *    DISPLAY 'DTSBD140 P5000 T025 FIRST TIME '                    DTSBD140
01192 *       FIRST-TIME-T027-IND '  T027 ' FIRST-TIME-T025-IND         DTSBD140
01193 *       '  ' AHDR-BATCH-NO.                                       DTSBD140
01194 *&                                                                DTSBD140
01195 **   IF FIRST-TIME-T027-NO-88                                     DTSBD140
01196 *        PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
01197 *        PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
01198 *        SET FIRST-TIME-T027-YES-88 TO TRUE.                      DTSBD140
01199 *                                                                 DTSBD140
01200 *    IF FIRST-TIME-T025-NO-88                                     DTSBD140
01201 *        PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
01202 *        PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
01203 **       SET FIRST-TIME-T025-YES-88 TO TRUE.                      DTSBD140
01204                                                                   DTSBD140
01205      IF WRK-CURR-REC-TYPE NOT = '031'                             DTSBD140
01206         MOVE RSK5-REC-TYPE            TO WRK-CURR-REC-TYPE        DTSBD140
01207         IF AHDR-ATC-FILE-TRAN-CNT > 0                             DTSBD140
01208            PERFORM S2000-TERMINATE-AHDR  THRU S2000-EXIT          DTSBD140
01209            PERFORM S1000-INITIATE-AHDR   THRU S1000-EXIT          DTSBD140
01210         END-IF                                                    DTSBD140
01211      END-IF.                                                      DTSBD140
01212                                                                   DTSBD140
01213      IF AHDR-ATC-FILE-TRAN-CNT NOT < +475                            CL**4
01214          PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
01215          PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT.             DTSBD140
01216                                                                   DTSBD140
01217      IF T031-EMP-NO = HOLD-EMP-NO                                 DTSBD140
01218          NEXT SENTENCE                                            DTSBD140
01219      ELSE                                                         DTSBD140
01220          MOVE T031-EMP-NO TO HOLD-EMP-NO                          DTSBD140
01221          MOVE 'N' TO HOLD-CREDIT-MSG-WRITTEN-IND                  DTSBD140
01222          MOVE +0 TO HOLD-YRQ-CNT.                                 DTSBD140
01223                                                                   DTSBD140
01224                                                                   DTSBD140
01225      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD140
01226                                                                   DTSBD140
01227      MOVE T031-EMP-NO TO MSKL-EMP-NO.                             DTSBD140
01228                                                                   DTSBD140
01229      SET MSKL-PRF-88 TO TRUE.                                     DTSBD140
01230                                                                   DTSBD140
01231      PERFORM S910-READ THRU S910-EXIT.                            DTSBD140
01232                                                                   DTSBD140
01233      IF L910-OK-88                                                DTSBD140
01234          MOVE MSKL-REC TO MPRF-REC                                DTSBD140
01235          IF NOT MPRF-CLASS-SUB-88                                 DTSBD140
01236              MOVE HIGH-VALUES TO TRANSFER-FROM-NAME-CHECK         DTSBD140
01237          ELSE                                                     DTSBD140
01238              MOVE MPRF-EMP-CLASS TO TRANSFER-FROM-EMP-CLASS       DTSBD140
01239              MOVE MPRF-TOT-CREDIT-AMT                             DTSBD140
01240                TO TRANSFER-FROM-TOT-CREDIT-AMT                    DTSBD140
01241              MOVE MPRF-PRIMARY-NAME TO TRANSFER-FROM-NAME-CHECK   DTSBD140
01242      ELSE                                                         DTSBD140
01243          MOVE HIGH-VALUES TO TRANSFER-FROM-NAME-CHECK.            DTSBD140
01244                                                                   DTSBD140
01245                                                                   DTSBD140
01246      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD140
01247                                                                   DTSBD140
01248      MOVE T031-TRANSFER-TO-EMP-NO TO MSKL-EMP-NO.                 DTSBD140
01249                                                                   DTSBD140
01250      SET MSKL-PRF-88 TO TRUE.                                     DTSBD140
01251                                                                   DTSBD140
01252      PERFORM S910-READ THRU S910-EXIT.                            DTSBD140
01253                                                                   DTSBD140
01254      IF L910-OK-88                                                DTSBD140
01255          MOVE MSKL-REC TO MPRF-REC                                DTSBD140
01256          IF NOT MPRF-CLASS-SUB-88                                 DTSBD140
01257              MOVE HIGH-VALUES TO TRANSFER-TO-NAME-CHECK           DTSBD140
01258          ELSE                                                     DTSBD140
01259              MOVE MPRF-PRIMARY-NAME TO TRANSFER-TO-NAME-CHECK     DTSBD140
01260      ELSE                                                         DTSBD140
01261          MOVE HIGH-VALUES TO TRANSFER-TO-NAME-CHECK.              DTSBD140
01262                                                                   DTSBD140
01263                                                                   DTSBD140
01264      IF (TRANSFER-FROM-NAME-CHECK = HIGH-VALUES)                  DTSBD140
01265             OR                                                    DTSBD140
01266         (TRANSFER-TO-NAME-CHECK = HIGH-VALUES)                    DTSBD140
01267          GO TO P5000-EXIT.                                        DTSBD140
01268                                                                   DTSBD140
01269                                                                   DTSBD140
01270      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD140
01271                                                                   DTSBD140
01272      MOVE T031-EMP-NO TO MQTR-EMP-NO.                             DTSBD140
01273                                                                   DTSBD140
01274      SET MQTR-QTR-88 TO TRUE.                                     DTSBD140
01275                                                                   DTSBD140
01276      MOVE T031-START-YRQ TO MQTR-YRQ.                             DTSBD140
01277                                                                   DTSBD140
01278      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
01279                                                                   DTSBD140
01280      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD140
01281                                                                   DTSBD140
01282      IF L910-OK-88                                                DTSBD140
01283          MOVE MSKL-REC TO MQTR-REC.                               DTSBD140
01284                                                                   DTSBD140
01285      PERFORM                                                      DTSBD140
01286        UNTIL (L910-NO-REC-88)                                     DTSBD140
01287                   OR                                              DTSBD140
01288              (MQTR-YRQ > T031-END-YRQ)                            DTSBD140
01289          MOVE MQTR-YRQ TO TRANSFER-YRQ                            DTSBD140
01290          PERFORM P5100-PROCESS-MQTR THRU P5100-EXIT               DTSBD140
01291          MOVE LOW-VALUES TO MQTR-KEY-AREA                         DTSBD140
01292          MOVE T031-EMP-NO TO MQTR-EMP-NO                          DTSBD140
01293          SET MQTR-QTR-88 TO TRUE                                  DTSBD140
01294          MOVE TRANSFER-YRQ TO MQTR-YRQ                            DTSBD140
01295          MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA                      DTSBD140
01296          PERFORM S910-START-BROWSE THRU S910-EXIT                 DTSBD140
01297          IF L910-OK-88                                            DTSBD140
01298              PERFORM S910-READ-NEXT THRU S910-EXIT                DTSBD140
01299              IF L910-OK-88                                        DTSBD140
01300                  MOVE MSKL-REC TO MQTR-REC                        DTSBD140
01301              END-IF                                               DTSBD140
01302          END-IF                                                   DTSBD140
01303      END-PERFORM.                                                 DTSBD140
01304  P5000-EXIT.                                                      DTSBD140
01305      EXIT.                                                        DTSBD140
01306                                                                   DTSBD140
01307                                                                   DTSBD140
01308                                                                   DTSBD140
01309  P5100-PROCESS-MQTR.                                              DTSBD140
01310      MOVE +0 TO HOLD-YRQ-SUB.                                     DTSBD140
01311                                                                   DTSBD140
01312      PERFORM                                                      DTSBD140
01313        VARYING HOLD-YRQ-IDX FROM 1 BY 1                           DTSBD140
01314        UNTIL (HOLD-YRQ-IDX > HOLD-YRQ-CNT)                        DTSBD140
01315                 OR                                                DTSBD140
01316              (HOLD-YRQ-SUB NOT = +0)                              DTSBD140
01317          IF HOLD-TRANSFERRED-YRQ (HOLD-YRQ-IDX) = TRANSFER-YRQ    DTSBD140
01318              SET HOLD-YRQ-SUB TO HOLD-YRQ-IDX                     DTSBD140
01319          END-IF                                                   DTSBD140
01320      END-PERFORM.                                                 DTSBD140
01321                                                                   DTSBD140
01322      IF HOLD-YRQ-SUB > +0                                         DTSBD140
01323          GO TO P5100-EXIT.                                        DTSBD140
01324                                                                   DTSBD140
01325      IF MQTR-CURR-RCVD-88                                         DTSBD140
01326          NEXT SENTENCE                                            DTSBD140
01327      ELSE                                                         DTSBD140
01328          GO TO P5100-EXIT.                                        DTSBD140
01329                                                                   DTSBD140
01330                                                                   DTSBD140
01331      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD140
01332                                                                   DTSBD140
01333      MOVE T031-EMP-NO TO MSKL-EMP-NO.                             DTSBD140
01334                                                                   DTSBD140
01335      SET MSKL-PRF-88 TO TRUE.                                     DTSBD140
01336                                                                   DTSBD140
01337      PERFORM S910-READ THRU S910-EXIT.                            DTSBD140
01338                                                                   DTSBD140
01339      IF L910-NO-REC-88                                            DTSBD140
01340          GO TO P5100-EXIT.                                        DTSBD140
01341                                                                   DTSBD140
01342      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD140
01343                                                                   DTSBD140
01344                                                                   DTSBD140
01345      MOVE TRANSFER-YRQ TO L516-YRQ.                               DTSBD140
01346                                                                   DTSBD140
01347      PERFORM S516-DETERMINE-LIABILITY THRU S516-EXIT.             DTSBD140
01348                                                                   DTSBD140
01349      IF L516-LIABLE-88                                            DTSBD140
01350          GO TO P5100-EXIT.                                        DTSBD140
01351                                                                   DTSBD140
01352                                                                   DTSBD140
01353      MOVE MQTR-TOT-WAGE TO TRANSFER-TOT-WAGE.                     DTSBD140
01354                                                                   DTSBD140
01355      MOVE MQTR-EXCESS-WAGE TO TRANSFER-EXCESS-WAGE.               DTSBD140
01356                                                                   DTSBD140
01357      MOVE MQTR-TAX-WAGE TO TRANSFER-TAX-WAGE.                     DTSBD140
01358                                                                   DTSBD140
01359                                                                   DTSBD140
01360      MOVE MQTR-1ST-MTH-EMPL-CNT TO TRANSFER-1ST-MTH-EMPL-CNT.     DTSBD140
01361                                                                   DTSBD140
01362      MOVE MQTR-2ND-MTH-EMPL-CNT TO TRANSFER-2ND-MTH-EMPL-CNT.     DTSBD140
01363                                                                   DTSBD140
01364      MOVE MQTR-3RD-MTH-EMPL-CNT TO TRANSFER-3RD-MTH-EMPL-CNT.     DTSBD140
01365                                                                   DTSBD140
01366      MOVE +0 TO TRANSFER-LATE-PEN-CHARGED                         DTSBD140
01367                 TRANSFER-LATE-PEN-WAIVED.                         DTSBD140
01368                                                                   DTSBD140
01369      PERFORM                                                      DTSBD140
01370        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSBD140
01371        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBD140
01372          IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)                 DTSBD140
01373              ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                 DTSBD140
01374               TO TRANSFER-LATE-PEN-CHARGED                        DTSBD140
01375              ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)                  DTSBD140
01376               TO TRANSFER-LATE-PEN-WAIVED                         DTSBD140
01377          END-IF                                                   DTSBD140
01378      END-PERFORM.                                                 DTSBD140
01379                                                                   DTSBD140
01380                                                                   DTSBD140
01381      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD140
01382                                                                   DTSBD140
01383      MOVE T031-TRANSFER-TO-EMP-NO TO MSKL-EMP-NO.                 DTSBD140
01384                                                                   DTSBD140
01385      SET MSKL-PRF-88 TO TRUE.                                     DTSBD140
01386                                                                   DTSBD140
01387      PERFORM S910-READ THRU S910-EXIT.                            DTSBD140
01388                                                                   DTSBD140
01389      IF L910-NO-REC-88                                            DTSBD140
01390          GO TO P5100-EXIT.                                        DTSBD140
01391                                                                   DTSBD140
01392      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD140
01393                                                                   DTSBD140
01394                                                                   DTSBD140
01395      MOVE TRANSFER-YRQ TO L516-YRQ.                               DTSBD140
01396                                                                   DTSBD140
01397      PERFORM S516-DETERMINE-LIABILITY THRU S516-EXIT.             DTSBD140
01398                                                                   DTSBD140
01399      IF L516-NOT-LIABLE-88                                        DTSBD140
01400          GO TO P5100-EXIT.                                        DTSBD140
01401                                                                   DTSBD140
01402                                                                   DTSBD140
01403      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD140
01404                                                                   DTSBD140
01405      MOVE T031-TRANSFER-TO-EMP-NO TO MQTR-EMP-NO.                 DTSBD140
01406                                                                   DTSBD140
01407      SET MQTR-QTR-88 TO TRUE.                                     DTSBD140
01408                                                                   DTSBD140
01409      MOVE TRANSFER-YRQ TO MQTR-YRQ.                               DTSBD140
01410                                                                   DTSBD140
01411      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
01412                                                                   DTSBD140
01413      PERFORM S910-READ THRU S910-EXIT.                            DTSBD140
01414                                                                   DTSBD140
01415      IF L910-OK-88                                                DTSBD140
01416          MOVE MSKL-REC TO MQTR-REC                                DTSBD140
01417          IF MQTR-CURR-RCVD-88                                     DTSBD140
01418              PERFORM P5101-MSG387 THRU P5101-EXIT                 DTSBD140
01419              GO TO P5100-EXIT.                                    DTSBD140
01420                                                                   DTSBD140
01421                                                                   DTSBD140
01422      IF HOLD-CREDIT-MSG-WRITTEN-IND = 'N'                         DTSBD140
01423          IF TRANSFER-FROM-TOT-CREDIT-AMT > +0                     DTSBD140
01424              PERFORM P5102-MSG388 THRU P5102-EXIT                 DTSBD140
01425              MOVE 'Y' TO HOLD-CREDIT-MSG-WRITTEN-IND.             DTSBD140
01426                                                                   DTSBD140
01427                                                                   DTSBD140
01428      MOVE +0 TO RECENT-RECEIVED-DATE.                             DTSBD140
01429                                                                   DTSBD140
01430                                                                   DTSBD140
01431      MOVE LOW-VALUES TO MRPT-KEY-AREA.                            DTSBD140
01432                                                                   DTSBD140
01433      MOVE T031-EMP-NO TO MRPT-EMP-NO.                             DTSBD140
01434                                                                   DTSBD140
01435      SET MRPT-RPT-88 TO TRUE.                                     DTSBD140
01436                                                                   DTSBD140
01437      MOVE TRANSFER-YRQ TO MRPT-YRQ.                               DTSBD140
01438                                                                   DTSBD140
01439      MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
01440                                                                   DTSBD140
01441      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD140
01442                                                                   DTSBD140
01443      PERFORM P5110-MRPT-SCAN THRU P5110-EXIT                      DTSBD140
01444          UNTIL L910-NO-REC-88.                                    DTSBD140
01445                                                                   DTSBD140
01446                                                                   DTSBD140
01447      IF HOLD-YRQ-CNT < HOLD-YRQ-MAX                               DTSBD140
01448          ADD +1 TO HOLD-YRQ-CNT                                   DTSBD140
01449          MOVE TRANSFER-YRQ                                        DTSBD140
01450            TO HOLD-TRANSFERRED-YRQ (HOLD-YRQ-CNT).                DTSBD140
01451                                                                   DTSBD140
01452                                                                   DTSBD140
01453      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBD140
01454                                                                   DTSBD140
01455      MOVE T031-EMP-NO TO MDST-EMP-NO.                             DTSBD140
01456                                                                   DTSBD140
01457      SET MDST-DST-88 TO TRUE.                                     DTSBD140
01458                                                                   DTSBD140
01459      MOVE TRANSFER-YRQ TO MDST-YRQ.                               DTSBD140
01460                                                                   DTSBD140
01461      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
01462                                                                   DTSBD140
01463      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD140
01464                                                                   DTSBD140
01465      IF L910-OK-88                                                DTSBD140
01466          MOVE MSKL-REC TO MDST-REC.                               DTSBD140
01467                                                                   DTSBD140
01468      PERFORM                                                      DTSBD140
01469        UNTIL (L910-NO-REC-88)                                     DTSBD140
01470                 OR                                                DTSBD140
01471              (MDST-YRQ NOT = TRANSFER-YRQ)                        DTSBD140
01472          PERFORM P5150-GENERATE-PEN-INT-PR THRU P5150-EXIT        DTSBD140
01473          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD140
01474          IF L910-OK-88                                            DTSBD140
01475              MOVE MSKL-REC TO MDST-REC                            DTSBD140
01476          END-IF                                                   DTSBD140
01477      END-PERFORM.                                                 DTSBD140
01478                                                                   DTSBD140
01479                                                                   DTSBD140
01480      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBD140
01481                                                                   DTSBD140
01482      MOVE T031-EMP-NO TO MDST-EMP-NO.                             DTSBD140
01483                                                                   DTSBD140
01484      SET MDST-DST-88 TO TRUE.                                     DTSBD140
01485                                                                   DTSBD140
01486      MOVE TRANSFER-YRQ TO MDST-YRQ.                               DTSBD140
01487                                                                   DTSBD140
01488      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
01489                                                                   DTSBD140
01490      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD140
01491                                                                   DTSBD140
01492      IF L910-OK-88                                                DTSBD140
01493          MOVE MSKL-REC TO MDST-REC.                               DTSBD140
01494                                                                   DTSBD140
01495      PERFORM                                                      DTSBD140
01496        UNTIL (L910-NO-REC-88)                                     DTSBD140
01497                 OR                                                DTSBD140
01498              (MDST-YRQ NOT = TRANSFER-YRQ)                        DTSBD140
01499          PERFORM P5160-GENERATE-TAX-PR THRU P5160-EXIT            DTSBD140
01500          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD140
01501          IF L910-OK-88                                            DTSBD140
01502              MOVE MSKL-REC TO MDST-REC                            DTSBD140
01503          END-IF                                                   DTSBD140
01504      END-PERFORM.                                                 DTSBD140
01505                                                                   DTSBD140
01506                                                                   DTSBD140
01507      PERFORM P5120-GENERATE-WITHDRAWAL THRU P5120-EXIT.           DTSBD140
01508                                                                   DTSBD140
01509                                                                   DTSBD140
01510      PERFORM P5140-GENERATE-OR THRU P5140-EXIT.                   DTSBD140
01511                                                                   DTSBD140
01512                                                                   DTSBD140
01513      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBD140
01514                                                                   DTSBD140
01515      MOVE T031-EMP-NO TO MDST-EMP-NO.                             DTSBD140
01516                                                                   DTSBD140
01517      SET MDST-DST-88 TO TRUE.                                     DTSBD140
01518                                                                   DTSBD140
01519      MOVE TRANSFER-YRQ TO MDST-YRQ.                               DTSBD140
01520                                                                   DTSBD140
01521      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
01522                                                                   DTSBD140
01523      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD140
01524                                                                   DTSBD140
01525      IF L910-OK-88                                                DTSBD140
01526          MOVE MSKL-REC TO MDST-REC.                               DTSBD140
01527                                                                   DTSBD140
01528      PERFORM                                                      DTSBD140
01529        UNTIL (L910-NO-REC-88)                                     DTSBD140
01530                 OR                                                DTSBD140
01531              (MDST-YRQ NOT = TRANSFER-YRQ)                        DTSBD140
01532          PERFORM P5170-GENERATE-PA THRU P5170-EXIT                DTSBD140
01533          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD140
01534          IF L910-OK-88                                            DTSBD140
01535              MOVE MSKL-REC TO MDST-REC                            DTSBD140
01536          END-IF                                                   DTSBD140
01537      END-PERFORM.                                                 DTSBD140
01538                                                                   DTSBD140
01539                                                                   DTSBD140
01540      IF (TRANSFER-LATE-PEN-CHARGED > +0)                          DTSBD140
01541              AND                                                  DTSBD140
01542         (NOT TRANSFER-FROM-EMP-SELF-INS-88)                       DTSBD140
01543          PERFORM P5180-TRANSFER-LATE-PEN THRU P5180-EXIT.         DTSBD140
01544  P5100-EXIT.                                                      DTSBD140
01545      EXIT.                                                        DTSBD140
01546      SKIP3                                                        DTSBD140
01547  P5101-MSG387.                                                    DTSBD140
01548      MOVE MSG387-ID TO R907-MSG-ID.                               DTSBD140
01549                                                                   DTSBD140
01550      MOVE T031-EMP-NO TO R907-EMP-NO.                             DTSBD140
01551                                                                   DTSBD140
01552      MOVE T031-EMP-NO TO MSG387-SOURCE-EMP-NO.                    DTSBD140
01553                                                                   DTSBD140
01554      MOVE T031-TRANSFER-TO-EMP-NO TO MSG387-TARGET-EMP-NO.        DTSBD140
01555                                                                   DTSBD140
01556      MOVE TRANSFER-YRQ TO L004-QTR-5-9.                           DTSBD140
01557                                                                   DTSBD140
01558      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD140
01559                                                                   DTSBD140
01560      MOVE L004-SLASH-QTR TO MSG387-SLASH-QTR.                     DTSBD140
01561                                                                   DTSBD140
01562      MOVE MSG387-TEXT TO R907-MSG-TEXT.                           DTSBD140
01563                                                                   DTSBD140
01564      MOVE WRK-MOD-NAME TO R907-MODULE-NAME.                       DTSBD140
01565                                                                   DTSBD140
01566      PERFORM S947-R907-WRITE THRU S947-EXIT.                      DTSBD140
01567  P5101-EXIT.                                                      DTSBD140
01568      EXIT.                                                        DTSBD140
01569      SKIP3                                                        DTSBD140
01570  P5102-MSG388.                                                    DTSBD140
01571      MOVE MSG388-ID TO R907-MSG-ID.                               DTSBD140
01572                                                                   DTSBD140
01573      MOVE T031-EMP-NO TO R907-EMP-NO.                             DTSBD140
01574                                                                   DTSBD140
01575      MOVE MSG388-TEXT TO R907-MSG-TEXT.                           DTSBD140
01576                                                                   DTSBD140
01577      MOVE WRK-MOD-NAME TO R907-MODULE-NAME.                       DTSBD140
01578                                                                   DTSBD140
01579      PERFORM S947-R907-WRITE THRU S947-EXIT.                      DTSBD140
01580  P5102-EXIT.                                                      DTSBD140
01581      EXIT.                                                        DTSBD140
01582      SKIP3                                                        DTSBD140
01583  P5110-MRPT-SCAN.                                                 DTSBD140
01584      MOVE MSKL-REC TO MRPT-REC.                                   DTSBD140
01585                                                                   DTSBD140
01586      IF MRPT-YRQ = TRANSFER-YRQ                                   DTSBD140
01587          NEXT SENTENCE                                            DTSBD140
01588      ELSE                                                         DTSBD140
01589          SET L910-NO-REC-88 TO TRUE                               DTSBD140
01590          GO TO P5110-EXIT.                                        DTSBD140
01591                                                                   DTSBD140
01592      IF MRPT-ORIG-88                                              DTSBD140
01593          IF MRPT-RECEIVED-DATE > RECENT-RECEIVED-DATE             DTSBD140
01594              MOVE MRPT-RECEIVED-DATE TO RECENT-RECEIVED-DATE.     DTSBD140
01595                                                                   DTSBD140
01596      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD140
01597  P5110-EXIT.                                                      DTSBD140
01598      EXIT.                                                        DTSBD140
01599      SKIP3                                                        DTSBD140
01600  P5120-GENERATE-WITHDRAWAL.                                       DTSBD140
01601      PERFORM P5191-INITIALIZE-ARPT THRU P5191-EXIT.               DTSBD140
01602                                                                   DTSBD140
01603      MOVE TRANSFER-FROM-NAME-CHECK TO ARPT-NAME-CHECK.            DTSBD140
01604                                                                   DTSBD140
01605      MOVE T031-EMP-NO TO ARPT-EMP-NO.                             DTSBD140
01606                                                                   DTSBD140
01607      SET ARPT-WITHDRW-88 TO TRUE.                                 DTSBD140
01608                                                                   DTSBD140
01609      IF TRANSFER-TOT-WAGE = +0                                    DTSBD140
01610          MOVE +0 TO ARPT-TOT-WAGE                                 DTSBD140
01611      ELSE                                                         DTSBD140
01612          COMPUTE ARPT-TOT-WAGE = TRANSFER-TOT-WAGE * -1.          DTSBD140
01613                                                                   DTSBD140
01614      IF TRANSFER-EXCESS-WAGE = +0                                 DTSBD140
01615          MOVE +0 TO ARPT-EXCESS-WAGE                              DTSBD140
01616      ELSE                                                         DTSBD140
01617          COMPUTE ARPT-EXCESS-WAGE = TRANSFER-EXCESS-WAGE * -1.    DTSBD140
01618                                                                   DTSBD140
01619      IF TRANSFER-TAX-WAGE = +0                                    DTSBD140
01620          MOVE +0 TO ARPT-TAX-WAGE                                 DTSBD140
01621      ELSE                                                         DTSBD140
01622          COMPUTE ARPT-TAX-WAGE = TRANSFER-TAX-WAGE * -1.          DTSBD140
01623                                                                   DTSBD140
01624      PERFORM P4100-WRITE-ARPT THRU P4100-EXIT.                    DTSBD140
01625  P5120-EXIT.                                                      DTSBD140
01626      EXIT.                                                        DTSBD140
01627      SKIP3                                                        DTSBD140
01628 *P5130-GENERATE-AC.                                               DTSBD140
01629 *****PERFORM P5191-INITIALIZE-ARPT THRU P5191-EXIT.               DTSBD140
01630 *****                                                             DTSBD140
01631 *****MOVE TRANSFER-TO-NAME-CHECK TO ARPT-NAME-CHECK.              DTSBD140
01632 *****                                                             DTSBD140
01633 *****MOVE T031-TRANSFER-TO-EMP-NO TO ARPT-EMP-NO.                 DTSBD140
01634 *****                                                             DTSBD140
01635 *****SET ARPT-ADMIN-CORR-88 TO TRUE.                              DTSBD140
01636 *****                                                             DTSBD140
01637 *****COMPUTE ARPT-TOT-WAGE                                        DTSBD140
01638 *****          = TRANSFER-TOT-WAGE + MQTR-TOT-WAGE.               DTSBD140
01639 *****                                                             DTSBD140
01640 *****COMPUTE ARPT-EXCESS-WAGE                                     DTSBD140
01641 *****          = TRANSFER-EXCESS-WAGE + MQTR-EXCESS-WAGE.         DTSBD140
01642 *****                                                             DTSBD140
01643 *****COMPUTE ARPT-TAX-WAGE                                        DTSBD140
01644 *****          = TRANSFER-TAX-WAGE + MQTR-TAX-WAGE.               DTSBD140
01645 *****                                                             DTSBD140
01646 *****MOVE L516-UI-RATE TO ARPT-UI-RATE.                           DTSBD140
01647 *****                                                             DTSBD140
01648 *****PERFORM P4100-WRITE-ARPT THRU P4100-EXIT.                    DTSBD140
01649 *P5130-EXIT.                                                      DTSBD140
01650 *****EXIT.                                                        DTSBD140
01651      SKIP3                                                        DTSBD140
01652  P5140-GENERATE-OR.                                               DTSBD140
01653      PERFORM P5191-INITIALIZE-ARPT THRU P5191-EXIT.               DTSBD140
01654                                                                   DTSBD140
01655      MOVE TRANSFER-TO-NAME-CHECK TO ARPT-NAME-CHECK.              DTSBD140
01656                                                                   DTSBD140
01657      MOVE T031-TRANSFER-TO-EMP-NO TO ARPT-EMP-NO.                 DTSBD140
01658                                                                   DTSBD140
01659      SET ARPT-ORIG-88 TO TRUE.                                    DTSBD140
01660                                                                   DTSBD140
01661      MOVE TRANSFER-TOT-WAGE TO ARPT-TOT-WAGE.                     DTSBD140
01662                                                                   DTSBD140
01663      MOVE TRANSFER-EXCESS-WAGE TO ARPT-EXCESS-WAGE.               DTSBD140
01664                                                                   DTSBD140
01665      MOVE TRANSFER-TAX-WAGE TO ARPT-TAX-WAGE.                     DTSBD140
01666                                                                   DTSBD140
01667      IF TRANSFER-WAGE-RPT-YES-88                                  DTSBD140
01668          MOVE TRANSFER-WAGE-RPT-IND TO ARPT-WAGE-RPT-IND.         DTSBD140
01669                                                                   DTSBD140
01670      MOVE TRANSFER-1ST-MTH-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT.     DTSBD140
01671                                                                   DTSBD140
01672      MOVE TRANSFER-2ND-MTH-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT.     DTSBD140
01673                                                                   DTSBD140
01674      MOVE TRANSFER-3RD-MTH-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT.     DTSBD140
01675                                                                   DTSBD140
01676      MOVE RECENT-RECEIVED-DATE TO ARPT-RECEIVED-DATE.             DTSBD140
01677                                                                   DTSBD140
01678      PERFORM P4100-WRITE-ARPT THRU P4100-EXIT.                    DTSBD140
01679  P5140-EXIT.                                                      DTSBD140
01680      EXIT.                                                        DTSBD140
01681       SKIP3                                                       DTSBD140
01682  P5150-GENERATE-PEN-INT-PR.                                       DTSBD140
01683      PERFORM P5192-INITIALIZE-APAY THRU P5192-EXIT.               DTSBD140
01684                                                                   DTSBD140
01685      MOVE TRANSFER-FROM-NAME-CHECK TO APAY-NAME-CHECK.            DTSBD140
01686                                                                   DTSBD140
01687      MOVE T031-EMP-NO TO APAY-EMP-NO.                             DTSBD140
01688                                                                   DTSBD140
01689      SET APAY-PAY-REV-88 TO TRUE.                                 DTSBD140
01690                                                                   DTSBD140
01691      MOVE MDST-DOC-NO TO APAY-APPLIC-DOC-NO.                      DTSBD140
01692                                                                   DTSBD140
01693      PERFORM P5151-MDST-ACCT-LOOP THRU P5151-EXIT                 DTSBD140
01694          VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSBD140
01695          UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                     DTSBD140
01696  P5150-EXIT.                                                      DTSBD140
01697      EXIT.                                                        DTSBD140
01698      SKIP3                                                        DTSBD140
01699  P5151-MDST-ACCT-LOOP.                                            DTSBD140
01700      IF MDST-ACCT-LATE-PEN-88 (MDST-ACCT-IDX)                     DTSBD140
01701              OR                                                   DTSBD140
01702         MDST-ACCT-INT-88 (MDST-ACCT-IDX)                          DTSBD140
01703          NEXT SENTENCE                                            DTSBD140
01704      ELSE                                                         DTSBD140
01705          GO TO P5151-EXIT.                                        DTSBD140
01706                                                                   DTSBD140
01707      COMPUTE APAY-REMIT-AMT = MDST-AMT (MDST-ACCT-IDX) * -1.      DTSBD140
01708                                                                   DTSBD140
01709      MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO APAY-APPLIC-IND.       DTSBD140
01710                                                                   DTSBD140
01711      PERFORM P4200-WRITE-APAY THRU P4200-EXIT.                    DTSBD140
01712  P5151-EXIT.                                                      DTSBD140
01713      EXIT.                                                        DTSBD140
01714      SKIP3                                                        DTSBD140
01715  P5160-GENERATE-TAX-PR.                                           DTSBD140
01716      PERFORM P5192-INITIALIZE-APAY THRU P5192-EXIT.               DTSBD140
01717                                                                   DTSBD140
01718      MOVE TRANSFER-FROM-NAME-CHECK TO APAY-NAME-CHECK.            DTSBD140
01719                                                                   DTSBD140
01720      MOVE T031-EMP-NO TO APAY-EMP-NO.                             DTSBD140
01721                                                                   DTSBD140
01722      SET APAY-PAY-REV-88 TO TRUE.                                 DTSBD140
01723                                                                   DTSBD140
01724      MOVE MDST-DOC-NO TO APAY-APPLIC-DOC-NO.                      DTSBD140
01725                                                                   DTSBD140
01726      PERFORM P5161-MDST-ACCT-LOOP THRU P5161-EXIT                 DTSBD140
01727          VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSBD140
01728          UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                     DTSBD140
01729  P5160-EXIT.                                                      DTSBD140
01730      EXIT.                                                        DTSBD140
01731      SKIP3                                                        DTSBD140
01732  P5161-MDST-ACCT-LOOP.                                            DTSBD140
01733      IF MDST-ACCT-TAX-88 (MDST-ACCT-IDX)                          DTSBD140
01734          NEXT SENTENCE                                            DTSBD140
01735      ELSE                                                         DTSBD140
01736          GO TO P5161-EXIT.                                        DTSBD140
01737                                                                   DTSBD140
01738      IF MDST-ACCT-UI-88 (MDST-ACCT-IDX)                           DTSBD140
01739          IF TRANSFER-FROM-EMP-SELF-INS-88                         DTSBD140
01740              GO TO P5161-EXIT.                                    DTSBD140
01741                                                                   DTSBD140
01742      COMPUTE APAY-REMIT-AMT = MDST-AMT (MDST-ACCT-IDX) * -1.      DTSBD140
01743                                                                   DTSBD140
01744      MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO APAY-APPLIC-IND.       DTSBD140
01745                                                                   DTSBD140
01746      PERFORM P4200-WRITE-APAY THRU P4200-EXIT.                    DTSBD140
01747  P5161-EXIT.                                                      DTSBD140
01748      EXIT.                                                        DTSBD140
01749      SKIP3                                                        DTSBD140
01750  P5170-GENERATE-PA.                                               DTSBD140
01751      PERFORM P5192-INITIALIZE-APAY THRU P5192-EXIT.               DTSBD140
01752                                                                   DTSBD140
01753      PERFORM P5171-MDST-ACCT-LOOP THRU P5171-EXIT                 DTSBD140
01754          VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSBD140
01755          UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                     DTSBD140
01756                                                                   DTSBD140
01757      IF APAY-REMIT-AMT = +0                                       DTSBD140
01758          GO TO P5170-EXIT.                                        DTSBD140
01759                                                                   DTSBD140
01760      MOVE TRANSFER-TO-NAME-CHECK TO APAY-NAME-CHECK.              DTSBD140
01761                                                                   DTSBD140
01762      MOVE T031-TRANSFER-TO-EMP-NO TO APAY-EMP-NO.                 DTSBD140
01763                                                                   DTSBD140
01764      SET APAY-PAYMENT-88 TO TRUE.                                 DTSBD140
01765                                                                   DTSBD140
01766      MOVE MDST-RECEIVED-DATE TO APAY-RECEIVED-DATE.               DTSBD140
01767                                                                   DTSBD140
01768      PERFORM P4200-WRITE-APAY THRU P4200-EXIT.                    DTSBD140
01769  P5170-EXIT.                                                      DTSBD140
01770      EXIT.                                                        DTSBD140
01771      SKIP3                                                        DTSBD140
01772  P5171-MDST-ACCT-LOOP.                                            DTSBD140
01773      IF MDST-ACCT-LATE-PEN-88 (MDST-ACCT-IDX)                     DTSBD140
01774             OR                                                    DTSBD140
01775         MDST-ACCT-INT-88 (MDST-ACCT-IDX)                          DTSBD140
01776             OR                                                    DTSBD140
01777         MDST-ACCT-TAX-88 (MDST-ACCT-IDX)                          DTSBD140
01778          NEXT SENTENCE                                            DTSBD140
01779      ELSE                                                         DTSBD140
01780          GO TO P5171-EXIT.                                        DTSBD140
01781                                                                   DTSBD140
01782      IF MDST-ACCT-UI-88 (MDST-ACCT-IDX)                           DTSBD140
01783          IF TRANSFER-FROM-EMP-SELF-INS-88                         DTSBD140
01784              GO TO P5171-EXIT.                                    DTSBD140
01785                                                                   DTSBD140
01786      ADD MDST-AMT (MDST-ACCT-IDX) TO APAY-REMIT-AMT.              DTSBD140
01787  P5171-EXIT.                                                      DTSBD140
01788      EXIT.                                                        DTSBD140
01789      SKIP3                                                        DTSBD140
01790  P5180-TRANSFER-LATE-PEN.                                         DTSBD140
01791      PERFORM P5193-INITIALIZE-AADJ THRU P5193-EXIT.               DTSBD140
01792                                                                   DTSBD140
01793      MOVE TRANSFER-TO-NAME-CHECK TO AADJ-NAME-CHECK.              DTSBD140
01794                                                                   DTSBD140
01795      MOVE T031-TRANSFER-TO-EMP-NO TO AADJ-EMP-NO.                 DTSBD140
01796                                                                   DTSBD140
01797      SET AADJ-CHARGE-88 TO TRUE.                                  DTSBD140
01798                                                                   DTSBD140
01799      MOVE TRANSFER-LATE-PEN-CHARGED TO AADJ-AMT.                  DTSBD140
01800                                                                   DTSBD140
01801      MOVE TRANSFER-YRQ TO AADJ-APPLIC-YRQ.                        DTSBD140
01802                                                                   DTSBD140
01803      SET AADJ-LATE-PEN-88 TO TRUE.                                DTSBD140
01804                                                                   DTSBD140
01805      PERFORM P4300-WRITE-AADJ THRU P4300-EXIT.                    DTSBD140
01806                                                                   DTSBD140
01807                                                                   DTSBD140
01808      IF TRANSFER-LATE-PEN-WAIVED > +0                             DTSBD140
01809          SET AADJ-WAIVE-88 TO TRUE                                DTSBD140
01810          MOVE TRANSFER-LATE-PEN-WAIVED TO AADJ-AMT                DTSBD140
01811          PERFORM P4300-WRITE-AADJ THRU P4300-EXIT.                DTSBD140
01812  P5180-EXIT.                                                      DTSBD140
01813      EXIT.                                                        DTSBD140
01814      SKIP3                                                        DTSBD140
01815  P5191-INITIALIZE-ARPT.                                           DTSBD140
01816      MOVE LOW-VALUES TO ARPT-REC.                                 DTSBD140
01817                                                                   DTSBD140
01818                                                                   DTSBD140
01819      MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO.                         DTSBD140
01820                                                                   DTSBD140
01821      MOVE +0 TO ARPT-ITEM-NO.                                        CL**7
01822                                                                   DTSBD140
01823      SET ARPT-RPT-88 TO TRUE.                                     DTSBD140
01824                                                                   DTSBD140
01825      MOVE SPACE TO ARPT-NAME-CHECK.                               DTSBD140
01826                                                                   DTSBD140
01827      MOVE +0 TO ARPT-EMP-NO.                                      DTSBD140
01828                                                                   DTSBD140
01829      MOVE SPACE TO ARPT-RPT-TYPE.                                 DTSBD140
01830                                                                   DTSBD140
01831      MOVE TRANSFER-YRQ TO ARPT-YRQ.                               DTSBD140
01832                                                                   DTSBD140
01833      MOVE +0 TO ARPT-TOT-WAGE                                     DTSBD140
01834                 ARPT-EXCESS-WAGE                                  DTSBD140
01835                 ARPT-TAX-WAGE                                     DTSBD140
01836                 ARPT-REMIT-AMT.                                   DTSBD140
01837                                                                   DTSBD140
01838      SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE.                       DTSBD140
01839                                                                   DTSBD140
01840      SET ARPT-WAIVE-BOTH-NO-88 TO TRUE.                           DTSBD140
01841                                                                   DTSBD140
01842      SET ARPT-WAIVE-INT-NO-88 TO TRUE.                            DTSBD140
01843                                                                   DTSBD140
01844      SET ARPT-WAIVE-LATE-PEN-NO-88 TO TRUE.                       DTSBD140
01845                                                                   DTSBD140
01846      SET ARPT-TOTAL-NO-ENTRY-88 TO TRUE.                          DTSBD140
01847                                                                   DTSBD140
01848      SET ARPT-1ST-MTH-NO-ENTRY-88 TO TRUE.                        DTSBD140
01849                                                                   DTSBD140
01850      SET ARPT-2ND-MTH-NO-ENTRY-88 TO TRUE.                        DTSBD140
01851                                                                   DTSBD140
01852      SET ARPT-3RD-MTH-NO-ENTRY-88 TO TRUE.                        DTSBD140
01853                                                                   DTSBD140
01854      SET ARPT-VERIFIED-NO-88 TO TRUE.                             DTSBD140
01855                                                                   DTSBD140
01856      MOVE +0 TO ARPT-RECEIVED-DATE                                DTSBD140
01857                 ARPT-DEPOSIT-DATE                                 DTSBD140
01858                 ARPT-TRACE-NO.                                    DTSBD140
01859                                                                   DTSBD140
01860      MOVE 'N' TO ARPT-DISREGARD-EDITS-IND.                        DTSBD140
01861                                                                   DTSBD140
01862      SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE.                   DTSBD140
01863                                                                   DTSBD140
01864      MOVE TRANSFER-RESPONSIBLE-ACTIVITY                           DTSBD140
01865        TO ARPT-RESPONSIBLE-ACTIVITY.                              DTSBD140
01866                                                                   DTSBD140
01867      MOVE TRANSFER-RESPONSIBLE-OP-ID TO ARPT-RESPONSIBLE-OP-ID.   DTSBD140
01868                                                                   DTSBD140
01869      SET ARPT-STATUS-CHNG-NO-88 TO TRUE.                          DTSBD140
01870                                                                   DTSBD140
01871      SET ARPT-NOT-PROCESSED-88 TO TRUE.                           DTSBD140
01872  P5191-EXIT.                                                      DTSBD140
01873      EXIT.                                                        DTSBD140
01874      SKIP3                                                        DTSBD140
01875  P5192-INITIALIZE-APAY.                                           DTSBD140
01876      MOVE LOW-VALUES TO APAY-REC.                                 DTSBD140
01877                                                                   DTSBD140
01878                                                                   DTSBD140
01879      MOVE AHDR-BATCH-NO TO APAY-BATCH-NO.                         DTSBD140
01880                                                                   DTSBD140
01881      MOVE +0 TO APAY-ITEM-NO                                         CL**7
01882      MOVE +0 TO APAY-NSF-MNTE-ABSTIME.                               CL**4
01883                                                                   DTSBD140
01884      SET APAY-PAY-88 TO TRUE.                                     DTSBD140
01885                                                                   DTSBD140
01886      MOVE SPACE TO APAY-NAME-CHECK.                               DTSBD140
01887                                                                   DTSBD140
01888      MOVE +0 TO APAY-EMP-NO.                                      DTSBD140
01889                                                                   DTSBD140
01890      MOVE SPACE TO APAY-PAY-TYPE.                                 DTSBD140
01891                                                                   DTSBD140
01892      MOVE +0 TO APAY-REMIT-AMT.                                   DTSBD140
01893                                                                   DTSBD140
01894      SET APAY-WAIVE-INT-NO-88 TO TRUE.                            DTSBD140
01895                                                                   DTSBD140
01896      SET APAY-WAIVE-LATE-PEN-NO-88 TO TRUE.                       DTSBD140
01897                                                                   DTSBD140
01898      SET APAY-NSF-PEN-CHARGE-NO-88 TO TRUE.                       DTSBD140
01899                                                                   DTSBD140
01900      MOVE +0 TO APAY-RECEIVED-DATE                                DTSBD140
01901                 APAY-DEPOSIT-DATE                                 DTSBD140
01902                 APAY-TRACE-NO.                                    DTSBD140
01903                                                                   DTSBD140
01904      MOVE TRANSFER-YRQ TO APAY-APPLIC-YRQ.                        DTSBD140
01905                                                                   DTSBD140
01906      MOVE SPACES TO APAY-APPLIC-IND.                              DTSBD140
01907                                                                   DTSBD140
01908      MOVE +0 TO APAY-APPLIC-BATCH-NO                              DTSBD140
01909                 APAY-APPLIC-ITEM-NO.                              DTSBD140
01910                                                                   DTSBD140
01911      MOVE 'N' TO APAY-DISREGARD-EDITS-IND.                        DTSBD140
01912                                                                   DTSBD140
01913      MOVE TRANSFER-RESPONSIBLE-ACTIVITY                           DTSBD140
01914        TO APAY-RESPONSIBLE-ACTIVITY.                              DTSBD140
01915                                                                   DTSBD140
01916      MOVE TRANSFER-RESPONSIBLE-OP-ID TO APAY-RESPONSIBLE-OP-ID.   DTSBD140
01917                                                                   DTSBD140
01918      SET APAY-NOT-PROCESSED-88 TO TRUE.                           DTSBD140
01919  P5192-EXIT.                                                      DTSBD140
01920      EXIT.                                                        DTSBD140
01921      SKIP3                                                        DTSBD140
01922  P5193-INITIALIZE-AADJ.                                           DTSBD140
01923      MOVE LOW-VALUES TO AADJ-REC.                                 DTSBD140
01924                                                                   DTSBD140
01925                                                                   DTSBD140
01926      MOVE AHDR-BATCH-NO TO AADJ-BATCH-NO.                         DTSBD140
01927                                                                   DTSBD140
01928      MOVE +0 TO AADJ-ITEM-NO.                                        CL**7
01929                                                                   DTSBD140
01930      SET AADJ-ADJ-88 TO TRUE.                                     DTSBD140
01931                                                                   DTSBD140
01932      MOVE SPACE TO AADJ-NAME-CHECK.                               DTSBD140
01933                                                                   DTSBD140
01934      MOVE +0 TO AADJ-EMP-NO.                                      DTSBD140
01935                                                                   DTSBD140
01936      MOVE SPACE TO AADJ-ADJ-TYPE.                                 DTSBD140
01937                                                                   DTSBD140
01938      MOVE +0 TO AADJ-AMT.                                         DTSBD140
01939                                                                   DTSBD140
01940      MOVE +0 TO AADJ-RECEIVED-DATE                                DTSBD140
01941                 AADJ-DEPOSIT-DATE.                                DTSBD140
01942                                                                   DTSBD140
01943      MOVE +0 TO AADJ-APPLIC-YRQ.                                  DTSBD140
01944                                                                   DTSBD140
01945      MOVE SPACES TO AADJ-APPLIC-IND.                              DTSBD140
01946                                                                   DTSBD140
01947      MOVE +0 TO AADJ-APPLIC-BATCH-NO                              DTSBD140
01948                 AADJ-APPLIC-ITEM-NO.                              DTSBD140
01949                                                                   DTSBD140
01950      MOVE +0 TO AADJ-DATE-1                                       DTSBD140
01951                 AADJ-DATE-2.                                      DTSBD140
01952                                                                   DTSBD140
01953      MOVE SPACE TO AADJ-INT-SPAN-IND.                             DTSBD140
01954                                                                   DTSBD140
01955      MOVE +0 TO AADJ-INT-RATE.                                    DTSBD140
01956                                                                   DTSBD140
01957      MOVE 'N' TO AADJ-DISREGARD-EDITS-IND.                        DTSBD140
01958                                                                   DTSBD140
01959      MOVE TRANSFER-RESPONSIBLE-ACTIVITY                           DTSBD140
01960        TO AADJ-RESPONSIBLE-ACTIVITY.                              DTSBD140
01961                                                                   DTSBD140
01962      MOVE TRANSFER-RESPONSIBLE-OP-ID TO AADJ-RESPONSIBLE-OP-ID.   DTSBD140
01963                                                                   DTSBD140
01964      MOVE +0                   TO AADJ-CMP-ESTB-ABSTIME.          DTSBD140
01965                                                                   DTSBD140
01966      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSBD140
01967  P5193-EXIT.                                                      DTSBD140
01968      EXIT.                                                        DTSBD140
01969      EJECT                                                        DTSBD140
01970  P7000-GENERATE-PAY.                                              DTSBD140
01971 *****                                                             DTSBD140
01972 *  IF T025 RECORDS HAVE BEEN PROCESSED, THEN (BECAUSE IF A GIVEN  DTSBD140
01973 *  BATCH INCLUDES T025 GENERATED APAY RECOPRDS, THE BATCH MAY     DTSBD140
01974 *  INCLUDE ONLY T025 GENERATED APAY RECORDS) TERMINATE THE OPEN   DTSBD140
01975 *  BATCH AND INITIATE A NEW BATCH.                                DTSBD140
01976 *****                                                             DTSBD140
01977 *&                                                                DTSBD140
01978 *    DISPLAY 'DTSBD140 P7000 ' RSK5-REC-TYPE.                     DTSBD140
01979 *       FIRST-TIME-T027-IND '  T027 ' FIRST-TIME-T025-IND         DTSBD140
01980 *       '  ' AHDR-BATCH-NO.                                       DTSBD140
01981 *&                                                                DTSBD140
01982 **   IF FIRST-TIME-T025-YES-88                                    DTSBD140
01983 *        PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
01984 *        PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
01985 **       SET FIRST-TIME-T025-NO-88  TO TRUE.                      DTSBD140
01986                                                                   DTSBD140
01987      IF WRK-CURR-REC-TYPE NOT = '025'                             DTSBD140
01988         MOVE RSK5-REC-TYPE            TO WRK-CURR-REC-TYPE        DTSBD140
01989         IF AHDR-ATC-FILE-TRAN-CNT > 0                             DTSBD140
01990            PERFORM S2000-TERMINATE-AHDR  THRU S2000-EXIT          DTSBD140
01991            PERFORM S1000-INITIATE-AHDR   THRU S1000-EXIT          DTSBD140
01992         END-IF                                                    DTSBD140
01993      END-IF.                                                      DTSBD140
01994                                                                   DTSBD140
01995      IF AHDR-ATC-FILE-TRAN-CNT NOT < +475                            CL**4
01996          PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
01997          PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT.             DTSBD140
01998                                                                   DTSBD140
01999      IF RSK5-REC-TYPE = '025'                                     DTSBD140
02000          MOVE RSKL-REC TO T025-REC                                DTSBD140
02001          PERFORM P7100-PAYMENT        THRU P7100-EXIT             DTSBD140
02002      ELSE                                                         DTSBD140
02003          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD140
02004                                                                   DTSBD140
02005      ADD +1 TO AHDR-ATC-FILE-TRAN-CNT                                CL**9
02006            WRK-AHDR-ITEM-NO.                                         CL*16
02007                                                                      CL**7
02008      ADD APAY-REMIT-AMT    TO AHDR-ATC-FILE-REMIT-AMT.            DTSBD140
02009                                                                   DTSBD140
02010      MOVE WRK-AHDR-ITEM-NO     TO APAY-ITEM-NO.                      CL*16
02011                                                                   DTSBD140
02012      MOVE APAY-REC TO ASKL-REC.                                   DTSBD140
02013                                                                   DTSBD140
02014 *&                                                                DTSBD140
02015      DISPLAY 'DTSBD140 P7000 ' APAY-EMP-NO '  ' APAY-BATCH-NO     DTSBD140
02016         '  ' APAY-ITEM-NO '  ' AHDR-ATC-FILE-REMIT-AMT.           DTSBD140
02017 *&                                                                DTSBD140
02018      PERFORM S923-WRITE THRU S923-EXIT.                           DTSBD140
02019                                                                   DTSBD140
02020      ADD +1 TO WRK-ATC-TRAN-CNT.                                  DTSBD140
02021                                                                   DTSBD140
02022  P7000-EXIT.                                                      DTSBD140
02023      EXIT.                                                        DTSBD140
02024                                                                   DTSBD140
02025  P7100-PAYMENT.                                                   DTSBD140
02026 *&                                                                DTSBD140
02027 *    DISPLAY 'DTSBD140 P7100 ' T025-EMP-NO '  ' AHDR-BATCH-NO     DTSBD140
02028 *       '  ' T025-REMIT-AMT '  ' T025-PAY-TYPE.                   DTSBD140
02029 *&                                                                DTSBD140
02030      MOVE LOW-VALUES TO APAY-REC.                                 DTSBD140
02031                                                                   DTSBD140
02032      MOVE AHDR-BATCH-NO TO APAY-BATCH-NO.                         DTSBD140
02033                                                                   DTSBD140
02034      MOVE +0 TO APAY-ITEM-NO.                                        CL**7
02035                                                                   DTSBD140
02036      SET APAY-PAY-88 TO TRUE.                                     DTSBD140
02037                                                                   DTSBD140
02038      MOVE T025-NAME-CHECK TO APAY-NAME-CHECK.                     DTSBD140
02039                                                                   DTSBD140
02040      MOVE T025-EMP-NO TO APAY-EMP-NO.                             DTSBD140
02041                                                                   DTSBD140
02042      EVALUATE TRUE                                                DTSBD140
02043      WHEN T025-OR-PAY-88                                          DTSBD140
02044          SET APAY-OR-PAY-88  TO TRUE                              DTSBD140
02045                                                                   DTSBD140
02046      WHEN T025-PA-PAY-88                                          DTSBD140
02047          SET APAY-PAYMENT-88 TO TRUE                              DTSBD140
02048                                                                   DTSBD140
02049      WHEN T025-PAY-REV-88                                         DTSBD140
02050          SET APAY-PAY-REV-88 TO TRUE                              DTSBD140
02051                                                                   DTSBD140
02052      WHEN T025-NG-CHECK-88                                        DTSBD140
02053          SET APAY-NG-CHECK-88 TO TRUE                             DTSBD140
02054                                                                   DTSBD140
02055      WHEN T025-REFUND-88                                          DTSBD140
02056          SET APAY-REFUND-88 TO TRUE                               DTSBD140
02057                                                                   DTSBD140
02058      WHEN OTHER                                                   DTSBD140
02059          PERFORM S999-ABEND THRU S999-EXIT                        DTSBD140
02060                                                                   DTSBD140
02061      END-EVALUATE.                                                DTSBD140
02062                                                                   DTSBD140
02063      IF T025-REMIT-AMT NUMERIC                                    DTSBD140
02064          MOVE T025-REMIT-AMT TO APAY-REMIT-AMT                    DTSBD140
02065      ELSE                                                         DTSBD140
02066          MOVE +0 TO APAY-REMIT-AMT.                               DTSBD140
02067                                                                   DTSBD140
02068      SET APAY-WAIVE-INT-NO-88   TO TRUE.                          DTSBD140
02069      SET APAY-WAIVE-LATE-PEN-NO-88  TO TRUE.                      DTSBD140
02070                                                                   DTSBD140
02071      MOVE +0 TO APAY-NSF-MNTE-ABSTIME.                            DTSBD140
02072      IF APAY-NG-CHECK-88 AND T025-NSF-PEN-CHARGE-YES-88           DTSBD140
02073         SET APAY-NSF-PEN-CHARGE-YES-88  TO TRUE                   DTSBD140
02074      ELSE                                                         DTSBD140
02075         SET APAY-NSF-PEN-CHARGE-NO-88   TO TRUE.                  DTSBD140
02076                                                                   DTSBD140
02077      IF T025-RECEIVED-DATE NUMERIC                                DTSBD140
02078          MOVE T025-RECEIVED-DATE TO APAY-RECEIVED-DATE            DTSBD140
02079                                     APAY-DEPOSIT-DATE             DTSBD140
02080      ELSE                                                         DTSBD140
02081          MOVE +0 TO APAY-RECEIVED-DATE.                           DTSBD140
02082                                                                   DTSBD140
02083      MOVE T025-TRACE-NO   TO APAY-TRACE-NO.                       DTSBD140
02084                                                                   DTSBD140
02085      IF T025-APPLIC-YRQ NUMERIC                                   DTSBD140
02086          MOVE T025-APPLIC-YRQ TO APAY-APPLIC-YRQ                  DTSBD140
02087      ELSE                                                         DTSBD140
02088          MOVE +0 TO APAY-APPLIC-YRQ.                              DTSBD140
02089                                                                   DTSBD140
02090      MOVE T025-APPLIC-IND TO APAY-APPLIC-IND.                     DTSBD140
02091                                                                   DTSBD140
02092      IF (T025-APPLIC-BATCH-NO NUMERIC)                            DTSBD140
02093              AND                                                  DTSBD140
02094         (T025-APPLIC-ITEM-NO NUMERIC)                             DTSBD140
02095          MOVE T025-APPLIC-DOC-NO TO APAY-APPLIC-DOC-NO            DTSBD140
02096      ELSE                                                         DTSBD140
02097          MOVE +0 TO APAY-APPLIC-BATCH-NO                          DTSBD140
02098                     APAY-APPLIC-ITEM-NO.                          DTSBD140
02099                                                                   DTSBD140
02100      MOVE 'N' TO APAY-DISREGARD-EDITS-IND.                        DTSBD140
02101                                                                   DTSBD140
02102      SET APAY-ANNUAL-RPT-NULL-88    TO TRUE.                      DTSBD140
02103                                                                   DTSBD140
02104      MOVE T025-RESPONSIBLE-ACTIVITY                               DTSBD140
02105        TO APAY-RESPONSIBLE-ACTIVITY.                              DTSBD140
02106                                                                   DTSBD140
02107      MOVE T025-RESPONSIBLE-OP-ID TO APAY-RESPONSIBLE-OP-ID.       DTSBD140
02108                                                                   DTSBD140
02109      SET APAY-NOT-PROCESSED-88 TO TRUE.                           DTSBD140
02110  P7100-EXIT.                                                      DTSBD140
02111      EXIT.                                                        DTSBD140
02112      EJECT                                                        DTSBD140
02113  P8000-GENERATE-RPT.                                              DTSBD140
02114 *&                                                                DTSBD140
02115 *    DISPLAY 'DTSBD140 P8000-1'.                                  DTSBD140
02116 *&                                                                DTSBD140
02117      IF RSK5-REC-TYPE = '028'                                     DTSBD140
02118          MOVE RSKL-REC TO T028-REC                                DTSBD140
02119      ELSE                                                         DTSBD140
02120          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD140
02121                                                                   DTSBD140
02122 *&                                                                DTSBD140
02123      DISPLAY 'DTSBD140 P8000-2 ' T028-EMP-NO '  ' T028-RPT-TYPE   DTSBD140
02124         '  ' T028-TRN-TYPE '  ' T028-LOG-NBR.                     DTSBD140
02125 *&                                                                DTSBD140
02126 *****                                                             DTSBD140
02127 *  IF T027 RECORDS HAVE BEEN PROCESSED, THEN (BECAUSE IF A GIVEN  DTSBD140
02128 *  BATCH INCLUDES T027 GENERATED ARPT RECOPRDS, THE BATCH MAY     DTSBD140
02129 *  INCLUDE ONLY T027 GENERATED ARPT RECORDS) TERMINATE THE OPEN   DTSBD140
02130 *  BATCH AND INITIATE A NEW BATCH.                                DTSBD140
02131 *****                                                             DTSBD140
02132 **   IF FIRST-TIME-T027-YES-88                                    DTSBD140
02133 *        PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
02134 *        PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT              DTSBD140
02135 **       SET FIRST-TIME-T027-NO-88  TO TRUE.                      DTSBD140
02136                                                                   DTSBD140
02137 **   DISPLAY 'REC TYPE: ' WRK-CURR-REC-TYPE.                      DTSBD140
02138 **   DISPLAY 'CURR: ' WRK-CURR-KEY '  NEW: ' RSK5-KEY-AREA.       DTSBD140
02139                                                                   DTSBD140
02140      IF  WRK-CURR-REC-TYPE = '028'                                DTSBD140
02141      AND WRK-CURR-KEY NOT = RSK5-KEY-AREA                         DTSBD140
02142         MOVE RSK5-KEY-AREA               TO WRK-CURR-KEY          DTSBD140
02143         IF AHDR-ATC-FILE-TRAN-CNT > 0                             DTSBD140
02144            PERFORM S2000-TERMINATE-AHDR  THRU S2000-EXIT          DTSBD140
02145            PERFORM S1000-INITIATE-AHDR   THRU S1000-EXIT          DTSBD140
02146         END-IF                                                    DTSBD140
02147      END-IF.                                                      DTSBD140
02148                                                                   DTSBD140
02149      IF WRK-CURR-REC-TYPE NOT = '028'                             DTSBD140
02150         MOVE RSK5-REC-TYPE               TO WRK-CURR-REC-TYPE     DTSBD140
02151         MOVE RSK5-KEY-AREA               TO WRK-CURR-KEY          DTSBD140
02152         IF AHDR-ATC-FILE-TRAN-CNT > 0                             DTSBD140
02153            PERFORM S2000-TERMINATE-AHDR  THRU S2000-EXIT          DTSBD140
02154            PERFORM S1000-INITIATE-AHDR   THRU S1000-EXIT          DTSBD140
02155         END-IF                                                    DTSBD140
02156      END-IF.                                                      DTSBD140
02157                                                                   DTSBD140
02158      IF AHDR-ATC-FILE-TRAN-CNT NOT < +475                            CL**4
02159          PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT             DTSBD140
02160          PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT.             DTSBD140
02161                                                                   DTSBD140
02162      PERFORM P8100-ATC-REPORT     THRU P8100-EXIT.                DTSBD140
02163 *&                                                                DTSBD140
02164 *    DISPLAY 'DTSBD140 P8000 ' APAY-EMP-NO '  ' APAY-BATCH-NO     DTSBD140
02165 *       '  ' APAY-ITEM-NO '  ' AHDR-ATC-FILE-REMIT-AMT.           DTSBD140
02166 *&                                                                DTSBD140
02167                                                                   DTSBD140
02168      ADD +1 TO AHDR-ATC-FILE-TRAN-CNT                                CL**4
02169                WRK-AHDR-ITEM-NO.                                     CL*16
02170                                                                   DTSBD140
02171      MOVE WRK-AHDR-ITEM-NO     TO ARPT-ITEM-NO.                      CL*16
02172      ADD ARPT-REMIT-AMT    TO AHDR-ATC-FILE-REMIT-AMT.            DTSBD140
02173                                                                   DTSBD140
02174      MOVE ARPT-REC TO ASKL-REC.                                   DTSBD140
02175                                                                   DTSBD140
02176      PERFORM S923-WRITE THRU S923-EXIT.                           DTSBD140
02177                                                                   DTSBD140
02178      ADD +1 TO WRK-ATC-TRAN-CNT.                                  DTSBD140
02179                                                                   DTSBD140
02180      PERFORM P8200-BATCH-AUDIT   THRU P8200-EXIT.                 DTSBD140
02181                                                                   DTSBD140
02182  P8000-EXIT.                                                      DTSBD140
02183      EXIT.                                                        DTSBD140
02184                                                                   DTSBD140
02185  P8100-ATC-REPORT.                                                DTSBD140
02186 *&                                                                DTSBD140
02187 *    DISPLAY 'DTSBD140 P8100 ' T028-EMP-NO                        DTSBD140
02188 *       '  ' T028-PSEUDO-BATCH-NO '  ' T028-PSEUDO-ITEM-NO        DTSBD140
02189 *       '  ' T028-RPT-TYPE '  ' T028-YRQ.                         DTSBD140
02190 *    DISPLAY T028-TRACE-NO.                                       DTSBD140
02191 *&                                                                DTSBD140
02192      MOVE LOW-VALUES TO ARPT-REC.                                 DTSBD140
02193                                                                   DTSBD140
02194      MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO.                         DTSBD140
02195                                                                   DTSBD140
02196      MOVE +0 TO ARPT-ITEM-NO.                                        CL**7
02197                                                                   DTSBD140
02198      SET ARPT-RPT-88 TO TRUE.                                     DTSBD140
02199                                                                   DTSBD140
02200      MOVE T028-PSEUDO-DOC-NO TO ARPT-PSEUDO-DOC-NO.               DTSBD140
02201                                                                   DTSBD140
02202      MOVE T028-NAME-CHECK TO ARPT-NAME-CHECK.                     DTSBD140
02203                                                                   DTSBD140
02204      MOVE T028-EMP-NO TO ARPT-EMP-NO.                             DTSBD140
02205                                                                   DTSBD140
02206      MOVE T028-RPT-TYPE TO ARPT-RPT-TYPE.                         DTSBD140
02207                                                                   DTSBD140
02208      MOVE T028-YRQ      TO ARPT-YRQ.                              DTSBD140
02209                                                                   DTSBD140
02210      MOVE T028-TOT-WAGE     TO ARPT-TOT-WAGE.                     DTSBD140
02211                                                                   DTSBD140
02212      MOVE T028-EXCESS-WAGE  TO ARPT-EXCESS-WAGE.                  DTSBD140
02213                                                                   DTSBD140
02214      MOVE T028-TAX-WAGE     TO ARPT-TAX-WAGE.                     DTSBD140
02215                                                                   DTSBD140
02216      MOVE T028-REMIT-AMT    TO ARPT-REMIT-AMT.                    DTSBD140
02217                                                                   DTSBD140
02218      MOVE T028-WAIVE-BOTH-IND   TO ARPT-WAIVE-BOTH-IND.           DTSBD140
02219                                                                   DTSBD140
02220      MOVE T028-WAIVE-INT-IND    TO ARPT-WAIVE-INT-IND.            DTSBD140
02221                                                                   DTSBD140
02222      MOVE T028-WAIVE-LATE-PEN-IND TO ARPT-WAIVE-LATE-PEN-IND.     DTSBD140
02223                                                                   DTSBD140
02224      MOVE T028-TOTAL-EMPL-CNT     TO ARPT-TOTAL-EMPL-CNT.         DTSBD140
02225                                                                   DTSBD140
02226      MOVE T028-1ST-MTH-EMPL-CNT   TO ARPT-1ST-MTH-EMPL-CNT.       DTSBD140
02227                                                                   DTSBD140
02228      MOVE T028-2ND-MTH-EMPL-CNT   TO ARPT-2ND-MTH-EMPL-CNT.       DTSBD140
02229                                                                   DTSBD140
02230      MOVE T028-3RD-MTH-EMPL-CNT   TO ARPT-3RD-MTH-EMPL-CNT.       DTSBD140
02231                                                                   DTSBD140
02232      MOVE T028-RECEIVED-DATE TO ARPT-RECEIVED-DATE                DTSBD140
02233                                 ARPT-DEPOSIT-DATE.                DTSBD140
02234                                                                   DTSBD140
02235      SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE.                       DTSBD140
02236      MOVE T028-TRACE-NO   TO ARPT-TRACE-NO.                       DTSBD140
02237                                                                   DTSBD140
02238      SET ARPT-STATUS-CHNG-NO-88 TO TRUE.                          DTSBD140
02239                                                                   DTSBD140
02240                                                                   DTSBD140
02241      MOVE T028-RESPONSIBLE-ACTIVITY                               DTSBD140
02242        TO ARPT-RESPONSIBLE-ACTIVITY.                              DTSBD140
02243                                                                   DTSBD140
02244      MOVE T028-RESPONSIBLE-OP-ID TO ARPT-RESPONSIBLE-OP-ID.       DTSBD140
02245                                                                   DTSBD140
02246 *&                                                                DTSBD140
02247 *    DISPLAY 'DTSBD140 P8100 PASSED EDITS '                       DTSBD140
02248 *         T028-PASSED-FULL-EDITS-IND                              DTSBD140
02249 *         '  ' ARPT-BATCH-NO.                                     DTSBD140
02250 *&                                                                DTSBD140
02251      MOVE T028-PASSED-FULL-EDITS-IND                              DTSBD140
02252                                  TO ARPT-PASSED-FULL-EDITS-IND.   DTSBD140
02253                                                                   DTSBD140
02254      SET ARPT-NOT-PROCESSED-88 TO TRUE.                           DTSBD140
02255  P8100-EXIT.                                                      DTSBD140
02256      EXIT.                                                        DTSBD140
02257                                                                   DTSBD140
02258  P8200-BATCH-AUDIT.                                               DTSBD140
02259      MOVE ARPT-BATCH-NO          TO X214-BATCH.                   DTSBD140
02260      MOVE ARPT-ITEM-NO           TO X214-ITEM.                    DTSBD140
02261      MOVE ARPT-PSEUDO-BATCH-NO   TO X214-PSEUDO-BATCH.            DTSBD140
02262      MOVE ARPT-PSEUDO-ITEM-NO    TO X214-PSEUDO-ITEM.             DTSBD140
02263      MOVE T028-LOG-NBR           TO X214-LOG-NBR.                 DTSBD140
02264 **   MOVE T028-DEPOSIT-DATE      TO L001-FED-8-DATE-9.            DTSBD140
02265 *    PERFORM S001-FROM-FED-8     THRU S001-EXIT.                  DTSBD140
02266 **   MOVE L001-SLASH-8-DATE      TO X214-DEPOSIT-DT.              DTSBD140
02267                                                                   DTSBD140
02268      WRITE BATCH-AUDIT-REC FROM WRK-BATCH-AUDIT-REC.              DTSBD140
02269      IF BATCH-AUDIT-OK-88                                         DTSBD140
02270         ADD +1                   TO WRK-BX214-CNT                 DTSBD140
02271      ELSE                                                         DTSBD140
02272         DISPLAY 'CANNOT WRITE BATCH-AUDIT FILE: '                 DTSBD140
02273            BATCH-AUDIT-STATUS                                     DTSBD140
02274         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD140
02275      END-IF.                                                      DTSBD140
02276                                                                   DTSBD140
02277 *&                                                                DTSBD140
02278 *    DISPLAY 'DTSBD140 P8200 ' ARPT-EMP-NO '  ' X214-BATCH        DTSBD140
02279 *       '  ' X214-ITEM '  ' X214-LOG-NBR '  ' WRK-BX214-CNT.      DTSBD140
02280 *&                                                                DTSBD140
02281  P8200-EXIT.                                                      DTSBD140
02282      EXIT.                                                        DTSBD140
02283      EJECT                                                        DTSBD140
02284  P9000-ADD-PROFILE.                                               DTSBD140
02285 **************************************************************    DTSBD140
02286 * WHEN PROCESSING T002 DETERMINATION RECORDS, CALL DTSBD142       DTSBD140
02287 * TO ADD MPRF AND MERA RECORDS. PASS THE TRANSACTION ON TO        DTSBD140
02288 * DTSBD381 (THROUGH CALL TO P3000) ONLY IF THE DETERMINATION      DTSBD140
02289 * IS COMPLETE (I.E., THE REGISTRATION IS NOT FROM A UC-30 AND     DTSBD140
02290 * IS NOT FROM A FISCAL AGENT RATE TAPE).                          DTSBD140
02291 **************************************************************    DTSBD140
02292      MOVE RSKL-REC TO T002-REC.                                   DTSBD140
02293 *&                                                                DTSBD140
02294      DISPLAY 'DTSBD140 P9000 ' T002-EMP-NO '  ' T002-TRN-CD.      DTSBD140
02295 *&                                                                DTSBD140
02296                                                                   DTSBD140
02297      MOVE RSK5-REC-TYPE                TO WRK-CURR-REC-TYPE.      DTSBD140
02298                                                                   DTSBD140
02299      IF T002-DETERM-88                                            DTSBD140
02300         MOVE T002-DATA-AREA            TO Y104-REC                DTSBD140
02301         ADD +1                         TO WRK-T002-CNT            DTSBD140
02302         SET L142-PROCESS-88            TO TRUE                    DTSBD140
02303         PERFORM S142-NEW-EMP           THRU S142-EXIT             DTSBD140
02304         IF Y104-SOURCE-UC30-88                                    DTSBD140
02305         OR Y104-SOURCE-FISC-AGNT-88                               DTSBD140
02306            NEXT SENTENCE                                          DTSBD140
02307         ELSE                                                      DTSBD140
02308            PERFORM P3000-GENERATE-TRAN    THRU P3000-EXIT         DTSBD140
02309         END-IF                                                    DTSBD140
02310      ELSE                                                         DTSBD140
02311         PERFORM P3000-GENERATE-TRAN    THRU P3000-EXIT            DTSBD140
02312      END-IF.                                                      DTSBD140
02313                                                                   DTSBD140
02314  P9000-EXIT.                                                      DTSBD140
02315      EXIT.                                                        DTSBD140
02316                                                                   DTSBD140
02317  T0000-TERMINATE.                                                 DTSBD140
02318 *&                                                                DTSBD140
02319 *    DISPLAY 'DTSBD140 T0000 T025 FIRST TIME '                    DTSBD140
02320 *       FIRST-TIME-T027-IND '  T027 ' FIRST-TIME-T025-IND         DTSBD140
02321 *       '  ' AHDR-BATCH-NO.                                       DTSBD140
02322 *&                                                                DTSBD140
02323      PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT.                DTSBD140
02324                                                                   DTSBD140
02325                                                                   DTSBD140
02326      PERFORM T1000-UPDATE-MHDR-REC THRU T1000-EXIT.               DTSBD140
02327                                                                   DTSBD140
02328      DISPLAY 'T0000 ' WRK-BX214-CNT.                              DTSBD140
02329      IF WRK-BX214-CNT = 0                                         DTSBD140
02330         MOVE ZEROS                  TO X214-BATCH                 DTSBD140
02331                                        X214-PSEUDO-BATCH          DTSBD140
02332                                        X214-ITEM                  DTSBD140
02333                                        X214-PSEUDO-ITEM           DTSBD140
02334         MOVE ZEROS                  TO X214-LOG-NBR               DTSBD140
02335 ***     MOVE SPACES                 TO X214-DEPOSIT-DT            DTSBD140
02336         WRITE BATCH-AUDIT-REC FROM WRK-BATCH-AUDIT-REC            DTSBD140
02337         DISPLAY 'DUMMY X214 WRITTEN ' WRK-BATCH-AUDIT-REC         DTSBD140
02338      END-IF.                                                      DTSBD140
02339                                                                   DTSBD140
02340      DISPLAY ' '.                                                 DTSBD140
02341                                                                   DTSBD140
02342      DISPLAY '*** DTSBD140 TERMINATION STATISTICS ***'.           DTSBD140
02343                                                                   DTSBD140
02344      DISPLAY 'NUMBER OF BTC RECORDS ENCOUNTERED    : '            DTSBD140
02345              WRK-BTC-REC-CNT.                                     DTSBD140
02346                                                                   DTSBD140
02347      DISPLAY 'NUMBER OF TRANSACTION RECORDS CREATED: '            DTSBD140
02348              WRK-BTC-TRAN-CNT.                                    DTSBD140
02349                                                                   DTSBD140
02350      DISPLAY 'NUMBER OF ATC BATCHES CREATED        : '            DTSBD140
02351              WRK-ATC-BATCH-CNT.                                   DTSBD140
02352                                                                   DTSBD140
02353      DISPLAY 'NUMBER OF ATC TRANSACTIONS CREATED   : '            DTSBD140
02354              WRK-ATC-TRAN-CNT.                                    DTSBD140
02355                                                                   DTSBD140
02356      DISPLAY ' '.                                                 DTSBD140
02357                                                                   DTSBD140
02358      DISPLAY 'NUMBER OF R907 RECORDS CREATED       : '            DTSBD140
02359              WRK-R907-REC-CNT.                                    DTSBD140
02360                                                                   DTSBD140
02361      DISPLAY ' '.                                                 DTSBD140
02362                                                                   DTSBD140
02363      PERFORM S921-CLOSE THRU S921-EXIT.                           DTSBD140
02364                                                                   DTSBD140
02365      PERFORM S923-CLOSE THRU S923-EXIT.                           DTSBD140
02366                                                                   DTSBD140
02367      PERFORM S926-CLOSE THRU S926-EXIT.                           DTSBD140
02368                                                                   DTSBD140
02369      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD140
02370                                                                   DTSBD140
02371      PERFORM S931-CLOSE THRU S931-EXIT.                           DTSBD140
02372                                                                      CL*19
02373                                                                   DTSBD140
02374      MOVE -1 TO RSK5-LENGTH.                                      DTSBD140
02375                                                                   DTSBD140
02376      PERFORM S946-TRN-REC-O THRU S946-EXIT.                       DTSBD140
02377                                                                   DTSBD140
02378      MOVE -1 TO R907-LENGTH.                                      DTSBD140
02379                                                                   DTSBD140
02380      PERFORM S947-R907-WRITE THRU S947-EXIT.                      DTSBD140
02381                                                                   DTSBD140
02382      CLOSE  BATCH-AUDIT-FILE.                                     DTSBD140
02383                                                                   DTSBD140
02384      SET L142-TERMINATE-88          TO TRUE.                      DTSBD140
02385      PERFORM S142-NEW-EMP           THRU S142-EXIT.               DTSBD140
02386      PERFORM S985-CLOSE THRU S985-EXIT.                              CL*20
02387                                                                   DTSBD140
02388  T0000-EXIT.                                                      DTSBD140
02389      EXIT.                                                        DTSBD140
02390      EJECT                                                        DTSBD140
02391  T1000-UPDATE-MHDR-REC.                                           DTSBD140
02392      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD140
02393                                                                   DTSBD140
02394      PERFORM S910-READ THRU S910-EXIT.                            DTSBD140
02395                                                                   DTSBD140
02396      IF L910-OK-88                                                DTSBD140
02397         MOVE MHDR-REC TO MSKL-REC                                 DTSBD140
02398         PERFORM S910-REWRITE THRU S910-EXIT                       DTSBD140
02399      ELSE                                                         DTSBD140
02400         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD140
02401  T1000-EXIT.                                                      DTSBD140
02402      EXIT.                                                        DTSBD140
02403      EJECT                                                        DTSBD140
02404  S1000-INITIATE-AHDR.                                             DTSBD140
02405      MOVE LOW-VALUES TO AHDR-REC.                                 DTSBD140
02406                                                                   DTSBD140
02407      PERFORM S1100-DETERMINE-BATCH-NO THRU S1100-EXIT.            DTSBD140
02408                                                                   DTSBD140
02409      DISPLAY 'NEW HEADER: ' AHDR-BATCH-NO.                        DTSBD140
02410                                                                   DTSBD140
02411      MOVE +0 TO AHDR-ITEM-NO.                                        CL*23
02412      MOVE +500 TO   WRK-AHDR-ITEM-NO.                                CL*23
02413                                                                   DTSBD140
02414      SET AHDR-HDR-88 TO TRUE.                                     DTSBD140
02415                                                                   DTSBD140
02416      SET AHDR-BATCH-BALANCED-YES-88 TO TRUE.                      DTSBD140
02417                                                                   DTSBD140
02418      SET AHDR-BATCH-HELD-NO-88 TO TRUE.                           DTSBD140
02419                                                                   DTSBD140
02420      IF RSK5-REC-TYPE = '028'                                     DTSBD140
02421         MOVE T028-RESPONSIBLE-OP-ID TO AHDR-ESTB-OP-ID            DTSBD140
02422      ELSE                                                         DTSBD140
02423         SET AHDR-ESTB-SYSTEM-88 TO TRUE                           DTSBD140
02424      END-IF.                                                      DTSBD140
02425                                                                   DTSBD140
02426      MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE.                   DTSBD140
02427                                                                   DTSBD140
02428      MOVE SPACES TO AHDR-CHNG-OP-ID.                              DTSBD140
02429                                                                   DTSBD140
02430      MOVE +0 TO AHDR-CHNG-DATE.                                   DTSBD140
02431                                                                   DTSBD140
02432      MOVE MHDR-CURR-MAIL-DATE TO AHDR-DEPOSIT-DATE.               DTSBD140
02433                                                                   DTSBD140
02434      MOVE MHDR-CURR-RUN-DATE TO AHDR-RECEIVED-DATE.               DTSBD140
02435                                                                      CL**3
02436                                                                   DTSBD140
02437      MOVE +0 TO AHDR-LAST-USED-ITEM-NO                            DTSBD140
02438                 AHDR-ATC-FILE-TRAN-CNT                               CL**4
02439                 AHDR-CONTROL-TRAN-CNT                             DTSBD140
02440                 AHDR-PROC-TRAN-CNT                                DTSBD140
02441                 AHDR-CONTROL-REMIT-AMT                            DTSBD140
02442                 AHDR-ATC-FILE-REMIT-AMT                           DTSBD140
02443                 AHDR-PROC-REMIT-AMT                               DTSBD140
02444                 AHDR-BANK-BATCH-NO.                               DTSBD140
02445  S1000-EXIT.                                                      DTSBD140
02446      EXIT.                                                        DTSBD140
02447      SKIP3                                                        DTSBD140
02448  S1100-DETERMINE-BATCH-NO.                                        DTSBD140
02449      DISPLAY 'MHDR LAST BATCH NO: ' MHDR-LAST-USED-BATCH-NO.         CL**3
02450                                                                      CL**3
02451      IF MHDR-LAST-USED-BATCH-NO < +99999                             CL**3
02452         MOVE MHDR-LAST-USED-BATCH-NO TO WBAT-BATCH-NO                CL*13
02453         PERFORM S985-START-BROWSE      THRU S985-EXIT                CL*24
02454        IF L985-OK-88                                                 CL*13
02455           MOVE WBAT-BATCH-NO TO AHDR-BATCH-NO                        CL*13
02456        ELSE                                                          CL*13
02457          DISPLAY 'ERROR-L985 RETURN CODE: ' L985-RESULT-IND          CL*22
02458           PERFORM S999-ABEND THRU S999-EXIT                          CL*14
02459        END-IF                                                        CL*13
02460      END-IF.                                                         CL*13
02461                                                                      CL**3
02462       DISPLAY 'NEW MHDR-LAST BATCH NO: ' AHDR-BATCH-NO.              CL**3
02463                                                                      CL**3
02464  S1100-EXIT.                                                      DTSBD140
02465      EXIT.                                                        DTSBD140
02466      SKIP3                                                        DTSBD140
02467  S2000-TERMINATE-AHDR.                                            DTSBD140
02468 *&                                                                DTSBD140
02469      DISPLAY 'DTSBD140 S2000 TRAN CNT '                           DTSBD140
02470         AHDR-ATC-FILE-TRAN-CNT '  REMIT '                         DTSBD140
02471         AHDR-ATC-FILE-REMIT-AMT                                   DTSBD140
02472         '  ' AHDR-BATCH-NO.                                       DTSBD140
02473 *&                                                                DTSBD140
02474      IF AHDR-ATC-FILE-TRAN-CNT = 0                                DTSBD140
02475          GO TO S2000-EXIT.                                        DTSBD140
02476                                                                   DTSBD140
02477      MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO.               DTSBD140
02478                                                                   DTSBD140
02479      MOVE WRK-AHDR-ITEM-NO       TO AHDR-LAST-USED-ITEM-NO.          CL*23
02480                                                                   DTSBD140
02481      MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT.        DTSBD140
02482                                                                   DTSBD140
02483      MOVE AHDR-ATC-FILE-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT.      DTSBD140
02484                                                                   DTSBD140
02485      MOVE AHDR-REC TO ASKL-REC.                                   DTSBD140
02486                                                                   DTSBD140
02487      PERFORM S923-WRITE THRU S923-EXIT.                           DTSBD140
02488                                                                   DTSBD140
02489      ADD +1 TO WRK-ATC-BATCH-CNT.                                 DTSBD140
02490  S2000-EXIT.                                                      DTSBD140
02491      EXIT.                                                        DTSBD140
02492      EJECT                                                        DTSBD140
02493  S001-FROM-FED-8.                                                 DTSBD140
02494      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD140
02495      GO TO S001-DATE.                                             DTSBD140
02496                                                                   DTSBD140
02497  S001-FROM-CAL-8.                                                 DTSBD140
02498      SET L001-FROM-CAL-8 TO TRUE.                                 DTSBD140
02499      GO TO S001-DATE.                                             DTSBD140
02500                                                                   DTSBD140
02501  S001-DATE.                                                       DTSBD140
02502      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD140
02503  S001-EXIT.                                                       DTSBD140
02504      EXIT.                                                        DTSBD140
02505                                                                   DTSBD140
02506  S004-FROM-5.                                                     DTSBD140
02507      SET L004-FROM-5 TO TRUE.                                     DTSBD140
02508      GO TO S004-YRQ.                                              DTSBD140
02509                                                                   DTSBD140
02510  S004-FROM-ABS.                                                   DTSBD140
02511      SET L004-FROM-ABS TO TRUE.                                   DTSBD140
02512      GO TO S004-YRQ.                                              DTSBD140
02513                                                                   DTSBD140
02514  S004-YRQ.                                                        DTSBD140
02515      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD140
02516  S004-EXIT.                                                       DTSBD140
02517      EXIT.                                                        DTSBD140
02518                                                                   DTSBD140
02519  S142-NEW-EMP.                                                    DTSBD140
02520      CALL 'DTSBD142' USING L142-LINK-AREA                         DTSBD140
02521                            T002-REC.                              DTSBD140
02522                                                                   DTSBD140
02523  S142-EXIT.                                                       DTSBD140
02524      EXIT.                                                        DTSBD140
02525                                                                   DTSBD140
02526  S516-DETERMINE-LIABILITY.                                        DTSBD140
02527      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBD140
02528                            MPRF-REC.                              DTSBD140
02529  S516-EXIT.                                                       DTSBD140
02530      EXIT.                                                        DTSBD140
02531      SKIP3                                                        DTSBD140
02532  S910-OPEN-UPDATE-HDR.                                            DTSBD140
02533      SET L910-OPEN-UPDATE-HDR-88 TO TRUE.                         DTSBD140
02534      GO TO S910-MSTR-CALL.                                        DTSBD140
02535                                                                   DTSBD140
02536  S910-OPEN-UPDATE.                                                DTSBD140
02537      SET L910-OPEN-UPDATE-88     TO TRUE.                         DTSBD140
02538      GO TO S910-MSTR-CALL.                                        DTSBD140
02539                                                                   DTSBD140
02540  S910-READ.                                                       DTSBD140
02541      SET L910-READ-88 TO TRUE.                                    DTSBD140
02542      GO TO S910-MSTR-CALL.                                        DTSBD140
02543                                                                   DTSBD140
02544  S910-START-BROWSE.                                               DTSBD140
02545      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD140
02546      GO TO S910-MSTR-CALL.                                        DTSBD140
02547                                                                   DTSBD140
02548  S910-READ-NEXT.                                                  DTSBD140
02549      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD140
02550      GO TO S910-MSTR-CALL.                                        DTSBD140
02551                                                                   DTSBD140
02552 *S910-COUNT.                                                      DTSBD140
02553 *****SET L910-COUNT-88 TO TRUE.                                   DTSBD140
02554 *****GO TO S910-MSTR-CALL.                                        DTSBD140
02555                                                                   DTSBD140
02556 *S910-WRITE.                                                      DTSBD140
02557 *****SET L910-WRITE-88 TO TRUE.                                   DTSBD140
02558 *****GO TO S910-MSTR-CALL.                                        DTSBD140
02559                                                                   DTSBD140
02560  S910-REWRITE.                                                    DTSBD140
02561      SET L910-REWRITE-88 TO TRUE.                                 DTSBD140
02562      GO TO S910-MSTR-CALL.                                        DTSBD140
02563                                                                   DTSBD140
02564 *S910-DELETE.                                                     DTSBD140
02565 *****SET L910-DELETE-88 TO TRUE.                                  DTSBD140
02566 *****GO TO S910-MSTR-CALL.                                        DTSBD140
02567                                                                   DTSBD140
02568  S910-CLOSE.                                                      DTSBD140
02569      SET L910-CLOSE-88 TO TRUE.                                   DTSBD140
02570      GO TO S910-MSTR-CALL.                                        DTSBD140
02571                                                                   DTSBD140
02572  S910-MSTR-CALL.                                                  DTSBD140
02573      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD140
02574                            MSKL-REC.                              DTSBD140
02575  S910-EXIT.                                                       DTSBD140
02576      EXIT.                                                        DTSBD140
02577                                                                   DTSBD140
02578  S921-OPEN-UPDATE.                                                DTSBD140
02579      SET L921-OPEN-UPDATE-88 TO TRUE.                             DTSBD140
02580      GO TO S921-AIX-IO.                                           DTSBD140
02581                                                                   DTSBD140
02582  S921-CLOSE.                                                      DTSBD140
02583      SET L921-CLOSE-88 TO TRUE.                                   DTSBD140
02584      GO TO S921-AIX-IO.                                           DTSBD140
02585                                                                   DTSBD140
02586  S921-AIX-IO.                                                     DTSBD140
02587      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD140
02588                            ISKL-REC.                              DTSBD140
02589  S921-EXIT.                                                       DTSBD140
02590      EXIT.                                                        DTSBD140
02591                                                                   DTSBD140
02592                                                                   DTSBD140
02593  S923-OPEN-UPDATE.                                                DTSBD140
02594      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSBD140
02595      GO TO S923-ATC-CALL.                                         DTSBD140
02596                                                                   DTSBD140
02597 *S923-READ.                                                       DTSBD140
02598 *****SET L923-READ-88 TO TRUE.                                    DTSBD140
02599 *****GO TO S923-ATC-CALL.                                         DTSBD140
02600                                                                   DTSBD140
02601 *S923-START-BROWSE.                                               DTSBD140
02602 *****SET L923-START-BROWSE-88 TO TRUE.                            DTSBD140
02603 *****GO TO S923-ATC-CALL.                                         DTSBD140
02604                                                                   DTSBD140
02605 *S923-READ-NEXT.                                                  DTSBD140
02606 *****SET L923-READ-NEXT-88 TO TRUE.                               DTSBD140
02607 *****GO TO S923-ATC-CALL.                                         DTSBD140
02608                                                                   DTSBD140
02609  S923-WRITE.                                                      DTSBD140
02610      SET L923-WRITE-88 TO TRUE.                                   DTSBD140
02611      GO TO S923-ATC-CALL.                                         DTSBD140
02612                                                                   DTSBD140
02613 *S923-REWRITE.                                                    DTSBD140
02614 *****SET L923-REWRITE-88 TO TRUE.                                 DTSBD140
02615 *****GO TO S923-ATC-CALL.                                         DTSBD140
02616                                                                   DTSBD140
02617 *S923-DELETE.                                                     DTSBD140
02618 *****SET L923-DELETE-88 TO TRUE.                                  DTSBD140
02619 *****GO TO S923-ATC-CALL.                                         DTSBD140
02620                                                                   DTSBD140
02621  S923-CLOSE.                                                      DTSBD140
02622      SET L923-CLOSE-88 TO TRUE.                                   DTSBD140
02623      GO TO S923-ATC-CALL.                                         DTSBD140
02624                                                                   DTSBD140
02625  S923-ATC-CALL.                                                   DTSBD140
02626      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSBD140
02627                            ASKL-REC.                              DTSBD140
02628  S923-EXIT.                                                       DTSBD140
02629      EXIT.                                                        DTSBD140
02630      SKIP3                                                        DTSBD140
02631  S926-OPEN-READ.                                                  DTSBD140
02632      SET L926-OPEN-READ-88 TO TRUE.                               DTSBD140
02633      GO TO S926-BTC-I.                                            DTSBD140
02634                                                                   DTSBD140
02635  S926-READ-NEXT.                                                  DTSBD140
02636      SET L926-READ-NEXT-88 TO TRUE.                               DTSBD140
02637      GO TO S926-BTC-I.                                            DTSBD140
02638                                                                   DTSBD140
02639  S926-CLOSE.                                                      DTSBD140
02640      SET L926-CLOSE-88 TO TRUE.                                   DTSBD140
02641      GO TO S926-BTC-I.                                            DTSBD140
02642                                                                   DTSBD140
02643  S926-BTC-I.                                                      DTSBD140
02644      CALL 'DTSBU926' USING L926-LINK-AREA                         DTSBD140
02645                            RSKL-REC.                              DTSBD140
02646  S926-EXIT.                                                       DTSBD140
02647      EXIT.                                                        DTSBD140
02648      SKIP3                                                        DTSBD140
02649  S931-OPEN-READ.                                                  DTSBD140
02650      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD140
02651      GO TO S931-REF-CALL.                                         DTSBD140
02652                                                                   DTSBD140
02653  S931-CLOSE.                                                      DTSBD140
02654      SET L931-CLOSE-88 TO TRUE.                                   DTSBD140
02655      GO TO S931-REF-CALL.                                         DTSBD140
02656                                                                   DTSBD140
02657  S931-REF-CALL.                                                   DTSBD140
02658      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD140
02659                            FSKL-REC.                              DTSBD140
02660  S931-EXIT.                                                       DTSBD140
02661      EXIT.                                                        DTSBD140
02662      SKIP3                                                        DTSBD140
02663  S946-TRN-REC-O.                                                  DTSBD140
02664      CALL 'DTSBU946' USING RSKL-REC.                              DTSBD140
02665  S946-EXIT.                                                       DTSBD140
02666      EXIT.                                                        DTSBD140
02667      SKIP3                                                        DTSBD140
02668  S947-R907-WRITE.                                                 DTSBD140
02669      CALL 'DTSBU947' USING R907-REC.                              DTSBD140
02670  S947-EXIT.                                                       DTSBD140
02671      EXIT.                                                        DTSBD140
02672      SKIP3                                                        DTSBD140
02673                                                                      CL**9
02674  S985-OPEN.                                                          CL**9
02675      SET L985-OPEN-READ-88 TO TRUE.                                  CL**9
02676      GO TO S985-BAT-IO.                                              CL**9
02677  S985-READ.                                                          CL**9
02678      SET L985-READ-88 TO TRUE.                                       CL**9
02679      GO TO S985-BAT-IO.                                              CL**9
02680                                                                      CL**9
02681  S985-START-BROWSE.                                                  CL**9
02682      SET L985-START-BROWSE-88 TO TRUE.                               CL**9
02683      GO TO S985-BAT-IO.                                              CL**9
02684                                                                      CL**9
02685  S985-READ-NEXT.                                                     CL**9
02686      SET L985-READ-NEXT-88 TO TRUE.                                  CL**9
02687      GO TO S985-BAT-IO.                                              CL**9
02688                                                                      CL**9
02689  S985-WRITE.                                                         CL**9
02690      SET L985-WRITE-88 TO TRUE.                                      CL**9
02691      GO TO S985-BAT-IO.                                              CL**9
02692                                                                      CL**9
02693  S985-REWRITE.                                                       CL**9
02694      SET L985-REWRITE-88 TO TRUE.                                    CL**9
02695      GO TO S985-BAT-IO.                                              CL**9
02696                                                                      CL**9
02697  S985-DELETE.                                                        CL**9
02698      SET L985-DELETE-88 TO TRUE.                                     CL**9
02699      GO TO S985-BAT-IO.                                              CL**9
02700                                                                      CL**9
02701  S985-CLOSE.                                                         CL**9
02702      SET L985-CLOSE-88 TO TRUE.                                      CL**9
02703      GO TO S985-BAT-IO.                                              CL**9
02704                                                                      CL**9
02705  S985-BAT-IO.                                                        CL**9
02706      CALL 'DTSBU985' USING L985-LINK-AREA                            CL**9
02707                            LINK-REC.                                 CL**9
02708  S985-EXIT.                                                          CL**9
02709      EXIT.                                                           CL**9
02710  S999-ABEND.                                                      DTSBD140
02711      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD140
02712  S999-EXIT.                                                       DTSBD140
02713      EXIT.                                                        DTSBD140
