00001 IDENTIFICATION DIVISION. 10/28/98 00002 PROGRAM-ID. DTSBU037. DTSBU037 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. JULY 1994. DTSBU037 00005 DATE-COMPILED. DTSBU037 00006 SKIP3 DTSBU037 00007 ***** DTSBU037 00008 * DTSBU037 00009 * FUNCTION: MISCELLANEOUS CODES EDIT/DESCRIPTION. DTSBU037 00010 * DTSBU037 00011 * DTSBU037 00012 * MODIFICATION LOG: DTSBU037 00013 * DTSBU037 00014 * 07/12/94 CLONED FROM DTSCU037. CL**2 00015 * WORK ORDER: PROGRAMMER: RHC DTSBU037 00016 * DTSBU037 00017 * 10/28/97 MODIFIED TO DUTAS PROGRAMMING CONVENTIONS. CL**2 00018 * WORK ORDER: PROGRAMMER: DVS CL**2 00019 * CL**2 00020 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00022 * WORK ORDER: PROGRAMMER: XXX CL**2 00023 * DTSBU037 00024 * DESCRIPTION: DTSBU037 00025 * DTSBU037 00026 * DTSBU037 EDITS MISCELLANEOUS CODES AND INDICATORS. CL**2 00027 * DTSBU037 00028 * DTSBU037 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION CL**2 00029 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSBU037 00030 * VALUE. DTSBU037 00031 * DTSBU037 00032 * IF L037-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN DTSBU037 00033 * ABEND CODE OF 'U037'. DTSBU037 00034 * DTSBU037 00035 * GO TO DEPENDING ON L037-OPTION TO GET TO THE PARAGRAPH DTSBU037 00036 * THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED DTSBU037 00037 * BY L037-OPTION. USE A SEARCH STATEMENT TO DETERMINE THE DTSBU037 00038 * VALIDITY OF L037-CD-*. DTSBU037 00039 * DTSBU037 00040 * IF L037-CD-* IS A VALID VALUE DTSBU037 00041 * MOVE '1' TO L037-RESULT-IND DTSBU037 00042 * MOVE THE APPROPRIATE C037-*-SHORT-DSCR DTSBU037 00043 * TO L037-SHORT-DSCR DTSBU037 00044 * MOVE THE APPROPRIATE C037-*-LONG-DSCR DTSBU037 00045 * TO L037-LONG-DSCR DTSBU037 00046 * ELSE DTSBU037 00047 * MOVE '2' TO L037-RESULT-IND DTSBU037 00048 * MOVE 'NOT VALID' TO L037-SHORT-DSCR DTSBU037 00049 * L037-LONG-DSCR. DTSBU037 00050 * DTSBU037 00051 ***** DTSBU037 00052 SKIP3 DTSBU037 00053 ENVIRONMENT DIVISION. DTSBU037 00054 SKIP3 DTSBU037 00055 DATA DIVISION. DTSBU037 00056 SKIP3 DTSBU037 00057 WORKING-STORAGE SECTION. DTSBU037 000575 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU037 10/28/98'. DTSBU037 00058 SKIP3 DTSBU037 00059 01 WRK-AREA. DTSBU037 00060 05 WRK-ABEND-CODE PIC S9(04) COMP DTSBU037 00061 VALUE +037. DTSBU037 00062 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU037 00063 EJECT DTSBU037 00064 01 C037-LITERALS. DTSBU037 00065 ++INCLUDE DTSIC037 CL**2 00066 EJECT DTSBU037 00067 LINKAGE SECTION. DTSBU037 00068 SKIP3 DTSBU037 00069 01 L037-LINK-AREA. DTSBU037 00070 ++INCLUDE DTSIL037 CL**2 00071 EJECT DTSBU037 00072 PROCEDURE DIVISION DTSBU037 00073 USING L037-LINK-AREA. DTSBU037 00074 SKIP2 DTSBU037 00075 MOVE '2' TO L037-RESULT-IND. DTSBU037 00076 MOVE 'NOT VALID' TO L037-SHORT-DSCR DTSBU037 00077 L037-LONG-DSCR. DTSBU037 00078 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU037 00079 SKIP2 DTSBU037 00080 GOBACK. DTSBU037 00081 EJECT DTSBU037 00082 P1000-PROCESS. DTSBU037 00083 GO TO P1000-01 DTSBU037 00084 DEPENDING ON L037-OPTION. DTSBU037 00085 SKIP1 DTSBU037 00086 PERFORM S999-ABEND THRU S999-EXIT. DTSBU037 00087 SKIP3 DTSBU037 00088 P1000-01. DTSBU037 00089 SET C037-01-IDX TO 1. DTSBU037 00090 SEARCH C037-01-ENTRY DTSBU037 00091 VARYING DTSBU037 00092 C037-01-IDX DTSBU037 00093 WHEN L037-CD-3 = C037-01-CD (C037-01-IDX) DTSBU037 00094 MOVE '1' TO L037-RESULT-IND DTSBU037 00095 MOVE C037-01-SHORT-DSCR (C037-01-IDX) DTSBU037 00096 TO L037-SHORT-DSCR DTSBU037 00097 MOVE C037-01-LONG-DSCR (C037-01-IDX) DTSBU037 00098 TO L037-LONG-DSCR. DTSBU037 00099 SKIP1 DTSBU037 00100 GO TO P1000-EXIT. DTSBU037 00101 SKIP3 DTSBU037 00102 P1000-EXIT. DTSBU037 00103 EXIT. DTSBU037 00104 EJECT DTSBU037 00105 S999-ABEND. DTSBU037 00106 SKIP1 DTSBU037 00107 CALL 'DTSBU999' CL**2 00108 USING WRK-ABEND-CODE. DTSBU037 00109 SKIP1 DTSBU037 00110 S999-EXIT. EXIT. DTSBU037 00111 EXIT. DTSBU037