00001 IDENTIFICATION DIVISION. 09/08/98 00002 PROGRAM-ID. DTSCU073. DTSCU073 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU073 00005 DATE-COMPILED. DTSCU073 00006 SKIP3 DTSCU073 00007 ***** DTSCU073 00008 * DTSCU073 00009 * FUNCTION: TELEPHONE NUMBER EDIT. DTSCU073 00010 * DTSCU073 00011 * DTSCU073 00012 * MODIFICATION LOG: DTSCU073 00013 * DTSCU073 00014 * 08/30/98 INITIAL DEVELOPMENT. COPIED FROM MACCU073. CL**2 00015 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00016 * DTSCU073 00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU073 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU073 00019 * WORK ORDER: PROGRAMMER: XXX DTSCU073 00020 * DTSCU073 00021 * DTSCU073 00022 * DESCRIPTION: DTSCU073 00023 * DTSCU073 00024 * DTSCU073 IS PASSED L073-TELEPHONE. DTSCU073 EDITS CL**2 00025 * L073-TELEPHONE AND RETURNS L073-RESULT-IND. DTSCU073 00026 * DTSCU073 00027 * L073-ST AND L073-ZIP ARE NOT USED. IN THE FUTURE, DTSCU073 00028 * TIGHTER EDITS ON L073-TELEPHONE COULD UTILIZE L073-ST AND DTSCU073 00029 * L073-ZIP. DTSCU073 00030 * DTSCU073 00031 ***** DTSCU073 00032 CL**3 00033 ENVIRONMENT DIVISION. DTSCU073 00034 CL**3 00035 DATA DIVISION. DTSCU073 00036 CL**3 00037 WORKING-STORAGE SECTION. DTSCU073 000375 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU073 09/08/98'. DTSCU073 00038 CL**3 00039 01 WRK-AREA. DTSCU073 00040 05 WRK-ABEND-CODE PIC X(04) VALUE 'U073'. DTSCU073 00041 CL**3 00042 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU073 00043 EJECT DTSCU073 00044 LINKAGE SECTION. DTSCU073 00045 SKIP3 DTSCU073 00046 01 DFHCOMMAREA. DTSCU073 00047 ++INCLUDE DTSIL073 CL**3 00048 EJECT DTSCU073 00049 PROCEDURE DIVISION. DTSCU073 00050 CL**3 00051 SET L073-VALID TO TRUE. DTSCU073 00052 CL**3 00053 IF L073-TELEPHONE NOT = SPACE DTSCU073 00054 IF L073-AREA-CD = SPACE DTSCU073 00055 IF L073-ST = 'DC' CL**2 00056 MOVE '202' TO L073-AREA-CD CL**2 00057 ELSE DTSCU073 00058 SET L073-NOT-VALID TO TRUE. DTSCU073 00059 *********ELSE DTSCU073 00060 *************IF L073-AREA-CD < 201 DTSCU073 00061 *************OR L073-AREA-CD (2:1) > '1' DTSCU073 00062 *************** SET L073-NOT-VALID TO TRUE. DTSCU073 00063 CL**3 00064 PROCEDURE-EXIT. DTSCU073 00065 CL**3 00066 CL**3 00067 EXEC CICS DTSCU073 00068 RETURN DTSCU073 00069 END-EXEC. DTSCU073 00070 CL**3 00071 CL**3 00072 GOBACK. DTSCU073 00073 CL**3 00074 CL**3 00075 ****************** S899-ABEND NOT USED. DTSCU073 00076 *S899-ABEND. DTSCU073 00077 * SKIP1 DTSCU073 00078 * EXEC CICS DTSCU073 00079 * ABEND DTSCU073 00080 * ABCODE (WRK-ABEND-CODE) DTSCU073 00081 * END-EXEC. DTSCU073 00082 * SKIP1 DTSCU073 00083 *S899-EXIT. DTSCU073 00084 * EXIT. DTSCU073