00001 IDENTIFICATION DIVISION. 02/02/99 00002 PROGRAM-ID. DTSBU038. DTSBU038 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004 00004 DATE-WRITTEN. MARCH 1994. DTSBU038 00005 DATE-COMPILED. DTSBU038 00006 SKIP3 DTSBU038 00007 ***** DTSBU038 00008 * DTSBU038 00009 * FUNCTION: R&A CODES EDIT/DESCRIPTION. DTSBU038 00010 * DTSBU038 00011 * DTSBU038 00012 * MODIFICATION LOG: DTSBU038 00013 * DTSBU038 00014 * 03/22/91 INITIAL DEVELOPMENT. DTSBU038 00015 * WORK ORDER: PROGRAMMER: EHH DTSBU038 00016 * DTSBU038 00017 * 02/02/1999 REVIEWED AND MODIFIED FOR DC. CL**2 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2 00019 * CL**2 00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2 00023 * DTSBU038 00024 * DTSBU038 00025 * DESCRIPTION: DTSBU038 00026 * DTSBU038 00027 * DTSCU038 EDITS LMI CODES AND INDICATORS. CL**2 00028 * DTSBU038 00029 * DTSCU038 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION CL**2 00030 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSBU038 00031 * VALUE. DTSBU038 00032 * DTSBU038 00033 * IF L038-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN DTSBU038 00034 * ABEND CODE OF 'U038'. DTSBU038 00035 * DTSBU038 00036 * GO TO DEPENDING ON L038-OPTION TO GET TO THE PARAGRAPH DTSBU038 00037 * THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED DTSBU038 00038 * BY L038-OPTION. USE A SEARCH STATEMENT TO DETERMINE THE DTSBU038 00039 * VALIDITY OF L038-CD-*. DTSBU038 00040 * DTSBU038 00041 * IF L038-CD-* IS A VALID VALUE DTSBU038 00042 * MOVE '1' TO L038-RESULT-IND DTSBU038 00043 * MOVE THE APPROPRIATE C038-*-SHORT-DSCR DTSBU038 00044 * TO L038-SHORT-DSCR DTSBU038 00045 * MOVE THE APPROPRIATE C038-*-LONG-DSCR DTSBU038 00046 * TO L038-LONG-DSCR DTSBU038 00047 * ELSE DTSBU038 00048 * MOVE '2' TO L038-RESULT-IND DTSBU038 00049 * MOVE 'NOT VALID' TO L038-SHORT-DSCR DTSBU038 00050 * L038-LONG-DSCR. DTSBU038 00051 * DTSBU038 00052 * DTSBU038 00053 ***** DTSBU038 00054 SKIP3 DTSBU038 00055 ENVIRONMENT DIVISION. DTSBU038 00056 SKIP3 DTSBU038 00057 DATA DIVISION. DTSBU038 00058 SKIP3 DTSBU038 00059 WORKING-STORAGE SECTION. DTSBU038 000595 77 PAN-VALET PICTURE X(24) VALUE '004DTSBU038 02/02/99'. DTSBU038 00060 SKIP3 DTSBU038 00061 01 WRK-AREA. DTSBU038 00062 05 WRK-ABEND-CODE PIC S9(04) COMP VALUE +038. CL**4 00063 CL**2 00064 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU038 00065 EJECT DTSBU038 00066 01 C038-LITERALS. DTSBU038 00067 ++INCLUDE DTSIC038 CL**2 00068 EJECT DTSBU038 00069 LINKAGE SECTION. DTSBU038 00070 SKIP3 DTSBU038 00071 01 L038-LINK-AREA. CL**4 00072 ++INCLUDE DTSIL038 CL**2 00073 EJECT DTSBU038 00074 PROCEDURE DIVISION USING L038-LINK-AREA. CL**4 00075 CL**2 00076 CL**2 00077 SET L038-NOT-VALID TO TRUE. CL**2 00078 CL**2 00079 CL**2 00080 MOVE 'NOT VALID' TO L038-SHORT-DSCR DTSBU038 00081 L038-LONG-DSCR. DTSBU038 00082 CL**2 00083 CL**2 00084 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU038 00085 CL**2 00086 CL**2 00087 GOBACK. DTSBU038 00088 EJECT DTSBU038 00089 P1000-PROCESS. DTSBU038 00090 GO TO P1000-01-02 CL**2 00091 P1000-01-02 CL**2 00092 P1000-03 DTSBU038 00093 P1000-04 DTSBU038 00094 P1000-05 CL**2 00095 DEPENDING ON L038-OPTION. DTSBU038 00096 CL**2 00097 PERFORM S999-ABEND THRU S999-EXIT. CL**4 00098 CL**3 00099 CL**3 00100 P1000-01-02. CL**2 00101 SET C038-01-02-IDX TO 1. CL**2 00102 CL**2 00103 SEARCH C038-01-02-ENTRY CL**2 00104 VARYING DTSBU038 00105 C038-01-02-IDX CL**2 00106 WHEN L038-CD-1 = C038-01-02-CD (C038-01-02-IDX) CL**3 00107 SET L038-VALID TO TRUE CL**2 00108 MOVE C038-01-02-SHORT-DSCR (C038-01-02-IDX) CL**2 00109 TO L038-SHORT-DSCR DTSBU038 00110 MOVE C038-01-02-LONG-DSCR (C038-01-02-IDX) CL**2 00111 TO L038-LONG-DSCR. DTSBU038 00112 CL**2 00113 GO TO P1000-EXIT. DTSBU038 00114 CL**3 00115 CL**3 00116 P1000-03. CL**2 00117 SET C038-03-IDX TO 1. CL**2 00118 CL**2 00119 SEARCH C038-03-ENTRY CL**2 00120 VARYING DTSBU038 00121 C038-03-IDX CL**2 00122 WHEN L038-CD-2 = C038-03-CD (C038-03-IDX) CL**3 00123 SET L038-VALID TO TRUE CL**2 00124 MOVE C038-03-SHORT-DSCR (C038-03-IDX) CL**2 00125 TO L038-SHORT-DSCR DTSBU038 00126 MOVE C038-03-LONG-DSCR (C038-03-IDX) CL**2 00127 TO L038-LONG-DSCR. DTSBU038 00128 CL**2 00129 GO TO P1000-EXIT. DTSBU038 00130 CL**3 00131 CL**3 00132 P1000-04. CL**2 00133 SET C038-04-IDX TO 1. CL**2 00134 CL**2 00135 SEARCH C038-04-ENTRY CL**2 00136 VARYING DTSBU038 00137 C038-04-IDX CL**2 00138 WHEN L038-CD-1 = C038-04-CD (C038-04-IDX) CL**2 00139 SET L038-VALID TO TRUE CL**2 00140 MOVE C038-04-SHORT-DSCR (C038-04-IDX) CL**2 00141 TO L038-SHORT-DSCR DTSBU038 00142 MOVE C038-04-LONG-DSCR (C038-04-IDX) CL**2 00143 TO L038-LONG-DSCR. DTSBU038 00144 CL**2 00145 GO TO P1000-EXIT. DTSBU038 00146 CL**3 00147 CL**3 00148 P1000-05. CL**2 00149 SET C038-05-IDX TO 1. CL**2 00150 CL**2 00151 SEARCH C038-05-ENTRY CL**2 00152 VARYING DTSBU038 00153 C038-05-IDX CL**2 00154 WHEN L038-CD-2 = C038-05-CD (C038-05-IDX) CL**2 00155 SET L038-VALID TO TRUE CL**2 00156 MOVE C038-05-SHORT-DSCR (C038-05-IDX) CL**2 00157 TO L038-SHORT-DSCR DTSBU038 00158 MOVE C038-05-LONG-DSCR (C038-05-IDX) CL**2 00159 TO L038-LONG-DSCR. DTSBU038 00160 CL**2 00161 GO TO P1000-EXIT. DTSBU038 00162 CL**2 00163 CL**2 00164 P1000-EXIT. DTSBU038 00165 EXIT. DTSBU038 00166 EJECT DTSBU038 00167 S999-ABEND. CL**4 00168 CALL 'DTSBU999' USING WRK-ABEND-CODE. CL**4 00169 S999-EXIT. CL**4 00170 EXIT. DTSBU038