00001  IDENTIFICATION DIVISION.                                         03/20/01
00002  PROGRAM-ID.             DTSBE309.                                DTSBE309
00003  AUTHOR.                 TRICOASTAL                                  LV032
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE309
00005  DATE-COMPILED.                                                   DTSBE309
00006      SKIP3                                                        DTSBE309
00007 *****                                                             DTSBE309
00008 *                                                                 DTSBE309
00009 *    CALLING SEQUENCE:  DTSBE309 CREATES DTSIR309 RECORDS.        DTSBE309
00010 *                       DTSBD800 CALLS DTSBR309 WHICH             DTSBE309
00011 *                                PRODUCES THE CREDIT STATEMENT.   DTSBE309
00012 *                                                                 DTSBE309
00013 *    FUNCTION:  CREDIT STATEMENT EXTRACT.                         DTSBE309
00014 *                                                                 DTSBE309
00015 *                                                                 DTSBE309
00016 *    MODIFICATION LOG:                                            DTSBE309
00017 *                                                                 DTSBE309
00018 *    11/16/94  CHANGE REQUEST.                                    DTSBE309
00019 *              WORK ORDER:  CR 022              PROGRAMMER: EHH   DTSBE309
00020 *                                                                 DTSBE309
00021 *                                                                 DTSBE309
00022 *    02/26/01  ADDED EMPLOYER FEIN TO IR RECORD                   DTSBE309
00023 *              WORK ORDER:  REG MAINT           PROGRAMMER: ZL1   DTSBE309
00024 *                                                                 DTSBE309
00025 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE309
00026 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE309
00027 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBE309
00028 *                                                                 DTSBE309
00029 *                                                                 DTSBE309
00030 *  DESCRIPTION:                                                   DTSBE309
00031 *                                                                 DTSBE309
00032 *                                                                 DTSBE309
00033 *    INITIATION:                                                  DTSBE309
00034 *                                                                 DTSBE309
00035 *      SET LECM-MST-OPEN-UPDATE-88 TO TRUE.                       DTSBE309
00036 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE309
00037 *                                                                 DTSBE309
00038 *      NO PARAMETERS ARE INPUT.                                   DTSBE309
00039 *                                                                 DTSBE309
00040 *                                                                 DTSBE309
00041 *    PROCESSING:                                                  DTSBE309
00042 *                                                                 DTSBE309
00043 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (309R1 AND     DTSBE309
00044 *      (310R1).                                                   DTSBE309
00045 *                                                                 DTSBE309
00046 *      IF A CREDIT STATEMENT IS NOT GENERATED BECAUSE ALL         DTSBE309
00047 *      OCCURRENCES OF MTAD-DEBIT-MEMO-IND INDICATE                DTSBE309
00048 *      MTAD-NO-DEBIT-MEMO-88, THEN WRITE A R907 RECORD,           DTSBE309
00049 *      REPORTING THE SITUATION.                                   DTSBE309
00050 *                                                                 DTSBE309
00051 *      IF, FOR A GIVEN EMPLOYER, MORE THAN ONE CREDIT STATEMENT   DTSBE309
00052 *      IS GENERATED, THEN WRITE A R907 RECORD REPORTING THE       DTSBE309
00053 *      SITUATION.                                                 DTSBE309
00054 *                                                                 DTSBE309
00055 *                                                                 DTSBE309
00056 *    TERMINATION:                                                 DTSBE309
00057 *                                                                 DTSBE309
00058 *      NONE.                                                      DTSBE309
00059 *                                                                 DTSBE309
00060 *                                                                 DTSBE309
00061 *    RECORDS READ:                                                DTSBE309
00062 *                                                                 DTSBE309
00063 *      MASTER:                                                    DTSBE309
00064 *                                                                 DTSBE309
00065 *        MAPL                                                     DTSBE309
00066 *        MCOL                                                     DTSBE309
00067 *        MTAD                                                     DTSBE309
00068 *        MOPO                                                     DTSBE309
00069 *                                                                 DTSBE309
00070 *                                                                 DTSBE309
00071 *      ALTERNATE INDEX:                                           DTSBE309
00072 *                                                                 DTSBE309
00073 *        NONE.                                                    DTSBE309
00074 *                                                                 DTSBE309
00075 *                                                                 DTSBE309
00076 *      REFERENCE:                                                 DTSBE309
00077 *                                                                 DTSBE309
00078 *        NONE.                                                    DTSBE309
00079 *                                                                 DTSBE309
00080 *                                                                 DTSBE309
00081 *    RECORDS UPDATED:                                             DTSBE309
00082 *                                                                 DTSBE309
00083 *        MCOL (REWRITE).                                          DTSBE309
00084 *        MEVL (WRITE).                                            DTSBE309
00085 *                                                                 DTSBE309
00086 *                                                                 DTSBE309
00087 *    REPORT RECORDS WRITTEN:                                      DTSBE309
00088 *                                                                 DTSBE309
00089 *        R309 STATEMENT OF ACCOUNT (CREDITS).                     DTSBE309
00090 *        R310 STATEMENT OF ACCOUNT (CREDITS) CONTROL REPORT.      DTSBE309
00091 *        R907 UNUSUAL CONDITIONS ENCOUNTERED REPORT RECORD.       DTSBE309
00092 *                                                                 DTSBE309
00093 *                                                                 DTSBE309
00094 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE309
00095 *                                                                 DTSBE309
00096 *        NONE.                                                    DTSBE309
00097 *                                                                 DTSBE309
00098 *                                                                 DTSBE309
00099 *    MODULES CALLED:                                              DTSBE309
00100 *                                                                 DTSBE309
00101 *        DTSBU005  ABSOLUTE TIME CONVERSION/EDIT.                 DTSBE309
00102 *        DTSBU111  ADDRESS LOOKUP.                                DTSBE309
00103 *        DTSBU112  ADDRESS FORMAT.                                DTSBE309
00104 *        DTSBU910  MASTER FILE I/O DRIVER.                        DTSBE309
00105 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE309
00106 *                                                                 DTSBE309
00107 *                                                                 DTSBE309
00108 *    VERMONT REFERENCE:                                           DTSBE309
00109 *                                                                 DTSBE309
00110 *        TXBE311                                                  DTSBE309
00111 *                                                                 DTSBE309
00112 *****                                                             DTSBE309
00113      SKIP3                                                        DTSBE309
00114  ENVIRONMENT DIVISION.                                            DTSBE309
00115      EJECT                                                        DTSBE309
00116  DATA DIVISION.                                                   DTSBE309
00117      SKIP3                                                        DTSBE309
00118  WORKING-STORAGE SECTION.                                         DTSBE309
001185 77  PAN-VALET PICTURE X(24) VALUE '032DTSBE309  03/20/01'.       DTSBE309
00119      SKIP3                                                        DTSBE309
00120  01  WRK-AREA.                                                    DTSBE309
00121      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +309.DTSBE309
00122      SKIP1                                                        DTSBE309
00123      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE309'.DTSBE309
00124      SKIP3                                                        DTSBE309
00125      05  ABEND-MSG                   PIC  X(60).                  DTSBE309
00126      SKIP3                                                        DTSBE309
00127      05  WRK-SELECT-EMPLOYER-IND     PIC X(01).                   DTSBE309
00128          88  WRK-SELECT-EMPLOYER                 VALUE 'Y'.       DTSBE309
00129          88  WRK-NO-SELECT-EMPLOYER              VALUE 'N'.       DTSBE309
00130      SKIP3                                                        DTSBE309
00131      05  WRK-MCOL-IND                PIC X(01).                   DTSBE309
00132          88  WRK-MCOL-FOUND                      VALUE 'Y'.       DTSBE309
00133          88  WRK-NO-MCOL                         VALUE 'N'.       DTSBE309
00134      SKIP3                                                        DTSBE309
00135 *****05  WRK-MTAD-IND                PIC X(01).                   DTSBE309
00136 *****    88  WRK-MTAD-STMT-SENT                  VALUE 'Y'.       DTSBE309
00137 *****    88  WRK-MTAD-NO-STMT-SENT               VALUE 'N'.       DTSBE309
00138                                                                   DTSBE309
00139 *****05  WRK-STATEMENT-SENT          PIC S9(03)  COMP-3.          DTSBE309
00140                                                                   DTSBE309
00141      05  EVL-TEXT.                                                DTSBE309
00142          10  FILLER                  PIC X(35)   VALUE            DTSBE309
00143              'CREDIT STMT WRITTEN.  CREDIT AMT = '.               DTSBE309
00144          10  EVL-CREDIT-AMT          PIC ZZZ,ZZZ,ZZ9.99.          DTSBE309
00145      EJECT                                                        DTSBE309
00146  01  MSG-AREA.                                                    DTSBE309
00147 *****05  MSG1-AREA.                                               DTSBE309
00148 *****    10  MSG1-ID                     PIC  X(03)               DTSBE309
00149 *****      VALUE '391'.                                           DTSBE309
00150 *****    10  MSG1-TEXT.                                           DTSBE309
00151 *****        15  FILLER                  PIC  X(40)               DTSBE309
00152 *****          VALUE 'CREDIT EXISTS BUT NO CREDIT STATEMENTS S'.  DTSBE309
00153 *****        15  FILLER                  PIC  X(40)               DTSBE309
00154 *****          VALUE 'ENT TO AN MTAD ADDRESS.                 '.  DTSBE309
00155 *****        15  FILLER                  PIC  X(20)               DTSBE309
00156 *****          VALUE '                '.                          DTSBE309
00157      SKIP1                                                        DTSBE309
00158 *****05  MSG2-AREA.                                               DTSBE309
00159 *****    10  MSG2-ID                     PIC  X(03)               DTSBE309
00160 *****      VALUE '392'.                                           DTSBE309
00161 *****    10  MSG2-TEXT.                                           DTSBE309
00162 *****        15  FILLER                  PIC  X(40)               DTSBE309
00163 *****          VALUE 'MORE THAN ONE CREDIT STATEMENT GENERATED'.  DTSBE309
00164 *****        15  FILLER                  PIC  X(40)               DTSBE309
00165 *****          VALUE ' FOR THIS EMPLOYER.                     '.  DTSBE309
00166      SKIP1                                                        DTSBE309
00167      05  MSG3-AREA.                                               DTSBE309
00168          10  MSG3-ID                     PIC  X(03)               DTSBE309
00169            VALUE '393'.                                           DTSBE309
00170          10  MSG3-TEXT.                                           DTSBE309
00171              15  FILLER                  PIC  X(40)               DTSBE309
00172                VALUE 'MCOL-STMT-TEXT-TYPE INDICATES DEBIT TEXT'.  DTSBE309
00173              15  FILLER                  PIC  X(40)               DTSBE309
00174                VALUE ' EXISTS.  TEXT NOT PRINTED ON CREDIT STA'.  DTSBE309
00175              15  FILLER                  PIC  X(20)               DTSBE309
00176                VALUE 'TEMENT.'.                                   DTSBE309
00177      EJECT                                                        DTSBE309
00178  01  L005-LINK-AREA.                                              DTSBE309
00179  ++INCLUDE DTSIL005                                               DTSBE309
00180      EJECT                                                        DTSBE309
00181  01  L111-LINK-AREA.                                              DTSBE309
00182  ++INCLUDE DTSIL111                                               DTSBE309
00183      EJECT                                                        DTSBE309
00184  01  L112-LINK-AREA.                                              DTSBE309
00185  ++INCLUDE DTSIL112                                               DTSBE309
00186      EJECT                                                        DTSBE309
00187  01  L910-LINK-AREA.                                              DTSBE309
00188  ++INCLUDE DTSIL910                                               DTSBE309
00189      SKIP3                                                        DTSBE309
00190  01  MSKL-REC.                                                    DTSBE309
00191  ++INCLUDE DTSIMSKL                                               DTSBE309
00192      SKIP3                                                        DTSBE309
00193  01  MAPL-REC.                                                    DTSBE309
00194  ++INCLUDE DTSIMAPL                                               DTSBE309
00195      SKIP3                                                        DTSBE309
00196  01  MCOL-REC.                                                    DTSBE309
00197  ++INCLUDE DTSIMCOL                                               DTSBE309
00198      SKIP3                                                        DTSBE309
00199  01  MEVL-REC.                                                    DTSBE309
00200  ++INCLUDE DTSIMEVL                                               DTSBE309
00201      SKIP3                                                        DTSBE309
00202  01  R309-REC.                                                    DTSBE309
00203  ++INCLUDE DTSIR309                                               DTSBE309
00204      EJECT                                                        DTSBE309
00205  01  R310-REC.                                                    DTSBE309
00206  ++INCLUDE DTSIR310                                               DTSBE309
00207      SKIP3                                                        DTSBE309
00208  01  R907-REC.                                                    DTSBE309
00209  ++INCLUDE DTSIR907                                               DTSBE309
00210      EJECT                                                        DTSBE309
00211  01  LEN-REC.                                                     DTSBE309
00212  ++INCLUDE DTSIRLEN                                               DTSBE309
00213      EJECT                                                        DTSBE309
00214  LINKAGE SECTION.                                                 DTSBE309
00215      SKIP3                                                        DTSBE309
00216  01  LECM-LINK-AREA.                                              DTSBE309
00217  ++INCLUDE DTSILECM                                               DTSBE309
00218      EJECT                                                        DTSBE309
00219  01  MPRF-LINK-REC.                                               DTSBE309
00220  ++INCLUDE DTSIMPRF                                               DTSBE309
00221      EJECT                                                        DTSBE309
00222                                                                   DTSBE309
00223 **************************************************************    DTSBE309
00224 *  PROCEDURE DIVISION FOR DTSBE309 - STATEMENT OF ACCOUNT         DTSBE309
00225 *  CREDITS MEMO BEGINS HERE.                                      DTSBE309
00226 **************************************************************    DTSBE309
00227                                                                   DTSBE309
00228  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE309
00229                           MPRF-LINK-REC.                          DTSBE309
00230      SKIP2                                                        DTSBE309
00231      IF LECM-PROCESS-88                                           DTSBE309
00232          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE309
00233      ELSE                                                         DTSBE309
00234      IF LECM-INITIALIZE-88                                        DTSBE309
00235          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE309
00236      ELSE                                                         DTSBE309
00237      IF LECM-TERMINATE-88                                         DTSBE309
00238          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE309
00239      ELSE                                                         DTSBE309
00240          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE309
00241            TO ABEND-MSG                                           DTSBE309
00242          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE309
00243      SKIP2                                                        DTSBE309
00244      GOBACK.                                                      DTSBE309
00245      EJECT                                                        DTSBE309
00246                                                                   DTSBE309
00247 **************************************************************    DTSBE309
00248 *  THIS IS THE INITIALIZATION PARAGRAPH FOR DTSBE309.             DTSBE309
00249 **************************************************************    DTSBE309
00250                                                                   DTSBE309
00251  I0000-INITIALIZE.                                                DTSBE309
00252      SKIP2                                                        DTSBE309
00253      MOVE LENGTH OF R309-REC      TO  R309-LENGTH.                DTSBE309
00254      MOVE '309'                   TO  R309-REC-TYPE.              DTSBE309
00255      MOVE LENGTH OF R310-REC      TO  R310-LENGTH.                DTSBE309
00256      MOVE '310'                   TO  R310-REC-TYPE.              DTSBE309
00257      MOVE LENGTH OF R907-REC      TO  R907-LENGTH.                DTSBE309
00258      MOVE '907'                   TO  R907-REC-TYPE.              DTSBE309
00259      MOVE LECM-TRACE-IND          TO  L910-TRACE-IND.             DTSBE309
00260      MOVE WRK-MOD-NAME            TO  L910-MOD-NAME               DTSBE309
00261                                       R907-MODULE-NAME.           DTSBE309
00262                                                                   DTSBE309
00263      SET LECM-MST-OPEN-UPDATE-88  TO  TRUE.                       DTSBE309
00264      SET LECM-REF-OPEN-READ-88    TO  TRUE.                       DTSBE309
00265                                                                   DTSBE309
00266  I0000-EXIT.                                                      DTSBE309
00267      EXIT.                                                        DTSBE309
00268      EJECT                                                        DTSBE309
00269 **************************************************************    DTSBE309
00270 *  THIS IS THE PROCESS PARAGRAPH FOR DTSBE309.                    DTSBE309
00271 **************************************************************    DTSBE309
00272                                                                   DTSBE309
00273  P0000-PROCESS.                                                   DTSBE309
00274                                                                   DTSBE309
00275      IF MPRF-TOT-CREDIT-AMT > +0                                  DTSBE309
00276          NEXT SENTENCE                                            DTSBE309
00277      ELSE                                                         DTSBE309
00278          GO TO P0000-EXIT.                                        DTSBE309
00279                                                                   DTSBE309
00280      PERFORM P1000-SELECT-EMPLOYERS  THRU  P1000-EXIT.            DTSBE309
00281                                                                   DTSBE309
00282      IF WRK-SELECT-EMPLOYER                                       DTSBE309
00283          PERFORM P2000-SETUP-R309  THRU  P2000-EXIT               DTSBE309
00284      ELSE                                                         DTSBE309
00285          GO TO P0000-EXIT.                                        DTSBE309
00286                                                                   DTSBE309
00287  P0000-EXIT.                                                      DTSBE309
00288      EXIT.                                                        DTSBE309
00289      EJECT                                                        DTSBE309
00290 **************************************************************    DTSBE309
00291 *  THIS PARAGRAPH SELECTS THE EMPLOYERS TO BE EXTRACTED FROM      DTSBE309
00292 *  THE MONTHLY RUN.  DO NOT SELECT EMPLOYERS WHO ARE              DTSBE309
00293 *  SELF INSURED, HAVE BEEN SUSPENDED, HAVE AN OPEN                DTSBE309
00294 *  BANKRUPTCY, AN UNKNOWN STATUS, PURSUED REPORTS OR OPEN         DTSBE309
00295 *  APPEALS.                                                       DTSBE309
00296 **************************************************************    DTSBE309
00297                                                                   DTSBE309
00298  P1000-SELECT-EMPLOYERS.                                          DTSBE309
00299                                                                   DTSBE309
00300      SET WRK-SELECT-EMPLOYER         TO  TRUE.                    DTSBE309
00301                                                                   DTSBE309
00302      IF MPRF-CLASS-SELF-INS-88                                    DTSBE309
00303          SET WRK-NO-SELECT-EMPLOYER  TO  TRUE                     DTSBE309
00304          GO TO P1000-EXIT.                                        DTSBE309
00305                                                                   DTSBE309
00306      IF MPRF-SUSPEND-COLL-YES-88                                  DTSBE309
00307          SET WRK-NO-SELECT-EMPLOYER  TO  TRUE                     DTSBE309
00308          GO TO P1000-EXIT.                                        DTSBE309
00309                                                                   DTSBE309
00310      IF MPRF-BANKRP-OPEN-88                                       DTSBE309
00311          SET WRK-NO-SELECT-EMPLOYER  TO  TRUE                     DTSBE309
00312          GO TO P1000-EXIT.                                        DTSBE309
00313                                                                   DTSBE309
00314      IF MPRF-STATUS-UNK-88                                        DTSBE309
00315          SET WRK-NO-SELECT-EMPLOYER  TO  TRUE                     DTSBE309
00316          GO TO P1000-EXIT.                                        DTSBE309
00317                                                                   DTSBE309
00318      IF MPRF-PURSUED-RPT-CNT  GREATER THAN  ZERO                  DTSBE309
00319          SET WRK-NO-SELECT-EMPLOYER  TO  TRUE                     DTSBE309
00320          GO TO P1000-EXIT.                                        DTSBE309
00321                                                                   DTSBE309
00322      MOVE LOW-VALUES                 TO  MAPL-KEY-AREA.           DTSBE309
00323      MOVE MPRF-EMP-NO                TO  MAPL-EMP-NO.             DTSBE309
00324      SET  MAPL-APL-88                TO  TRUE.                    DTSBE309
00325      MOVE MAPL-KEY-AREA              TO  MSKL-KEY-AREA.           DTSBE309
00326                                                                   DTSBE309
00327      PERFORM S910-START-BROWSE  THRU  S910-EXIT.                  DTSBE309
00328                                                                   DTSBE309
00329      PERFORM P1100-SCAN-MAPL  THRU  P1100-EXIT                    DTSBE309
00330          UNTIL L910-NO-REC-88.                                    DTSBE309
00331                                                                   DTSBE309
00332  P1000-EXIT.                                                      DTSBE309
00333      EXIT.                                                        DTSBE309
00334      EJECT                                                        DTSBE309
00335 **************************************************************    DTSBE309
00336 *  THIS PARAGRAPH SCANS THE MAPL RECORDS TO DETERMINE IF THE      DTSBE309
00337 *  EMPLOYER HAS AN OPEN APPEAL.                                   DTSBE309
00338 **************************************************************    DTSBE309
00339                                                                   DTSBE309
00340  P1100-SCAN-MAPL.                                                 DTSBE309
00341                                                                   DTSBE309
00342      MOVE MSKL-REC                   TO  MAPL-REC.                DTSBE309
00343                                                                   DTSBE309
00344      IF MAPL-STATUS-OPEN-88                                       DTSBE309
00345          SET WRK-NO-SELECT-EMPLOYER  TO  TRUE                     DTSBE309
00346          SET L910-NO-REC-88          TO  TRUE                     DTSBE309
00347          GO TO P1100-EXIT.                                        DTSBE309
00348                                                                   DTSBE309
00349      PERFORM S910-READ-NEXT  THRU  S910-EXIT.                     DTSBE309
00350                                                                   DTSBE309
00351  P1100-EXIT.                                                      DTSBE309
00352      EXIT.                                                        DTSBE309
00353      EJECT                                                        DTSBE309
00354 **************************************************************    DTSBE309
00355 *  THIS PARAGRAPH SETS UP THE R309 RECORDS, DETERMINES THE        DTSBE309
00356 *  ADDRESSES TO BE USED.                                          DTSBE309
00357 **************************************************************    DTSBE309
00358                                                                   DTSBE309
00359  P2000-SETUP-R309.                                                DTSBE309
00360                                                                   DTSBE309
00361      MOVE MPRF-EMP-NO           TO  R309-EMP-NO.                  DTSBE309
00362      MOVE MPRF-FEIN             TO  R309-FEIN.                    DTSBE309
00363      MOVE LECM-CURR-RUN-DATE    TO  R309-STMT-DATE.               DTSBE309
00364      MOVE LECM-PRIOR-RUN-DATE   TO  R309-LAST-ACCT-UPDATE-DATE.   DTSBE309
00365      MOVE MPRF-TOT-CREDIT-AMT   TO  R309-TOT-CREDIT-AMT.          DTSBE309
00366                                                                   DTSBE309
00367                                                                   DTSBE309
00368      PERFORM P2100-READ-MCOL  THRU  P2100-EXIT.                   DTSBE309
00369                                                                   DTSBE309
00370      IF WRK-MCOL-FOUND                                            DTSBE309
00371          PERFORM P2200-PROCESS-MCOL  THRU  P2200-EXIT             DTSBE309
00372      ELSE                                                         DTSBE309
00373          MOVE ZEROS                TO  R309-STMT-TEXT-CNT         DTSBE309
00374          MOVE LOW-VALUES           TO  R309-STMT-TEXT-AREA.       DTSBE309
00375                                                                   DTSBE309
00376 *****MOVE ZERO                     TO  WRK-STATEMENT-SENT.        DTSBE309
00377 *****SET WRK-MTAD-NO-STMT-SENT     TO  TRUE.                      DTSBE309
00378 *****MOVE LOW-VALUES               TO  MTAD-KEY-AREA.             DTSBE309
00379 *****MOVE MPRF-EMP-NO              TO  MTAD-EMP-NO.               DTSBE309
00380 *****SET MTAD-TAD-88               TO  TRUE.                      DTSBE309
00381 *****MOVE MTAD-KEY-AREA            TO  MSKL-KEY-AREA.             DTSBE309
00382 *****                                                             DTSBE309
00383 *****PERFORM S910-START-BROWSE  THRU  S910-EXIT.                  DTSBE309
00384 *****                                                             DTSBE309
00385 *****PERFORM P2300-SCAN-MTAD  THRU  P2300-EXIT                    DTSBE309
00386 *****    UNTIL  L910-NO-REC-88.                                   DTSBE309
00387 *****                                                             DTSBE309
00388 *****IF WRK-MTAD-NO-STMT-SENT                                     DTSBE309
00389 *****    PERFORM P2400-WRITE-R907-NONE-SENT  THRU  P2400-EXIT.    DTSBE309
00390 *****                                                             DTSBE309
00391 *****MOVE LOW-VALUES        TO  MOPO-KEY-AREA.                    DTSBE309
00392 *****MOVE MPRF-EMP-NO       TO  MOPO-EMP-NO.                      DTSBE309
00393 *****SET MOPO-OPO-88        TO  TRUE.                             DTSBE309
00394 *****MOVE MOPO-KEY-AREA     TO  MSKL-KEY-AREA.                    DTSBE309
00395 *****                                                             DTSBE309
00396 *****PERFORM S910-START-BROWSE  THRU  S910-EXIT.                  DTSBE309
00397 *****                                                             DTSBE309
00398 *****PERFORM P2500-SCAN-MOPO  THRU  P2500-EXIT                    DTSBE309
00399 *****    UNTIL  L910-NO-REC-88.                                   DTSBE309
00400 *****                                                             DTSBE309
00401 *****IF WRK-STATEMENT-SENT  GREATER THAN  +1                      DTSBE309
00402 *****    PERFORM P2600-WRITE-R907-SENT-MULTI  THRU P2600-EXIT.    DTSBE309
00403 *****                                                             DTSBE309
00404 *****IF WRK-STATEMENT-SENT  GREATER THAN  ZERO                    DTSBE309
00405 *****    PERFORM P2700-WRITE-MEVL  THRU  P2700-EXIT.              DTSBE309
00406                                                                   DTSBE309
00407      PERFORM P2310-PROCESS-MTAD THRU P2310-EXIT.                  DTSBE309
00408                                                                   DTSBE309
00409      PERFORM P2700-WRITE-MEVL THRU P2700-EXIT.                    DTSBE309
00410                                                                   DTSBE309
00411  P2000-EXIT.                                                      DTSBE309
00412      EXIT.                                                        DTSBE309
00413      EJECT                                                        DTSBE309
00414 **************************************************************    DTSBE309
00415 *  THIS PARAGRAPH DETERMINES IF AN MCOL RECORD EXISTS.            DTSBE309
00416 **************************************************************    DTSBE309
00417                                                                   DTSBE309
00418  P2100-READ-MCOL.                                                 DTSBE309
00419                                                                   DTSBE309
00420      MOVE LOW-VALUES            TO  MCOL-KEY-AREA.                DTSBE309
00421      MOVE MPRF-EMP-NO           TO  MCOL-EMP-NO.                  DTSBE309
00422      SET MCOL-COL-88            TO  TRUE.                         DTSBE309
00423      MOVE MCOL-KEY-AREA         TO  MSKL-KEY-AREA.                DTSBE309
00424                                                                   DTSBE309
00425      PERFORM S910-READ  THRU  S910-EXIT.                          DTSBE309
00426                                                                   DTSBE309
00427      IF L910-NO-REC-88                                            DTSBE309
00428          SET WRK-NO-MCOL        TO  TRUE                          DTSBE309
00429          GO TO P2100-EXIT                                         DTSBE309
00430      ELSE                                                         DTSBE309
00431          MOVE MSKL-REC          TO  MCOL-REC                      DTSBE309
00432          SET WRK-MCOL-FOUND     TO  TRUE.                         DTSBE309
00433                                                                   DTSBE309
00434  P2100-EXIT.                                                      DTSBE309
00435      EXIT.                                                        DTSBE309
00436      EJECT                                                        DTSBE309
00437 **************************************************************    DTSBE309
00438 *  THIS PARAGRAPH PROCESSES THE MCOL RECORD.                      DTSBE309
00439 **************************************************************    DTSBE309
00440                                                                   DTSBE309
00441  P2200-PROCESS-MCOL.                                              DTSBE309
00442                                                                   DTSBE309
00443      IF MCOL-STMT-TEXT-TYPE-CREDIT-88                             DTSBE309
00444          IF MCOL-STMT-TEXT-CNT  GREATER THAN  ZERO                DTSBE309
00445              MOVE ZERO          TO  R309-STMT-TEXT-CNT            DTSBE309
00446                                                                   DTSBE309
00447              PERFORM P2210-SETUP-TEXT  THRU  P2210-EXIT           DTSBE309
00448                VARYING MCOL-STMT-TEXT-IDX  FROM 1 BY 1            DTSBE309
00449                  UNTIL MCOL-STMT-TEXT-IDX                         DTSBE309
00450                        GREATER THAN  MCOL-STMT-TEXT-CNT           DTSBE309
00451                                                                   DTSBE309
00452              IF MCOL-STMT-TEXT-PERM-NO-88                         DTSBE309
00453                  MOVE ZERO      TO  MCOL-STMT-TEXT-CNT            DTSBE309
00454                  SET MCOL-STMT-TEXT-TYPE-NONE-88                  DTSBE309
00455                                 TO  TRUE                          DTSBE309
00456                  SET MCOL-STMT-TEXT-PERM-NONE-88                  DTSBE309
00457                                 TO  TRUE                          DTSBE309
00458                  MOVE MCOL-REC  TO  MSKL-REC                      DTSBE309
00459                  PERFORM S910-REWRITE  THRU  S910-EXIT            DTSBE309
00460              ELSE                                                 DTSBE309
00461                  NEXT SENTENCE                                    DTSBE309
00462          ELSE                                                     DTSBE309
00463              MOVE ZERO          TO  R309-STMT-TEXT-CNT            DTSBE309
00464              MOVE LOW-VALUES    TO  R309-STMT-TEXT-AREA           DTSBE309
00465      ELSE                                                         DTSBE309
00466          MOVE ZERO             TO  R309-STMT-TEXT-CNT             DTSBE309
00467          MOVE LOW-VALUES       TO  R309-STMT-TEXT-AREA.           DTSBE309
00468                                                                   DTSBE309
00469      IF MCOL-STMT-TEXT-TYPE-DEBIT-88                              DTSBE309
00470          PERFORM P2230-WRITE-R907-SYNC-ERROR  THRU P2230-EXIT.    DTSBE309
00471                                                                   DTSBE309
00472  P2200-EXIT.                                                      DTSBE309
00473       EXIT.                                                       DTSBE309
00474       EJECT                                                       DTSBE309
00475 **************************************************************    DTSBE309
00476 *  THIS PARAGRAPH SETS UP THE TEXT FROM AN EXISTING MCOL          DTSBE309
00477 *  RECORD.                                                        DTSBE309
00478 **************************************************************    DTSBE309
00479                                                                   DTSBE309
00480  P2210-SETUP-TEXT.                                                DTSBE309
00481                                                                   DTSBE309
00482      ADD +1         TO  R309-STMT-TEXT-CNT.                       DTSBE309
00483                                                                   DTSBE309
00484      MOVE MCOL-STMT-TEXT (MCOL-STMT-TEXT-IDX)                     DTSBE309
00485                     TO  R309-STMT-TEXT (R309-STMT-TEXT-CNT).      DTSBE309
00486                                                                   DTSBE309
00487  P2210-EXIT.                                                      DTSBE309
00488      EXIT.                                                        DTSBE309
00489      EJECT                                                        DTSBE309
00490 **************************************************************    DTSBE309
00491 *  THIS PARAGRAPH WRITES AN R907 UNEXPLAINED EVENTS RECORD        DTSBE309
00492 *  IF THEIR IS A CREDIT AMOUNT WITH DEBIT INFORMATION TEXT.       DTSBE309
00493 **************************************************************    DTSBE309
00494                                                                   DTSBE309
00495  P2230-WRITE-R907-SYNC-ERROR.                                     DTSBE309
00496                                                                   DTSBE309
00497      MOVE LOW-VALUES               TO  R907-DATA-AREA.            DTSBE309
00498      MOVE MSG3-ID                  TO  R907-MSG-ID.               DTSBE309
00499      MOVE MPRF-EMP-NO              TO  R907-EMP-NO.               DTSBE309
00500      MOVE MSG3-TEXT                TO  R907-MSG-TEXT.             DTSBE309
00501      MOVE WRK-MOD-NAME             TO  R907-MODULE-NAME.          DTSBE309
00502                                                                   DTSBE309
00503      PERFORM S946-WRITE-R907  THRU  S946-EXIT.                    DTSBE309
00504                                                                   DTSBE309
00505                                                                   DTSBE309
00506  P2230-EXIT.                                                      DTSBE309
00507      EXIT.                                                        DTSBE309
00508      EJECT                                                        DTSBE309
00509 **************************************************************    DTSBE309
00510 *  THIS PARAGRAPH SCANS THE MTAD RECORDS.                         DTSBE309
00511 **************************************************************    DTSBE309
00512                                                                   DTSBE309
00513 *P2300-SCAN-MTAD.                                                 DTSBE309
00514 *****                                                             DTSBE309
00515 *****MOVE MSKL-REC                 TO  MTAD-REC.                  DTSBE309
00516 *****                                                             DTSBE309
00517 *****PERFORM P2310-PROCESS-MTAD  THRU  P2310-EXIT.                DTSBE309
00518 *****                                                             DTSBE309
00519 *****PERFORM S910-READ-NEXT  THRU  S910-EXIT.                     DTSBE309
00520 *****                                                             DTSBE309
00521 *P2300-EXIT.                                                      DTSBE309
00522 *****EXIT.                                                        DTSBE309
00523      EJECT                                                        DTSBE309
00524 **************************************************************    DTSBE309
00525 *  THIS PARAGRAPH PROCESSES THE MTAD RECORDS AND WRITES AN        DTSBE309
00526 *  EXTRACT RECORD.                                                DTSBE309
00527 **************************************************************    DTSBE309
00528                                                                   DTSBE309
00529  P2310-PROCESS-MTAD.                                              DTSBE309
00530      MOVE LOW-VALUES            TO  L111-RETURN-AREA.             DTSBE309
00531      MOVE MPRF-EMP-NO           TO  L111-EMP-NO.                  DTSBE309
00532      SET L111-LOOKUP-TAD-88     TO  TRUE.                         DTSBE309
00533      SET L111-ID-NO-TAD-MAIL-88 TO  TRUE.                         DTSBE309
00534                                                                   DTSBE309
00535      PERFORM S111-LOOKUP-ADDRESS THRU S111-EXIT.                  DTSBE309
00536                                                                   DTSBE309
00537      IF L111-ADDR-FOUND-88                                        DTSBE309
00538          MOVE MPRF-PRIMARY-NAME    TO  L112-PRIMARY-NAME          DTSBE309
00539          MOVE LOW-VALUES           TO  L112-NAME-ADDRESS-AREA     DTSBE309
00540          SET  L112-TAD-ADDR-88     TO  TRUE                       DTSBE309
00541          SET  L112-ANCHOR-LAST-88  TO  TRUE                       DTSBE309
00542          MOVE L111-RETURN-AREA      TO  L112-NAME-ADDRESS-AREA    DTSBE309
00543          PERFORM S112-FORMAT-ADDR   THRU  S112-EXIT               DTSBE309
00544          MOVE L112-MAILING-ADDRESS  TO R309-FMT-ADDR              DTSBE309
00545          MOVE L112-ZIP              TO R309-ZIP                   DTSBE309
00546          MOVE L112-ADVANCED-BARCODE TO R309-ADVANCED-BARCODE      DTSBE309
00547      ELSE                                                         DTSBE309
00548          MOVE ALL '?'           TO  R309-FMT-ADDR                 DTSBE309
00549                                     R309-ZIP                      DTSBE309
00550          GO TO P2310-EXIT.                                        DTSBE309
00551      MOVE MPRF-EMP-NO           TO  R309-EMP-NO.                  DTSBE309
00552      PERFORM S946-WRITE-R309  THRU  S946-EXIT.                    DTSBE309
00553      MOVE MPRF-EMP-NO           TO  R310-EMP-NO.                  DTSBE309
00554      PERFORM S946-WRITE-R310  THRU  S946-EXIT.                    DTSBE309
00555  P2310-EXIT.                                                      DTSBE309
00556      EXIT.                                                        DTSBE309
00557      EJECT                                                        DTSBE309
00558 **************************************************************    DTSBE309
00559 *  THIS PARAGRAPH FORMATS THE ADDRESS.                            DTSBE309
00560 **************************************************************    DTSBE309
00561                                                                   DTSBE309
00562 *BO P2311-FORMAT-ADDR.                                            DTSBE309
00563 *    CALL 'DTSBU112' USING L112-LINK-AREA.                        DTSBE309
00564 *    SET L112-ANCHOR-LAST-88       TO  TRUE.                      DTSBE309
00565 *    MOVE MPRF-PRIMARY-NAME        TO  L112-PRIMARY-NAME.         DTSBE309
00566 *                                                                 DTSBE309
00567 *    PERFORM S112-FORMAT-ADDR  THRU  S112-EXIT.                   DTSBE309
00568 *                                                                 DTSBE309
00569 *    MOVE L112-MAILING-ADDRESS     TO  R309-FMT-ADDR.             DTSBE309
00570 *    MOVE L112-ZIP                 TO  R309-ZIP.                  DTSBE309
00571 *    MOVE L112-DELIV-POINT         TO  R309-DELIV-POINT.          DTSBE309
00572 *    MOVE L112-CHECK-DIGIT         TO  R309-CHECK-DIGIT.          DTSBE309
00573 * P2311-EXIT.                                                     DTSBE309
00574 *     EXIT.                                                       DTSBE309
00575 *BO     EJECT                                                     DTSBE309
00576 **************************************************************    DTSBE309
00577 *  THIS PARAGRAPH WRITES AN R907 UNUSUAL EVENTS RECORD WHEN NO    DTSBE309
00578 *  MTAD RECORD INDICATED THAT A STATEMENT SHOULD BE SENT.         DTSBE309
00579 **************************************************************    DTSBE309
00580                                                                   DTSBE309
00581 *P2400-WRITE-R907-NONE-SENT.                                      DTSBE309
00582 *****                                                             DTSBE309
00583 *****MOVE LOW-VALUES               TO  R907-DATA-AREA.            DTSBE309
00584 *****MOVE MSG1-ID                  TO  R907-MSG-ID.               DTSBE309
00585 *****MOVE MPRF-EMP-NO              TO  R907-EMP-NO.               DTSBE309
00586 *****MOVE MSG1-TEXT                TO  R907-MSG-TEXT.             DTSBE309
00587 *****MOVE WRK-MOD-NAME             TO  R907-MODULE-NAME.          DTSBE309
00588 *****                                                             DTSBE309
00589 *****PERFORM S946-WRITE-R907  THRU  S946-EXIT.                    DTSBE309
00590 *****                                                             DTSBE309
00591 *P2400-EXIT.                                                      DTSBE309
00592 *****EXIT.                                                        DTSBE309
00593      EJECT                                                        DTSBE309
00594 **************************************************************    DTSBE309
00595 *  THIS PARAGRAPH SCANS THE MOPO RECORDS AND WRITES AN EXTRACT    DTSBE309
00596 *  RECORD FOR EACH ADDRESS THAT INDICATES A UC223 SHOULD BE       DTSBE309
00597 *  SENT.                                                          DTSBE309
00598 **************************************************************    DTSBE309
00599                                                                   DTSBE309
00600 *P2500-SCAN-MOPO.                                                 DTSBE309
00601 *****                                                             DTSBE309
00602 *****MOVE MSKL-REC                 TO  MOPO-REC.                  DTSBE309
00603 *****                                                             DTSBE309
00604 *****PERFORM P2510-PROCESS-MOPO  THRU  P2510-EXIT.                DTSBE309
00605 *****                                                             DTSBE309
00606 *****PERFORM S910-READ-NEXT  THRU  S910-EXIT.                     DTSBE309
00607 *****                                                             DTSBE309
00608 *P2500-EXIT.                                                      DTSBE309
00609 *****EXIT.                                                        DTSBE309
00610      EJECT                                                        DTSBE309
00611 **************************************************************    DTSBE309
00612 *  THIS PARAGRAPH PROCESSES THE MOPO RECORDS AND WRITES AN        DTSBE309
00613 *  EXTRACT RECORD FOR EACH ADDRESS THAT INDICATES A UC223         DTSBE309
00614 *  SHOULD BE SENT.                                                DTSBE309
00615 **************************************************************    DTSBE309
00616                                                                   DTSBE309
00617 *P2510-PROCESS-MOPO.                                              DTSBE309
00618 *****                                                             DTSBE309
00619 *****IF MOPO-NO-DEBIT-MEMO-88                                     DTSBE309
00620 *****    GO TO P2510-EXIT.                                        DTSBE309
00621 *****                                                             DTSBE309
00622 *****ADD +1                        TO  WRK-STATEMENT-SENT.        DTSBE309
00623 *****MOVE LOW-VALUES               TO  L112-NAME-ADDRESS-AREA.    DTSBE309
00624 *****SET L112-OPO-ADDR-88          TO  TRUE.                      DTSBE309
00625 *****MOVE MOPO-MAIL-DELIV-IND      TO  L112-MAIL-DELIV-IND.       DTSBE309
00626 *****MOVE MOPO-NAME                TO  L112-NAME.                 DTSBE309
00627 *****MOVE MOPO-TITLE               TO  L112-TITLE.                DTSBE309
00628 *****MOVE MOPO-ADDRESS             TO  L112-ADDRESS.              DTSBE309
00629 *****                                                             DTSBE309
00630 *****PERFORM P2311-FORMAT-ADDR  THRU  P2311-EXIT.                 DTSBE309
00631 *****                                                             DTSBE309
00632 *****SET R309-PRINT-TYPE-FICHE-88  TO  TRUE.                      DTSBE309
00633 *****PERFORM S946-WRITE-R309  THRU  S946-EXIT.                    DTSBE309
00634 *****                                                             DTSBE309
00635 *****SET R309-PRINT-TYPE-PAPER-88  TO  TRUE.                      DTSBE309
00636 *****PERFORM S946-WRITE-R309  THRU  S946-EXIT.                    DTSBE309
00637 *****                                                             DTSBE309
00638 *****MOVE MPRF-EMP-NO              TO  R310-EMP-NO.               DTSBE309
00639 *****PERFORM S946-WRITE-R310  THRU  S946-EXIT.                    DTSBE309
00640 *****                                                             DTSBE309
00641 *P2510-EXIT.                                                      DTSBE309
00642 *****EXIT.                                                        DTSBE309
00643      EJECT                                                        DTSBE309
00644                                                                   DTSBE309
00645 **************************************************************    DTSBE309
00646 *  THIS PARAGRAPH WRITES AN R907 UNUSUAL EVENTS RECORD WHEN MORE  DTSBE309
00647 *  THAN ONE CREDIT STATEMENT WAS ISSUED FOR THE SAME EMPLOYER.    DTSBE309
00648 **************************************************************    DTSBE309
00649                                                                   DTSBE309
00650 *P2600-WRITE-R907-SENT-MULTI.                                     DTSBE309
00651 *****                                                             DTSBE309
00652 *****MOVE LOW-VALUES               TO  R907-DATA-AREA.            DTSBE309
00653 *****MOVE MSG2-ID                  TO  R907-MSG-ID.               DTSBE309
00654 *****MOVE MPRF-EMP-NO              TO  R907-EMP-NO.               DTSBE309
00655 *****MOVE MSG2-TEXT                TO  R907-MSG-TEXT.             DTSBE309
00656 *****MOVE WRK-MOD-NAME             TO  R907-MODULE-NAME.          DTSBE309
00657 *****                                                             DTSBE309
00658 *****PERFORM S946-WRITE-R907  THRU  S946-EXIT.                    DTSBE309
00659 *****                                                             DTSBE309
00660 *P2600-EXIT.                                                      DTSBE309
00661 *****EXIT.                                                        DTSBE309
00662      EJECT                                                        DTSBE309
00663 **************************************************************    DTSBE309
00664 *  THIS PARAGRAPH WRITES A MEVL RECORD FOR EACH EMPLOYER THAT     DTSBE309
00665 *  IS ISSUED A CREDIT STATEMENT.                                  DTSBE309
00666 **************************************************************    DTSBE309
00667                                                                   DTSBE309
00668  P2700-WRITE-MEVL.                                                DTSBE309
00669                                                                   DTSBE309
00670      MOVE LOW-VALUES               TO  MEVL-REC.                  DTSBE309
00671      MOVE MPRF-EMP-NO              TO  MEVL-EMP-NO.               DTSBE309
00672      SET MEVL-EVL-88               TO  TRUE.                      DTSBE309
00673      ADD +1000                     TO  LECM-EMP-ABSTIME.          DTSBE309
00674      MOVE LECM-EMP-ABSTIME         TO  L005-ABSTIME.              DTSBE309
00675                                                                   DTSBE309
00676      PERFORM S005-FROM-ABSTIME  THRU  S005-EXIT.                  DTSBE309
00677                                                                   DTSBE309
00678      MOVE L005-DATE                TO  MEVL-DATE.                 DTSBE309
00679      MOVE L005-TIME                TO  MEVL-TIME.                 DTSBE309
00680      MOVE ZEROS                    TO  MEVL-PURGE-DATE.           DTSBE309
00681      MOVE MPRF-TOT-CREDIT-AMT      TO  EVL-CREDIT-AMT.            DTSBE309
00682      MOVE EVL-TEXT                 TO  MEVL-TEXT.                 DTSBE309
00683                                                                   DTSBE309
00684      SET MEVL-SOURCE-SYSTEM-88     TO  TRUE.                      DTSBE309
00685      SET MEVL-NOT-CONVERTED-88     TO  TRUE.                      DTSBE309
00686      MOVE LECM-CURR-RUN-DATE       TO  MEVL-ESTB-DATE             DTSBE309
00687                                        MEVL-CHNG-DATE.            DTSBE309
00688      MOVE MEVL-REC                 TO  MSKL-REC.                  DTSBE309
00689      PERFORM  S910-WRITE  THRU  S910-EXIT.                        DTSBE309
00690                                                                   DTSBE309
00691  P2700-EXIT.                                                      DTSBE309
00692      EXIT.                                                        DTSBE309
00693      EJECT                                                        DTSBE309
00694  T0000-TERMINATE.                                                 DTSBE309
00695      SKIP2                                                        DTSBE309
00696      SKIP2                                                        DTSBE309
00697  T0000-EXIT.                                                      DTSBE309
00698      EXIT.                                                        DTSBE309
00699      EJECT                                                        DTSBE309
00700  S005-FROM-ABSTIME.                                               DTSBE309
00701      SET L005-FROM-ABSTIME TO TRUE.                               DTSBE309
00702      GO TO S005-ABSTIME.                                          DTSBE309
00703      SKIP1                                                        DTSBE309
00704  S005-ABSTIME.                                                    DTSBE309
00705      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBE309
00706  S005-EXIT.                                                       DTSBE309
00707      EXIT.                                                        DTSBE309
00708      SKIP3                                                        DTSBE309
00709  S111-LOOKUP-ADDRESS.                                             DTSBE309
00710      CALL 'DTSBU111' USING L111-LINK-AREA.                        DTSBE309
00711  S111-EXIT.                                                       DTSBE309
00712      EXIT.                                                        DTSBE309
00713      SKIP3                                                        DTSBE309
00714  S112-FORMAT-ADDR.                                                DTSBE309
00715      CALL 'DTSBU112' USING L112-LINK-AREA.                        DTSBE309
00716  S112-EXIT.                                                       DTSBE309
00717      EXIT.                                                        DTSBE309
00718      SKIP3                                                        DTSBE309
00719  S910-READ.                                                       DTSBE309
00720      SET L910-READ-88 TO TRUE.                                    DTSBE309
00721      GO TO S910-MSTR-IO.                                          DTSBE309
00722      SKIP1                                                        DTSBE309
00723  S910-START-BROWSE.                                               DTSBE309
00724      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE309
00725      GO TO S910-MSTR-IO.                                          DTSBE309
00726      SKIP1                                                        DTSBE309
00727  S910-READ-NEXT.                                                  DTSBE309
00728      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE309
00729      GO TO S910-MSTR-IO.                                          DTSBE309
00730      SKIP1                                                        DTSBE309
00731 *BO S910-COUNT.                                                   DTSBE309
00732 *     SET L910-COUNT-88 TO TRUE.                                  DTSBE309
00733 *     GO TO S910-MSTR-IO.                                         DTSBE309
00734 *BO   SKIP1                                                       DTSBE309
00735  S910-WRITE.                                                      DTSBE309
00736      SET L910-WRITE-88 TO TRUE.                                   DTSBE309
00737      SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE309
00738      GO TO S910-MSTR-IO.                                          DTSBE309
00739      SKIP1                                                        DTSBE309
00740  S910-REWRITE.                                                    DTSBE309
00741      SET L910-REWRITE-88 TO TRUE.                                 DTSBE309
00742      SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE309
00743      GO TO S910-MSTR-IO.                                          DTSBE309
00744      SKIP1                                                        DTSBE309
00745 *BO S910-DELETE.                                                  DTSBE309
00746 *     SET L910-DELETE-88 TO TRUE.                                 DTSBE309
00747 *     SET LECM-EMP-UPDATED-YES-88 TO TRUE.                        DTSBE309
00748 *BO     GO TO S910-MSTR-IO.                                       DTSBE309
00749      SKIP1                                                        DTSBE309
00750  S910-MSTR-IO.                                                    DTSBE309
00751      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE309
00752                            MSKL-REC.                              DTSBE309
00753  S910-EXIT.                                                       DTSBE309
00754      EXIT.                                                        DTSBE309
00755      SKIP3                                                        DTSBE309
00756  S946-WRITE-R309.                                                 DTSBE309
00757 *    COMPUTE R309-LENGTH  =                                       DTSBE309
00758 *            RLEN-R309-FIXED-LEN  +                               DTSBE309
00759 *            (R309-STMT-TEXT-CNT * RLEN-R309-OCC-LEN).            DTSBE309
00760 *BOA MOVE 8 TO R309-STMT-TEXT-CNT.                                DTSBE309
00761 *    PERFORM  VARYING R309-STMT-TEXT-IDX FROM 1 BY 1              DTSBE309
00762 *             UNTIL R309-STMT-TEXT-IDX                            DTSBE309
00763 *             GREATER THAN R309-STMT-TEXT-CNT                     DTSBE309
00764 *             MOVE 'STATEMENT TEXT' TO                            DTSBE309
00765 *                R309-STMT-TEXT (R309-STMT-TEXT-IDX)              DTSBE309
00766 *    END-PERFORM.                                                 DTSBE309
00767      MOVE LENGTH OF R309-REC      TO  R309-LENGTH.                DTSBE309
00768      CALL 'DTSBU946' USING R309-REC.                              DTSBE309
00769      GO TO S946-EXIT.                                             DTSBE309
00770      SKIP1                                                        DTSBE309
00771  S946-WRITE-R310.                                                 DTSBE309
00772      CALL 'DTSBU946' USING R310-REC.                              DTSBE309
00773      GO TO S946-EXIT.                                             DTSBE309
00774      SKIP1                                                        DTSBE309
00775  S946-WRITE-R907.                                                 DTSBE309
00776      CALL 'DTSBU946' USING R907-REC.                              DTSBE309
00777      GO TO S946-EXIT.                                             DTSBE309
00778      SKIP1                                                        DTSBE309
00779  S946-EXIT.                                                       DTSBE309
00780      EXIT.                                                        DTSBE309
00781      SKIP3                                                        DTSBE309
00782  S999-ABEND.                                                      DTSBE309
00783      DISPLAY '*** DTSBE309 ABENDING.  '                           DTSBE309
00784              ABEND-MSG.                                           DTSBE309
00785      SKIP1                                                        DTSBE309
00786      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE309
00787  S999-EXIT.                                                       DTSBE309
00788      EXIT.                                                        DTSBE309
