00001  IDENTIFICATION DIVISION.                                         01/14/10
00002  PROGRAM-ID.             DTSCU084.                                DTSCU084
00003  AUTHOR.                 NGC.                                        LV003
00004  DATE-WRITTEN.           DECEMBER 2009.                           DTSCU084
00005  DATE-COMPILED.                                                   DTSCU084
00006      SKIP3                                                        DTSCU084
00007 *****                                                             DTSCU084
00008 *                                                                 DTSCU084
00009 *    FUNCTION:  SCAN MEVL FOR A GIVEN EMPLOYER TO DETERMINE       DTSCU084
00010 *               WHETHER A CURRENT APPROVAL FOR A STATUS           DTSCU084
00011 *               CHANGE IS ON FILE.                                DTSCU084
00012 *                                                                 DTSCU084
00013 *                                                                 DTSCU084
00014 *    MODIFICATION LOG:                                            DTSCU084
00015 *                                                                 DTSCU084
00016 *    12/01/2009  INITIAL DEVELOPMENT.                             DTSCU084
00017 *                WORK ORDER:                    PROGRAMMER: GD    DTSCU084
00018 *                                                                 DTSCU084
00019 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU084
00020 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU084
00021 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU084
00022 *                                                                 DTSCU084
00023 *                                                                 DTSCU084
00024 *  DESCRIPTION:                                                   DTSCU084
00025 *                                                                 DTSCU084
00026 *      BROWSE MEVL RECORDS TO FIND ONE WHERE                      DTSCU084
00027 *      MEVL-BA-STATUS-APPRV-88 IS TRUE AND MEVL-DATE IS           DTSCU084
00028 *      WITHIN 2 DAYS OF THE CURRENT RUN DATE.                     DTSCU084
00029 *      IF FOUND, RETURN THE DOCUMENT ID OF THE DOCUMENT SET       DTSCU084
00030 *      FOR THE STATUS CHANGE STORED ON THE SERVER DATABASE.       DTSCU084
00031 *                                                                 DTSCU084
00032 *                                                                 DTSCU084
00033 *      MASTER FILE RECORDS READ:                                  DTSCU084
00034 *                                                                 DTSCU084
00035 *        MEVL                                                     DTSCU084
00036 *                                                                 DTSCU084
00037 *                                                                 DTSCU084
00038 *      MASTER FILE RECORDS UPDATED:                               DTSCU084
00039 *                                                                 DTSCU084
00040 *        NONE.                                                    DTSCU084
00041 *                                                                 DTSCU084
00042 *                                                                 DTSCU084
00043 *      REFERENCE FILE RECORDS READ:                               DTSCU084
00044 *                                                                 DTSCU084
00045 *        NONE                                                     DTSCU084
00046 *                                                                 DTSCU084
00047 *                                                                 DTSCU084
00048 *      REPORT RECORDS WRITTEN:                                    DTSCU084
00049 *                                                                 DTSCU084
00050 *        NONE                                                     DTSCU084
00051 *                                                                 DTSCU084
00052 *                                                                 DTSCU084
00053 *      MODULES CALLED:                                            DTSCU084
00054 *                                                                 DTSCU084
00055 *        DTSCU004 QUARTER EDIT/CONVERSION.                        DTSCU084
00056 *        DTSCU810 MASTER FILE I/O.                                DTSCU084
00057 *                                                                 DTSCU084
00058 *                                                                 DTSCU084
00059 *****                                                             DTSCU084
00060      SKIP3                                                        DTSCU084
00061  ENVIRONMENT DIVISION.                                            DTSCU084
00062      EJECT                                                        DTSCU084
00063  DATA DIVISION.                                                   DTSCU084
00064      SKIP3                                                        DTSCU084
00065  WORKING-STORAGE SECTION.                                         DTSCU084
000655 77  PAN-VALET PICTURE X(24) VALUE '003DTSCU084  01/14/10'.       DTSCU084
00066      SKIP3                                                        DTSCU084
00067  01  WRK-AREA.                                                    DTSCU084
00068      05  W-ABEND-CD                  PIC  X(04)  VALUE 'U084'.    DTSCU084
00069                                                                   DTSCU084
00070      05  W-CUTOFF-DATE               PIC S9(09)  COMP-3           DTSCU084
00071                                       VALUE +0.                   DTSCU084
00072                                                                   DTSCU084
00073  01  L810-LINK-AREA.                                              DTSCU084
00074      05  L810-CONTROL-BLOCK.                                      DTSCU084
00075  ++INCLUDE DTSIL810                                               DTSCU084
00076      SKIP3                                                        DTSCU084
00077      05  MSKL-REC.                                                DTSCU084
00078  ++INCLUDE DTSIMSKL                                               DTSCU084
00079      EJECT                                                        DTSCU084
00080  01  MEVL-REC.                                                    DTSCU084
00081  ++INCLUDE DTSIMEVL                                               DTSCU084
00082                                                                   DTSCU084
00083  01  L001-LINK-AREA.                                              DTSCU084
00084  ++INCLUDE DTSIL001                                               DTSCU084
00085                                                                   DTSCU084
00086  01  L003-LINK-AREA.                                              DTSCU084
00087  ++INCLUDE DTSIL003                                               DTSCU084
00088                                                                   DTSCU084
00089  LINKAGE SECTION.                                                 DTSCU084
00090                                                                   DTSCU084
00091  01  DFHCOMMAREA.                                                 DTSCU084
00092  ++INCLUDE DTSIL084                                               DTSCU084
00093      EJECT                                                        DTSCU084
00094  PROCEDURE DIVISION.                                              DTSCU084
00095                                                                   DTSCU084
00096      SET L084-NOT-FOUND-88   TO TRUE.                             DTSCU084
00097                                                                   DTSCU084
00098      MOVE +0 TO L084-DOC-ID.                                      DTSCU084
00099                                                                   DTSCU084
00100      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSCU084
00101                                                                   DTSCU084
00102                                                                   DTSCU084
00103  MAINLINE-RETURN.                                                 DTSCU084
00104      EXEC CICS                                                    DTSCU084
00105          RETURN                                                   DTSCU084
00106      END-EXEC.                                                    DTSCU084
00107                                                                   DTSCU084
00108                                                                   DTSCU084
00109      GOBACK.                                                      DTSCU084
00110      EJECT                                                        DTSCU084
00111  P0000-PROCESS.                                                   DTSCU084
00112      PERFORM P1000-CUTOFF-DATE  THRU P1000-EXIT.                  DTSCU084
00113                                                                   DTSCU084
00114      PERFORM P2000-SCAN-MEVL    THRU P2000-EXIT.                  DTSCU084
00115                                                                   DTSCU084
00116  P0000-EXIT.                                                      DTSCU084
00117      EXIT.                                                        DTSCU084
00118                                                                   DTSCU084
00119  P1000-CUTOFF-DATE.                                               DTSCU084
00120      MOVE L084-CURR-RUN-DATE          TO L001-FED-8-DATE-9.       DTSCU084
00121      SET L001-FROM-FED-8              TO TRUE.                    DTSCU084
00122      PERFORM S001-DATE-CONVERT        THRU S001-EXIT.             DTSCU084
00123      IF L001-VALID-DATE                                           DTSCU084
00124         SUBTRACT +2                   FROM L001-JUL-ABS-DAY       DTSCU084
00125         SET L001-FROM-ABS-DAY         TO TRUE                     DTSCU084
00126         PERFORM S001-DATE-CONVERT     THRU S001-EXIT              DTSCU084
00127         SET L003-NOT-WORK-DAY         TO TRUE                     DTSCU084
00128         PERFORM P1100-WORK-DAY-LOOP   THRU P1100-EXIT             DTSCU084
00129             UNTIL L003-IS-WORK-DAY                                DTSCU084
00130         MOVE L001-FED-8-DATE-9        TO W-CUTOFF-DATE            DTSCU084
00131      END-IF.                                                      DTSCU084
00132                                                                   DTSCU084
00133  P1000-EXIT.                                                      DTSCU084
00134      EXIT.                                                        DTSCU084
00135                                                                   DTSCU084
00136  P1100-WORK-DAY-LOOP.                                             DTSCU084
00137      MOVE L001-FED-8-DATE-9           TO L003-DATE.               DTSCU084
00138      PERFORM S003-AGENCY-DAY          THRU S003-EXIT.             DTSCU084
00139                                                                   DTSCU084
00140      IF L003-NOT-WORK-DAY                                         DTSCU084
00141         SUBTRACT +1                   FROM L001-JUL-ABS-DAY       DTSCU084
00142         SET L001-FROM-ABS-DAY         TO TRUE                     DTSCU084
00143         PERFORM S001-DATE-CONVERT     THRU S001-EXIT              DTSCU084
00144      END-IF.                                                      DTSCU084
00145                                                                   DTSCU084
00146  P1100-EXIT.                                                      DTSCU084
00147      EXIT.                                                        DTSCU084
00148                                                                   DTSCU084
00149  P2000-SCAN-MEVL.                                                 DTSCU084
00150      MOVE LOW-VALUES                  TO MEVL-KEY-AREA.           DTSCU084
00151      MOVE L084-EMP-NO                 TO MEVL-EMP-NO.             DTSCU084
00152      SET MEVL-EVL-88                  TO TRUE.                    DTSCU084
00153      MOVE W-CUTOFF-DATE               TO MEVL-DATE.               DTSCU084
00154      MOVE +0                          TO MEVL-TIME.               DTSCU084
00155      MOVE MEVL-KEY-AREA               TO MSKL-KEY-AREA.           DTSCU084
00156                                                                   DTSCU084
00157      PERFORM S810-START-BROWSE        THRU S810-EXIT.             DTSCU084
00158      IF L810-OK-88                                                DTSCU084
00159         PERFORM P2100-CHECK-MEVL      THRU P2100-EXIT             DTSCU084
00160            UNTIL L810-NO-REC-88                                   DTSCU084
00161         PERFORM S810-END-BROWSE       THRU S810-EXIT              DTSCU084
00162      END-IF.                                                      DTSCU084
00163                                                                   DTSCU084
00164  P2000-EXIT.                                                      DTSCU084
00165      EXIT.                                                        DTSCU084
00166                                                                   DTSCU084
00167  P2100-CHECK-MEVL.                                                DTSCU084
00168      MOVE MSKL-REC                         TO MEVL-REC.           DTSCU084
00169      IF MEVL-BA-STATUS-APPRV-88                                   DTSCU084
00170         SET L084-VALID-APPROVAL-88         TO TRUE                DTSCU084
00171      END-IF.                                                      DTSCU084
00172 **   IF MEVL-BA-STATUS-APPRV-88                                   DTSCU084
00173 *       EVALUATE TRUE                                             DTSCU084
00174 *         WHEN L084-SUCCESSOR-88                                  DTSCU084
00175 *           IF MEVL-ACT-APPRV-SUCC-88                             DTSCU084
00176 *             SET L084-VALID-APPROVAL-88   TO TRUE                DTSCU084
00177 *           END-IF                                                DTSCU084
00178 *                                                                 DTSCU084
00179 *         WHEN L084-SOL-CHANGE-88                                 DTSCU084
00180 *           IF MEVL-ACT-APPRV-INACT-88                            DTSCU084
00181 *             SET L084-VALID-APPROVAL-88   TO TRUE                DTSCU084
00182 *           END-IF                                                DTSCU084
00183 *                                                                 DTSCU084
00184 *         WHEN L084-RATE-CHANGE-88                                DTSCU084
00185 *           IF MEVL-ACT-APPRV-RATE-88                             DTSCU084
00186 *             SET L084-VALID-APPROVAL-88   TO TRUE                DTSCU084
00187 *           END-IF                                                DTSCU084
00188 *                                                                 DTSCU084
00189 *       END-EVALUATE                                              DTSCU084
00190 **   END-IF.                                                      DTSCU084
00191                                                                   DTSCU084
00192      IF L084-VALID-APPROVAL-88                                    DTSCU084
00193         SET L810-NO-REC-88               TO TRUE                  DTSCU084
00194      ELSE                                                         DTSCU084
00195         PERFORM S810-READ-NEXT           THRU S810-EXIT           DTSCU084
00196      END-IF.                                                      DTSCU084
00197                                                                   DTSCU084
00198  P2100-EXIT.                                                      DTSCU084
00199      EXIT.                                                        DTSCU084
00200                                                                   DTSCU084
00201  S001-DATE-CONVERT.                                               DTSCU084
00202      EXEC CICS                                                    DTSCU084
00203         LINK                                                      DTSCU084
00204            PROGRAM ('DTSCU001')                                   DTSCU084
00205            COMMAREA (L001-LINK-AREA)                              DTSCU084
00206      END-EXEC.                                                    DTSCU084
00207                                                                   DTSCU084
00208  S001-EXIT.                                                       DTSCU084
00209      EXIT.                                                        DTSCU084
00210                                                                   DTSCU084
00211  S003-AGENCY-DAY.                                                 DTSCU084
00212      SET L003-AGENCY-DAY    TO TRUE.                              DTSCU084
00213      EXEC CICS                                                    DTSCU084
00214         LINK                                                      DTSCU084
00215            PROGRAM ('DTSCU003')                                   DTSCU084
00216            COMMAREA (L003-LINK-AREA)                              DTSCU084
00217      END-EXEC.                                                    DTSCU084
00218                                                                   DTSCU084
00219  S003-EXIT.                                                       DTSCU084
00220      EXIT.                                                        DTSCU084
00221                                                                   DTSCU084
00222  S810-READ.                                                       DTSCU084
00223      SET L810-READ-88 TO TRUE.                                    DTSCU084
00224      GO TO S810-IO.                                               DTSCU084
00225                                                                   DTSCU084
00226  S810-START-BROWSE.                                               DTSCU084
00227      SET L810-START-BROWSE-88 TO TRUE.                            DTSCU084
00228      GO TO S810-IO.                                               DTSCU084
00229                                                                   DTSCU084
00230  S810-READ-NEXT.                                                  DTSCU084
00231      SET L810-READ-NEXT-88 TO TRUE.                               DTSCU084
00232      GO TO S810-IO.                                               DTSCU084
00233                                                                   DTSCU084
00234  S810-END-BROWSE.                                                 DTSCU084
00235      SET L810-END-BROWSE-88 TO TRUE.                              DTSCU084
00236      GO TO S810-IO.                                               DTSCU084
00237                                                                   DTSCU084
00238  S810-IO.                                                         DTSCU084
00239      EXEC CICS                                                    DTSCU084
00240          LINK                                                     DTSCU084
00241              PROGRAM ('DTSCU810')                                 DTSCU084
00242              COMMAREA (L810-LINK-AREA)                            DTSCU084
00243      END-EXEC.                                                    DTSCU084
00244                                                                   DTSCU084
00245      IF L810-FILE-CLOSED-88                                       DTSCU084
00246          SET L084-FILE-CLOSED-88 TO TRUE                          DTSCU084
00247          GO TO MAINLINE-RETURN.                                   DTSCU084
00248  S810-EXIT.                                                       DTSCU084
00249      EXIT.                                                        DTSCU084
00250      SKIP3                                                        DTSCU084
00251  S899-ABEND.                                                      DTSCU084
00252      EXEC CICS                                                    DTSCU084
00253          ABEND                                                    DTSCU084
00254              ABCODE (W-ABEND-CD)                                  DTSCU084
00255      END-EXEC.                                                    DTSCU084
00256  S899-EXIT.                                                       DTSCU084
00257      EXIT.                                                        DTSCU084
