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