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

61
Batch/DTSBU017.cob Normal file
View File

@ -0,0 +1,61 @@
00001 IDENTIFICATION DIVISION. 04/05/04
00002 PROGRAM-ID. DTSBU017 DTSBU017
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV001
00004 DATE-WRITTEN AUGUST 2003. DTSBU017
00005 DATE-COMPILED. DTSBU017
00006 SKIP3 DTSBU017
00007 ***** DTSBU017
00008 * DTSBU017
00009 * FUNCTION: EDIT AND FORMAT FEIN FROM BATCH DTSBU017
00010 * DTSBU017
00011 * DTSBU017
00012 * MODIFICATION LOG: DTSBU017
00013 * DTSBU017
00014 * 08/06/98 INITIAL DEVELOPMENT. MODIFIED FROM DTSCU017. DTSBU017
00015 * WORK ORDER: PROGRAMMER: ZL1. DTSBU017
00016 * DTSBU017
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU017
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU017
00019 * WORK ORDER: PROGRAMMER: DTSBU017
00020 * DTSBU017
00021 * DTSBU017
00022 * DESCRIPTION: DTSBU017
00023 * DTSBU017
00024 ***** DTSBU017
00025 SKIP3 DTSBU017
00026 ENVIRONMENT DIVISION. DTSBU017
00027 DATA DIVISION. DTSBU017
00028 SKIP3 DTSBU017
00029 WORKING-STORAGE SECTION. DTSBU017
000295 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU017 04/05/04'. DTSBU017
00030 01 WRK-AREA. DTSBU017
00031 05 WRK-FEIN-X. DTSBU017
00032 10 WRK-FEIN-1 PIC X(02). DTSBU017
00033 10 WRK-FEIN-2 PIC X(07). DTSBU017
00034 05 WRK-FEIN-9 REDEFINES WRK-FEIN-X PIC 9(09). DTSBU017
00035 LINKAGE SECTION. DTSBU017
00036 01 L017-LINK-AREA. DTSBU017
00037 ++INCLUDE DTSIL017 DTSBU017
00038 PROCEDURE DIVISION USING L017-LINK-AREA. DTSBU017
00039 SKIP2 DTSBU017
00040 IF (L017-S-FEIN1 = SPACES OR LOW-VALUES) DTSBU017
00041 AND DTSBU017
00042 (L017-S-FEIN2 = SPACES OR LOW-VALUES) DTSBU017
00043 SET L017-NO-ENTRY TO TRUE DTSBU017
00044 MOVE ZERO TO L017-FEIN DTSBU017
00045 GO TO INIT0199-GO-BACK. DTSBU017
00046 IF (L017-S-FEIN1 NOT NUMERIC) DTSBU017
00047 OR DTSBU017
00048 (L017-S-FEIN2 NOT NUMERIC) DTSBU017
00049 OR DTSBU017
00050 ((L017-S-FEIN1 = ZEROS) AND (L017-S-FEIN2 = ZEROS)) DTSBU017
00051 SET L017-NOT-VALID TO TRUE DTSBU017
00052 MOVE ZERO TO L017-FEIN DTSBU017
00053 GO TO INIT0199-GO-BACK DTSBU017
00054 ELSE DTSBU017
00055 MOVE L017-S-FEIN1 TO WRK-FEIN-1 DTSBU017
00056 MOVE L017-S-FEIN2 TO WRK-FEIN-2 DTSBU017
00057 MOVE WRK-FEIN-9 TO L017-FEIN DTSBU017
00058 SET L017-VALID TO TRUE. DTSBU017
00059 INIT0199-GO-BACK. DTSBU017
00060 GOBACK. DTSBU017