100 lines
7.8 KiB
COBOL
100 lines
7.8 KiB
COBOL
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
|