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

99
CICS/DTSCU007.cob Normal file
View File

@ -0,0 +1,99 @@
00001 IDENTIFICATION DIVISION. 10/06/99
00002 PROGRAM-ID. DTSCU007 DTSCU007
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005
00004 DATE-WRITTEN NOVEMBER 1991. DTSCU007
00005 DATE-COMPILED. DTSCU007
00006 SKIP3 DTSCU007
00007 ***** DTSCU007
00008 * DTSCU007
00009 * FUNCTION: AUDIT YEAR / EDIT CONVERSION DTSCU007
00010 * DTSCU007
00011 * DTSCU007
00012 * MODIFICATION LOG: DTSCU007
00013 * DTSCU007
00014 * 08/03/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU007. CL**2
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
00016 * DTSCU007
00017 * DTSCU007
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU007
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU007
00020 * WORK ORDER: PROGRAMMER: DTSCU007
00021 * DTSCU007
00022 * DTSCU007
00023 * DESCRIPTION: DTSCU007
00024 * DTSCU007
00025 ***** DTSCU007
00026 SKIP3 DTSCU007
00027 ENVIRONMENT DIVISION. DTSCU007
00028 DATA DIVISION. DTSCU007
00029 SKIP3 DTSCU007
00030 WORKING-STORAGE SECTION. DTSCU007
000305 77 PAN-VALET PICTURE X(24) VALUE '005DTSCU007 10/06/99'. DTSCU007
00031 01 WRK-AREA. DTSCU007
00032 05 WS-ABEND-CODE PIC X(04) DTSCU007
00033 VALUE 'U007'. DTSCU007
00034 05 WS-YEAR-APART. CL**3
00035 10 WS-CENTURY PIC 9(02). DTSCU007
00036 10 WS-YR PIC 9(02). DTSCU007
00037 05 WS-START-YRQ-X. DTSCU007
00038 10 WS-START-YR PIC 9(04). DTSCU007
00039 10 WS-START-Q PIC 9(01) DTSCU007
00040 VALUE 1. DTSCU007
00041 05 WS-START-YRQ-9 REDEFINES WS-START-YRQ-X DTSCU007
00042 PIC 9(05). DTSCU007
00043 05 WS-END-YRQ-X. DTSCU007
00044 10 WS-END-YR PIC 9(04). DTSCU007
00045 10 WS-END-Q PIC 9(01) DTSCU007
00046 VALUE 4. DTSCU007
00047 05 WS-END-YRQ-9 REDEFINES WS-END-YRQ-X DTSCU007
00048 PIC 9(05). DTSCU007
00049 LINKAGE SECTION. DTSCU007
00050 01 DFHCOMMAREA. DTSCU007
00051 ++INCLUDE DTSIL007 CL**2
00052 PROCEDURE DIVISION. DTSCU007
00053 SKIP2 DTSCU007
00054 SET L007-VALID-YR TO TRUE. CL**5
00055 SKIP2 CL**5
00056 IF L007-FROM-YR-4 DTSCU007
00057 PERFORM PROC100-FROM-YR-4 THRU CL**3
00058 PROC100-FROM-YR-4-EXIT CL**3
00059 ELSE DTSCU007
00060 IF L007-FROM-YR-2 DTSCU007
00061 PERFORM PROC200-FROM-YR-2 THRU CL**3
00062 PROC200-FROM-YR-2-EXIT CL**3
00063 ELSE DTSCU007
00064 EXEC CICS ABEND ABCODE (WS-ABEND-CODE) END-EXEC. CL**3
00065 CL**4
00066 IF L007-NOT-VALID-YR CL**4
00067 GO TO INIT0199-GOBACK. CL**4
00068 CL**4
00069 MOVE L007-YR-4-9 TO CL**4
00070 WS-START-YR CL**4
00071 WS-END-YR CL**4
00072 MOVE WS-START-YRQ-9 TO L007-START-YRQ CL**4
00073 MOVE WS-END-YRQ-9 TO L007-END-YRQ CL**4
00074 SET L007-VALID-YR TO TRUE. CL**4
00075 INIT0199-GOBACK. DTSCU007
00076 EXEC CICS DTSCU007
00077 RETURN DTSCU007
00078 END-EXEC. DTSCU007
00079 PROC100-FROM-YR-4. DTSCU007
00080 IF L007-YR-4-9 NOT NUMERIC OR CL**3
00081 L007-YR-4-9 < 1930 OR CL**3
00082 L007-YR-4-9 > 2029 CL**3
00083 SET L007-NOT-VALID-YR TO TRUE CL**3
00084 GO TO PROC100-FROM-YR-4-EXIT. CL**3
00085 SKIP2 DTSCU007
00086 MOVE L007-YR-4-9 TO WS-YEAR-APART. DTSCU007
00087 MOVE WS-YR TO L007-YR-2-9. DTSCU007
00088 PROC100-FROM-YR-4-EXIT. EXIT. CL**3
00089 SKIP2 DTSCU007
00090 PROC200-FROM-YR-2. DTSCU007
00091 IF L007-YR-2-9 NOT NUMERIC DTSCU007
00092 SET L007-NOT-VALID-YR TO TRUE CL**3
00093 GO TO PROC200-FROM-YR-2-EXIT. CL**3
00094 IF L007-YR-2-9 < 30 DTSCU007
00095 ADD L007-YR-2-9 2000 GIVING L007-YR-4-9 DTSCU007
00096 ELSE DTSCU007
00097 ADD L007-YR-2-9 1900 GIVING L007-YR-4-9. DTSCU007
00098 PROC200-FROM-YR-2-EXIT. EXIT. CL**3