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