DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
104
CICS/DTSCU024.cob
Normal file
104
CICS/DTSCU024.cob
Normal file
@ -0,0 +1,104 @@
|
||||
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
|
||||
Reference in New Issue
Block a user