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