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