00001  IDENTIFICATION DIVISION.                                         05/25/07
00002  PROGRAM-ID.             DTSBU036.                                DTSBU036
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV029
00004  DATE-WRITTEN.           JULY 1994.                               DTSBU036
00005  DATE-COMPILED.                                                   DTSBU036
00006      SKIP3                                                        DTSBU036
00007 *****                                                             DTSBU036
00008 *                                                                 DTSBU036
00009 *    FUNCTION:  FIELD SUPPORT CODES EDIT/DESCRIPTION.             DTSBU036
00010 *                                                                 DTSBU036
00011 *                                                                 DTSBU036
00012 *    MODIFICATION LOG:                                            DTSBU036
00013 *                                                                 DTSBU036
00014 *    07/12/94  CLONED FROM DTSCU036.                              DTSBU036
00015 *              WORK ORDER:                      PROGRAMMER: RHC   DTSBU036
00016 *                                                                 DTSBU036
00017 *    11/22/2004  RECOMPILED WITH NEW DTSIC036 - MAUR ERROR:       DTSBU036
00018 *                EMPLOYEE MISCLASSIFIED                           DTSBU036
00019 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU036
00020 *                                                                 DTSBU036
00021 *    05/25/2007  RECOMPILED WITH NEW DTSIC036 - MAUR ERROR:       DTSBU036
00022 *                69: INTERNS, 70: WAGES REPORTED TO WRONG STATE   DTSBU036
00023 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU036
00024 *                                                                 DTSBU036
00025 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU036
00026 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU036
00027 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBU036
00028 *                                                                 DTSBU036
00029 *                                                                 DTSBU036
00030 *    DESCRIPTION:                                                 DTSBU036
00031 *                                                                 DTSBU036
00032 *    DTSBU036 EDITS FIELD SUPPORT CODES AND INDICATORS.           DTSBU036
00033 *                                                                 DTSBU036
00034 *    DTSBU036 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION     DTSBU036
00035 *    OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE        DTSBU036
00036 *    VALUE.                                                       DTSBU036
00037 *                                                                 DTSBU036
00038 *    IF L036-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN     DTSBU036
00039 *    ABEND CODE OF 'U036'.                                        DTSBU036
00040 *                                                                 DTSBU036
00041 *    GO TO DEPENDING ON L036-OPTION TO GET TO THE PARAGRAPH       DTSBU036
00042 *    THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED      DTSBU036
00043 *    BY L036-OPTION.  USE A SEARCH STATEMENT TO DETERMINE THE     DTSBU036
00044 *    VALIDITY OF L036-CD-*.                                       DTSBU036
00045 *                                                                 DTSBU036
00046 *    IF L036-CD-* IS A VALID VALUE                                DTSBU036
00047 *        MOVE '1' TO L036-RESULT-IND                              DTSBU036
00048 *        MOVE THE APPROPRIATE C036-*-SHORT-DSCR                   DTSBU036
00049 *          TO L036-SHORT-DSCR                                     DTSBU036
00050 *        MOVE THE APPROPRIATE C036-*-LONG-DSCR                    DTSBU036
00051 *          TO L036-LONG-DSCR                                      DTSBU036
00052 *    ELSE                                                         DTSBU036
00053 *        MOVE '2' TO L036-RESULT-IND                              DTSBU036
00054 *        MOVE 'NOT VALID' TO L036-SHORT-DSCR                      DTSBU036
00055 *                            L036-LONG-DSCR.                      DTSBU036
00056 *                                                                 DTSBU036
00057 *****                                                             DTSBU036
00058      SKIP3                                                        DTSBU036
00059  ENVIRONMENT DIVISION.                                            DTSBU036
00060      SKIP3                                                        DTSBU036
00061  DATA DIVISION.                                                   DTSBU036
00062      SKIP3                                                        DTSBU036
00063  WORKING-STORAGE SECTION.                                         DTSBU036
000635 77  PAN-VALET PICTURE X(24) VALUE '029DTSBU036  05/25/07'.       DTSBU036
00064      SKIP3                                                        DTSBU036
00065  01  WRK-AREA.                                                    DTSBU036
00066      05  WRK-ABEND-CODE              PIC S9(04)  COMP             DTSBU036
00067                                                  VALUE +036.      DTSBU036
00068      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSBU036
00069      05  WS-OPTION                   PIC  9(04).                  DTSBU036
00070      EJECT                                                        DTSBU036
00071  01  C036-LITERALS.                                               DTSBU036
00072  ++INCLUDE DTSIC036                                               DTSBU036
00073      EJECT                                                        DTSBU036
00074  LINKAGE SECTION.                                                 DTSBU036
00075      SKIP3                                                        DTSBU036
00076  01  L036-LINK-AREA.                                              DTSBU036
00077  ++INCLUDE DTSIL036                                               DTSBU036
00078      EJECT                                                        DTSBU036
00079  PROCEDURE DIVISION USING L036-LINK-AREA.                         DTSBU036
00080      SKIP2                                                        DTSBU036
00081      MOVE '2' TO L036-RESULT-IND.                                 DTSBU036
00082      MOVE 'NOT VALID' TO L036-SHORT-DSCR                          DTSBU036
00083                          L036-LONG-DSCR.                          DTSBU036
00084      PERFORM P1000-PROCESS THRU P1000-EXIT.                       DTSBU036
00085      GOBACK.                                                      DTSBU036
00086      SKIP2                                                        DTSBU036
00087  P1000-PROCESS.                                                   DTSBU036
00088       MOVE L036-OPTION TO WS-OPTION                               DTSBU036
00089       DISPLAY 'L036 OPTION ' WS-OPTION.                           DTSBU036
00090      GO TO P1000-01                                               DTSBU036
00091            P1000-02                                               DTSBU036
00092            P1000-03                                               DTSBU036
00093            P1000-04                                               DTSBU036
00094            P1000-05                                               DTSBU036
00095            P1000-06                                               DTSBU036
00096          DEPENDING ON L036-OPTION.                                DTSBU036
00097      SKIP1                                                        DTSBU036
00098      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBU036
00099      SKIP3                                                        DTSBU036
00100  P1000-01.                                                        DTSBU036
00101      SET C036-01-IDX TO 1.                                        DTSBU036
00102      SEARCH C036-01-ENTRY                                         DTSBU036
00103         VARYING                                                   DTSBU036
00104           C036-01-IDX                                             DTSBU036
00105          WHEN L036-CD-1 = C036-01-CD (C036-01-IDX)                DTSBU036
00106              MOVE '1' TO L036-RESULT-IND                          DTSBU036
00107              MOVE C036-01-SHORT-DSCR (C036-01-IDX)                DTSBU036
00108                TO L036-SHORT-DSCR                                 DTSBU036
00109              MOVE C036-01-LONG-DSCR (C036-01-IDX)                 DTSBU036
00110                TO L036-LONG-DSCR.                                 DTSBU036
00111      SKIP1                                                        DTSBU036
00112      GO TO P1000-EXIT.                                            DTSBU036
00113      SKIP3                                                        DTSBU036
00114  P1000-02.                                                        DTSBU036
00115      SET C036-02-IDX TO 1.                                        DTSBU036
00116      SEARCH C036-02-ENTRY                                         DTSBU036
00117         VARYING                                                   DTSBU036
00118           C036-02-IDX                                             DTSBU036
00119          WHEN L036-CD-1 = C036-02-CD (C036-02-IDX)                DTSBU036
00120              MOVE '1' TO L036-RESULT-IND                          DTSBU036
00121              MOVE C036-02-SHORT-DSCR (C036-02-IDX)                DTSBU036
00122                TO L036-SHORT-DSCR                                 DTSBU036
00123              MOVE C036-02-LONG-DSCR (C036-02-IDX)                 DTSBU036
00124                TO L036-LONG-DSCR.                                 DTSBU036
00125      SKIP1                                                        DTSBU036
00126      GO TO P1000-EXIT.                                            DTSBU036
00127      SKIP3                                                        DTSBU036
00128  P1000-03.                                                        DTSBU036
00129      SET C036-03-IDX TO 1.                                        DTSBU036
00130      SEARCH C036-03-ENTRY                                         DTSBU036
00131         VARYING                                                   DTSBU036
00132           C036-03-IDX                                             DTSBU036
00133          WHEN L036-CD-2 = C036-03-CD (C036-03-IDX)                DTSBU036
00134              MOVE '1' TO L036-RESULT-IND                          DTSBU036
00135              MOVE C036-03-SHORT-DSCR (C036-03-IDX)                DTSBU036
00136                TO L036-SHORT-DSCR                                 DTSBU036
00137              MOVE C036-03-LONG-DSCR (C036-03-IDX)                 DTSBU036
00138                TO L036-LONG-DSCR.                                 DTSBU036
00139      SKIP1                                                        DTSBU036
00140      GO TO P1000-EXIT.                                            DTSBU036
00141      SKIP3                                                        DTSBU036
00142  P1000-04.                                                        DTSBU036
00143      SET C036-04-IDX TO 1.                                        DTSBU036
00144      SEARCH C036-04-ENTRY                                         DTSBU036
00145         VARYING                                                   DTSBU036
00146           C036-04-IDX                                             DTSBU036
00147          WHEN L036-CD-1 = C036-04-CD (C036-04-IDX)                DTSBU036
00148              MOVE '1' TO L036-RESULT-IND                          DTSBU036
00149              MOVE C036-04-SHORT-DSCR (C036-04-IDX)                DTSBU036
00150                TO L036-SHORT-DSCR                                 DTSBU036
00151              MOVE C036-04-LONG-DSCR (C036-04-IDX)                 DTSBU036
00152                TO L036-LONG-DSCR.                                 DTSBU036
00153      SKIP1                                                        DTSBU036
00154      GO TO P1000-EXIT.                                            DTSBU036
00155      SKIP3                                                        DTSBU036
00156  P1000-05.                                                        DTSBU036
00157      SET C036-05-IDX TO 1.                                        DTSBU036
00158      SEARCH C036-05-ENTRY                                         DTSBU036
00159         VARYING                                                   DTSBU036
00160           C036-05-IDX                                             DTSBU036
00161          WHEN L036-CD-2 = C036-05-CD (C036-05-IDX)                DTSBU036
00162              MOVE '1' TO L036-RESULT-IND                          DTSBU036
00163              MOVE C036-05-SHORT-DSCR (C036-05-IDX)                DTSBU036
00164                TO L036-SHORT-DSCR                                 DTSBU036
00165              MOVE C036-05-LONG-DSCR (C036-05-IDX)                 DTSBU036
00166                TO L036-LONG-DSCR.                                 DTSBU036
00167      SKIP1                                                        DTSBU036
00168      GO TO P1000-EXIT.                                            DTSBU036
00169      SKIP3                                                        DTSBU036
00170  P1000-06.                                                        DTSBU036
00171      SET C036-06-IDX TO 1.                                        DTSBU036
00172      SEARCH C036-06-ENTRY                                         DTSBU036
00173         VARYING                                                   DTSBU036
00174           C036-06-IDX                                             DTSBU036
00175          WHEN L036-CD-1 = C036-06-CD (C036-06-IDX)                DTSBU036
00176              MOVE '1' TO L036-RESULT-IND                          DTSBU036
00177              MOVE C036-06-SHORT-DSCR (C036-06-IDX)                DTSBU036
00178                TO L036-SHORT-DSCR                                 DTSBU036
00179              MOVE C036-06-LONG-DSCR (C036-06-IDX)                 DTSBU036
00180                TO L036-LONG-DSCR.                                 DTSBU036
00181      SKIP1                                                        DTSBU036
00182      GO TO P1000-EXIT.                                            DTSBU036
00183      SKIP3                                                        DTSBU036
00184  P1000-EXIT.                                                      DTSBU036
00185      EXIT.                                                        DTSBU036
00186      EJECT                                                        DTSBU036
00187  S999-ABEND.                                                      DTSBU036
00188      SKIP1                                                        DTSBU036
00189      CALL 'DTSBU999'                                              DTSBU036
00190          USING WRK-ABEND-CODE.                                    DTSBU036
00191      SKIP1                                                        DTSBU036
00192  S999-EXIT. EXIT.                                                 DTSBU036
00193      EXIT.                                                        DTSBU036
