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

106
Batch/DTSBU007.cob Normal file
View File

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