86 lines
6.7 KiB
COBOL
86 lines
6.7 KiB
COBOL
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
|