DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
134
CICS/DTSCU040.cob
Normal file
134
CICS/DTSCU040.cob
Normal file
@ -0,0 +1,134 @@
|
||||
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
|
||||
Reference in New Issue
Block a user