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