MP Batchs, copybooks, jcls, Procs
This commit is contained in:
99
Batch/DTSBU076.cob
Normal file
99
Batch/DTSBU076.cob
Normal file
@ -0,0 +1,99 @@
|
||||
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
|
||||
Reference in New Issue
Block a user