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