00001 IDENTIFICATION DIVISION. 02/02/99 00002 PROGRAM-ID. DTSCU039. DTSCU039 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU039 00005 DATE-COMPILED. DTSCU039 00006 SKIP3 DTSCU039 00007 ***** DTSCU039 00008 * DTSCU039 00009 * FUNCTION: SIC EDIT/DESCRIPTION. DTSCU039 00010 * DTSCU039 00011 * DTSCU039 00012 * MODIFICATION LOG: DTSCU039 00013 * DTSCU039 00014 * 09/13/98 INITIAL DEVELOPMENT. COPIED FROM MACCU039. CL**2 00015 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00016 * DTSCU039 00017 * DTSCU039 00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU039 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU039 00020 * WORK ORDER: PROGRAMMER: XXX DTSCU039 00021 * DTSCU039 00022 * DTSCU039 00023 * DESCRIPTION: DTSCU039 00024 * DTSCU039 00025 * DTSCU039 EDITS SIC CODE. CL**2 00026 * DTSCU039 00027 * DTSCU039 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION CL**2 00028 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSCU039 00029 * VALUE. DTSCU039 00030 * DTSCU039 00031 ***** DTSCU039 00032 SKIP3 DTSCU039 00033 ENVIRONMENT DIVISION. DTSCU039 00034 SKIP3 DTSCU039 00035 DATA DIVISION. DTSCU039 00036 SKIP3 DTSCU039 00037 WORKING-STORAGE SECTION. DTSCU039 000375 77 PAN-VALET PICTURE X(24) VALUE '004DTSCU039 02/02/99'. DTSCU039 00038 SKIP3 DTSCU039 00039 01 WRK-AREA. DTSCU039 00040 05 WRK-ABEND-CODE PIC X(04) VALUE 'U039'. DTSCU039 00041 EJECT DTSCU039 00042 01 L833-COMM-AREA. DTSCU039 00043 05 L833-CONTROL-BLOCK. DTSCU039 00044 ++INCLUDE DTSIL833 CL**2 00045 SKIP3 DTSCU039 00046 05 XSIC-REC. DTSCU039 00047 ++INCLUDE DTSIXSIC CL**2 00048 EJECT DTSCU039 00049 LINKAGE SECTION. DTSCU039 00050 SKIP3 DTSCU039 00051 01 DFHCOMMAREA. DTSCU039 00052 ++INCLUDE DTSIL039 CL**2 00053 EJECT DTSCU039 00054 PROCEDURE DIVISION. DTSCU039 00055 SKIP2 DTSCU039 00056 PERFORM P1000-PROCESS THRU P1000-EXIT DTSCU039 00057 SKIP2 DTSCU039 00058 EXEC CICS DTSCU039 00059 RETURN DTSCU039 00060 END-EXEC. DTSCU039 00061 SKIP2 DTSCU039 00062 GOBACK. DTSCU039 00063 EJECT DTSCU039 00064 P1000-PROCESS. DTSCU039 00065 SET L039-SIC-NOT-VALID TO TRUE. DTSCU039 00066 MOVE 'NOT VALID' TO L039-SIC-SHORT-DSCR DTSCU039 00067 L039-SIC-LONG-DSCR. DTSCU039 00068 DTSCU039 00069 *****SET L039-OWN-NOT-VALID TO TRUE. CL**4 00070 *****MOVE 'NOT VALID' TO L039-OWN-SHORT-DSCR CL**4 00071 *************************L039-OWN-LONG-DSCR. CL**4 00072 DTSCU039 00073 MOVE SPACES TO L039-MSG-AREA. DTSCU039 00074 DTSCU039 00075 PERFORM P1100-SIC-CD THRU P1100-EXIT. DTSCU039 00076 DTSCU039 00077 *****PERFORM P1200-OWN-CD THRU P1200-EXIT. CL**4 00078 P1000-EXIT. DTSCU039 00079 EXIT. DTSCU039 00080 EJECT DTSCU039 00081 P1100-SIC-CD. DTSCU039 00082 IF L039-SIC-CD NUMERIC CL**3 00083 NEXT SENTENCE DTSCU039 00084 ELSE DTSCU039 00085 GO TO P1100-EXIT. DTSCU039 00086 DTSCU039 00087 IF L039-SIC-CD = '9999' CL**3 00088 MOVE 'NOT DETRM' TO L039-SIC-SHORT-DSCR DTSCU039 00089 MOVE 'NOT DETERMINED' TO L039-SIC-LONG-DSCR DTSCU039 00090 SET L039-SIC-VALID TO TRUE DTSCU039 00091 GO TO P1100-EXIT. DTSCU039 00092 DTSCU039 00093 MOVE L039-SIC-CD TO XSIC-KEY-AREA. CL**3 00094 DTSCU039 00095 MOVE '01' TO XSIC-LINE-NUMBER. DTSCU039 00096 DTSCU039 00097 SET L833-READ-88 TO TRUE. DTSCU039 00098 DTSCU039 00099 PERFORM S833-SIC-I THRU S833-EXIT. DTSCU039 00100 DTSCU039 00101 IF L833-FILE-CLOSED-88 DTSCU039 00102 SET L039-SIC-FILE-CLOSED TO TRUE DTSCU039 00103 MOVE L833-MSG-AREA TO L039-MSG-AREA DTSCU039 00104 GO TO P1100-EXIT. DTSCU039 00105 DTSCU039 00106 IF L833-NO-REC-88 DTSCU039 00107 GO TO P1100-EXIT. DTSCU039 00108 DTSCU039 00109 MOVE XSIC-SIC-DSCR TO L039-SIC-SHORT-DSCR DTSCU039 00110 L039-SIC-LONG-DSCR. DTSCU039 00111 DTSCU039 00112 SET L039-SIC-VALID TO TRUE. DTSCU039 00113 P1100-EXIT. DTSCU039 00114 EXIT. DTSCU039 00115 SKIP3 DTSCU039 00116 *P1200-OWN-CD. CL**4 00117 *****IF L039-OWN-CDA = '1' CL**4 00118 *********SET L039-OWN-VALID TO TRUE CL**4 00119 *********MOVE 'FED GOV ' CL**4 00120 ***********TO L039-OWN-SHORT-DSCR CL**4 00121 *********MOVE 'FEDERAL GOVERNMENT' CL**4 00122 ***********TO L039-OWN-LONG-DSCR CL**4 00123 *****ELSE CL**4 00124 *****IF L039-OWN-CDA = '2' CL**4 00125 *********SET L039-OWN-VALID TO TRUE CL**4 00126 *********MOVE 'STATE GOV ' CL**4 00127 ***********TO L039-OWN-SHORT-DSCR CL**4 00128 *********MOVE 'STATE GOVERNMENT' CL**4 00129 ***********TO L039-OWN-LONG-DSCR CL**4 00130 *****ELSE CL**4 00131 *****IF L039-OWN-CDA = '3' CL**4 00132 *********SET L039-OWN-VALID TO TRUE CL**4 00133 *********MOVE 'LOCAL GOV ' CL**4 00134 ***********TO L039-OWN-SHORT-DSCR CL**4 00135 *********MOVE 'LOCAL GOVERNMENT' CL**4 00136 ***********TO L039-OWN-LONG-DSCR CL**4 00137 *****ELSE CL**4 00138 *****IF L039-OWN-CDA = '4' CL**4 00139 *********SET L039-OWN-VALID TO TRUE CL**4 00140 *********MOVE 'FOREIGN ' CL**4 00141 ***********TO L039-OWN-SHORT-DSCR CL**4 00142 *********MOVE 'FOREIGN' CL**4 00143 ***********TO L039-OWN-LONG-DSCR CL**4 00144 *****ELSE CL**4 00145 *****IF L039-OWN-CDA = '5' CL**4 00146 *********SET L039-OWN-VALID TO TRUE CL**4 00147 *********MOVE 'PRIVATE ' CL**4 00148 ***********TO L039-OWN-SHORT-DSCR CL**4 00149 *********MOVE 'PRIVATE' CL**4 00150 ***********TO L039-OWN-LONG-DSCR. CL**4 00151 *P1200-EXIT. CL**4 00152 *****EXIT. CL**4 00153 EJECT DTSCU039 00154 S833-SIC-I. DTSCU039 00155 EXEC CICS DTSCU039 00156 LINK DTSCU039 00157 PROGRAM ('DTSCU833') CL**2 00158 COMMAREA (L833-COMM-AREA) DTSCU039 00159 END-EXEC. DTSCU039 00160 S833-EXIT. DTSCU039 00161 EXIT. DTSCU039