00001  IDENTIFICATION DIVISION.                                         11/04/98
00002  PROGRAM-ID.             DTSCU037.                                DTSCU037
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           MARCH 1994.                              DTSCU037
00005  DATE-COMPILED.                                                   DTSCU037
00006      SKIP3                                                        DTSCU037
00007 *****                                                             DTSCU037
00008 *                                                                 DTSCU037
00009 *    FUNCTION:  MISCELLANEOUS CODES EDIT/DESCRIPTION.             DTSCU037
00010 *                                                                 DTSCU037
00011 *                                                                 DTSCU037
00012 *    MODIFICATION LOG:                                            DTSCU037
00013 *                                                                 DTSCU037
00014 *    03/28/94  INITIAL DEVELOPMENT.                               DTSCU037
00015 *              WORK ORDER:                      PROGRAMMER: RHC   DTSCU037
00016 *                                                                 DTSCU037
00017 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU037
00018 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU037
00019 *              WORK ORDER:                      PROGRAMMER: XXX   DTSCU037
00020 *                                                                 DTSCU037
00021 *                                                                 DTSCU037
00022 *    DESCRIPTION:                                                 DTSCU037
00023 *                                                                 DTSCU037
00024 *    DTSCU037 EDITS MISCELLANEOUS CODES AND INDICATORS.              CL**2
00025 *                                                                 DTSCU037
00026 *    DTSCU037 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION        CL**2
00027 *    OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE        DTSCU037
00028 *    VALUE.                                                       DTSCU037
00029 *                                                                 DTSCU037
00030 *    IF L037-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN     DTSCU037
00031 *    ABEND CODE OF 'U037'.                                        DTSCU037
00032 *                                                                 DTSCU037
00033 *    GO TO DEPENDING ON L037-OPTION TO GET TO THE PARAGRAPH       DTSCU037
00034 *    THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED      DTSCU037
00035 *    BY L037-OPTION.  USE A SEARCH STATEMENT TO DETERMINE THE     DTSCU037
00036 *    VALIDITY OF L037-CD-*.                                       DTSCU037
00037 *                                                                 DTSCU037
00038 *    IF L037-CD-* IS A VALID VALUE                                DTSCU037
00039 *        MOVE '1' TO L037-RESULT-IND                              DTSCU037
00040 *        MOVE THE APPROPRIATE C037-*-SHORT-DSCR                   DTSCU037
00041 *          TO L037-SHORT-DSCR                                     DTSCU037
00042 *        MOVE THE APPROPRIATE C037-*-LONG-DSCR                    DTSCU037
00043 *          TO L037-LONG-DSCR                                      DTSCU037
00044 *    ELSE                                                         DTSCU037
00045 *        MOVE '2' TO L037-RESULT-IND                              DTSCU037
00046 *        MOVE 'NOT VALID' TO L037-SHORT-DSCR                      DTSCU037
00047 *                            L037-LONG-DSCR.                      DTSCU037
00048 *                                                                 DTSCU037
00049 *****                                                             DTSCU037
00050      SKIP3                                                        DTSCU037
00051  ENVIRONMENT DIVISION.                                            DTSCU037
00052      SKIP3                                                        DTSCU037
00053  DATA DIVISION.                                                   DTSCU037
00054      SKIP3                                                        DTSCU037
00055  WORKING-STORAGE SECTION.                                         DTSCU037
000555 77  PAN-VALET PICTURE X(24) VALUE '002DTSCU037  11/04/98'.       DTSCU037
00056      SKIP3                                                        DTSCU037
00057  01  WRK-AREA.                                                    DTSCU037
00058      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U037'.    DTSCU037
00059      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSCU037
00060      EJECT                                                        DTSCU037
00061  01  C037-LITERALS.                                               DTSCU037
00062  ++INCLUDE DTSIC037                                                  CL**2
00063      EJECT                                                        DTSCU037
00064  LINKAGE SECTION.                                                 DTSCU037
00065      SKIP3                                                        DTSCU037
00066  01  DFHCOMMAREA.                                                 DTSCU037
00067  ++INCLUDE DTSIL037                                                  CL**2
00068      EJECT                                                        DTSCU037
00069  PROCEDURE DIVISION.                                              DTSCU037
00070      SKIP2                                                        DTSCU037
00071      MOVE '2' TO L037-RESULT-IND.                                 DTSCU037
00072      MOVE 'NOT VALID' TO L037-SHORT-DSCR                          DTSCU037
00073                          L037-LONG-DSCR.                          DTSCU037
00074      PERFORM P1000-PROCESS THRU P1000-EXIT.                       DTSCU037
00075      SKIP2                                                        DTSCU037
00076      EXEC CICS                                                    DTSCU037
00077          RETURN                                                   DTSCU037
00078      END-EXEC.                                                    DTSCU037
00079      SKIP2                                                        DTSCU037
00080      GOBACK.                                                      DTSCU037
00081      EJECT                                                        DTSCU037
00082  P1000-PROCESS.                                                   DTSCU037
00083      GO TO P1000-01                                               DTSCU037
00084          DEPENDING ON L037-OPTION.                                DTSCU037
00085      SKIP1                                                        DTSCU037
00086      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU037
00087      SKIP3                                                        DTSCU037
00088  P1000-01.                                                        DTSCU037
00089      SET C037-01-IDX TO 1.                                        DTSCU037
00090      SEARCH C037-01-ENTRY                                         DTSCU037
00091         VARYING                                                   DTSCU037
00092           C037-01-IDX                                             DTSCU037
00093          WHEN L037-CD-3 = C037-01-CD (C037-01-IDX)                DTSCU037
00094              MOVE '1' TO L037-RESULT-IND                          DTSCU037
00095              MOVE C037-01-SHORT-DSCR (C037-01-IDX)                DTSCU037
00096                TO L037-SHORT-DSCR                                 DTSCU037
00097              MOVE C037-01-LONG-DSCR (C037-01-IDX)                 DTSCU037
00098                TO L037-LONG-DSCR.                                 DTSCU037
00099      SKIP1                                                        DTSCU037
00100      GO TO P1000-EXIT.                                            DTSCU037
00101      SKIP3                                                        DTSCU037
00102  P1000-EXIT.                                                      DTSCU037
00103      EXIT.                                                        DTSCU037
00104      EJECT                                                        DTSCU037
00105  S899-ABEND.                                                      DTSCU037
00106      SKIP1                                                        DTSCU037
00107      EXEC CICS                                                    DTSCU037
00108          ABEND                                                    DTSCU037
00109              ABCODE (WRK-ABEND-CODE)                              DTSCU037
00110      END-EXEC.                                                    DTSCU037
00111      SKIP1                                                        DTSCU037
00112  S899-EXIT.                                                       DTSCU037
00113      EXIT.                                                        DTSCU037
