00001  IDENTIFICATION DIVISION.                                         03/22/99
00002  PROGRAM-ID.             DTSBU034.                                DTSBU034
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           MARCH 1994.                              DTSBU034
00005  DATE-COMPILED.                                                   DTSBU034
00006      SKIP3                                                        DTSBU034
00007 *****                                                             DTSBU034
00008 *                                                                 DTSBU034
00009 *    FUNCTION:  COLLECTIONS CODES EDIT/DESCRIPTION.               DTSBU034
00010 *                                                                 DTSBU034
00011 *                                                                 DTSBU034
00012 *    MODIFICATION LOG:                                            DTSBU034
00013 *                                                                 DTSBU034
00014 *    07/12/94  CLONED FROM DTSCU034.                                 CL**2
00015 *              WORK ORDER:                      PROGRAMMER: RHC   DTSBU034
00016 *                                                                 DTSBU034
00017 *    12/22/94  ADD SUBPOENA CODE.                                 DTSBU034
00018 *              WORK ORDER: CR025                PROGRAMMER: RHC   DTSBU034
00019 *                                                                 DTSBU034
00020 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU034
00021 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU034
00022 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBU034
00023 *                                                                 DTSBU034
00024 *                                                                 DTSBU034
00025 *    DESCRIPTION:                                                 DTSBU034
00026 *                                                                 DTSBU034
00027 *    DTSBU034 EDITS COLLECTIONS CODES AND INDICATORS.                CL**2
00028 *                                                                 DTSBU034
00029 *    DTSBU034 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION        CL**2
00030 *    OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE        DTSBU034
00031 *    VALUE.                                                       DTSBU034
00032 *                                                                 DTSBU034
00033 *    IF L034-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN     DTSBU034
00034 *    ABEND CODE OF 'U034'.                                        DTSBU034
00035 *                                                                 DTSBU034
00036 *    GO TO DEPENDING ON L034-OPTION TO GET TO THE PARAGRAPH       DTSBU034
00037 *    THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED      DTSBU034
00038 *    BY L034-OPTION.  USE A SEARCH STATEMENT TO DETERMINE THE     DTSBU034
00039 *    VALIDITY OF L034-CD-*.                                       DTSBU034
00040 *                                                                 DTSBU034
00041 *    IF L034-CD-* IS A VALID VALUE                                DTSBU034
00042 *        MOVE '1' TO L034-RESULT-IND                              DTSBU034
00043 *        MOVE THE APPROPRIATE C034-*-SHORT-DSCR                   DTSBU034
00044 *          TO L034-SHORT-DSCR                                     DTSBU034
00045 *        MOVE THE APPROPRIATE C034-*-LONG-DSCR                    DTSBU034
00046 *          TO L034-LONG-DSCR                                      DTSBU034
00047 *    ELSE                                                         DTSBU034
00048 *        MOVE '2' TO L034-RESULT-IND                              DTSBU034
00049 *        MOVE 'NOT VALID' TO L034-SHORT-DSCR                      DTSBU034
00050 *                            L034-LONG-DSCR.                      DTSBU034
00051 *                                                                 DTSBU034
00052 *****                                                             DTSBU034
00053      SKIP3                                                        DTSBU034
00054  ENVIRONMENT DIVISION.                                            DTSBU034
00055      SKIP3                                                        DTSBU034
00056  DATA DIVISION.                                                   DTSBU034
00057      SKIP3                                                        DTSBU034
00058  WORKING-STORAGE SECTION.                                         DTSBU034
000585 77  PAN-VALET PICTURE X(24) VALUE '004DTSBU034  03/22/99'.       DTSBU034
00059      SKIP3                                                        DTSBU034
00060  01  WRK-AREA.                                                    DTSBU034
00061      05  WRK-ABEND-CODE              PIC S9(04)  COMP             DTSBU034
00062                                                  VALUE +034.      DTSBU034
00063      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSBU034
00064      EJECT                                                        DTSBU034
00065  01  C034-LITERALS.                                               DTSBU034
00066  ++INCLUDE DTSIC034                                                  CL**2
00067      EJECT                                                        DTSBU034
00068  LINKAGE SECTION.                                                 DTSBU034
00069      SKIP3                                                        DTSBU034
00070  01  L034-LINK-AREA.                                              DTSBU034
00071  ++INCLUDE DTSIL034                                                  CL**2
00072      EJECT                                                        DTSBU034
00073  PROCEDURE DIVISION                                               DTSBU034
00074      USING L034-LINK-AREA.                                        DTSBU034
00075      SKIP2                                                        DTSBU034
00076      MOVE '2' TO L034-RESULT-IND.                                 DTSBU034
00077      MOVE 'NOT VALID' TO L034-SHORT-DSCR                          DTSBU034
00078                          L034-LONG-DSCR.                          DTSBU034
00079      PERFORM P1000-PROCESS THRU P1000-EXIT.                       DTSBU034
00080      SKIP2                                                        DTSBU034
00081      GOBACK.                                                      DTSBU034
00082      EJECT                                                        DTSBU034
00083  P1000-PROCESS.                                                   DTSBU034
00084      GO TO P1000-01                                               DTSBU034
00085            P1000-02                                               DTSBU034
00086            S999-ABEND                                             DTSBU034
00087            S999-ABEND                                             DTSBU034
00088            P1000-05                                               DTSBU034
00089            P1000-06                                               DTSBU034
00090            S999-ABEND                                             DTSBU034
00091            P1000-08                                               DTSBU034
00092            P1000-09                                               DTSBU034
00093            P1000-10                                                  CL**4
00094            P1000-11                                               DTSBU034
00095            P1000-12                                                  CL**3
00096          DEPENDING ON L034-OPTION.                                DTSBU034
00097      SKIP1                                                        DTSBU034
00098      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBU034
00099      SKIP3                                                        DTSBU034
00100  P1000-01.                                                        DTSBU034
00101      SET C034-01-IDX TO 1.                                        DTSBU034
00102      SEARCH C034-01-ENTRY                                         DTSBU034
00103         VARYING                                                   DTSBU034
00104           C034-01-IDX                                             DTSBU034
00105          WHEN L034-CD-1 = C034-01-CD (C034-01-IDX)                DTSBU034
00106              MOVE '1' TO L034-RESULT-IND                          DTSBU034
00107              MOVE C034-01-SHORT-DSCR (C034-01-IDX)                DTSBU034
00108                TO L034-SHORT-DSCR                                 DTSBU034
00109              MOVE C034-01-LONG-DSCR (C034-01-IDX)                 DTSBU034
00110                TO L034-LONG-DSCR.                                 DTSBU034
00111      SKIP1                                                        DTSBU034
00112      GO TO P1000-EXIT.                                            DTSBU034
00113      SKIP3                                                        DTSBU034
00114  P1000-02.                                                        DTSBU034
00115      SET C034-02-IDX TO 1.                                        DTSBU034
00116      SEARCH C034-02-ENTRY                                         DTSBU034
00117         VARYING                                                   DTSBU034
00118           C034-02-IDX                                             DTSBU034
00119          WHEN L034-CD-1 = C034-02-CD (C034-02-IDX)                DTSBU034
00120              MOVE '1' TO L034-RESULT-IND                          DTSBU034
00121              MOVE C034-02-SHORT-DSCR (C034-02-IDX)                DTSBU034
00122                TO L034-SHORT-DSCR                                 DTSBU034
00123              MOVE C034-02-LONG-DSCR (C034-02-IDX)                 DTSBU034
00124                TO L034-LONG-DSCR.                                 DTSBU034
00125      SKIP1                                                        DTSBU034
00126      GO TO P1000-EXIT.                                            DTSBU034
00127      SKIP3                                                        DTSBU034
00128  P1000-05.                                                        DTSBU034
00129      SET C034-05-IDX TO 1.                                        DTSBU034
00130      SEARCH C034-05-ENTRY                                         DTSBU034
00131         VARYING                                                   DTSBU034
00132           C034-05-IDX                                             DTSBU034
00133          WHEN L034-CD-1 = C034-05-CD (C034-05-IDX)                DTSBU034
00134              MOVE '1' TO L034-RESULT-IND                          DTSBU034
00135              MOVE C034-05-SHORT-DSCR (C034-05-IDX)                DTSBU034
00136                TO L034-SHORT-DSCR                                 DTSBU034
00137              MOVE C034-05-LONG-DSCR (C034-05-IDX)                 DTSBU034
00138                TO L034-LONG-DSCR.                                 DTSBU034
00139      SKIP1                                                        DTSBU034
00140      GO TO P1000-EXIT.                                            DTSBU034
00141      SKIP3                                                        DTSBU034
00142  P1000-06.                                                        DTSBU034
00143      SET C034-06-IDX TO 1.                                        DTSBU034
00144      SEARCH C034-06-ENTRY                                         DTSBU034
00145         VARYING                                                   DTSBU034
00146           C034-06-IDX                                             DTSBU034
00147          WHEN L034-CD-2 = C034-06-CD (C034-06-IDX)                DTSBU034
00148              MOVE '1' TO L034-RESULT-IND                          DTSBU034
00149              MOVE C034-06-SHORT-DSCR (C034-06-IDX)                DTSBU034
00150                TO L034-SHORT-DSCR                                 DTSBU034
00151              MOVE C034-06-LONG-DSCR (C034-06-IDX)                 DTSBU034
00152                TO L034-LONG-DSCR.                                 DTSBU034
00153      SKIP1                                                        DTSBU034
00154      GO TO P1000-EXIT.                                            DTSBU034
00155      SKIP3                                                        DTSBU034
00156  P1000-08.                                                        DTSBU034
00157      SET C034-08-IDX TO 1.                                        DTSBU034
00158      SEARCH C034-08-ENTRY                                         DTSBU034
00159         VARYING                                                   DTSBU034
00160           C034-08-IDX                                             DTSBU034
00161          WHEN L034-CD-1 = C034-08-CD (C034-08-IDX)                DTSBU034
00162              MOVE '1' TO L034-RESULT-IND                          DTSBU034
00163              MOVE C034-08-SHORT-DSCR (C034-08-IDX)                DTSBU034
00164                TO L034-SHORT-DSCR                                 DTSBU034
00165              MOVE C034-08-LONG-DSCR (C034-08-IDX)                 DTSBU034
00166                TO L034-LONG-DSCR.                                 DTSBU034
00167      SKIP1                                                        DTSBU034
00168      GO TO P1000-EXIT.                                            DTSBU034
00169      SKIP3                                                        DTSBU034
00170  P1000-09.                                                        DTSBU034
00171      SET C034-09-IDX TO 1.                                        DTSBU034
00172      SEARCH C034-09-ENTRY                                         DTSBU034
00173         VARYING                                                   DTSBU034
00174           C034-09-IDX                                             DTSBU034
00175          WHEN L034-CD-1 = C034-09-CD (C034-09-IDX)                DTSBU034
00176              MOVE '1' TO L034-RESULT-IND                          DTSBU034
00177              MOVE C034-09-SHORT-DSCR (C034-09-IDX)                DTSBU034
00178                TO L034-SHORT-DSCR                                 DTSBU034
00179              MOVE C034-09-LONG-DSCR (C034-09-IDX)                 DTSBU034
00180                TO L034-LONG-DSCR.                                 DTSBU034
00181      SKIP1                                                        DTSBU034
00182      GO TO P1000-EXIT.                                            DTSBU034
00183      SKIP3                                                        DTSBU034
00184  P1000-10.                                                           CL**4
00185      SET C034-10-IDX TO 1.                                           CL**4
00186      SEARCH C034-10-ENTRY                                            CL**4
00187         VARYING                                                      CL**4
00188           C034-10-IDX                                                CL**4
00189          WHEN L034-CD-1 = C034-10-CD (C034-10-IDX)                   CL**4
00190              MOVE '1' TO L034-RESULT-IND                             CL**4
00191              MOVE C034-10-SHORT-DSCR (C034-10-IDX)                   CL**4
00192                TO L034-SHORT-DSCR                                    CL**4
00193              MOVE C034-10-LONG-DSCR (C034-10-IDX)                    CL**4
00194                TO L034-LONG-DSCR.                                    CL**4
00195      SKIP1                                                           CL**4
00196      GO TO P1000-EXIT.                                               CL**4
00197      SKIP3                                                           CL**4
00198  P1000-11.                                                        DTSBU034
00199      SET C034-11-IDX TO 1.                                        DTSBU034
00200      SEARCH C034-11-ENTRY                                         DTSBU034
00201         VARYING                                                   DTSBU034
00202           C034-11-IDX                                             DTSBU034
00203          WHEN L034-CD-1 = C034-11-CD (C034-11-IDX)                DTSBU034
00204              MOVE '1' TO L034-RESULT-IND                          DTSBU034
00205              MOVE C034-11-SHORT-DSCR (C034-11-IDX)                DTSBU034
00206                TO L034-SHORT-DSCR                                 DTSBU034
00207              MOVE C034-11-LONG-DSCR (C034-11-IDX)                 DTSBU034
00208                TO L034-LONG-DSCR.                                 DTSBU034
00209      SKIP1                                                        DTSBU034
00210      GO TO P1000-EXIT.                                            DTSBU034
00211      SKIP3                                                        DTSBU034
00212  P1000-12.                                                           CL**3
00213      SET C034-12-IDX TO 1.                                           CL**3
00214      SEARCH C034-12-ENTRY                                            CL**3
00215         VARYING                                                      CL**3
00216           C034-12-IDX                                                CL**3
00217          WHEN L034-CD-3 = C034-12-CD (C034-12-IDX)                   CL**3
00218              MOVE '1' TO L034-RESULT-IND                             CL**3
00219              MOVE C034-12-SHORT-DSCR (C034-12-IDX)                   CL**3
00220                TO L034-SHORT-DSCR                                    CL**3
00221              MOVE C034-12-LONG-DSCR (C034-12-IDX)                    CL**3
00222                TO L034-LONG-DSCR.                                    CL**3
00223      SKIP1                                                           CL**3
00224      GO TO P1000-EXIT.                                               CL**3
00225      SKIP3                                                           CL**3
00226  P1000-EXIT.                                                      DTSBU034
00227      EXIT.                                                        DTSBU034
00228      EJECT                                                        DTSBU034
00229  S999-ABEND.                                                      DTSBU034
00230      SKIP1                                                        DTSBU034
00231      CALL 'DTSBU999'                                                 CL**2
00232          USING WRK-ABEND-CODE.                                    DTSBU034
00233      SKIP1                                                        DTSBU034
00234  S999-EXIT. EXIT.                                                 DTSBU034
00235      EXIT.                                                        DTSBU034
