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