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
