00001  IDENTIFICATION DIVISION.                                         02/13/02
00002  PROGRAM-ID.             DTSCU400.                                DTSCU400
00003  AUTHOR.                 TRW.                                        LV005
00004  DATE-WRITTEN.           OCTOBER 20001.                           DTSCU400
00005  DATE-COMPILED.                                                   DTSCU400
00006 DTSCU4KIP3                                                        DTSCU400
00007 *****                                                             DTSCU400
00008 *                                                                 DTSCU400
00009 *    FUNCTION:  FILING SCHEDULE MAINTENANCE MODULE                DTSCU400
00010 *                                                                 DTSCU400
00011 *                                                                 DTSCU400
00012 *    MODIFICATION LOG:                                            DTSCU400
00013 *                                                                 DTSCU400
00014 *    10/15/2001  INITIAL DEVELOPMENT.                             DTSCU400
00015 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU400
00016 *                                                                 DTSCU400
00017 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU400
00018 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU400
00019 *                WORK ORDER:                      PROGRAMMER: XXX DTSCU400
00020 *****                                                             DTSCU400
00021 *                                                                 DTSCU400
00022 *    DESCRIPTION:                                                 DTSCU400
00023 *                                                                 DTSCU400
00024 *    DTSCU400 PERFORMS COMMON FUNCTIONS NEEDED TO ADD AND UPDATE  DTSCU400
00025 *             MFSC RECORDS.                                       DTSCU400
00026 *                                                                 DTSCU400
00027 *                                                                 DTSCU400
00028 *****                                                             DTSCU400
00029      SKIP3                                                        DTSCU400
00030  ENVIRONMENT DIVISION.                                            DTSCU400
00031      SKIP3                                                        DTSCU400
00032  DATA DIVISION.                                                   DTSCU400
00033      SKIP3                                                        DTSCU400
00034  WORKING-STORAGE SECTION.                                         DTSCU400
000345 77  PAN-VALET PICTURE X(24) VALUE '005DTSCU400  02/13/02'.       DTSCU400
00035      SKIP3                                                        DTSCU400
00036  01  WRK-AREA.                                                    DTSCU400
00037      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U400'.    DTSCU400
00038      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSCU400
00039                                                                   DTSCU400
00040      05  WRK-EMP-NO                  PIC S9(07)  COMP-3           DTSCU400
00041                                            VALUE +0.              DTSCU400
00042      05  WRK-ABS-QTR                 PIC S9(04)  COMP.            DTSCU400
00043      05  WRK-START-YRQ               PIC S9(05)  COMP-3.          DTSCU400
00044      05  WRK-PRIOR-START-YRQ         PIC S9(05)  COMP-3.          DTSCU400
00045      05  WRK-PRIOR-MFSC-KEY          PIC  X(16).                  DTSCU400
00046      05  WRK-NEXT-START-YRQ          PIC S9(05)  COMP-3.          DTSCU400
00047                                                                   DTSCU400
00048      05  WRK-PENDING-MFSC-KEY        PIC  X(16).                  DTSCU400
00049                                                                   DTSCU400
00050      05  WRK-OPEN-CNT                PIC S9(04)  COMP             DTSCU400
00051                                            VALUE +0.              DTSCU400
00052      05  WRK-ALL-NINES-YRQ           PIC S9(05)  COMP-3           DTSCU400
00053                                            VALUE +99999.          DTSCU400
00054                                                                   DTSCU400
00055      05  WRK-RETURN-AREA.                                         DTSCU400
00056          10  WRK-PRIOR-STATE-IND     PIC  X(01).                  DTSCU400
00057              88  WRK-PENDING-MFSC-88        VALUE '1'.            DTSCU400
00058              88  WRK-ORIG-DETERM-88         VALUE '2'.            DTSCU400
00059              88  WRK-REDETERM-88            VALUE '3'.            DTSCU400
00060          10  WRK-NOTICE-SENT-IND     PIC  X(01).                  DTSCU400
00061              88  WRK-NOTICE-SENT-YES-88     VALUE 'Y'.            DTSCU400
00062              88  WRK-NOTICE-SENT-NO-88      VALUE 'N'.            DTSCU400
00063                                                                   DTSCU400
00064       05  WRK-T001-RPT-TYPE       PIC  X(02).                     DTSCU400
00065           88  WRK-POT-HOUSEHOLD-88       VALUE '01'.              DTSCU400
00066           88  WRK-ADMIN-REACT-88         VALUE '21'.              DTSCU400
00067                                                                   DTSCU400
00068      05  WRK-R907-MSG-TABLE.                                      DTSCU400
00069          10  WRK-R907-MSG1.                                       DTSCU400
00070              15  WRK-R907-MSG1-ID            PIC X(11)            DTSCU400
00071                           VALUE 'DTSCU400401'.                    DTSCU400
00072              15  WRK-R907-MSG1-SHORT-TEXT    PIC X(20)            DTSCU400
00073                           VALUE 'MFSC ALREADY EXISTS'.            DTSCU400
00074              15  WRK-R907-MSG1-LONG-TEXT.                         DTSCU400
00075                  20 FILLER                   PIC  X(30)           DTSCU400
00076                        VALUE 'MFSC ALREADY EXISTS - USING EX'.    DTSCU400
00077                  20 FILLER                   PIC  X(30)           DTSCU400
00078                        VALUE 'ISTING RECORD                 '.    DTSCU400
00079          10  WRK-R907-MSG2.                                       DTSCU400
00080              15  WRK-R907-MSG2-ID            PIC X(11)            DTSCU400
00081                           VALUE 'DTSCU400402'.                    DTSCU400
00082              15  WRK-R907-MSG2-SHORT-TEXT    PIC X(20)            DTSCU400
00083                           VALUE 'MFSC ALREADY EXISTS'.            DTSCU400
00084              15  WRK-R907-MSG2-LONG-TEXT.                         DTSCU400
00085                  20 FILLER                   PIC  X(30)           DTSCU400
00086                        VALUE 'MFSC EXISTS - REPLACING FILING'.    DTSCU400
00087                  20 FILLER                   PIC  X(30)           DTSCU400
00088                        VALUE ' SCHEDULE                     '.    DTSCU400
00089          10  WRK-R907-MSG3.                                       DTSCU400
00090              15  WRK-R907-MSG3-ID            PIC X(11)            DTSCU400
00091                           VALUE 'DTSCU400403'.                    DTSCU400
00092              15  WRK-R907-MSG3-SHORT-TEXT    PIC X(20)            DTSCU400
00093                           VALUE 'MFSC FILE ERROR    '.            DTSCU400
00094              15  WRK-R907-MSG3-LONG-TEXT.                         DTSCU400
00095                  20 FILLER                   PIC  X(30)           DTSCU400
00096                        VALUE 'PRIOR MFSC NOT FOUND - NO RECO'.    DTSCU400
00097                  20 FILLER                   PIC  X(30)           DTSCU400
00098                        VALUE 'RD ADDED                      '.    DTSCU400
00099                                                                   DTSCU400
00100  01  L810-COMM-AREA.                                              DTSCU400
00101      05  L810-CONTROL-BLOCK.                                      DTSCU400
00102  ++INCLUDE DTSIL810                                               DTSCU400
00103      05  MSKL-REC.                                                DTSCU400
00104  ++INCLUDE DTSIMSKL                                               DTSCU400
00105      EJECT                                                        DTSCU400
00106  01  MFSC-REC.                                                    DTSCU400
00107  ++INCLUDE DTSIMFSC                                               DTSCU400
00108      EJECT                                                        DTSCU400
00109  01  L004-COMM-AREA.                                              DTSCU400
00110  ++INCLUDE DTSIL004                                               DTSCU400
00111      EJECT                                                        DTSCU400
00112  01  L005-COMM-AREA.                                              DTSCU400
00113  ++INCLUDE DTSIL005                                               DTSCU400
00114      EJECT                                                        DTSCU400
00115  01  L825-COMM-AREA.                                              DTSCU400
00116      05  L825-CONTROL-BLOCK.                                      DTSCU400
00117  ++INCLUDE DTSIL825                                               DTSCU400
00118      05  RSKL-REC.                                                DTSCU400
00119  ++INCLUDE DTSIRSK1                                               DTSCU400
00120      EJECT                                                        DTSCU400
00121  01  T001-REC.                                                    DTSCU400
00122  ++INCLUDE DTSIT001                                               DTSCU400
00123      EJECT                                                        DTSCU400
00124  01  R907-REC.                                                    DTSCU400
00125  ++INCLUDE DTSIR907                                               DTSCU400
00126      EJECT                                                        DTSCU400
00127  LINKAGE SECTION.                                                 DTSCU400
00128      SKIP3                                                        DTSCU400
00129  01  DFHCOMMAREA.                                                 DTSCU400
00130  ++INCLUDE DTSIL400                                               DTSCU400
00131      EJECT                                                        DTSCU400
00132  01  MPRF-REC.                                                    DTSCU400
00133  ++INCLUDE DTSIMPRF                                               DTSCU400
00134      EJECT                                                        DTSCU400
00135  PROCEDURE DIVISION.                                              DTSCU400
00136      SKIP2                                                        DTSCU400
00137  DTSCU400-MAINLINE.                                               DTSCU400
00138      PERFORM I0000-INITIALIZE           THRU I0000-EXIT.          DTSCU400
00139                                                                   DTSCU400
00140      PERFORM P0000-PROCESS              THRU P0000-EXIT.          DTSCU400
00141                                                                   DTSCU400
00142  DTSCU400-MAINLINE-EXIT.                                          DTSCU400
00143      EXEC CICS                                                    DTSCU400
00144         RETURN                                                    DTSCU400
00145      END-EXEC.                                                    DTSCU400
00146                                                                   DTSCU400
00147      EJECT                                                        DTSCU400
00148  I0000-INITIALIZE.                                                DTSCU400
00149      PERFORM I1000-EDIT-INPUT           THRU I1000-EXIT.          DTSCU400
00150      PERFORM I2000-INIT-RETURN          THRU I2000-EXIT.          DTSCU400
00151      PERFORM I3000-INIT-WS              THRU I3000-EXIT.          DTSCU400
00152                                                                   DTSCU400
00153  I0000-EXIT.                                                      DTSCU400
00154      EXIT.                                                        DTSCU400
00155  I1000-EDIT-INPUT.                                                DTSCU400
00156      IF L400-EMP-NO NOT NUMERIC                                   DTSCU400
00157         PERFORM S899-ABEND              THRU S899-EXIT            DTSCU400
00158      ELSE                                                         DTSCU400
00159         MOVE L400-EMP-NO                TO WRK-EMP-NO.            DTSCU400
00160                                                                   DTSCU400
00161      IF L400-ADD-PENDING-1A-88                                    DTSCU400
00162      OR L400-LIAB-DETERM-88                                       DTSCU400
00163         PERFORM I1100-ADD-UPD           THRU I1100-EXIT.          DTSCU400
00164                                                                   DTSCU400
00165  I1000-EXIT.                                                      DTSCU400
00166      EXIT.                                                        DTSCU400
00167                                                                   DTSCU400
00168  I1100-ADD-UPD.                                                   DTSCU400
00169      IF L400-FIRST-LIAB-YRQ NOT NUMERIC                           DTSCU400
00170         PERFORM S899-ABEND              THRU S899-EXIT.           DTSCU400
00171                                                                   DTSCU400
00172      IF L400-CURR-RUN-DATE NOT > ZERO                             DTSCU400
00173         PERFORM S899-ABEND              THRU S899-EXIT.           DTSCU400
00174                                                                   DTSCU400
00175  I1100-EXIT.                                                      DTSCU400
00176      EXIT.                                                        DTSCU400
00177                                                                   DTSCU400
00178  I2000-INIT-RETURN.                                               DTSCU400
00179      MOVE SPACES               TO L400-PRIOR-STATE-IND.           DTSCU400
00180                                                                   DTSCU400
00181  I2000-EXIT.                                                      DTSCU400
00182      EXIT.                                                        DTSCU400
00183                                                                   DTSCU400
00184  I3000-INIT-WS.                                                   DTSCU400
00185      SET L005-FROM-SYS TO TRUE.                                   DTSCU400
00186      PERFORM S005-ABSTIME           THRU S005-EXIT.               DTSCU400
00187                                                                   DTSCU400
00188      MOVE ZERO                 TO WRK-ABS-QTR                     DTSCU400
00189                                   WRK-START-YRQ                   DTSCU400
00190                                   WRK-PRIOR-START-YRQ             DTSCU400
00191                                   WRK-OPEN-CNT.                   DTSCU400
00192      MOVE LOW-VALUES           TO WRK-PENDING-MFSC-KEY            DTSCU400
00193                                   WRK-PRIOR-MFSC-KEY.             DTSCU400
00194                                                                   DTSCU400
00195      MOVE WRK-ALL-NINES-YRQ    TO WRK-NEXT-START-YRQ.             DTSCU400
00196      MOVE SPACES               TO WRK-PRIOR-STATE-IND             DTSCU400
00197                                   WRK-T001-RPT-TYPE.              DTSCU400
00198      SET WRK-NOTICE-SENT-NO-88 TO TRUE.                           DTSCU400
00199                                                                   DTSCU400
00200  I3000-EXIT.                                                      DTSCU400
00201      EXIT.                                                        DTSCU400
00202                                                                   DTSCU400
00203  P0000-PROCESS.                                                   DTSCU400
00204      IF L400-FIND-PRIOR-88                                        DTSCU400
00205      OR L400-NOT-LIAB-DETERM-88                                   DTSCU400
00206         NEXT SENTENCE                                             DTSCU400
00207      ELSE                                                         DTSCU400
00208         PERFORM S1000-START-YRQ             THRU S1000-EXIT.      DTSCU400
00209                                                                   DTSCU400
00210      PERFORM P1000-FIND-PRIOR               THRU P1000-EXIT.      DTSCU400
00211                                                                   DTSCU400
00212      IF L400-FIND-PRIOR-88                                        DTSCU400
00213         GO TO P0000-EXIT.                                         DTSCU400
00214                                                                   DTSCU400
00215      IF L400-ADD-PENDING-1A-88                                    DTSCU400
00216      OR L400-DETERM-PENDING-88                                    DTSCU400
00217         PERFORM P2000-ADD-MFSC-T001          THRU P2000-EXIT      DTSCU400
00218      ELSE                                                         DTSCU400
00219         IF L400-LIAB-DETERM-88                                    DTSCU400
00220            PERFORM P0100-LIAB-DETERM         THRU P0100-EXIT      DTSCU400
00221         ELSE                                                      DTSCU400
00222            IF L400-NOT-LIAB-DETERM-88                             DTSCU400
00223               PERFORM P3000-UPDATE-MFSC      THRU P3000-EXIT      DTSCU400
00224            ELSE                                                   DTSCU400
00225               IF L400-ORG-TYPE-CHANGE-88                          DTSCU400
00226                  PERFORM P5000-ORG-TYPE-CHNG THRU P5000-EXIT.     DTSCU400
00227                                                                   DTSCU400
00228  P0000-EXIT.                                                      DTSCU400
00229      EXIT.                                                        DTSCU400
00230                                                                   DTSCU400
00231  P0100-LIAB-DETERM.                                               DTSCU400
00232      IF WRK-ORIG-DETERM-88                                        DTSCU400
00233         PERFORM P2000-ADD-MFSC-T001    THRU P2000-EXIT            DTSCU400
00234      ELSE                                                         DTSCU400
00235         IF WRK-PENDING-MFSC-88                                    DTSCU400
00236            PERFORM P3000-UPDATE-MFSC   THRU P3000-EXIT            DTSCU400
00237 *&      ELSE                                                      DTSCU400
00238 *&         PERFORM P4000-REACTIVATE    THRU P4000-EXIT            DTSCU400
00239         END-IF                                                    DTSCU400
00240      END-IF.                                                      DTSCU400
00241                                                                   DTSCU400
00242  P0100-EXIT.                                                      DTSCU400
00243      EXIT.                                                        DTSCU400
00244                                                                   DTSCU400
00245  P1000-FIND-PRIOR.                                                DTSCU400
00246      MOVE LOW-VALUES TO MFSC-KEY-AREA.                            DTSCU400
00247      MOVE WRK-EMP-NO TO MFSC-EMP-NO.                              DTSCU400
00248      SET MFSC-FSC-88 TO TRUE.                                     DTSCU400
00249      MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA.                         DTSCU400
00250      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCU400
00251      IF L810-NO-REC-88                                            DTSCU400
00252         SET WRK-ORIG-DETERM-88      TO TRUE                       DTSCU400
00253      ELSE                                                         DTSCU400
00254         MOVE ZERO                TO WRK-OPEN-CNT                  DTSCU400
00255         PERFORM P1100-SCAN-MFSC  THRU P1100-EXIT                  DTSCU400
00256            UNTIL L810-NO-REC-88                                   DTSCU400
00257               OR WRK-PENDING-MFSC-88.                             DTSCU400
00258                                                                   DTSCU400
00259      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCU400
00260                                                                   DTSCU400
00261      IF WRK-PENDING-MFSC-88                                       DTSCU400
00262      OR WRK-ORIG-DETERM-88                                        DTSCU400
00263         NEXT SENTENCE                                             DTSCU400
00264      ELSE                                                         DTSCU400
00265         IF WRK-OPEN-CNT = ZERO                                    DTSCU400
00266            SET WRK-ORIG-DETERM-88      TO TRUE                    DTSCU400
00267         ELSE                                                      DTSCU400
00268            SET WRK-REDETERM-88      TO TRUE                       DTSCU400
00269         END-IF                                                    DTSCU400
00270      END-IF.                                                      DTSCU400
00271                                                                   DTSCU400
00272      MOVE WRK-PRIOR-STATE-IND       TO L400-PRIOR-STATE-IND.      DTSCU400
00273      MOVE WRK-NOTICE-SENT-IND       TO L400-NOTICE-SENT-IND.      DTSCU400
00274                                                                   DTSCU400
00275  P1000-EXIT.                                                      DTSCU400
00276      EXIT.                                                        DTSCU400
00277                                                                   DTSCU400
00278  P1100-SCAN-MFSC.                                                 DTSCU400
00279      MOVE MSKL-REC                   TO MFSC-REC.                 DTSCU400
00280                                                                   DTSCU400
00281      IF MFSC-STATUS-PENDING-88                                    DTSCU400
00282         PERFORM P1110-PENDING        THRU P1110-EXIT              DTSCU400
00283         GO TO P1100-EXIT                                          DTSCU400
00284      ELSE                                                         DTSCU400
00285         IF MFSC-STATUS-OPEN-88                                    DTSCU400
00286            ADD +1                    TO WRK-OPEN-CNT              DTSCU400
00287            IF MFSC-START-YRQ <= WRK-START-YRQ                     DTSCU400
00288               IF MFSC-START-YRQ > WRK-PRIOR-START-YRQ             DTSCU400
00289                  MOVE MFSC-START-YRQ TO WRK-PRIOR-START-YRQ       DTSCU400
00290                  MOVE MFSC-KEY-AREA  TO WRK-PRIOR-MFSC-KEY        DTSCU400
00291               END-IF                                              DTSCU400
00292            ELSE                                                   DTSCU400
00293               IF MFSC-START-YRQ < WRK-NEXT-START-YRQ              DTSCU400
00294                  MOVE MFSC-START-YRQ TO WRK-NEXT-START-YRQ        DTSCU400
00295               END-IF                                              DTSCU400
00296            END-IF                                                 DTSCU400
00297         END-IF                                                    DTSCU400
00298      END-IF.                                                      DTSCU400
00299                                                                   DTSCU400
00300      PERFORM S810-READ-NEXT         THRU S810-EXIT.               DTSCU400
00301                                                                   DTSCU400
00302  P1100-EXIT.                                                      DTSCU400
00303      EXIT.                                                        DTSCU400
00304                                                                   DTSCU400
00305  P1110-PENDING.                                                   DTSCU400
00306      MOVE MSKL-KEY-AREA            TO WRK-PENDING-MFSC-KEY.       DTSCU400
00307                                                                   DTSCU400
00308      IF MFSC-INITIAL-MAIL-DATE > ZERO                             DTSCU400
00309         SET WRK-NOTICE-SENT-YES-88 TO TRUE                        DTSCU400
00310      END-IF.                                                      DTSCU400
00311                                                                   DTSCU400
00312      IF MFSC-STATUS-PENDING-88                                    DTSCU400
00313         SET WRK-PENDING-MFSC-88     TO TRUE.                      DTSCU400
00314                                                                   DTSCU400
00315  P1110-EXIT.                                                      DTSCU400
00316      EXIT.                                                        DTSCU400
00317                                                                   DTSCU400
00318 **************************************************************    DTSCU400
00319 *  THIS PARAGRAPH EXECUTES IN THREE SITUATIONS:                   DTSCU400
00320 *    1. WHEN DTSCU400 IS CALLED FROM SCREEN 1A TO ADD A           DTSCU400
00321 *       PENDING MFSC AND T001 REPORT TRANSACTION.                 DTSCU400
00322 *    2. WHEN DTSCU400 IS CALLED FROM SCREEN 1A TO ADD A           DTSCU400
00323 *       T001 REPORT TRANSACTION ONLY.                             DTSCU400
00324 *    3. WHEN DTSCU400 IS CALLED FROM SCREEN 1C AND THIS           DTSCU400
00325 *       IS AN ORIGINAL DETERMINATION.                             DTSCU400
00326 *                                                                 DTSCU400
00327 *    IF THIS IS AN ORIGINAL DETERMINATION, ONLY ADD AN            DTSCU400
00328 *    MFSC IF THE ORGANIZATION TYPE IS 'HOUSEHOLD.'                DTSCU400
00329 *                                                                 DTSCU400
00330 *    WHEN CALLED FROM SCREEN 1A, IF THERE IS ALREADY A PENDING    DTSCU400
00331 *    MFSC ON FILE AND THE INITIAL NOTICE DATE = ZERO, THIS IS     DTSCU400
00332 *    A REQUEST TO PRINT THE NOTICES ONLY.                         DTSCU400
00333 *                                                                 DTSCU400
00334 *    ADD A PENDING MFSC UNLESS THE EMPLOYER HAS BEEN              DTSCU400
00335 *    DETERMINED LIABLE AND INACTIVATED AT THE SAME TIME.          DTSCU400
00336 *    IN THIS CASE, ADD A QUARTERLY MFSC AND DO NOT PRINT          DTSCU400
00337 *    ANY NOTICES.                                                 DTSCU400
00338 **************************************************************    DTSCU400
00339  P2000-ADD-MFSC-T001.                                             DTSCU400
00340      IF L400-ADD-PENDING-1A-88                                    DTSCU400
00341      OR L400-DETERM-PENDING-88                                    DTSCU400
00342         IF WRK-ORIG-DETERM-88                                     DTSCU400
00343            PERFORM P2100-BUILD-MFSC    THRU P2100-EXIT            DTSCU400
00344         ELSE                                                      DTSCU400
00345            IF WRK-PENDING-MFSC-88                                 DTSCU400
00346            AND WRK-NOTICE-SENT-NO-88                              DTSCU400
00347               PERFORM P2200-NOTICE-ONLY    THRU P2200-EXIT        DTSCU400
00348            END-IF                                                 DTSCU400
00349         END-IF                                                    DTSCU400
00350      ELSE                                                         DTSCU400
00351         IF L400-ORG-HOUSEHOLD-88                                  DTSCU400
00352            PERFORM P2100-BUILD-MFSC THRU P2100-EXIT.              DTSCU400
00353                                                                   DTSCU400
00354  P2000-EXIT.                                                      DTSCU400
00355      EXIT.                                                        DTSCU400
00356                                                                   DTSCU400
00357  P2100-BUILD-MFSC.                                                DTSCU400
00358                                                                   DTSCU400
00359      PERFORM S2000-INIT-MFSC      THRU S2000-EXIT.                DTSCU400
00360                                                                   DTSCU400
00361      IF L400-ADD-PENDING-1A-88                                    DTSCU400
00362      OR L400-DETERM-PENDING-88                                    DTSCU400
00363         SET MFSC-STATUS-PENDING-88                                DTSCU400
00364                                   TO TRUE                         DTSCU400
00365         MOVE SPACES               TO MFSC-FILING-SCHEDULE-CD      DTSCU400
00366      ELSE                                                         DTSCU400
00367         SET MFSC-STATUS-OPEN-88   TO TRUE                         DTSCU400
00368         MOVE L400-FILING-SCHED    TO MFSC-FILING-SCHEDULE-CD.     DTSCU400
00369                                                                   DTSCU400
00370      IF MFSC-STATUS-OPEN-88                                       DTSCU400
00371      AND WRK-PRIOR-MFSC-KEY NOT = LOW-VALUES                      DTSCU400
00372         PERFORM P2110-CHK-DUPLICATE  THRU P2110-EXIT              DTSCU400
00373      ELSE                                                         DTSCU400
00374         MOVE MFSC-REC                TO MSKL-REC                  DTSCU400
00375         PERFORM S810-WRITE           THRU S810-EXIT.              DTSCU400
00376                                                                   DTSCU400
00377      IF L400-ADD-PENDING-1A-88                                    DTSCU400
00378      OR L400-DETERM-PENDING-88                                    DTSCU400
00379         SET WRK-POT-HOUSEHOLD-88  TO TRUE                         DTSCU400
00380         PERFORM S825-WRITE-T001   THRU S825-EXIT.                 DTSCU400
00381                                                                   DTSCU400
00382  P2100-EXIT.                                                      DTSCU400
00383      EXIT.                                                        DTSCU400
00384                                                                   DTSCU400
00385 *************************************************************     DTSCU400
00386 *  IF THERE IS AN MFSC RECORD ALREADY ON FILE WITH THE SAME       DTSCU400
00387 *  START YRQ:                                                     DTSCU400
00388 *     IF THE FILING SCHEDULES ARE THE SAME, LEAVE THE             DTSCU400
00389 *        EXISTING MFSC UNCHANGED AND WRITE AN R907 RECORD.        DTSCU400
00390 *     IF THE FILING SCHEDULES ARE DIFFERENT, CHANGE THE           DTSCU400
00391 *        FILING SCHEDULE ON THE EXISTING MFSC, REWRITE IT AND     DTSCU400
00392 *        WRITE AN R907 RECORD.                                    DTSCU400
00393 *  IF THERE IS NO PREVIOUS MFSC, ADD THE NEW RECORD.              DTSCU400
00394 *************************************************************     DTSCU400
00395  P2110-CHK-DUPLICATE.                                             DTSCU400
00396      MOVE WRK-PRIOR-MFSC-KEY       TO MSKL-KEY-AREA.              DTSCU400
00397      PERFORM S810-READ             THRU S810-EXIT                 DTSCU400
00398      IF L810-OK-88                                                DTSCU400
00399         MOVE MSKL-REC              TO MFSC-REC                    DTSCU400
00400         IF MFSC-FILING-SCHEDULE-CD = L400-FILING-SCHED            DTSCU400
00401            PERFORM P2111-ERR-MSG1  THRU P2111-EXIT                DTSCU400
00402         ELSE                                                      DTSCU400
00403            MOVE L400-FILING-SCHED  TO MFSC-FILING-SCHEDULE-CD     DTSCU400
00404            PERFORM S810-REWRITE    THRU S810-EXIT                 DTSCU400
00405            PERFORM P2112-ERR-MSG2  THRU P2112-EXIT                DTSCU400
00406         END-IF                                                    DTSCU400
00407      ELSE                                                         DTSCU400
00408         MOVE MFSC-REC                TO MSKL-REC                  DTSCU400
00409         PERFORM S810-WRITE           THRU S810-EXIT               DTSCU400
00410      END-IF.                                                      DTSCU400
00411                                                                   DTSCU400
00412  P2110-EXIT.                                                      DTSCU400
00413      EXIT.                                                        DTSCU400
00414                                                                   DTSCU400
00415  P2111-ERR-MSG1.                                                  DTSCU400
00416      MOVE '401'                      TO R907-MSG-ID.              DTSCU400
00417      MOVE WRK-R907-MSG1-LONG-TEXT    TO R907-MSG-TEXT.            DTSCU400
00418      PERFORM S825-WRITE-R907         THRU S825-EXIT.              DTSCU400
00419                                                                   DTSCU400
00420  P2111-EXIT.                                                      DTSCU400
00421      EXIT.                                                        DTSCU400
00422                                                                   DTSCU400
00423  P2112-ERR-MSG2.                                                  DTSCU400
00424      MOVE '402'                      TO R907-MSG-ID.              DTSCU400
00425      MOVE WRK-R907-MSG2-LONG-TEXT    TO R907-MSG-TEXT.            DTSCU400
00426      PERFORM S825-WRITE-R907         THRU S825-EXIT.              DTSCU400
00427                                                                   DTSCU400
00428  P2112-EXIT.                                                      DTSCU400
00429      EXIT.                                                        DTSCU400
00430                                                                   DTSCU400
00431  P2200-NOTICE-ONLY.                                               DTSCU400
00432      MOVE ZERO                       TO WRK-START-YRQ.            DTSCU400
00433      SET WRK-POT-HOUSEHOLD-88        TO TRUE                      DTSCU400
00434      PERFORM S825-WRITE-T001         THRU S825-EXIT.              DTSCU400
00435                                                                   DTSCU400
00436  P2200-EXIT.                                                      DTSCU400
00437      EXIT.                                                        DTSCU400
00438                                                                   DTSCU400
00439                                                                   DTSCU400
00440 *************************************************************     DTSCU400
00441 *  THIS PARAGRAPH UPDATES AN MFSC CREATED FROM SCREEN 1A          DTSCU400
00442 *  ONCE THE LIABILITY DATE IS KNOWN.  SINCE THE KEY CHANGES       DTSCU400
00443 *  WHEN MFSC-ABS-QTR IS UPDATED, THE RECORD MUST FIRST BE         DTSCU400
00444 *  DELETED.  THE ORIGINAL DATA REMAINS IN WORKING-STORAGE IN      DTSCU400
00445 *  THE MFSC-REC AREA.  THE PARAGRAPH UPDATES THIS DATA AND        DTSCU400
00446 *  WRITES THE NEW RECORD.                                         DTSCU400
00447 *************************************************************     DTSCU400
00448  P3000-UPDATE-MFSC.                                               DTSCU400
00449      IF WRK-PENDING-MFSC-88                                       DTSCU400
00450         NEXT SENTENCE                                             DTSCU400
00451      ELSE                                                         DTSCU400
00452         GO TO P3000-EXIT.                                         DTSCU400
00453                                                                   DTSCU400
00454      IF NOT L400-ORG-HOUSEHOLD-88                                 DTSCU400
00455      OR L400-NOT-LIAB-DETERM-88                                   DTSCU400
00456         PERFORM P3100-WITHDRAW      THRU P3100-EXIT               DTSCU400
00457      ELSE                                                         DTSCU400
00458         PERFORM P3200-UPDATE        THRU P3200-EXIT.              DTSCU400
00459                                                                   DTSCU400
00460  P3000-EXIT.                                                      DTSCU400
00461      EXIT.                                                        DTSCU400
00462                                                                   DTSCU400
00463  P3100-WITHDRAW.                                                  DTSCU400
00464      MOVE WRK-PENDING-MFSC-KEY      TO MSKL-KEY-AREA.             DTSCU400
00465      PERFORM S810-READ              THRU S810-EXIT.               DTSCU400
00466      MOVE MSKL-REC                  TO MFSC-REC.                  DTSCU400
00467                                                                   DTSCU400
00468      SET MFSC-STATUS-WITHDRAWN-88   TO TRUE.                      DTSCU400
00469      MOVE L400-CURR-RUN-DATE        TO MFSC-CHNG-DATE.            DTSCU400
00470      SET MFSC-CHNG-SYSTEM-88        TO TRUE.                      DTSCU400
00471                                                                   DTSCU400
00472      MOVE MFSC-REC                  TO MSKL-REC.                  DTSCU400
00473      PERFORM S810-REWRITE           THRU S810-EXIT.               DTSCU400
00474                                                                   DTSCU400
00475  P3100-EXIT.                                                      DTSCU400
00476      EXIT.                                                        DTSCU400
00477                                                                   DTSCU400
00478  P3200-UPDATE.                                                    DTSCU400
00479      MOVE WRK-PENDING-MFSC-KEY    TO MSKL-KEY-AREA.               DTSCU400
00480      PERFORM S810-READ            THRU S810-EXIT.                 DTSCU400
00481      MOVE MSKL-REC                  TO MFSC-REC.                  DTSCU400
00482                                                                   DTSCU400
00483      PERFORM S810-DELETE          THRU S810-EXIT.                 DTSCU400
00484                                                                   DTSCU400
00485      MOVE WRK-ABS-QTR             TO MFSC-ABS-QTR.                DTSCU400
00486      MOVE WRK-START-YRQ           TO MFSC-START-YRQ.              DTSCU400
00487                                                                   DTSCU400
00488      SET MFSC-STATUS-OPEN-88 TO TRUE.                             DTSCU400
00489      MOVE L400-FILING-SCHED  TO MFSC-FILING-SCHEDULE-CD.          DTSCU400
00490                                                                   DTSCU400
00491      MOVE L400-OP-ID              TO MFSC-CHNG-OP-ID.             DTSCU400
00492      MOVE L400-CURR-RUN-DATE      TO MFSC-CHNG-DATE.              DTSCU400
00493                                                                   DTSCU400
00494      MOVE MFSC-REC                TO MSKL-REC.                    DTSCU400
00495      PERFORM S810-WRITE           THRU S810-EXIT.                 DTSCU400
00496                                                                   DTSCU400
00497  P3200-EXIT.                                                      DTSCU400
00498      EXIT.                                                        DTSCU400
00499                                                                   DTSCU400
00500 *P4000-REACTIVATE.                                                DTSCU400
00501 *    IF L400-DELINQUENT-YES-88                                    DTSCU400
00502 *       IF MFSC-FILING-SCHED-ANN-88                               DTSCU400
00503 *          PERFORM P4100-TERMINATE-CURR-MFSC  THRU P4100-EXIT     DTSCU400
00504 *          PERFORM P4200-ADD-QTRLY            THRU P4200-EXIT     DTSCU400
00505 *          SET WRK-ADMIN-REACT-88  TO TRUE                        DTSCU400
00506 *          PERFORM S825-WRITE-T001 THRU S825-EXIT                 DTSCU400
00507 *       END-IF                                                    DTSCU400
00508 *    END-IF.                                                      DTSCU400
00509 *                                                                 DTSCU400
00510 *P4000-EXIT.                                                      DTSCU400
00511 *    EXIT.                                                        DTSCU400
00512 *                                                                 DTSCU400
00513 *P4100-TERMINATE-CURR-MFSC.                                       DTSCU400
00514 *    MOVE WRK-PRIOR-MFSC-KEY        TO MSKL-KEY-AREA.             DTSCU400
00515 *    PERFORM S810-READ              THRU S810-EXIT.               DTSCU400
00516 *    MOVE MSKL-REC                  TO MFSC-REC.                  DTSCU400
00517 *                                                                 DTSCU400
00518 *    MOVE WRK-ABS-QTR               TO L004-ABS-QTR.              DTSCU400
00519 *    SUBTRACT +1                    FROM L004-ABS-QTR.            DTSCU400
00520 *    PERFORM S004-FROM-ABS          THRU S004-EXIT.               DTSCU400
00521 *    MOVE L004-QTR-5-9              TO MFSC-END-YRQ.              DTSCU400
00522 *                                                                 DTSCU400
00523 *    MOVE L400-CURR-RUN-DATE        TO MFSC-CHNG-DATE.            DTSCU400
00524 *    SET MFSC-CHNG-SYSTEM-88        TO TRUE.                      DTSCU400
00525 *    MOVE MFSC-REC                  TO MSKL-REC.                  DTSCU400
00526 *                                                                 DTSCU400
00527 *    PERFORM S810-REWRITE           THRU S810-EXIT.               DTSCU400
00528 *                                                                 DTSCU400
00529 *P4100-EXIT.                                                      DTSCU400
00530 *    EXIT.                                                        DTSCU400
00531 *                                                                 DTSCU400
00532 *P4200-ADD-QTRLY.                                                 DTSCU400
00533 *    PERFORM S2000-INIT-MFSC      THRU S2000-EXIT.                DTSCU400
00534 *                                                                 DTSCU400
00535 *    SET MFSC-STATUS-OPEN-88      TO TRUE.                        DTSCU400
00536 *                                                                 DTSCU400
00537 *    SET MFSC-FILING-SCHED-QTR-88 TO TRUE.                        DTSCU400
00538 *                                                                 DTSCU400
00539 *    SET MFSC-REQ-ADMIN-88        TO TRUE.                        DTSCU400
00540 *                                                                 DTSCU400
00541 *    MOVE MFSC-REC                TO MSKL-REC.                    DTSCU400
00542 *    PERFORM S810-WRITE           THRU S810-EXIT.                 DTSCU400
00543 *                                                                 DTSCU400
00544 *P4200-EXIT.                                                      DTSCU400
00545 *    EXIT.                                                        DTSCU400
00546                                                                   DTSCU400
00547  P5000-ORG-TYPE-CHNG.                                             DTSCU400
00548      PERFORM S2000-INIT-MFSC        THRU S2000-EXIT.              DTSCU400
00549                                                                   DTSCU400
00550      SET MFSC-STATUS-OPEN-88        TO TRUE                       DTSCU400
00551      SET MFSC-FILING-SCHED-QTR-88   TO TRUE.                      DTSCU400
00552      SET MFSC-REQ-ORG-TYPE-88       TO TRUE.                      DTSCU400
00553                                                                   DTSCU400
00554      MOVE MFSC-REC                  TO MSKL-REC.                  DTSCU400
00555      PERFORM S810-WRITE             THRU S810-EXIT.               DTSCU400
00556                                                                   DTSCU400
00557      SET WRK-POT-HOUSEHOLD-88  TO TRUE.                           DTSCU400
00558      PERFORM S825-WRITE-T001   THRU S825-EXIT.                    DTSCU400
00559                                                                   DTSCU400
00560  P5000-EXIT.                                                      DTSCU400
00561      EXIT.                                                        DTSCU400
00562                                                                   DTSCU400
00563  S004-FROM-5.                                                     DTSCU400
00564      SET L004-FROM-5     TO TRUE.                                 DTSCU400
00565      GO TO S004-LINK.                                             DTSCU400
00566                                                                   DTSCU400
00567  S004-FROM-ABS.                                                   DTSCU400
00568      SET L004-FROM-ABS   TO TRUE.                                 DTSCU400
00569      GO TO S004-LINK.                                             DTSCU400
00570                                                                   DTSCU400
00571  S004-LINK.                                                       DTSCU400
00572      EXEC CICS LINK                                               DTSCU400
00573          PROGRAM('DTSCU004')                                      DTSCU400
00574          COMMAREA(L004-COMM-AREA)                                 DTSCU400
00575      END-EXEC.                                                    DTSCU400
00576  S004-EXIT.                                                       DTSCU400
00577      EXIT.                                                        DTSCU400
00578                                                                   DTSCU400
00579  S005-ABSTIME.                                                    DTSCU400
00580      EXEC CICS LINK                                               DTSCU400
00581          PROGRAM('DTSCU005')                                      DTSCU400
00582          COMMAREA(L005-COMM-AREA)                                 DTSCU400
00583      END-EXEC.                                                    DTSCU400
00584  S005-EXIT.                                                       DTSCU400
00585      EXIT.                                                        DTSCU400
00586                                                                   DTSCU400
00587  S810-READ.                                                       DTSCU400
00588      SET L810-READ-88 TO TRUE.                                    DTSCU400
00589      GO TO S810-IO.                                               DTSCU400
00590                                                                   DTSCU400
00591  S810-READ-UPDATE.                                                DTSCU400
00592      SET L810-READ-UPDATE-88 TO TRUE.                             DTSCU400
00593      GO TO S810-IO.                                               DTSCU400
00594                                                                   DTSCU400
00595  S810-START-BROWSE.                                               DTSCU400
00596      SET L810-START-BROWSE-88 TO TRUE.                            DTSCU400
00597      GO TO S810-IO.                                               DTSCU400
00598                                                                   DTSCU400
00599  S810-READ-NEXT.                                                  DTSCU400
00600      SET L810-READ-NEXT-88 TO TRUE.                               DTSCU400
00601      GO TO S810-IO.                                               DTSCU400
00602                                                                   DTSCU400
00603  S810-READ-PREV.                                                  DTSCU400
00604      SET L810-READ-PREV-88 TO TRUE.                               DTSCU400
00605      GO TO S810-IO.                                               DTSCU400
00606                                                                   DTSCU400
00607  S810-END-BROWSE.                                                 DTSCU400
00608      SET L810-END-BROWSE-88 TO TRUE.                              DTSCU400
00609      GO TO S810-IO.                                               DTSCU400
00610                                                                   DTSCU400
00611  S810-COUNT.                                                      DTSCU400
00612      SET L810-COUNT-88 TO TRUE.                                   DTSCU400
00613      GO TO S810-IO.                                               DTSCU400
00614                                                                   DTSCU400
00615  S810-REWRITE.                                                    DTSCU400
00616      SET L810-REWRITE-88 TO TRUE.                                 DTSCU400
00617      GO TO S810-IO.                                               DTSCU400
00618                                                                   DTSCU400
00619  S810-REWRITE-UPDATE.                                             DTSCU400
00620      SET L810-REWRITE-UPDATE-88 TO TRUE.                          DTSCU400
00621      GO TO S810-IO.                                               DTSCU400
00622                                                                   DTSCU400
00623  S810-WRITE.                                                      DTSCU400
00624      SET L810-WRITE-88  TO TRUE.                                  DTSCU400
00625      GO TO S810-IO.                                               DTSCU400
00626                                                                   DTSCU400
00627  S810-DELETE.                                                     DTSCU400
00628      SET L810-DELETE-88 TO TRUE.                                  DTSCU400
00629      GO TO S810-IO.                                               DTSCU400
00630                                                                   DTSCU400
00631  S810-IO.                                                         DTSCU400
00632      EXEC CICS LINK                                               DTSCU400
00633          PROGRAM ('DTSCU810')                                     DTSCU400
00634          COMMAREA (L810-COMM-AREA)                                DTSCU400
00635      END-EXEC.                                                    DTSCU400
00636                                                                   DTSCU400
00637  S810-EXIT.                                                       DTSCU400
00638      EXIT.                                                        DTSCU400
00639                                                                   DTSCU400
00640  S825-WRITE-T001.                                                 DTSCU400
00641      MOVE '001'                TO T001-REC-TYPE.                  DTSCU400
00642      MOVE LENGTH OF T001-REC   TO T001-LENGTH.                    DTSCU400
00643      MOVE WRK-EMP-NO           TO T001-EMP-NO.                    DTSCU400
00644      MOVE L400-OP-ID           TO T001-OP-ID                      DTSCU400
00645                                   T001-RESP-OP-ID.                DTSCU400
00646      MOVE '1A'                 TO T001-SCR-ID                     DTSCU400
00647      MOVE L005-DATE            TO T001-SYS-DATE.                  DTSCU400
00648      MOVE L005-TIME            TO T001-SYS-TIME.                  DTSCU400
00649      SET T001-HSEHLD-NOTICES   TO TRUE.                           DTSCU400
00650      MOVE WRK-T001-RPT-TYPE    TO T001-HSEHLD-RPT-TYPE.           DTSCU400
00651      MOVE WRK-START-YRQ        TO T001-HH-START-YRQ.              DTSCU400
00652      MOVE SPACES               TO T001-INACT-LTR-TYPE             DTSCU400
00653                                   T001-NOT-LIABLE-LTR-TYPE        DTSCU400
00654                                   T001-WELCOME-LTR-IND.           DTSCU400
00655      MOVE T001-REC TO RSKL-REC.                                   DTSCU400
00656                                                                   DTSCU400
00657      SET L825-WRITE-88 TO TRUE.                                   DTSCU400
00658      GO TO S825-O.                                                DTSCU400
00659                                                                   DTSCU400
00660  S825-WRITE-R907.                                                 DTSCU400
00661      MOVE LENGTH OF R907-REC         TO R907-LENGTH.              DTSCU400
00662      MOVE WRK-EMP-NO                 TO R907-EMP-NO.              DTSCU400
00663      MOVE 'DTSCU400'                 TO R907-MODULE-NAME.         DTSCU400
00664      MOVE R907-REC                   TO RSKL-REC.                 DTSCU400
00665                                                                   DTSCU400
00666      SET L825-WRITE-88 TO TRUE.                                   DTSCU400
00667      GO TO S825-O.                                                DTSCU400
00668                                                                   DTSCU400
00669  S825-O.                                                          DTSCU400
00670      EXEC CICS LINK                                               DTSCU400
00671          PROGRAM ('DTSCU825')                                     DTSCU400
00672          COMMAREA (L825-COMM-AREA)                                DTSCU400
00673      END-EXEC.                                                    DTSCU400
00674                                                                   DTSCU400
00675      IF L825-FILE-CLOSED-88                                       DTSCU400
00676         PERFORM S899-ABEND       THRU S899-EXIT.                  DTSCU400
00677                                                                   DTSCU400
00678  S825-EXIT.                                                       DTSCU400
00679      EXIT.                                                        DTSCU400
00680                                                                   DTSCU400
00681  S1000-START-YRQ.                                                 DTSCU400
00682      IF L400-ADD-PENDING-1A-88                                    DTSCU400
00683      OR L400-DETERM-PENDING-88                                    DTSCU400
00684         MOVE ZERO                TO WRK-ABS-QTR                   DTSCU400
00685                                     WRK-START-YRQ                 DTSCU400
00686         GO TO S1000-EXIT                                          DTSCU400
00687      END-IF.                                                      DTSCU400
00688                                                                   DTSCU400
00689      MOVE L400-FIRST-LIAB-YRQ    TO L004-QTR-5-9                  DTSCU400
00690      MOVE 1                      TO L004-QTR-5-Q                  DTSCU400
00691      PERFORM S004-FROM-5         THRU S004-EXIT                   DTSCU400
00692      IF L004-VALID-QTR                                            DTSCU400
00693         MOVE L004-ABS-QTR        TO WRK-ABS-QTR                   DTSCU400
00694         MOVE L004-QTR-5-9        TO WRK-START-YRQ                 DTSCU400
00695      ELSE                                                         DTSCU400
00696         PERFORM S899-ABEND       THRU S899-EXIT.                  DTSCU400
00697                                                                   DTSCU400
00698  S1000-EXIT.                                                      DTSCU400
00699      EXIT.                                                        DTSCU400
00700                                                                   DTSCU400
00701  S2000-INIT-MFSC.                                                 DTSCU400
00702      MOVE LOW-VALUE               TO MFSC-REC.                    DTSCU400
00703                                                                   DTSCU400
00704      MOVE WRK-EMP-NO              TO MFSC-EMP-NO.                 DTSCU400
00705      SET MFSC-FSC-88              TO TRUE.                        DTSCU400
00706      MOVE WRK-ABS-QTR             TO MFSC-ABS-QTR.                DTSCU400
00707      MOVE L005-ABSTIME            TO MFSC-ABSTIME.                DTSCU400
00708                                                                   DTSCU400
00709      MOVE ZERO                    TO MFSC-PURGE-DATE              DTSCU400
00710                                      MFSC-INITIAL-MAIL-DATE       DTSCU400
00711                                      MFSC-CONFIRM-MAIL-DATE       DTSCU400
00712                                      MFSC-DENIAL-MAIL-DATE.       DTSCU400
00713                                                                   DTSCU400
00714      MOVE WRK-START-YRQ           TO MFSC-START-YRQ.              DTSCU400
00715      MOVE +99999                  TO MFSC-END-YRQ.                DTSCU400
00716      SET MFSC-REQ-LIAB-DETERM-88  TO TRUE.                        DTSCU400
00717      MOVE SPACES                  TO MFSC-CHANGE-REASON-CD        DTSCU400
00718                                      MFSC-INIT-NOTICE-TYPE        DTSCU400
00719                                      MFSC-CONFIRM-NOTICE-TYPE     DTSCU400
00720                                      MFSC-DENIAL-NOTICE-TYPE.     DTSCU400
00721      MOVE L400-OP-ID              TO MFSC-CHNG-OP-ID.             DTSCU400
00722      MOVE L400-CURR-RUN-DATE      TO MFSC-ESTB-DATE               DTSCU400
00723                                      MFSC-CHNG-DATE.              DTSCU400
00724      MOVE ZERO                    TO MFSC-NOTE-CNT.               DTSCU400
00725                                                                   DTSCU400
00726                                                                   DTSCU400
00727  S2000-EXIT.                                                      DTSCU400
00728      EXIT.                                                        DTSCU400
00729                                                                   DTSCU400
00730  S899-ABEND.                                                      DTSCU400
00731      SKIP1                                                        DTSCU400
00732      EXEC CICS                                                    DTSCU400
00733          ABEND                                                    DTSCU400
00734              ABCODE (WRK-ABEND-CODE)                              DTSCU400
00735      END-EXEC.                                                    DTSCU400
00736      SKIP1                                                        DTSCU400
00737  S899-EXIT.                                                       DTSCU400
00738      EXIT.                                                        DTSCU400
