DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
193
Batch/DTSBU002.cob
Normal file
193
Batch/DTSBU002.cob
Normal file
@ -0,0 +1,193 @@
|
||||
00001 IDENTIFICATION DIVISION. 08/05/98
|
||||
00002 PROGRAM-ID. DTSBU002. DTSBU002
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
||||
00004 DATE-WRITTEN. NOVEMBER 1991. DTSBU002
|
||||
00005 DATE-COMPILED. DTSBU002
|
||||
00006 SKIP3 DTSBU002
|
||||
00007 ***** DTSBU002
|
||||
00008 * DTSBU002
|
||||
00009 * FUNCTION: DISPLAY DATE IN TEXT FORMAT. DTSBU002
|
||||
00010 * DTSBU002
|
||||
00011 * DTSBU002
|
||||
00012 * MODIFICATION LOG: DTSBU002
|
||||
00013 * DTSBU002
|
||||
00014 * 08/04/98 CLONED FROM MACCU002. CL**2
|
||||
00015 * WORK ORDER: PROGRAMMER: ZL1 CL**2
|
||||
00016 * DTSBU002
|
||||
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU002
|
||||
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU002
|
||||
00019 * WORK ORDER: PROGRAMMER: DTSBU002
|
||||
00020 * DTSBU002
|
||||
00021 * DTSBU002
|
||||
00022 * DESCRIPTION: DTSBU002
|
||||
00023 * DTSBU002
|
||||
00024 * DTSBU002 IS PASSED L002-OPTION, AND L002-DATE. DTSBU002 CL**2
|
||||
00025 * RETURNS L002-LONG-TEXT-CNT, L002-LONG-TEXT-AREA, DTSBU002
|
||||
00026 * L002-SHORT-TEXT-CNT, AND L002-SHORT-TEXT-AREA. DTSBU002
|
||||
00027 * DTSBU002
|
||||
00028 * IF L002-OPTION IS NOT A VALID OPTION OR L002-DATE IS NOT A DTSBU002
|
||||
00029 * VALID DATE, THEN ABEND DTSBU002 WITH ABEND CODE +002. CL**2
|
||||
00030 * DTSBU002
|
||||
00031 * EXAMPLE OF USE: DTSBU002
|
||||
00032 * DTSBU002
|
||||
00033 * IF L002-UPPER-CASE AND L002-DATE = 19911203, THEN DTSBU002
|
||||
00034 * RETURN L002-LONG-TEXT-CNT = 16 AND L002-LONG-TEXT-AREA = DTSBU002
|
||||
00035 * 'DECEMBER 3, 1991' AND L002-SHORT-TEXT-CNT = 11 AND DTSBU002
|
||||
00036 * L002-SHORT-TEXT-AREA = 'DEC 3, 1991' DTSBU002
|
||||
00037 * DTSBU002
|
||||
00038 * SET THE SPF EDITOR TO "CAPS OFF" AND THE SCREEN DISPLAY TO DTSBU002
|
||||
00039 * MIXED MODE ("Aa") WHEN EDITING THIS MODULE. DTSBU002
|
||||
00040 ***** DTSBU002
|
||||
00041 SKIP3 DTSBU002
|
||||
00042 ENVIRONMENT DIVISION. DTSBU002
|
||||
00043 SKIP3 DTSBU002
|
||||
00044 DATA DIVISION. DTSBU002
|
||||
00045 SKIP3 DTSBU002
|
||||
00046 WORKING-STORAGE SECTION. DTSBU002
|
||||
000465 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU002 08/05/98'. DTSBU002
|
||||
00047 SKIP3 DTSBU002
|
||||
00048 01 WRK-AREA. DTSBU002
|
||||
00049 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +002. DTSBU002
|
||||
00050 05 LONG-SUB PIC S9(04) COMP. DTSBU002
|
||||
00051 05 SHORT-SUB PIC S9(04) COMP. DTSBU002
|
||||
00052 05 WRK-DAY. DTSBU002
|
||||
00053 10 WRK-DAY-1 PIC X(01). DTSBU002
|
||||
00054 10 WRK-DAY-2 PIC X(01). DTSBU002
|
||||
00055 01 LONG-DATE PIC X(18). DTSBU002
|
||||
00056 01 SHORT-DATE PIC X(12). DTSBU002
|
||||
00057 SKIP1 DTSBU002
|
||||
00058 01 MONTH-TABLE-1. DTSBU002
|
||||
00059 05 FILLER PIC X(09) VALUE 'JANUARY '. DTSBU002
|
||||
00060 05 FILLER PIC X(09) VALUE 'FEBRUARY '. DTSBU002
|
||||
00061 05 FILLER PIC X(09) VALUE 'MARCH '. DTSBU002
|
||||
00062 05 FILLER PIC X(09) VALUE 'APRIL '. DTSBU002
|
||||
00063 05 FILLER PIC X(09) VALUE 'MAY '. DTSBU002
|
||||
00064 05 FILLER PIC X(09) VALUE 'JUNE '. DTSBU002
|
||||
00065 05 FILLER PIC X(09) VALUE 'JULY '. DTSBU002
|
||||
00066 05 FILLER PIC X(09) VALUE 'AUGUST '. DTSBU002
|
||||
00067 05 FILLER PIC X(09) VALUE 'SEPTEMBER'. DTSBU002
|
||||
00068 05 FILLER PIC X(09) VALUE 'OCTOBER '. DTSBU002
|
||||
00069 05 FILLER PIC X(09) VALUE 'NOVEMBER '. DTSBU002
|
||||
00070 05 FILLER PIC X(09) VALUE 'DECEMBER '. DTSBU002
|
||||
00071 01 FILLER REDEFINES MONTH-TABLE-1. DTSBU002
|
||||
00072 05 FILLER OCCURS 12. DTSBU002
|
||||
00073 10 MONTH-NAME-1. DTSBU002
|
||||
00074 15 MONTH-NAME-1-SHORT PIC X(03). DTSBU002
|
||||
00075 15 FILLER PIC X(06). DTSBU002
|
||||
00076 SKIP1 DTSBU002
|
||||
00077 01 MONTH-TABLE-2. DTSBU002
|
||||
00078 05 FILLER PIC X(09) VALUE 'January '. DTSBU002
|
||||
00079 05 FILLER PIC X(09) VALUE 'February '. DTSBU002
|
||||
00080 05 FILLER PIC X(09) VALUE 'March '. DTSBU002
|
||||
00081 05 FILLER PIC X(09) VALUE 'April '. DTSBU002
|
||||
00082 05 FILLER PIC X(09) VALUE 'May '. DTSBU002
|
||||
00083 05 FILLER PIC X(09) VALUE 'June '. DTSBU002
|
||||
00084 05 FILLER PIC X(09) VALUE 'July '. DTSBU002
|
||||
00085 05 FILLER PIC X(09) VALUE 'August '. DTSBU002
|
||||
00086 05 FILLER PIC X(09) VALUE 'September'. DTSBU002
|
||||
00087 05 FILLER PIC X(09) VALUE 'October '. DTSBU002
|
||||
00088 05 FILLER PIC X(09) VALUE 'November '. DTSBU002
|
||||
00089 05 FILLER PIC X(09) VALUE 'December '. DTSBU002
|
||||
00090 01 FILLER REDEFINES MONTH-TABLE-2. DTSBU002
|
||||
00091 05 FILLER OCCURS 12. DTSBU002
|
||||
00092 10 MONTH-NAME-2. DTSBU002
|
||||
00093 15 MONTH-NAME-2-SHORT PIC X(03). DTSBU002
|
||||
00094 15 FILLER PIC X(06). DTSBU002
|
||||
00095 SKIP1 DTSBU002
|
||||
00096 01 MONTH-TABLE-LENGTH. DTSBU002
|
||||
00097 05 LENGTH-JANUARY PIC S9(04) COMP VALUE +7. DTSBU002
|
||||
00098 05 LENGTH-FEBRUARY PIC S9(04) COMP VALUE +8. DTSBU002
|
||||
00099 05 LENGTH-MARCH PIC S9(04) COMP VALUE +5. DTSBU002
|
||||
00100 05 LENGTH-APRIL PIC S9(04) COMP VALUE +5. DTSBU002
|
||||
00101 05 LENGTH-MAY PIC S9(04) COMP VALUE +3. DTSBU002
|
||||
00102 05 LENGTH-JUNE PIC S9(04) COMP VALUE +4. DTSBU002
|
||||
00103 05 LENGTH-JULY PIC S9(04) COMP VALUE +4. DTSBU002
|
||||
00104 05 LENGTH-AUGUST PIC S9(04) COMP VALUE +6. DTSBU002
|
||||
00105 05 LENGTH-SEPTEMBER PIC S9(04) COMP VALUE +9. DTSBU002
|
||||
00106 05 LENGTH-OCTOBER PIC S9(04) COMP VALUE +7. DTSBU002
|
||||
00107 05 LENGTH-NOVEMBER PIC S9(04) COMP VALUE +8. DTSBU002
|
||||
00108 05 LENGTH-DECEMBER PIC S9(04) COMP VALUE +8. DTSBU002
|
||||
00109 01 FILLER REDEFINES MONTH-TABLE-LENGTH. DTSBU002
|
||||
00110 05 MONTH-NAME-LENGTH OCCURS 12 TIMES PIC S9(04) COMP. DTSBU002
|
||||
00111 EJECT DTSBU002
|
||||
00112 01 L001-LINK-AREA. DTSBU002
|
||||
00113 ++INCLUDE DTSIL001 CL**3
|
||||
00114 EJECT DTSBU002
|
||||
00115 LINKAGE SECTION. DTSBU002
|
||||
00116 SKIP3 DTSBU002
|
||||
00117 01 L002-LINK-AREA. DTSBU002
|
||||
00118 ++INCLUDE DTSIL002 CL**3
|
||||
00119 EJECT DTSBU002
|
||||
00120 PROCEDURE DIVISION DTSBU002
|
||||
00121 USING L002-LINK-AREA. DTSBU002
|
||||
00122 SKIP2 DTSBU002
|
||||
00123 PERFORM P1000-PROCESS THRU CL**2
|
||||
00124 P1000-PROCESS-EXIT. CL**2
|
||||
00125 SKIP2 DTSBU002
|
||||
00126 GOBACK. DTSBU002
|
||||
00127 EJECT DTSBU002
|
||||
00128 P1000-PROCESS. DTSBU002
|
||||
00129 SKIP1 DTSBU002
|
||||
00130 MOVE '1' TO L001-OPTION. DTSBU002
|
||||
00131 MOVE L002-DATE TO L001-FED-8-DATE-9. DTSBU002
|
||||
00132 PERFORM S001-LINK-DATE THRU CL**2
|
||||
00133 S001-LINK-DATE-EXIT. CL**2
|
||||
00134 IF L001-INVALID-DATE DTSBU002
|
||||
00135 PERFORM S999-ABEND THRU S999-ABEND-EXIT. CL**2
|
||||
00136 SKIP1 DTSBU002
|
||||
00137 IF L002-UPPER-CASE DTSBU002
|
||||
00138 MOVE MONTH-NAME-1 (L001-FED-8-MO) TO LONG-DATE DTSBU002
|
||||
00139 MOVE MONTH-NAME-1-SHORT (L001-FED-8-MO) TO SHORT-DATE DTSBU002
|
||||
00140 ELSE DTSBU002
|
||||
00141 IF L002-MIXED-CASE DTSBU002
|
||||
00142 MOVE MONTH-NAME-2 (L001-FED-8-MO) TO LONG-DATE DTSBU002
|
||||
00143 MOVE MONTH-NAME-2-SHORT (L001-FED-8-MO) TO SHORT-DATE DTSBU002
|
||||
00144 ELSE DTSBU002
|
||||
00145 PERFORM S999-ABEND THRU S999-ABEND-EXIT. CL**2
|
||||
00146 SKIP1 DTSBU002
|
||||
00147 PERFORM P1100-DAY-AND-YEAR THRU CL**2
|
||||
00148 P1100-DAY-AND-YEAR-EXIT. CL**2
|
||||
00149 SKIP1 DTSBU002
|
||||
00150 MOVE LONG-DATE TO L002-LONG-TEXT-AREA. DTSBU002
|
||||
00151 ADD LONG-SUB, 5 GIVING L002-LONG-TEXT-CNT. DTSBU002
|
||||
00152 MOVE SHORT-DATE TO L002-SHORT-TEXT-AREA. DTSBU002
|
||||
00153 ADD SHORT-SUB, 5 GIVING L002-SHORT-TEXT-CNT. DTSBU002
|
||||
00154 SKIP1 DTSBU002
|
||||
00155 P1000-PROCESS-EXIT. CL**2
|
||||
00156 EXIT. DTSBU002
|
||||
00157 EJECT DTSBU002
|
||||
00158 P1100-DAY-AND-YEAR. DTSBU002
|
||||
00159 ADD MONTH-NAME-LENGTH (L001-FED-8-MO), 2 GIVING LONG-SUB. DTSBU002
|
||||
00160 MOVE +5 TO SHORT-SUB. DTSBU002
|
||||
00161 SKIP1 DTSBU002
|
||||
00162 MOVE L001-FED-8-DA TO WRK-DAY. DTSBU002
|
||||
00163 IF WRK-DAY-1 NOT = '0' DTSBU002
|
||||
00164 MOVE WRK-DAY-1 TO LONG-DATE (LONG-SUB : 1) DTSBU002
|
||||
00165 SHORT-DATE (SHORT-SUB : 1) DTSBU002
|
||||
00166 ADD +1 TO LONG-SUB DTSBU002
|
||||
00167 SHORT-SUB. DTSBU002
|
||||
00168 MOVE WRK-DAY-2 TO LONG-DATE (LONG-SUB : 1) DTSBU002
|
||||
00169 SHORT-DATE (SHORT-SUB : 1) DTSBU002
|
||||
00170 SKIP1 DTSBU002
|
||||
00171 ADD +1 TO LONG-SUB DTSBU002
|
||||
00172 SHORT-SUB. DTSBU002
|
||||
00173 MOVE ',' TO LONG-DATE (LONG-SUB : 1) DTSBU002
|
||||
00174 SHORT-DATE (SHORT-SUB : 1). DTSBU002
|
||||
00175 MOVE L001-FED-8-YR TO LONG-DATE (LONG-SUB + 2 : 4) DTSBU002
|
||||
00176 SHORT-DATE (SHORT-SUB + 2 : 4). DTSBU002
|
||||
00177 SKIP1 DTSBU002
|
||||
00178 P1100-DAY-AND-YEAR-EXIT. EXIT. CL**2
|
||||
00179 EJECT DTSBU002
|
||||
00180 S001-LINK-DATE. DTSBU002
|
||||
00181 SKIP1 DTSBU002
|
||||
00182 CALL 'DTSBU001' CL**2
|
||||
00183 USING L001-LINK-AREA. DTSBU002
|
||||
00184 SKIP1 DTSBU002
|
||||
00185 S001-LINK-DATE-EXIT. EXIT. CL**2
|
||||
00186 EJECT DTSBU002
|
||||
00187 S999-ABEND. DTSBU002
|
||||
00188 SKIP1 DTSBU002
|
||||
00189 CALL 'DTSBU999' CL**2
|
||||
00190 USING WRK-ABEND-CD. DTSBU002
|
||||
00191 SKIP1 DTSBU002
|
||||
00192 S999-ABEND-EXIT. EXIT. CL**2
|
||||
Reference in New Issue
Block a user