70 lines
5.5 KiB
COBOL
70 lines
5.5 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/24/98
|
|
00002 PROGRAM-ID. DTSCU016 DTSCU016
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004
|
|
00004 DATE-WRITTEN NOVEMBER 1991. DTSCU016
|
|
00005 DATE-COMPILED. DTSCU016
|
|
00006 SKIP3 DTSCU016
|
|
00007 ***** DTSCU016
|
|
00008 * DTSCU016
|
|
00009 * FUNCTION: YEAR/QUARTER FROM SCREEN FORMAT/EDIT DTSCU016
|
|
00010 * DTSCU016
|
|
00011 * DTSCU016
|
|
00012 * MODIFICATION LOG: DTSCU016
|
|
00013 * DTSCU016
|
|
00014 * 08/04/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU016. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00016 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU016
|
|
00017 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU016
|
|
00018 * WORK ORDER: PROGRAMMER: DTSCU016
|
|
00019 * DTSCU016
|
|
00020 * DTSCU016
|
|
00021 * DESCRIPTION: DTSCU016
|
|
00022 * DTSCU016
|
|
00023 ***** DTSCU016
|
|
00024 SKIP3 DTSCU016
|
|
00025 ENVIRONMENT DIVISION. DTSCU016
|
|
00026 DATA DIVISION. DTSCU016
|
|
00027 SKIP3 DTSCU016
|
|
00028 WORKING-STORAGE SECTION. DTSCU016
|
|
000285 77 PAN-VALET PICTURE X(24) VALUE '004DTSCU016 08/24/98'. DTSCU016
|
|
00029 01 WRK-AREA. DTSCU016
|
|
00030 05 WRK-QTR-3-X. DTSCU016
|
|
00031 10 WRK-QTR-3-YR PIC X(02). DTSCU016
|
|
00032 10 WRK-QTR-3-Q PIC X(01). DTSCU016
|
|
00033 01 DTSIL004-COMM-AREA. CL**2
|
|
00034 ++INCLUDE DTSIL004 CL**3
|
|
00035 LINKAGE SECTION. DTSCU016
|
|
00036 01 DFHCOMMAREA. DTSCU016
|
|
00037 ++INCLUDE DTSIL016 CL**3
|
|
00038 PROCEDURE DIVISION. DTSCU016
|
|
00039 SKIP2 DTSCU016
|
|
00040 IF L016-S-Q = SPACES OR LOW-VALUES DTSCU016
|
|
00041 AND DTSCU016
|
|
00042 L016-S-YR = SPACES OR LOW-VALUES DTSCU016
|
|
00043 SET L016-NO-ENTRY TO TRUE CL**2
|
|
00044 MOVE ZERO TO L016-YRQ DTSCU016
|
|
00045 GO TO INIT0199-GO-BACK. DTSCU016
|
|
00046 MOVE L016-S-Q TO WRK-QTR-3-Q. DTSCU016
|
|
00047 MOVE L016-S-YR TO WRK-QTR-3-YR. DTSCU016
|
|
00048 MOVE WRK-QTR-3-X TO L004-QTR-3-X. DTSCU016
|
|
00049 MOVE '2' TO L004-OPTION. DTSCU016
|
|
00050 PERFORM S001-QTR THRU S001-EXIT. DTSCU016
|
|
00051 IF L004-VALID-QTR DTSCU016
|
|
00052 MOVE L004-QTR-5-9 TO L016-YRQ DTSCU016
|
|
00053 SET L016-VALID TO TRUE CL**2
|
|
00054 ELSE DTSCU016
|
|
00055 MOVE +0 TO L016-YRQ DTSCU016
|
|
00056 SET L016-NOT-VALID TO TRUE. CL**2
|
|
00057 INIT0199-GO-BACK. DTSCU016
|
|
00058 EXEC CICS DTSCU016
|
|
00059 RETURN DTSCU016
|
|
00060 END-EXEC. DTSCU016
|
|
00061 GOBACK. DTSCU016
|
|
00062 S001-QTR. DTSCU016
|
|
00063 EXEC CICS DTSCU016
|
|
00064 LINK PROGRAM ('DTSCU004') CL**2
|
|
00065 COMMAREA (DTSIL004-COMM-AREA) CL**2
|
|
00066 END-EXEC. DTSCU016
|
|
00067 S001-EXIT. DTSCU016
|
|
00068 EXIT. DTSCU016
|