00001  IDENTIFICATION DIVISION.                                         09/09/98
00002  PROGRAM-ID.             DTSCU202.                                DTSCU202
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           DECEMBER 1991.                           DTSCU202
00005  DATE-COMPILED.                                                   DTSCU202
00006      SKIP3                                                        DTSCU202
00007 *****                                                             DTSCU202
00008 *                                                                 DTSCU202
00009 *    FUNCTION:  DETERMINE ELIGIBLE CODE.                          DTSCU202
00010 *                                                                 DTSCU202
00011 *                                                                 DTSCU202
00012 *    MODIFICATION LOG:                                            DTSCU202
00013 *                                                                 DTSCU202
00014 *    12/01/91  INITIAL DEVELOPMENT.                               DTSCU202
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU202
00016 *                                                                 DTSCU202
00017 *    04/07/94  MODIFIED FOR MONATANA.                             DTSCU202
00018 *              WORK ORDER:                      PROGRAMMER: RHC   DTSCU202
00019 *                                                                 DTSCU202
00020 *    09/09/1998  REVIEWED AND MODIFIED FOR DC.                       CL**2
00021 *                                                                    CL**2
00022 *                UNLIKE MONTANA, IN DC DTSCU202 DOES NOT             CL**2
00023 *                ASSIGN ELIGIBLE-CD VALUES TO "CHARGING ONLY"        CL**2
00024 *                EMPLOYERS.                                          CL**2
00025 *                                                                    CL**2
00026 *                IN DC, ASSIGNMENT OF ELIGIBLE-CD VALUES TO          CL**2
00027 *                "CHARGING ONLY" EMPLOYERS OCCURS IN DTSCS1A.        CL**2
00028 *                                                                    CL**2
00029 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00030 *                                                                    CL**2
00031 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00032 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00033 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00034 *                                                                 DTSCU202
00035 *                                                                 DTSCU202
00036 *  DESCRIPTION:                                                   DTSCU202
00037 *                                                                 DTSCU202
00038 *    DETERMINE L202-ELIGIBLE-CD BASED ON L202-EMP-NO              DTSCU202
00039 *    AND L202-EMP-CLASS.                                          DTSCU202
00040 *                                                                 DTSCU202
00041 *    SEE MPRF-ELIGIBLE-CD DATA ELEMENT DEFINITION FOR DETAILS.    DTSCU202
00042 *                                                                 DTSCU202
00043 *****                                                             DTSCU202
00044      SKIP3                                                        DTSCU202
00045  ENVIRONMENT DIVISION.                                            DTSCU202
00046      SKIP3                                                        DTSCU202
00047  DATA DIVISION.                                                   DTSCU202
00048      SKIP3                                                        DTSCU202
00049  WORKING-STORAGE SECTION.                                         DTSCU202
000495 77  PAN-VALET PICTURE X(24) VALUE '002DTSCU202  09/09/98'.       DTSCU202
00050      SKIP3                                                        DTSCU202
00051  01  WRK-AREA.                                                    DTSCU202
00052      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U202'.    DTSCU202
00053                                                                      CL**2
00054      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU202
00055      EJECT                                                        DTSCU202
00056  LINKAGE SECTION.                                                 DTSCU202
00057      SKIP3                                                        DTSCU202
00058  01  DFHCOMMAREA.                                                 DTSCU202
00059  ++INCLUDE DTSIL202                                                  CL**2
00060      EJECT                                                        DTSCU202
00061  PROCEDURE DIVISION.                                              DTSCU202
00062                                                                      CL**2
00063      IF L202-EMP-CLASS = 'R'                                         CL**2
00064          MOVE 000 TO L202-ELIGIBLE-CD                                CL**2
00065      ELSE                                                            CL**2
00066      IF L202-EMP-CLASS = 'S'                                         CL**2
00067          MOVE 008 TO L202-ELIGIBLE-CD                                CL**2
00068      ELSE                                                            CL**2
00069      IF L202-EMP-CLASS = 'U'                                         CL**2
00070          MOVE 013 TO L202-ELIGIBLE-CD                                CL**2
00071      ELSE                                                            CL**2
00072          GO TO S899-ABEND                                            CL**2
00073                                                                      CL**2
00074                                                                      CL**2
00075      EXEC CICS                                                    DTSCU202
00076          RETURN                                                   DTSCU202
00077      END-EXEC.                                                    DTSCU202
00078      SKIP2                                                        DTSCU202
00079      GOBACK.                                                      DTSCU202
00080      SKIP3                                                        DTSCU202
00081  S899-ABEND.                                                      DTSCU202
00082                                                                      CL**2
00083      EXEC CICS                                                    DTSCU202
00084          ABEND                                                    DTSCU202
00085              ABCODE (WRK-ABEND-CD)                                DTSCU202
00086      END-EXEC.                                                    DTSCU202
00087                                                                      CL**2
00088  S899-EXIT.                                                       DTSCU202
00089      EXIT.                                                        DTSCU202
