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