163 lines
13 KiB
COBOL
163 lines
13 KiB
COBOL
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
|