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

78
CICS/DTSCU015.cob Normal file
View File

@ -0,0 +1,78 @@
00001 IDENTIFICATION DIVISION. 08/24/98
00002 PROGRAM-ID. DTSCU015 DTSCU015
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV006
00004 DATE-WRITTEN NOVEMBER 1991. DTSCU015
00005 DATE-COMPILED. DTSCU015
00006 SKIP3 DTSCU015
00007 ***** DTSCU015
00008 * DTSCU015
00009 * FUNCTION: DATE FROM SCREEN FORMAT/EDIT MODULE. DTSCU015
00010 * DTSCU015
00011 * DTSCU015
00012 * MODIFICATION LOG: DTSCU015
00013 * DTSCU015
00014 * 08/04/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU015. CL**2
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
00016 * DTSCU015
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU015
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU015
00019 * WORK ORDER: PROGRAMMER: DTSCU015
00020 * DTSCU015
00021 * DTSCU015
00022 * DESCRIPTION: DTSCU015
00023 * DTSCU015
00024 ***** DTSCU015
00025 SKIP3 DTSCU015
00026 ENVIRONMENT DIVISION. DTSCU015
00027 DATA DIVISION. DTSCU015
00028 SKIP3 DTSCU015
00029 WORKING-STORAGE SECTION. DTSCU015
000295 77 PAN-VALET PICTURE X(24) VALUE '006DTSCU015 08/24/98'. DTSCU015
00030 01 WRK-AREA. DTSCU015
00031 05 WRK-CAL-6-DATE-X. DTSCU015
00032 10 WRK-CAL-6-MO PIC X(02). DTSCU015
00033 10 WRK-CAL-6-DA PIC X(02). DTSCU015
00034 10 WRK-CAL-6-YR PIC X(02). DTSCU015
00035 SKIP3 DTSCU015
00036 01 DTSIL001-COMM-AREA. CL**2
00037 ++INCLUDE DTSIL001 CL**3
00038 LINKAGE SECTION. DTSCU015
00039 01 DFHCOMMAREA. DTSCU015
00040 ++INCLUDE DTSIL015 CL**4
00041 PROCEDURE DIVISION. DTSCU015
00042 SKIP2 DTSCU015
00043 IF (L015-S-MO = SPACES OR LOW-VALUES) DTSCU015
00044 AND DTSCU015
00045 (L015-S-DA = SPACES OR LOW-VALUES) DTSCU015
00046 AND DTSCU015
00047 (L015-S-YR = SPACES OR LOW-VALUES) DTSCU015
00048 MOVE ZERO TO L015-DATE DTSCU015
00049 SET L015-NO-ENTRY TO TRUE CL**2
00050 GO TO INIT0199-GO-BACK. DTSCU015
00051 MOVE L015-S-MO TO WRK-CAL-6-MO. DTSCU015
00052 MOVE L015-S-DA TO WRK-CAL-6-DA. DTSCU015
00053 MOVE L015-S-YR TO WRK-CAL-6-YR. DTSCU015
00054 MOVE WRK-CAL-6-DATE-X TO L001-CAL-6-DATE-X. DTSCU015
00055 MOVE '4' TO L001-OPTION. DTSCU015
00056 PERFORM S001-DATE THRU S001-EXIT. DTSCU015
00057 MOVE L001-FED-8-DATE-9 TO L015-DATE. DTSCU015
00058 IF L001-INVALID-DATE DTSCU015
00059 MOVE +0 TO L015-DATE DTSCU015
00060 SET L015-NOT-VALID TO TRUE CL**2
00061 ELSE DTSCU015
00062 MOVE L001-FED-8-DATE-9 TO L015-DATE DTSCU015
00063 SET L015-VALID TO TRUE. CL**5
00064 SKIP2 DTSCU015
00065 INIT0199-GO-BACK. DTSCU015
00066 EXEC CICS DTSCU015
00067 RETURN DTSCU015
00068 END-EXEC. DTSCU015
00069 GOBACK. DTSCU015
00070 SKIP2 DTSCU015
00071 S001-DATE. DTSCU015
00072 EXEC CICS DTSCU015
00073 LINK PROGRAM ('DTSCU001') CL**2
00074 COMMAREA (DTSIL001-COMM-AREA) CL**2
00075 END-EXEC. DTSCU015
00076 S001-EXIT. DTSCU015
00077 EXIT. DTSCU015