00001 IDENTIFICATION DIVISION. 04/05/04 00002 PROGRAM-ID. DTSBU076. DTSBU076 00003 LV001 00004 AUTHOR. PROFESSIONAL CONSULTING CORPORATION. DTSBU076 00005 DTSBU076 00006 ******************************************************************DTSBU076 00007 * DTSBU076 00008 * FUNCTION: REFORMATS L076-NAM TO OPPOSITE FORMAT OF FORMAT DTSBU076 00009 * RECEIVED. DTSBU076 00010 * DTSBU076 00011 * DTSBU076 00012 * 10/03/03 EFT, COPIED FROM DTSIL071. DTSBU076 00013 * WORK ORDER: PROGRAMMER: SCM. DTSBU076 00014 * DTSBU076 00015 * L076-NAM FORMATS PROCESSED: DTSBU076 00016 * L076-FROM-LAST-NAME-FIRST DTSBU076 00017 * LASTNAME/FIRSTNAME MIDDLENAME DTSBU076 00018 * LASTNAME/FIRSTNAME DTSBU076 00019 * DTSBU076 00020 * DTSBU076 00021 * RETURN CODES: DTSBU076 00022 * 0 - SUCCESSFUL COMPLETION DTSBU076 00023 * 8 - INVALID NAME DTSBU076 00024 * DTSBU076 00025 ******************************************************************DTSBU076 00026 DTSBU076 00027 ENVIRONMENT DIVISION. DTSBU076 00028 SKIP3 DTSBU076 00029 DATA DIVISION. DTSBU076 00030 EJECT DTSBU076 00031 WORKING-STORAGE SECTION. DTSBU076 000315 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU076 04/05/04'. DTSBU076 00032 SKIP3 DTSBU076 00033 01 CONSTANTS-AREA. DTSBU076 00034 05 WRK-ABEND-CODE PIC S9(04) COMP VALUE +073. DTSBU076 00035 05 INPUT-AREA-SIZE PIC S9(04) COMP VALUE +34. DTSBU076 00036 SKIP3 DTSBU076 00037 01 WRK-AREA. DTSBU076 00038 05 INPUT-AREA PIC X(34). DTSBU076 00039 05 HOLD-AREA PIC X(34). DTSBU076 00040 SKIP3 DTSBU076 00041 01 TALLY-AREA. DTSBU076 00042 05 D-S PIC X(02) VALUE SPACE. DTSBU076 00043 05 SLASH-TALLY PIC S9(04) COMP. DTSBU076 00044 05 LAST-NAME-LEN PIC S9(04) COMP. DTSBU076 00045 05 FIRST-NAME-LEN PIC S9(04) COMP. DTSBU076 00046 05 TOTAL-LEN PIC S9(04) COMP. DTSBU076 00047 EJECT DTSBU076 00048 LINKAGE SECTION. DTSBU076 00049 01 L076-LINK-AREA. DTSBU076 00050 ++INCLUDE DTSIL076 DTSBU076 00051 EJECT DTSBU076 00052 PROCEDURE DIVISION DTSBU076 00053 USING L076-LINK-AREA. DTSBU076 00054 DTSBU076 00055 SET L076-NAME-CONVERTED TO TRUE. DTSBU076 00056 DTSBU076 00057 INITIALIZE WRK-AREA DTSBU076 00058 TALLY-AREA. DTSBU076 00059 DTSBU076 00060 PERFORM P1000-STRING-NAME THRU P1000-EXIT. DTSBU076 00061 DTSBU076 00062 MAINLINE-EXIT. DTSBU076 00063 DTSBU076 00064 GOBACK. DTSBU076 00065 EJECT DTSBU076 00066 ******************************************************************DTSBU076 00067 ** PROCESS LAST NAME FIRST **DTSBU076 00068 ******************************************************************DTSBU076 00069 P1000-STRING-NAME. DTSBU076 00070 *-----------------------------------------------------------------DTSBU076 00071 * ERROR CHECK. DTSBU076 00072 *-----------------------------------------------------------------DTSBU076 00073 IF L076-NAMEL (1:1) NOT GREATER SPACES DTSBU076 00074 OR L076-NAMEF (1:1) NOT GREATER SPACES DTSBU076 00075 SET L076-NAME-INVALID TO TRUE DTSBU076 00076 GO TO P1000-EXIT. DTSBU076 00077 DTSBU076 00078 *-----------------------------------------------------------------DTSBU076 00079 * REFORMAT. DTSBU076 00080 *-----------------------------------------------------------------DTSBU076 00081 INSPECT L076-NAMEL TALLYING DTSBU076 00082 LAST-NAME-LEN FOR CHARACTERS BEFORE INITIAL D-S. DTSBU076 00083 INSPECT L076-NAMEF TALLYING DTSBU076 00084 FIRST-NAME-LEN FOR CHARACTERS BEFORE INITIAL D-S. DTSBU076 00085 ADD LAST-NAME-LEN TO FIRST-NAME-LEN GIVING TOTAL-LEN. DTSBU076 00086 SKIP3 DTSBU076 00087 MOVE L076-NAMEL (1 : LAST-NAME-LEN) TO L076-NAM. DTSBU076 00088 MOVE '/' TO L076-NAM (LAST-NAME-LEN + 1 : 1). DTSBU076 00089 MOVE L076-NAMEF (1 : FIRST-NAME-LEN) TO DTSBU076 00090 L076-NAM (LAST-NAME-LEN + 2 : FIRST-NAME-LEN). DTSBU076 00091 MOVE L076-NAMEI TO L076-NAM (TOTAL-LEN + 3 : 1). DTSBU076 00092 DTSBU076 00093 P1000-EXIT. EXIT. DTSBU076 00094 EJECT DTSBU076 00095 S999-ABEND. DTSBU076 00096 CALL 'DTSBU999' DTSBU076 00097 USING WRK-ABEND-CODE. DTSBU076 00098 S999-EXIT. EXIT. DTSBU076