giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

DUTAS re-platformed to Raincode - Initial Source Code

Browse Source
This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

103
CICS/DTSCU029.cob Normal file
View File

@ -0,0 +1,103 @@
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