62 lines
4.8 KiB
COBOL
62 lines
4.8 KiB
COBOL
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
|