00001  IDENTIFICATION DIVISION.                                         02/02/99
00002  PROGRAM-ID.             DTSBU038.                                DTSBU038
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           MARCH 1994.                              DTSBU038
00005  DATE-COMPILED.                                                   DTSBU038
00006      SKIP3                                                        DTSBU038
00007 *****                                                             DTSBU038
00008 *                                                                 DTSBU038
00009 *    FUNCTION:  R&A CODES EDIT/DESCRIPTION.                       DTSBU038
00010 *                                                                 DTSBU038
00011 *                                                                 DTSBU038
00012 *    MODIFICATION LOG:                                            DTSBU038
00013 *                                                                 DTSBU038
00014 *    03/22/91  INITIAL DEVELOPMENT.                               DTSBU038
00015 *              WORK ORDER:                      PROGRAMMER: EHH   DTSBU038
00016 *                                                                 DTSBU038
00017 *    02/02/1999  REVIEWED AND MODIFIED FOR DC.                       CL**2
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00019 *                                                                    CL**2
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00023 *                                                                 DTSBU038
00024 *                                                                 DTSBU038
00025 *    DESCRIPTION:                                                 DTSBU038
00026 *                                                                 DTSBU038
00027 *    DTSCU038 EDITS LMI CODES AND INDICATORS.                        CL**2
00028 *                                                                 DTSBU038
00029 *    DTSCU038 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION        CL**2
00030 *    OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE        DTSBU038
00031 *    VALUE.                                                       DTSBU038
00032 *                                                                 DTSBU038
00033 *    IF L038-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN     DTSBU038
00034 *    ABEND CODE OF 'U038'.                                        DTSBU038
00035 *                                                                 DTSBU038
00036 *    GO TO DEPENDING ON L038-OPTION TO GET TO THE PARAGRAPH       DTSBU038
00037 *    THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED      DTSBU038
00038 *    BY L038-OPTION.  USE A SEARCH STATEMENT TO DETERMINE THE     DTSBU038
00039 *    VALIDITY OF L038-CD-*.                                       DTSBU038
00040 *                                                                 DTSBU038
00041 *    IF L038-CD-* IS A VALID VALUE                                DTSBU038
00042 *        MOVE '1' TO L038-RESULT-IND                              DTSBU038
00043 *        MOVE THE APPROPRIATE C038-*-SHORT-DSCR                   DTSBU038
00044 *          TO L038-SHORT-DSCR                                     DTSBU038
00045 *        MOVE THE APPROPRIATE C038-*-LONG-DSCR                    DTSBU038
00046 *          TO L038-LONG-DSCR                                      DTSBU038
00047 *    ELSE                                                         DTSBU038
00048 *        MOVE '2' TO L038-RESULT-IND                              DTSBU038
00049 *        MOVE 'NOT VALID' TO L038-SHORT-DSCR                      DTSBU038
00050 *                            L038-LONG-DSCR.                      DTSBU038
00051 *                                                                 DTSBU038
00052 *                                                                 DTSBU038
00053 *****                                                             DTSBU038
00054      SKIP3                                                        DTSBU038
00055  ENVIRONMENT DIVISION.                                            DTSBU038
00056      SKIP3                                                        DTSBU038
00057  DATA DIVISION.                                                   DTSBU038
00058      SKIP3                                                        DTSBU038
00059  WORKING-STORAGE SECTION.                                         DTSBU038
000595 77  PAN-VALET PICTURE X(24) VALUE '004DTSBU038  02/02/99'.       DTSBU038
00060      SKIP3                                                        DTSBU038
00061  01  WRK-AREA.                                                    DTSBU038
00062      05  WRK-ABEND-CODE              PIC S9(04)  COMP VALUE +038.    CL**4
00063                                                                      CL**2
00064      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSBU038
00065      EJECT                                                        DTSBU038
00066  01  C038-LITERALS.                                               DTSBU038
00067  ++INCLUDE DTSIC038                                                  CL**2
00068      EJECT                                                        DTSBU038
00069  LINKAGE SECTION.                                                 DTSBU038
00070      SKIP3                                                        DTSBU038
00071  01  L038-LINK-AREA.                                                 CL**4
00072  ++INCLUDE DTSIL038                                                  CL**2
00073      EJECT                                                        DTSBU038
00074  PROCEDURE DIVISION USING L038-LINK-AREA.                            CL**4
00075                                                                      CL**2
00076                                                                      CL**2
00077      SET L038-NOT-VALID TO TRUE.                                     CL**2
00078                                                                      CL**2
00079                                                                      CL**2
00080      MOVE 'NOT VALID' TO L038-SHORT-DSCR                          DTSBU038
00081                          L038-LONG-DSCR.                          DTSBU038
00082                                                                      CL**2
00083                                                                      CL**2
00084      PERFORM P1000-PROCESS THRU P1000-EXIT.                       DTSBU038
00085                                                                      CL**2
00086                                                                      CL**2
00087      GOBACK.                                                      DTSBU038
00088      EJECT                                                        DTSBU038
00089  P1000-PROCESS.                                                   DTSBU038
00090      GO TO P1000-01-02                                               CL**2
00091            P1000-01-02                                               CL**2
00092            P1000-03                                               DTSBU038
00093            P1000-04                                               DTSBU038
00094            P1000-05                                                  CL**2
00095          DEPENDING ON L038-OPTION.                                DTSBU038
00096                                                                      CL**2
00097      PERFORM S999-ABEND THRU S999-EXIT.                              CL**4
00098                                                                      CL**3
00099                                                                      CL**3
00100  P1000-01-02.                                                        CL**2
00101      SET C038-01-02-IDX TO 1.                                        CL**2
00102                                                                      CL**2
00103      SEARCH C038-01-02-ENTRY                                         CL**2
00104         VARYING                                                   DTSBU038
00105           C038-01-02-IDX                                             CL**2
00106          WHEN L038-CD-1 = C038-01-02-CD (C038-01-02-IDX)             CL**3
00107              SET L038-VALID TO TRUE                                  CL**2
00108              MOVE C038-01-02-SHORT-DSCR (C038-01-02-IDX)             CL**2
00109                TO L038-SHORT-DSCR                                 DTSBU038
00110                  MOVE C038-01-02-LONG-DSCR (C038-01-02-IDX)          CL**2
00111                    TO L038-LONG-DSCR.                             DTSBU038
00112                                                                      CL**2
00113      GO TO P1000-EXIT.                                            DTSBU038
00114                                                                      CL**3
00115                                                                      CL**3
00116  P1000-03.                                                           CL**2
00117      SET C038-03-IDX TO 1.                                           CL**2
00118                                                                      CL**2
00119      SEARCH C038-03-ENTRY                                            CL**2
00120         VARYING                                                   DTSBU038
00121           C038-03-IDX                                                CL**2
00122          WHEN L038-CD-2 = C038-03-CD (C038-03-IDX)                   CL**3
00123              SET L038-VALID TO TRUE                                  CL**2
00124              MOVE C038-03-SHORT-DSCR (C038-03-IDX)                   CL**2
00125                TO L038-SHORT-DSCR                                 DTSBU038
00126                  MOVE C038-03-LONG-DSCR (C038-03-IDX)                CL**2
00127                    TO L038-LONG-DSCR.                             DTSBU038
00128                                                                      CL**2
00129      GO TO P1000-EXIT.                                            DTSBU038
00130                                                                      CL**3
00131                                                                      CL**3
00132  P1000-04.                                                           CL**2
00133      SET C038-04-IDX TO 1.                                           CL**2
00134                                                                      CL**2
00135      SEARCH C038-04-ENTRY                                            CL**2
00136         VARYING                                                   DTSBU038
00137           C038-04-IDX                                                CL**2
00138          WHEN L038-CD-1 = C038-04-CD (C038-04-IDX)                   CL**2
00139              SET L038-VALID TO TRUE                                  CL**2
00140              MOVE C038-04-SHORT-DSCR (C038-04-IDX)                   CL**2
00141                TO L038-SHORT-DSCR                                 DTSBU038
00142                  MOVE C038-04-LONG-DSCR (C038-04-IDX)                CL**2
00143                    TO L038-LONG-DSCR.                             DTSBU038
00144                                                                      CL**2
00145      GO TO P1000-EXIT.                                            DTSBU038
00146                                                                      CL**3
00147                                                                      CL**3
00148  P1000-05.                                                           CL**2
00149      SET C038-05-IDX TO 1.                                           CL**2
00150                                                                      CL**2
00151      SEARCH C038-05-ENTRY                                            CL**2
00152         VARYING                                                   DTSBU038
00153           C038-05-IDX                                                CL**2
00154          WHEN L038-CD-2 = C038-05-CD (C038-05-IDX)                   CL**2
00155              SET L038-VALID TO TRUE                                  CL**2
00156              MOVE C038-05-SHORT-DSCR (C038-05-IDX)                   CL**2
00157                TO L038-SHORT-DSCR                                 DTSBU038
00158                  MOVE C038-05-LONG-DSCR (C038-05-IDX)                CL**2
00159                    TO L038-LONG-DSCR.                             DTSBU038
00160                                                                      CL**2
00161      GO TO P1000-EXIT.                                            DTSBU038
00162                                                                      CL**2
00163                                                                      CL**2
00164  P1000-EXIT.                                                      DTSBU038
00165      EXIT.                                                        DTSBU038
00166      EJECT                                                        DTSBU038
00167  S999-ABEND.                                                         CL**4
00168      CALL 'DTSBU999' USING WRK-ABEND-CODE.                           CL**4
00169  S999-EXIT.                                                          CL**4
00170      EXIT.                                                        DTSBU038
