00001  IDENTIFICATION DIVISION.                                         09/08/98
00002  PROGRAM-ID.    DTSCU071.                                         DTSCU071
00003                                                                      LV003
00004  AUTHOR.        PROFESSIONAL CONSULTING CORPORATION.              DTSCU071
00005                                                                   DTSCU071
00006 ******************************************************************DTSCU071
00007 *                                                                 DTSCU071
00008 *    FUNCTION: REFORMATS L071-NAM TO OPPOSITE FORMAT OF FORMAT    DTSCU071
00009 *              RECEIVED.                                          DTSCU071
00010 *                                                                 DTSCU071
00011 *                                                                 DTSCU071
00012 *    08/30/98  ORIGINAL DEVELOPMENT. COPIED FROM MACCU071.           CL**2
00013 *              WORK ORDER:                      PROGRAMMER: ZL1      CL**2
00014 *                                                                 DTSCU071
00015 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU071
00016 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU071
00017 *              WORK ORDER:                      PROGRAMMER: XXX   DTSCU071
00018 *                                                                 DTSCU071
00019 *                                                                 DTSCU071
00020 *    L071-NAM FORMATS PROCESSED:                                  DTSCU071
00021 *      L071-FROM-LAST-NAME-FIRST                                  DTSCU071
00022 *               LASTNAME/FIRSTNAME MIDDLENAME                     DTSCU071
00023 *               LASTNAME/FIRSTNAME                                DTSCU071
00024 *                                                                 DTSCU071
00025 *                                                                 DTSCU071
00026 *    RETURN CODES:                                                DTSCU071
00027 *      0 - SUCCESSFUL COMPLETION                                  DTSCU071
00028 *      8 - INVALID NAME                                           DTSCU071
00029 *                                                                 DTSCU071
00030 *                                                                 DTSCU071
00031 *    NOTE: INPUT-AREA MUST BE TWO SPACES LONGER THAN L071-NAM.    DTSCU071
00032 *                                                                 DTSCU071
00033 ******************************************************************DTSCU071
00034                                                                   DTSCU071
00035  ENVIRONMENT      DIVISION.                                       DTSCU071
00036      SKIP3                                                        DTSCU071
00037  DATA DIVISION.                                                   DTSCU071
00038      EJECT                                                        DTSCU071
00039  WORKING-STORAGE SECTION.                                         DTSCU071
000395 77  PAN-VALET PICTURE X(24) VALUE '003DTSCU071  09/08/98'.       DTSCU071
00040      SKIP3                                                        DTSCU071
00041  01  CONSTANTS-AREA.                                              DTSCU071
00042      05  WRK-ABEND-CODE      PIC  X(04)      VALUE 'U071'.        DTSCU071
00043                                                                      CL**3
00044      05  INPUT-AREA-SIZE     PIC S9(04) COMP VALUE +34.           DTSCU071
00045      SKIP3                                                        DTSCU071
00046  01  WRK-AREA.                                                    DTSCU071
00047      05  INPUT-AREA          PIC  X(34).                          DTSCU071
00048                                                                      CL**3
00049      05  HOLD-AREA           PIC  X(34).                          DTSCU071
00050                                                                      CL**3
00051                                                                      CL**3
00052                                                                      CL**3
00053  01  TALLY-AREA.                                                  DTSCU071
00054      05  D-S                 PIC  X(02)      VALUE SPACE.         DTSCU071
00055                                                                      CL**3
00056      05  SLASH-TALLY         PIC S9(04) COMP.                     DTSCU071
00057                                                                      CL**3
00058      05  LAST-NAME-LEN       PIC S9(04) COMP.                     DTSCU071
00059                                                                      CL**3
00060      05  FIRST-MID-LEN       PIC S9(04) COMP.                     DTSCU071
00061                                                                      CL**3
00062      05  TOTAL-LEN           PIC S9(04) COMP.                     DTSCU071
00063      EJECT                                                        DTSCU071
00064  LINKAGE SECTION.                                                 DTSCU071
00065                                                                      CL**3
00066  01  DFHCOMMAREA.                                                 DTSCU071
00067  ++INCLUDE DTSIL071                                                  CL**2
00068      EJECT                                                        DTSCU071
00069  PROCEDURE DIVISION.                                              DTSCU071
00070                                                                      CL**3
00071      SET L071-NAME-CONVERTED TO TRUE.                             DTSCU071
00072                                                                      CL**3
00073      INITIALIZE WRK-AREA                                          DTSCU071
00074                 TALLY-AREA.                                       DTSCU071
00075                                                                      CL**3
00076      MOVE L071-NAM TO INPUT-AREA.                                 DTSCU071
00077                                                                      CL**3
00078      IF L071-FROM-LAST-NAME-FIRST                                 DTSCU071
00079          PERFORM P1000-LAST-NAME-FIRST THRU P1000-EXIT            DTSCU071
00080      ELSE                                                         DTSCU071
00081          GO TO S899-ABEND.                                        DTSCU071
00082                                                                      CL**3
00083                                                                      CL**3
00084      EXEC CICS                                                    DTSCU071
00085          RETURN                                                   DTSCU071
00086      END-EXEC.                                                    DTSCU071
00087                                                                      CL**3
00088                                                                      CL**3
00089                                                                      CL**3
00090      GOBACK.                                                         CL**3
00091      EJECT                                                        DTSCU071
00092 ******************************************************************DTSCU071
00093 **               PROCESS LAST NAME FIRST                        **DTSCU071
00094 ******************************************************************DTSCU071
00095  P1000-LAST-NAME-FIRST.                                           DTSCU071
00096      INSPECT INPUT-AREA TALLYING                                  DTSCU071
00097              SLASH-TALLY   FOR ALL '/'.                           DTSCU071
00098                                                                      CL**3
00099      INSPECT INPUT-AREA TALLYING                                  DTSCU071
00100              LAST-NAME-LEN FOR CHARACTERS BEFORE INITIAL '/'.     DTSCU071
00101                                                                      CL**3
00102      INSPECT INPUT-AREA TALLYING                                  DTSCU071
00103              TOTAL-LEN     FOR CHARACTERS BEFORE INITIAL D-S.     DTSCU071
00104                                                                      CL**3
00105 *-----------------------------------------------------------------DTSCU071
00106 *  ERROR CHECKS.                                                  DTSCU071
00107 *-----------------------------------------------------------------DTSCU071
00108      IF SLASH-TALLY  NOT = +1                                     DTSCU071
00109          SET L071-NAME-INVALID TO TRUE                            DTSCU071
00110          GO TO P1000-EXIT.                                        DTSCU071
00111                                                                      CL**3
00112      MOVE INPUT-AREA (TOTAL-LEN + 1 : INPUT-AREA-SIZE - TOTAL-LEN)DTSCU071
00113                                         TO HOLD-AREA.             DTSCU071
00114                                                                      CL**3
00115      IF HOLD-AREA  NOT =  SPACE                                   DTSCU071
00116          SET L071-NAME-INVALID TO TRUE                            DTSCU071
00117          GO TO P1000-EXIT.                                        DTSCU071
00118                                                                      CL**3
00119 *-----------------------------------------------------------------DTSCU071
00120 *  REFORMAT.                                                      DTSCU071
00121 *-----------------------------------------------------------------DTSCU071
00122      COMPUTE FIRST-MID-LEN = TOTAL-LEN - (LAST-NAME-LEN + 1).     DTSCU071
00123                                                                      CL**3
00124                                                                      CL**3
00125      MOVE INPUT-AREA (LAST-NAME-LEN + 2 : FIRST-MID-LEN)          DTSCU071
00126                               TO L071-NAM.                        DTSCU071
00127                                                                      CL**3
00128      MOVE INPUT-AREA (1 : LAST-NAME-LEN)                          DTSCU071
00129                               TO L071-NAM (FIRST-MID-LEN + 2 : ). DTSCU071
00130  P1000-EXIT. EXIT.                                                DTSCU071
00131      EJECT                                                        DTSCU071
00132  S899-ABEND.                                                      DTSCU071
00133      EXEC CICS                                                    DTSCU071
00134          ABEND                                                    DTSCU071
00135              ABCODE (WRK-ABEND-CODE)                              DTSCU071
00136      END-EXEC.                                                    DTSCU071
00137  S899-EXIT. EXIT.                                                    CL**3
