DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
277
CICS/DTSCU005.cob
Normal file
277
CICS/DTSCU005.cob
Normal file
@ -0,0 +1,277 @@
|
||||
00001 IDENTIFICATION DIVISION. 10/21/98
|
||||
00002 PROGRAM-ID. DTSCU005 DTSCU005
|
||||
00003 AUTHOR. LV009
|
||||
00004 ***** DTSCU005
|
||||
00005 * DTSCU005
|
||||
00006 * NAME: DTSCU005 CL**2
|
||||
00007 * DTSCU005
|
||||
00008 * FUNCTION: ABSOLUTE TIME EDIT/CONVERSION MODULE. DTSCU005
|
||||
00009 * DTSCU005
|
||||
00010 * DTSCU005
|
||||
00011 * DTSCU005
|
||||
00012 * MODIFICATION LOG: DTSCU005
|
||||
00013 * DTSCU005
|
||||
00014 * 11/05/91 INITIAL DEVELOPMENT. DTSCU005
|
||||
00015 * WORK ORDER: PROGRAMMER: TCL DTSCU005
|
||||
00016 * DTSCU005
|
||||
00017 * 02/12/92 WORK ORDER: PROGRAMMER: JME DTSCU005
|
||||
00018 * DTSCU005
|
||||
00019 * 03/21/94 NAME CHANGE FOR MONTANA. ADDED "EXIT."S. DTSCU005
|
||||
00020 * WORK ORDER: PROGRAMMER: RHC DTSCU005
|
||||
00021 * DTSCU005
|
||||
00022 * 09/19/1998 REVIEWED AND MODIFIED FOR DC. CL**2
|
||||
00023 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2
|
||||
00024 * CL**2
|
||||
00025 * 09/29/1998 ADDED L005-SLASH-8-DATE RELATED CODE. CL**3
|
||||
00026 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**3
|
||||
00027 * CL**3
|
||||
00028 * 10/14/1998 ADDED L005-DATE-8-SLASH-TIME CODE. CL**5
|
||||
00029 * CHANGED FILLER FROM 12 TO 30 BYTES. CL**5
|
||||
00030 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1. CL**5
|
||||
00031 * CL**5
|
||||
00032 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
||||
00033 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
||||
00034 * REFERENCE: XXXXXXXXXXXXXX PROGRAMMER: XXX CL**2
|
||||
00035 * DTSCU005
|
||||
00036 * DTSCU005
|
||||
00037 * DESCRIPTION: DTSCU005
|
||||
00038 * DTSCU005
|
||||
00039 ***** DTSCU005
|
||||
00040 CL**2
|
||||
00041 CL**2
|
||||
00042 CL**2
|
||||
00043 ENVIRONMENT DIVISION. DTSCU005
|
||||
00044 CL**2
|
||||
00045 CL**2
|
||||
00046 DATA DIVISION. DTSCU005
|
||||
00047 CL**2
|
||||
00048 WORKING-STORAGE SECTION. DTSCU005
|
||||
000485 77 PAN-VALET PICTURE X(24) VALUE '009DTSCU005 10/21/98'. DTSCU005
|
||||
00049 CL**2
|
||||
00050 01 WS-MISC-VARIABLES. DTSCU005
|
||||
00051 05 MSEC-PER-HOUR PIC S9(15) COMP-3 DTSCU005
|
||||
00052 VALUE +3600000. DTSCU005
|
||||
00053 CL**2
|
||||
00054 05 MSEC-PER-MINUTE PIC S9(15) COMP-3 DTSCU005
|
||||
00055 VALUE +60000. DTSCU005
|
||||
00056 CL**2
|
||||
00057 05 MSEC-PER-SECOND PIC S9(15) COMP-3 DTSCU005
|
||||
00058 VALUE +1000. DTSCU005
|
||||
00059 CL**2
|
||||
00060 05 MSEC-PER-DAY PIC S9(15) COMP-3 DTSCU005
|
||||
00061 VALUE +86400000. DTSCU005
|
||||
00062 CL**2
|
||||
00063 05 ABS-DAYS-FROM-01011900 PIC S9(08) COMP. DTSCU005
|
||||
00064 CL**2
|
||||
00065 05 JAN011930-ABS-DAY PIC S9(08) COMP. DTSCU005
|
||||
00066 CL**2
|
||||
00067 05 WS-ABEND-CODE PIC X(04). DTSCU005
|
||||
00068 CL**2
|
||||
00069 05 WS-DATE-FORMAT PIC 9(06). DTSCU005
|
||||
00070 05 FILLER REDEFINES WS-DATE-FORMAT. DTSCU005
|
||||
00071 10 WS-DATE-MO PIC 9(02). DTSCU005
|
||||
00072 10 WS-DATE-DAY PIC 9(02). DTSCU005
|
||||
00073 10 WS-DATE-YEAR PIC 9(02). DTSCU005
|
||||
00074 CL**2
|
||||
00075 05 WRK-TIME PIC 9(06). DTSCU005
|
||||
00076 05 FILLER REDEFINES WRK-TIME. DTSCU005
|
||||
00077 10 WRK-HOUR PIC 9(02). DTSCU005
|
||||
00078 10 WRK-MINUTE PIC 9(02). DTSCU005
|
||||
00079 10 WRK-SECOND PIC 9(02). DTSCU005
|
||||
00080 EJECT CL**2
|
||||
00081 01 DTSIL001-COMM-AREA. CL**2
|
||||
00082 ++INCLUDE DTSIL001 CL**2
|
||||
00083 EJECT CL**2
|
||||
00084 LINKAGE SECTION. DTSCU005
|
||||
00085 CL**2
|
||||
00086 01 DFHCOMMAREA. DTSCU005
|
||||
00087 ++INCLUDE DTSIL005 CL**2
|
||||
00088 EJECT CL**2
|
||||
00089 PROCEDURE DIVISION. DTSCU005
|
||||
00090 IF L005-FROM-SYS DTSCU005
|
||||
00091 PERFORM PROC0100-FROM-SYS THRU PROC0100-EXIT CL**7
|
||||
00092 ELSE DTSCU005
|
||||
00093 IF L005-FROM-ABSTIME DTSCU005
|
||||
00094 PERFORM PROC0200-FROM-ABSTIME THRU PROC0200-EXIT CL**7
|
||||
00095 ELSE DTSCU005
|
||||
00096 IF L005-FROM-NINES-COMPLEMENT DTSCU005
|
||||
00097 PERFORM PROC0300-FROM-ABSTIME-C THRU PROC0300-EXIT CL**7
|
||||
00098 ELSE DTSCU005
|
||||
00099 IF L005-FROM-DATE-TIME DTSCU005
|
||||
00100 PERFORM PROC0400-FROM-DATE-TIME THRU PROC0400-EXIT CL**7
|
||||
00101 ELSE DTSCU005
|
||||
00102 MOVE 'U005' TO WS-ABEND-CODE DTSCU005
|
||||
00103 GO TO S899-ABEND. DTSCU005
|
||||
00104 CL**2
|
||||
00105 INIT0199-GO-BACK. DTSCU005
|
||||
00106 EXEC CICS DTSCU005
|
||||
00107 RETURN DTSCU005
|
||||
00108 END-EXEC. DTSCU005
|
||||
00109 CL**2
|
||||
00110 GOBACK. CL**2
|
||||
00111 EJECT CL**2
|
||||
00112 PROC0100-FROM-SYS. DTSCU005
|
||||
00113 PERFORM PROC0500-SYS-ASKTIME THRU PROC0500-EXIT. CL**7
|
||||
00114 PERFORM PROC0600-ABSTIME-C THRU PROC0600-EXIT. CL**7
|
||||
00115 PERFORM PROC0700-FORMAT-TIME THRU PROC0700-EXIT. CL**7
|
||||
00116 PERFORM PROC0800-SLASH-DATE THRU PROC0800-EXIT. CL**7
|
||||
00117 MOVE WRK-TIME TO L005-TIME. DTSCU005
|
||||
00118 PERFORM PROC0900-SHOW-TIME THRU PROC0900-EXIT. CL**7
|
||||
00119 MOVE WS-DATE-FORMAT TO L001-CAL-6-DATE-9. DTSCU005
|
||||
00120 MOVE '4' TO L001-OPTION. DTSCU005
|
||||
00121 PERFORM S001-DATE THRU S001-EXIT. DTSCU005
|
||||
00122 MOVE L001-FED-8-DATE-9 TO L005-DATE. DTSCU005
|
||||
00123 PERFORM PROC0950-SHOW-DATE-8 THRU PROC0950-EXIT. CL**7
|
||||
00124 CL**2
|
||||
00125 PROC0100-EXIT. CL**7
|
||||
00126 EXIT. CL**7
|
||||
00127 CL**2
|
||||
00128 PROC0200-FROM-ABSTIME. DTSCU005
|
||||
00129 PERFORM PROC0600-ABSTIME-C THRU PROC0600-EXIT. CL**7
|
||||
00130 PERFORM PROC0700-FORMAT-TIME THRU PROC0700-EXIT. CL**7
|
||||
00131 PERFORM PROC0800-SLASH-DATE THRU PROC0800-EXIT. CL**7
|
||||
00132 MOVE WRK-TIME TO L005-TIME. DTSCU005
|
||||
00133 PERFORM PROC0900-SHOW-TIME THRU PROC0900-EXIT. CL**7
|
||||
00134 MOVE WS-DATE-FORMAT TO L001-CAL-6-DATE-9. DTSCU005
|
||||
00135 MOVE '4' TO L001-OPTION. DTSCU005
|
||||
00136 PERFORM S001-DATE THRU S001-EXIT. DTSCU005
|
||||
00137 MOVE L001-FED-8-DATE-9 TO L005-DATE. DTSCU005
|
||||
00138 PERFORM PROC0950-SHOW-DATE-8 THRU PROC0950-EXIT. CL**7
|
||||
00139 CL**2
|
||||
00140 PROC0200-EXIT. CL**7
|
||||
00141 EXIT. CL**7
|
||||
00142 CL**2
|
||||
00143 CL**2
|
||||
00144 PROC0300-FROM-ABSTIME-C. DTSCU005
|
||||
00145 PERFORM PROC1000-ABSTIME THRU PROC1000-EXIT. CL**7
|
||||
00146 PERFORM PROC0700-FORMAT-TIME THRU PROC0700-EXIT. CL**7
|
||||
00147 PERFORM PROC0800-SLASH-DATE THRU PROC0800-EXIT. CL**7
|
||||
00148 MOVE WRK-TIME TO L005-TIME. DTSCU005
|
||||
00149 PERFORM PROC0900-SHOW-TIME THRU PROC0900-EXIT. CL**7
|
||||
00150 MOVE WS-DATE-FORMAT TO L001-CAL-6-DATE-9. DTSCU005
|
||||
00151 MOVE '4' TO L001-OPTION. DTSCU005
|
||||
00152 PERFORM S001-DATE THRU S001-EXIT. DTSCU005
|
||||
00153 MOVE L001-FED-8-DATE-9 TO L005-DATE. DTSCU005
|
||||
00154 PERFORM PROC0950-SHOW-DATE-8 THRU PROC0950-EXIT. CL**7
|
||||
00155 CL**2
|
||||
00156 PROC0300-EXIT. CL**7
|
||||
00157 EXIT. CL**7
|
||||
00158 CL**7
|
||||
00159 CL**2
|
||||
00160 CL**2
|
||||
00161 PROC0400-FROM-DATE-TIME. DTSCU005
|
||||
00162 MOVE 19300101 TO L001-FED-8-DATE-9. DTSCU005
|
||||
00163 MOVE '1' TO L001-OPTION. DTSCU005
|
||||
00164 PERFORM S001-DATE THRU S001-EXIT. DTSCU005
|
||||
00165 MOVE L001-JUL-ABS-DAY TO JAN011930-ABS-DAY. DTSCU005
|
||||
00166 MOVE L005-DATE TO L001-FED-8-DATE-9. DTSCU005
|
||||
00167 MOVE '1' TO L001-OPTION. DTSCU005
|
||||
00168 PERFORM S001-DATE THRU S001-EXIT. DTSCU005
|
||||
00169 IF L001-INVALID-DATE DTSCU005
|
||||
00170 MOVE 'U005' TO WS-ABEND-CODE DTSCU005
|
||||
00171 PERFORM S899-ABEND THRU S899-EXIT. DTSCU005
|
||||
00172 COMPUTE ABS-DAYS-FROM-01011900 DTSCU005
|
||||
00173 = 10957 + (L001-JUL-ABS-DAY - JAN011930-ABS-DAY). DTSCU005
|
||||
00174 MOVE L005-TIME TO WRK-TIME. DTSCU005
|
||||
00175 COMPUTE L005-ABSTIME DTSCU005
|
||||
00176 = (ABS-DAYS-FROM-01011900 * MSEC-PER-DAY) DTSCU005
|
||||
00177 + (WRK-HOUR * MSEC-PER-HOUR) DTSCU005
|
||||
00178 + (WRK-MINUTE * MSEC-PER-MINUTE) DTSCU005
|
||||
00179 + (WRK-SECOND * MSEC-PER-SECOND). DTSCU005
|
||||
00180 PERFORM PROC0600-ABSTIME-C THRU PROC0600-EXIT. CL**7
|
||||
00181 MOVE L001-SLASH-DATE TO L005-SLASH-DATE. DTSCU005
|
||||
00182 PERFORM PROC0900-SHOW-TIME THRU PROC0900-EXIT. CL**7
|
||||
00183 PERFORM PROC0950-SHOW-DATE-8 THRU PROC0950-EXIT. CL**8
|
||||
00184 CL**2
|
||||
00185 PROC0400-EXIT. CL**7
|
||||
00186 EXIT. CL**7
|
||||
00187 CL**2
|
||||
00188 CL**2
|
||||
00189 PROC0500-SYS-ASKTIME. DTSCU005
|
||||
00190 EXEC CICS DTSCU005
|
||||
00191 ASKTIME DTSCU005
|
||||
00192 ABSTIME (L005-ABSTIME) DTSCU005
|
||||
00193 END-EXEC. DTSCU005
|
||||
00194 PROC0500-EXIT. CL**7
|
||||
00195 EXIT. DTSCU005
|
||||
00196 CL**2
|
||||
00197 CL**2
|
||||
00198 CL**2
|
||||
00199 PROC0600-ABSTIME-C. DTSCU005
|
||||
00200 COMPUTE L005-NINES-COMPLEMENT-ABSTIME DTSCU005
|
||||
00201 = 999999999999999 - L005-ABSTIME. DTSCU005
|
||||
00202 PROC0600-EXIT. CL**7
|
||||
00203 EXIT. DTSCU005
|
||||
00204 CL**2
|
||||
00205 CL**2
|
||||
00206 CL**2
|
||||
00207 PROC0700-FORMAT-TIME. DTSCU005
|
||||
00208 EXEC CICS DTSCU005
|
||||
00209 FORMATTIME DTSCU005
|
||||
00210 ABSTIME (L005-ABSTIME) DTSCU005
|
||||
00211 MMDDYY (WS-DATE-FORMAT) DTSCU005
|
||||
00212 TIME (WRK-TIME) DTSCU005
|
||||
00213 END-EXEC. DTSCU005
|
||||
00214 PROC0700-EXIT. CL**7
|
||||
00215 EXIT. DTSCU005
|
||||
00216 CL**2
|
||||
00217 CL**2
|
||||
00218 CL**2
|
||||
00219 PROC0800-SLASH-DATE. DTSCU005
|
||||
00220 MOVE ' / / ' TO L005-SLASH-DATE. DTSCU005
|
||||
00221 MOVE WS-DATE-MO TO L005-SLASH-MO. DTSCU005
|
||||
00222 MOVE WS-DATE-DAY TO L005-SLASH-DA. DTSCU005
|
||||
00223 MOVE WS-DATE-YEAR TO L005-SLASH-YR. DTSCU005
|
||||
00224 PROC0800-EXIT. CL**7
|
||||
00225 EXIT. DTSCU005
|
||||
00226 CL**2
|
||||
00227 CL**2
|
||||
00228 CL**2
|
||||
00229 PROC0900-SHOW-TIME. DTSCU005
|
||||
00230 MOVE ' : : ' TO L005-DISPLAY-TIME. DTSCU005
|
||||
00231 MOVE WRK-HOUR TO L005-DISPLAY-H. CL**6
|
||||
00232 MOVE WRK-MINUTE TO L005-DISPLAY-M. CL**6
|
||||
00233 MOVE WRK-SECOND TO L005-DISPLAY-S. CL**6
|
||||
00234 PROC0900-EXIT. CL**7
|
||||
00235 EXIT. DTSCU005
|
||||
00236 CL**2
|
||||
00237 CL**2
|
||||
00238 CL**2
|
||||
00239 PROC0950-SHOW-DATE-8. CL**5
|
||||
00240 MOVE ' / ' TO L005-DATE-8-SLASH-TIME. CL**6
|
||||
00241 MOVE L001-FED-8-YR TO L005-DATE-8-YR. CL**7
|
||||
00242 MOVE L001-FED-8-MO TO L005-DATE-8-MO. CL**9
|
||||
00243 MOVE L001-FED-8-DA TO L005-DATE-8-DA. CL**9
|
||||
00244 MOVE WRK-HOUR TO L005-TIME-HH. CL**7
|
||||
00245 MOVE WRK-MINUTE TO L005-TIME-MM. CL**7
|
||||
00246 MOVE WRK-SECOND TO L005-TIME-SS. CL**7
|
||||
00247 PROC0950-EXIT. CL**7
|
||||
00248 EXIT. CL**5
|
||||
00249 CL**5
|
||||
00250 CL**5
|
||||
00251 CL**5
|
||||
00252 PROC1000-ABSTIME. DTSCU005
|
||||
00253 COMPUTE L005-ABSTIME DTSCU005
|
||||
00254 = 999999999999999 - L005-NINES-COMPLEMENT-ABSTIME. DTSCU005
|
||||
00255 PROC1000-EXIT. CL**8
|
||||
00256 EXIT. DTSCU005
|
||||
00257 CL**2
|
||||
00258 CL**2
|
||||
00259 CL**2
|
||||
00260 S001-DATE. DTSCU005
|
||||
00261 EXEC CICS DTSCU005
|
||||
00262 LINK PROGRAM ('DTSCU001') CL**2
|
||||
00263 COMMAREA (DTSIL001-COMM-AREA) CL**2
|
||||
00264 END-EXEC. DTSCU005
|
||||
00265 S001-EXIT. DTSCU005
|
||||
00266 EXIT. DTSCU005
|
||||
00267 CL**2
|
||||
00268 CL**2
|
||||
00269 CL**2
|
||||
00270 S899-ABEND. DTSCU005
|
||||
00271 EXEC CICS DTSCU005
|
||||
00272 ABEND DTSCU005
|
||||
00273 ABCODE (WS-ABEND-CODE) DTSCU005
|
||||
00274 END-EXEC. DTSCU005
|
||||
00275 S899-EXIT. DTSCU005
|
||||
00276 EXIT. DTSCU005
|
||||
Reference in New Issue
Block a user