105 lines
8.2 KiB
COBOL
105 lines
8.2 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/24/98
|
|
00002 PROGRAM-ID. DTSCU024 DTSCU024
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004
|
|
00004 DATE-WRITTEN MAY 1994. DTSCU024
|
|
00005 DATE-COMPILED. DTSCU024
|
|
00006 SKIP3 DTSCU024
|
|
00007 ***** DTSCU024
|
|
00008 * DTSCU024
|
|
00009 * FUNCTION: START/END YEAR/QUARTER FROM SCREEN FORMAT/EDIT DTSCU024
|
|
00010 * DTSCU024
|
|
00011 * DTSCU024
|
|
00012 * MODIFICATION LOG: DTSCU024
|
|
00013 * DTSCU024
|
|
00014 * 08/04/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU024. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00016 * DTSCU024
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU024
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU024
|
|
00019 * WORK ORDER: PROGRAMMER: DTSCU024
|
|
00020 * DTSCU024
|
|
00021 * DTSCU024
|
|
00022 * DESCRIPTION: RECEIVES A GROUP OF FOUR SCREEN FIELDS. DTSCU024
|
|
00023 * DTSCU024
|
|
00024 ***** DTSCU024
|
|
00025 SKIP3 DTSCU024
|
|
00026 ENVIRONMENT DIVISION. DTSCU024
|
|
00027 DATA DIVISION. DTSCU024
|
|
00028 SKIP3 DTSCU024
|
|
00029 WORKING-STORAGE SECTION. DTSCU024
|
|
000295 77 PAN-VALET PICTURE X(24) VALUE '004DTSCU024 08/24/98'. DTSCU024
|
|
00030 01 WRK-AREA. DTSCU024
|
|
00031 05 WRK-ABS-START-QTR PIC S9(04) COMP. DTSCU024
|
|
00032 01 DTSIL004-COMM-AREA. CL**2
|
|
00033 ++INCLUDE DTSIL004 CL**3
|
|
00034 LINKAGE SECTION. DTSCU024
|
|
00035 01 DFHCOMMAREA. DTSCU024
|
|
00036 ++INCLUDE DTSIL024 CL**3
|
|
00037 EJECT DTSCU024
|
|
00038 PROCEDURE DIVISION. DTSCU024
|
|
00039 * INTIALIZE DTSCU024
|
|
00040 MOVE ZERO TO L024-START-YRQ DTSCU024
|
|
00041 L024-END-YRQ DTSCU024
|
|
00042 L024-QTRS-SPANNED. DTSCU024
|
|
00043 SET L024-START-VALID TO TRUE. DTSCU024
|
|
00044 SET L024-END-VALID TO TRUE. DTSCU024
|
|
00045 INSPECT L024-S-YRQ-RANGE-AREA CONVERTING LOW-VALUE TO SPACE. DTSCU024
|
|
00046 SKIP1 DTSCU024
|
|
00047 SET L004-FROM-3 TO TRUE. DTSCU024
|
|
00048 SKIP1 DTSCU024
|
|
00049 * START QUARTER DTSCU024
|
|
00050 IF L024-S-START-YR = SPACE DTSCU024
|
|
00051 AND L024-S-START-Q = SPACE DTSCU024
|
|
00052 SET L024-START-NO-ENTRY TO TRUE DTSCU024
|
|
00053 ELSE DTSCU024
|
|
00054 MOVE L024-S-START-YR TO L004-QTR-3-YR-X DTSCU024
|
|
00055 MOVE L024-S-START-Q TO L004-QTR-3-Q-X DTSCU024
|
|
00056 PERFORM S004-QTR THRU S004-EXIT DTSCU024
|
|
00057 IF L004-INVALID-QTR DTSCU024
|
|
00058 SET L024-START-NOT-VALID TO TRUE DTSCU024
|
|
00059 ELSE DTSCU024
|
|
00060 MOVE L004-QTR-5-9 TO L024-START-YRQ DTSCU024
|
|
00061 MOVE L004-ABS-QTR TO WRK-ABS-START-QTR. DTSCU024
|
|
00062 SKIP1 DTSCU024
|
|
00063 * END QUARTER DTSCU024
|
|
00064 IF L024-S-END-YR = SPACE DTSCU024
|
|
00065 AND L024-S-END-Q = SPACE DTSCU024
|
|
00066 IF L024-END-DEFAULT DTSCU024
|
|
00067 AND L024-START-VALID DTSCU024
|
|
00068 SET L024-END-COPIED-FROM-START TO TRUE DTSCU024
|
|
00069 MOVE L024-START-YRQ TO L024-END-YRQ DTSCU024
|
|
00070 MOVE +1 TO L024-QTRS-SPANNED DTSCU024
|
|
00071 ELSE DTSCU024
|
|
00072 SET L024-END-NO-ENTRY TO TRUE DTSCU024
|
|
00073 END-IF DTSCU024
|
|
00074 GO TO INIT0199-GO-BACK. DTSCU024
|
|
00075 SKIP1 DTSCU024
|
|
00076 MOVE L024-S-END-YR TO L004-QTR-3-YR-X. DTSCU024
|
|
00077 MOVE L024-S-END-Q TO L004-QTR-3-Q-X. DTSCU024
|
|
00078 PERFORM S004-QTR THRU S004-EXIT. DTSCU024
|
|
00079 IF L004-INVALID-QTR DTSCU024
|
|
00080 SET L024-END-NOT-VALID TO TRUE DTSCU024
|
|
00081 ELSE DTSCU024
|
|
00082 MOVE L004-QTR-5-9 TO L024-END-YRQ DTSCU024
|
|
00083 IF L024-START-VALID DTSCU024
|
|
00084 * CROSS-EDITS DTSCU024
|
|
00085 IF L024-START-YRQ > L024-END-YRQ DTSCU024
|
|
00086 SET L024-END-BEFORE-START TO TRUE DTSCU024
|
|
00087 ELSE DTSCU024
|
|
00088 COMPUTE L024-QTRS-SPANNED = DTSCU024
|
|
00089 L004-ABS-QTR - WRK-ABS-START-QTR + 1. DTSCU024
|
|
00090 SKIP1 DTSCU024
|
|
00091 INIT0199-GO-BACK. DTSCU024
|
|
00092 EXEC CICS DTSCU024
|
|
00093 RETURN DTSCU024
|
|
00094 END-EXEC. DTSCU024
|
|
00095 * GOBACK. DTSCU024
|
|
00096 SKIP3 DTSCU024
|
|
00097 S004-QTR. DTSCU024
|
|
00098 EXEC CICS LINK DTSCU024
|
|
00099 PROGRAM ('DTSCU004') CL**2
|
|
00100 COMMAREA (DTSIL004-COMM-AREA) CL**2
|
|
00101 END-EXEC. DTSCU024
|
|
00102 S004-EXIT. DTSCU024
|
|
00103 EXIT. DTSCU024
|