00001 IDENTIFICATION DIVISION. 05/13/99 00002 PROGRAM-ID. DTSCU029 DTSCU029 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008 00004 DATE-WRITTEN MAY 1999. CL**5 00005 DATE-COMPILED. DTSCU029 00006 SKIP3 DTSCU029 00007 ***** DTSCU029 00008 * DTSCU029 00009 * FUNCTION: YEAR/QUARTER (PICKUP INCLUDED) FROM SCREEN CL**5 00010 * FORMAT/EDIT. CL**5 00011 * CL**5 00012 * DTSCU029 00013 * MODIFICATION LOG: DTSCU029 00014 * DTSCU029 00015 * 05/13/1999 INITIAL DEVELOPMENT. CLONED FROM DTSCU016. CL**5 00016 * REFERENCE: PICKUP DIR PROGRAMMER: EHH CL**5 00017 * CL**5 00018 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**5 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**5 00020 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**5 00021 * DTSCU029 00022 * DTSCU029 00023 ***** DTSCU029 00024 CL**5 00025 CL**5 00026 CL**5 00027 ENVIRONMENT DIVISION. DTSCU029 00028 CL**5 00029 CL**5 00030 DATA DIVISION. DTSCU029 00031 CL**5 00032 CL**5 00033 WORKING-STORAGE SECTION. DTSCU029 000335 77 PAN-VALET PICTURE X(24) VALUE '008DTSCU029 05/13/99'. DTSCU029 00034 CL**5 00035 01 WRK-AREA. DTSCU029 00036 05 WRK-PICKUP-YRQ PIC S9(05) COMP-3 VALUE +19924. CL**6 00037 CL**5 00038 CL**5 00039 CL**5 00040 01 DTSIL004-COMM-AREA. CL**2 00041 ++INCLUDE DTSIL004 CL**3 00042 EJECT CL**5 00043 LINKAGE SECTION. DTSCU029 00044 CL**5 00045 01 DFHCOMMAREA. DTSCU029 00046 ++INCLUDE DTSIL029 CL**5 00047 EJECT CL**5 00048 PROCEDURE DIVISION. DTSCU029 00049 CL**5 00050 CL**5 00051 IF (L029-S-YR = SPACES OR LOW-VALUES) CL**5 00052 AND DTSCU029 00053 (L029-S-Q = SPACES OR LOW-VALUES) CL**5 00054 SET L029-NO-ENTRY TO TRUE CL**5 00055 MOVE ZERO TO L029-YRQ CL**5 00056 GO TO INIT0199-GO-BACK. CL**5 00057 CL**5 00058 CL**5 00059 IF (L029-S-YR = 'PU') CL**6 00060 AND CL**6 00061 (L029-S-Q = SPACES OR LOW-VALUES) CL**6 00062 SET L029-VALID TO TRUE CL**6 00063 MOVE WRK-PICKUP-YRQ TO L029-YRQ CL**6 00064 GO TO INIT0199-GO-BACK. CL**6 00065 CL**6 00066 CL**6 00067 MOVE L029-S-YR TO L004-QTR-3-YR-X. CL**8 00068 CL**7 00069 MOVE L029-S-Q TO L004-QTR-3-Q-X. CL**8 00070 CL**7 00071 PERFORM S004-FROM-3 THRU S004-EXIT. CL**6 00072 CL**7 00073 IF L004-VALID-QTR DTSCU029 00074 IF L004-QTR-5-9 > WRK-PICKUP-YRQ CL**7 00075 MOVE L004-QTR-5-9 TO L029-YRQ CL**7 00076 SET L029-VALID TO TRUE CL**7 00077 ELSE CL**7 00078 MOVE +0 TO L029-YRQ CL**7 00079 SET L029-NOT-VALID TO TRUE CL**7 00080 ELSE DTSCU029 00081 MOVE +0 TO L029-YRQ CL**5 00082 SET L029-NOT-VALID TO TRUE. CL**5 00083 CL**7 00084 CL**7 00085 INIT0199-GO-BACK. DTSCU029 00086 EXEC CICS DTSCU029 00087 RETURN DTSCU029 00088 END-EXEC. DTSCU029 00089 CL**7 00090 GOBACK. DTSCU029 00091 EJECT CL**7 00092 S004-FROM-3. CL**7 00093 SET L004-FROM-3 TO TRUE. CL**7 00094 GO TO S004-QTR. CL**7 00095 CL**7 00096 S004-QTR. CL**7 00097 EXEC CICS DTSCU029 00098 LINK PROGRAM ('DTSCU004') CL**2 00099 COMMAREA (DTSIL004-COMM-AREA) CL**2 00100 END-EXEC. DTSCU029 00101 S004-EXIT. CL**7 00102 EXIT. DTSCU029