DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
159
Batch/DTSBU039.cob
Normal file
159
Batch/DTSBU039.cob
Normal file
@ -0,0 +1,159 @@
|
||||
00001 IDENTIFICATION DIVISION. 02/02/99
|
||||
00002 PROGRAM-ID. DTSBU039. DTSBU039
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
||||
00004 DATE-WRITTEN. JULY 1994. DTSBU039
|
||||
00005 DATE-COMPILED. DTSBU039
|
||||
00006 SKIP3 DTSBU039
|
||||
00007 ***** DTSBU039
|
||||
00008 * DTSBU039
|
||||
00009 * FUNCTION: SIC EDIT/DESCRIPTION. DTSBU039
|
||||
00010 * DTSBU039
|
||||
00011 * DTSBU039
|
||||
00012 * MODIFICATION LOG: DTSBU039
|
||||
00013 * DTSBU039
|
||||
00014 * 07/12/94 CLONED FROM DTSCU039. CL**2
|
||||
00015 * WORK ORDER: PROGRAMMER: RHC DTSBU039
|
||||
00016 * DTSBU039
|
||||
00017 * 02/02/1999 REVIEWED AND MODIFIED FOR DC. CL**2
|
||||
00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2
|
||||
00019 * DTSBU039
|
||||
00020 * DTSBU039
|
||||
00021 * DESCRIPTION: DTSBU039
|
||||
00022 * DTSBU039
|
||||
00023 * DTSBU039 EDITS SIC CODE. CL**2
|
||||
00024 * DTSBU039
|
||||
00025 * DTSBU039 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION CL**2
|
||||
00026 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSBU039
|
||||
00027 * VALUE. DTSBU039
|
||||
00028 * DTSBU039
|
||||
00029 ***** DTSBU039
|
||||
00030 SKIP3 DTSBU039
|
||||
00031 ENVIRONMENT DIVISION. DTSBU039
|
||||
00032 SKIP3 DTSBU039
|
||||
00033 DATA DIVISION. DTSBU039
|
||||
00034 SKIP3 DTSBU039
|
||||
00035 WORKING-STORAGE SECTION. DTSBU039
|
||||
000355 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU039 02/02/99'. DTSBU039
|
||||
00036 SKIP3 DTSBU039
|
||||
00037 01 WRK-AREA. DTSBU039
|
||||
00038 05 WRK-ABEND-CODE PIC S9(04) COMP DTSBU039
|
||||
00039 VALUE +039. DTSBU039
|
||||
00040 EJECT DTSBU039
|
||||
00041 01 L933-LINK-AREA. DTSBU039
|
||||
00042 05 L933-CONTROL-BLOCK. DTSBU039
|
||||
00043 ++INCLUDE DTSIL933 CL**2
|
||||
00044 SKIP3 DTSBU039
|
||||
00045 01 XSIC-LINK-AREA. DTSBU039
|
||||
00046 05 XSIC-REC. DTSBU039
|
||||
00047 ++INCLUDE DTSIXSIC CL**2
|
||||
00048 EJECT DTSBU039
|
||||
00049 LINKAGE SECTION. DTSBU039
|
||||
00050 SKIP3 DTSBU039
|
||||
00051 01 L039-LINK-AREA. DTSBU039
|
||||
00052 ++INCLUDE DTSIL039 CL**2
|
||||
00053 EJECT DTSBU039
|
||||
00054 PROCEDURE DIVISION USING L039-LINK-AREA. CL**2
|
||||
00055 CL**2
|
||||
00056 CL**2
|
||||
00057 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBU039
|
||||
00058 CL**2
|
||||
00059 CL**2
|
||||
00060 GOBACK. DTSBU039
|
||||
00061 EJECT DTSBU039
|
||||
00062 P1000-PROCESS. DTSBU039
|
||||
00063 SET L039-SIC-NOT-VALID TO TRUE. DTSBU039
|
||||
00064 CL**2
|
||||
00065 MOVE 'NOT VALID' TO L039-SIC-SHORT-DSCR DTSBU039
|
||||
00066 L039-SIC-LONG-DSCR. DTSBU039
|
||||
00067 DTSBU039
|
||||
00068 CL**2
|
||||
00069 *****SET L039-OWN-NOT-VALID TO TRUE. CL**2
|
||||
00070 CL**2
|
||||
00071 *****MOVE 'NOT VALID' TO L039-OWN-SHORT-DSCR CL**2
|
||||
00072 *************************L039-OWN-LONG-DSCR. CL**2
|
||||
00073 DTSBU039
|
||||
00074 CL**2
|
||||
00075 MOVE SPACES TO L039-MSG-AREA. DTSBU039
|
||||
00076 DTSBU039
|
||||
00077 CL**2
|
||||
00078 PERFORM P1100-SIC-CD THRU P1100-EXIT. DTSBU039
|
||||
00079 DTSBU039
|
||||
00080 CL**2
|
||||
00081 *****PERFORM P1200-OWN-CD THRU P1200-EXIT. CL**2
|
||||
00082 P1000-EXIT. DTSBU039
|
||||
00083 EXIT. DTSBU039
|
||||
00084 EJECT DTSBU039
|
||||
00085 P1100-SIC-CD. DTSBU039
|
||||
00086 IF L039-SIC-CD NUMERIC CL**3
|
||||
00087 NEXT SENTENCE DTSBU039
|
||||
00088 ELSE DTSBU039
|
||||
00089 GO TO P1100-EXIT. DTSBU039
|
||||
00090 DTSBU039
|
||||
00091 IF L039-SIC-CD = '9999' CL**2
|
||||
00092 MOVE 'NOT DETRM' TO L039-SIC-SHORT-DSCR DTSBU039
|
||||
00093 MOVE 'NOT DETERMINED' TO L039-SIC-LONG-DSCR DTSBU039
|
||||
00094 SET L039-SIC-VALID TO TRUE DTSBU039
|
||||
00095 GO TO P1100-EXIT. DTSBU039
|
||||
00096 DTSBU039
|
||||
00097 MOVE L039-SIC-CD TO XSIC-KEY-AREA. CL**2
|
||||
00098 DTSBU039
|
||||
00099 MOVE '01' TO XSIC-LINE-NUMBER. DTSBU039
|
||||
00100 DTSBU039
|
||||
00101 SET L933-READ-88 TO TRUE. DTSBU039
|
||||
00102 DTSBU039
|
||||
00103 PERFORM S933-SIC-I THRU S933-EXIT. DTSBU039
|
||||
00104 DTSBU039
|
||||
00105 IF L933-NO-REC-88 DTSBU039
|
||||
00106 GO TO P1100-EXIT. DTSBU039
|
||||
00107 DTSBU039
|
||||
00108 MOVE XSIC-SIC-DSCR TO L039-SIC-SHORT-DSCR DTSBU039
|
||||
00109 L039-SIC-LONG-DSCR. DTSBU039
|
||||
00110 DTSBU039
|
||||
00111 SET L039-SIC-VALID TO TRUE. DTSBU039
|
||||
00112 P1100-EXIT. DTSBU039
|
||||
00113 EXIT. DTSBU039
|
||||
00114 SKIP3 DTSBU039
|
||||
00115 *P1200-OWN-CD. CL**2
|
||||
00116 *****IF L039-OWN-CD = '1 ' CL**2
|
||||
00117 *********SET L039-OWN-VALID TO TRUE CL**2
|
||||
00118 *********MOVE 'FED GOV ' CL**2
|
||||
00119 ***********TO L039-OWN-SHORT-DSCR CL**2
|
||||
00120 *********MOVE 'FEDERAL GOVERNMENT' CL**2
|
||||
00121 ***********TO L039-OWN-LONG-DSCR CL**2
|
||||
00122 *****ELSE CL**2
|
||||
00123 *****IF L039-OWN-CD = '2 ' CL**2
|
||||
00124 *********SET L039-OWN-VALID TO TRUE CL**2
|
||||
00125 *********MOVE 'STATE GOV ' CL**2
|
||||
00126 ***********TO L039-OWN-SHORT-DSCR CL**2
|
||||
00127 *********MOVE 'STATE GOVERNMENT' CL**2
|
||||
00128 ***********TO L039-OWN-LONG-DSCR CL**2
|
||||
00129 *****ELSE CL**2
|
||||
00130 *****IF L039-OWN-CD = '3 ' CL**2
|
||||
00131 *********SET L039-OWN-VALID TO TRUE CL**2
|
||||
00132 *********MOVE 'LOCAL GOV ' CL**2
|
||||
00133 ***********TO L039-OWN-SHORT-DSCR CL**2
|
||||
00134 *********MOVE 'LOCAL GOVERNMENT' CL**2
|
||||
00135 ***********TO L039-OWN-LONG-DSCR CL**2
|
||||
00136 *****ELSE CL**2
|
||||
00137 *****IF L039-OWN-CD = '4 ' CL**2
|
||||
00138 *********SET L039-OWN-VALID TO TRUE CL**2
|
||||
00139 *********MOVE 'FOREIGN ' CL**2
|
||||
00140 ***********TO L039-OWN-SHORT-DSCR CL**2
|
||||
00141 *********MOVE 'FOREIGN' CL**2
|
||||
00142 ***********TO L039-OWN-LONG-DSCR CL**2
|
||||
00143 *****ELSE CL**2
|
||||
00144 *****IF L039-OWN-CD = '5 ' CL**2
|
||||
00145 *********SET L039-OWN-VALID TO TRUE CL**2
|
||||
00146 *********MOVE 'PRIVATE ' CL**2
|
||||
00147 ***********TO L039-OWN-SHORT-DSCR CL**2
|
||||
00148 *********MOVE 'PRIVATE' CL**2
|
||||
00149 ***********TO L039-OWN-LONG-DSCR. CL**2
|
||||
00150 *P1200-EXIT. CL**2
|
||||
00151 *****EXIT. CL**2
|
||||
00152 EJECT DTSBU039
|
||||
00153 S933-SIC-I. DTSBU039
|
||||
00154 CALL 'DTSBU933' CL**2
|
||||
00155 USING L933-LINK-AREA DTSBU039
|
||||
00156 XSIC-LINK-AREA. DTSBU039
|
||||
00157 S933-EXIT. DTSBU039
|
||||
00158 EXIT. DTSBU039
|
||||
Reference in New Issue
Block a user