278 lines
22 KiB
COBOL
278 lines
22 KiB
COBOL
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
|