00001  IDENTIFICATION DIVISION.                                         03/30/04
00002  PROGRAM-ID.             DTSBU040.                                DTSBU040
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV014
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSBU040
00005  DATE-COMPILED.                                                   DTSBU040
00006      SKIP3                                                        DTSBU040
00007 *****                                                             DTSBU040
00008 *                                                                 DTSBU040
00009 *    FUNCTION: NAICS CODE EDIT/DESCRIPTION.                       DTSBU040
00010 *                                                                 DTSBU040
00011 *                                                                 DTSBU040
00012 *    MODIFICATION LOG:                                            DTSBU040
00013 *                                                                 DTSBU040
00014 *    02/02/1999  CLONED FROM DTSCU040.                            DTSBU040
00015 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBU040
00016 *                                                                 DTSBU040
00017 *    03/26/2004  REVISED FOR NEW FORMAT OF NAICS VSAM FILE        DTSBU040
00018 *                REFERENCE:                     PROGRAMMER: GD    DTSBU040
00019 *                                                                 DTSBU040
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU040
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU040
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU040
00023 *                                                                 DTSBU040
00024 *                                                                 DTSBU040
00025 *    DESCRIPTION:                                                 DTSBU040
00026 *                                                                 DTSBU040
00027 *    DTSCU040 EDITS NAICS CODE.                                   DTSBU040
00028 *                                                                 DTSBU040
00029 *    DTSCU040 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION     DTSBU040
00030 *    OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE        DTSBU040
00031 *    VALUE.                                                       DTSBU040
00032 *                                                                 DTSBU040
00033 *****                                                             DTSBU040
00034      SKIP3                                                        DTSBU040
00035  ENVIRONMENT DIVISION.                                            DTSBU040
00036      SKIP3                                                        DTSBU040
00037  DATA DIVISION.                                                   DTSBU040
00038      SKIP3                                                        DTSBU040
00039  WORKING-STORAGE SECTION.                                         DTSBU040
000395 77  PAN-VALET PICTURE X(24) VALUE '014DTSBU040  03/30/04'.       DTSBU040
00040      SKIP3                                                        DTSBU040
00041  01  WRK-AREA.                                                    DTSBU040
00042      05  WRK-ABEND-CODE              PIC S9(04)  COMP  VALUE +040.DTSBU040
00043      EJECT                                                        DTSBU040
00044  01  L934-LINK-AREA.                                              DTSBU040
00045      05  L934-CONTROL-BLOCK.                                      DTSBU040
00046  ++INCLUDE DTSIL934                                               DTSBU040
00047      SKIP3                                                        DTSBU040
00048  01  XNIC-REC.                                                    DTSBU040
00049  ++INCLUDE DTSIXNIC                                               DTSBU040
00050      EJECT                                                        DTSBU040
00051  LINKAGE SECTION.                                                 DTSBU040
00052      SKIP3                                                        DTSBU040
00053  01  L040-LINK-AREA.                                              DTSBU040
00054  ++INCLUDE DTSIL040                                               DTSBU040
00055      EJECT                                                        DTSBU040
00056  PROCEDURE DIVISION USING L040-LINK-AREA.                         DTSBU040
00057                                                                   DTSBU040
00058                                                                   DTSBU040
00059      PERFORM P1000-PROCESS THRU P1000-EXIT.                       DTSBU040
00060                                                                   DTSBU040
00061                                                                   DTSBU040
00062      GOBACK.                                                      DTSBU040
00063      EJECT                                                        DTSBU040
00064  P1000-PROCESS.                                                   DTSBU040
00065      SET L040-NAICS-NOT-VALID TO TRUE.                            DTSBU040
00066                                                                   DTSBU040
00067      MOVE 'NOT VALID' TO L040-NAICS-SHORT-DSCR                    DTSBU040
00068                          L040-NAICS-LONG-DSCR.                    DTSBU040
00069                                                                   DTSBU040
00070                                                                   DTSBU040
00071 *****SET L040-OWN-NOT-VALID TO TRUE.                              DTSBU040
00072                                                                   DTSBU040
00073 *****MOVE 'NOT VALID' TO L040-OWN-SHORT-DSCR                      DTSBU040
00074 *************************L040-OWN-LONG-DSCR.                      DTSBU040
00075                                                                   DTSBU040
00076                                                                   DTSBU040
00077      MOVE SPACES TO L040-MSG-AREA.                                DTSBU040
00078                                                                   DTSBU040
00079                                                                   DTSBU040
00080      PERFORM P1100-NAICS-CD THRU P1100-EXIT.                      DTSBU040
00081                                                                   DTSBU040
00082                                                                   DTSBU040
00083 *****PERFORM P1200-OWN-CD THRU P1200-EXIT.                        DTSBU040
00084  P1000-EXIT.                                                      DTSBU040
00085      EXIT.                                                        DTSBU040
00086      EJECT                                                        DTSBU040
00087  P1100-NAICS-CD.                                                  DTSBU040
00088      IF L040-NAICS-CD NUMERIC                                     DTSBU040
00089          NEXT SENTENCE                                            DTSBU040
00090      ELSE                                                         DTSBU040
00091          GO TO P1100-EXIT.                                        DTSBU040
00092                                                                   DTSBU040
00093      IF L040-NAICS-CD = '999999'                                  DTSBU040
00094          MOVE 'NOT DETRM' TO L040-NAICS-SHORT-DSCR                DTSBU040
00095          MOVE 'NOT DETERMINED' TO L040-NAICS-LONG-DSCR            DTSBU040
00096          SET L040-NAICS-VALID TO TRUE                             DTSBU040
00097          GO TO P1100-EXIT.                                        DTSBU040
00098                                                                   DTSBU040
00099      MOVE L040-NAICS-CD TO XNIC-KEY-AREA.                         DTSBU040
00100                                                                   DTSBU040
00101      SET L934-READ-88 TO TRUE.                                    DTSBU040
00102                                                                   DTSBU040
00103      PERFORM S934-NAICS-I THRU S934-EXIT.                         DTSBU040
00104                                                                   DTSBU040
00105 *****IF L934-FILE-CLOSED-88                                       DTSBU040
00106 *********SET L040-NAICS-FILE-CLOSED TO TRUE                       DTSBU040
00107 *********MOVE L934-MSG-AREA TO L040-MSG-AREA                      DTSBU040
00108 *********GO TO P1100-EXIT.                                        DTSBU040
00109                                                                   DTSBU040
00110      IF L934-NO-REC-88                                            DTSBU040
00111          GO TO P1100-EXIT.                                        DTSBU040
00112                                                                   DTSBU040
00113      MOVE XNIC-NIC-DSCR TO L040-NAICS-SHORT-DSCR                  DTSBU040
00114                            L040-NAICS-LONG-DSCR.                  DTSBU040
00115                                                                   DTSBU040
00116      SET L040-NAICS-VALID TO TRUE.                                DTSBU040
00117  P1100-EXIT.                                                      DTSBU040
00118      EXIT.                                                        DTSBU040
00119      SKIP3                                                        DTSBU040
00120  S934-NAICS-I.                                                    DTSBU040
00121      CALL 'DTSBU934' USING L934-LINK-AREA                         DTSBU040
00122                            XNIC-REC.                              DTSBU040
00123  S934-EXIT.                                                       DTSBU040
00124      EXIT.                                                        DTSBU040
