00001 IDENTIFICATION DIVISION. 05/25/07 00002 PROGRAM-ID. DTSCU036. DTSCU036 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV012 00004 DATE-WRITTEN. MARCH 1994. DTSCU036 00005 DATE-COMPILED. DTSCU036 00006 SKIP3 DTSCU036 00007 ***** DTSCU036 00008 * DTSCU036 00009 * FUNCTION: FIELD SUPPORT CODES EDIT/DESCRIPTION. DTSCU036 00010 * DTSCU036 00011 * DTSCU036 00012 * MODIFICATION LOG: DTSCU036 00013 * DTSCU036 00014 * 03/29/1994 INITIAL DEVELOPMENT. DTSCU036 00015 * WORK ORDER: PROGRAMMER: RHC DTSCU036 00016 * DTSCU036 00017 * 11/12/1998 MODIFIED FOR DC. DTSCU036 00018 * WORK ORDER: PROGRAMMER: GD DTSCU036 00019 * DTSCU036 00020 * 11/22/2004 RECOMPILED WITH NEW DTSIC036 - MAUR ERROR: DTSCU036 00021 * EMPLOYEE MISCLASSIFIED DTSCU036 00022 * WORK ORDER: PROGRAMMER: GD DTSCU036 00023 * DTSCU036 00024 * 05/25/2007 RECOMPILED WITH NEW DTSIC036 - MAUR ERROR: DTSCU036 00025 * 69: INTERNS, 70: WAGES REPORTED TO WRONG STATE DTSCU036 00026 * WORK ORDER: PROGRAMMER: GD DTSCU036 00027 * DTSCU036 00028 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU036 00029 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU036 00030 * WORK ORDER: PROGRAMMER: XXX DTSCU036 00031 * DTSCU036 00032 * DTSCU036 00033 * DESCRIPTION: DTSCU036 00034 * DTSCU036 00035 * DTSCU036 EDITS FIELD SUPPORT CODES AND INDICATORS. DTSCU036 00036 * DTSCU036 00037 * DTSCU036 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION DTSCU036 00038 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSCU036 00039 * VALUE. DTSCU036 00040 * DTSCU036 00041 * IF L036-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN DTSCU036 00042 * ABEND CODE OF 'U036'. DTSCU036 00043 * DTSCU036 00044 * GO TO DEPENDING ON L036-OPTION TO GET TO THE PARAGRAPH DTSCU036 00045 * THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED DTSCU036 00046 * BY L036-OPTION. USE A SEARCH STATEMENT TO DETERMINE THE DTSCU036 00047 * VALIDITY OF L036-CD-*. DTSCU036 00048 * DTSCU036 00049 * IF L036-CD-* IS A VALID VALUE DTSCU036 00050 * MOVE '1' TO L036-RESULT-IND DTSCU036 00051 * MOVE THE APPROPRIATE C036-*-SHORT-DSCR DTSCU036 00052 * TO L036-SHORT-DSCR DTSCU036 00053 * MOVE THE APPROPRIATE C036-*-LONG-DSCR DTSCU036 00054 * TO L036-LONG-DSCR DTSCU036 00055 * ELSE DTSCU036 00056 * MOVE '2' TO L036-RESULT-IND DTSCU036 00057 * MOVE 'NOT VALID' TO L036-SHORT-DSCR DTSCU036 00058 * L036-LONG-DSCR. DTSCU036 00059 * DTSCU036 00060 ***** DTSCU036 00061 SKIP3 DTSCU036 00062 ENVIRONMENT DIVISION. DTSCU036 00063 SKIP3 DTSCU036 00064 DATA DIVISION. DTSCU036 00065 SKIP3 DTSCU036 00066 WORKING-STORAGE SECTION. DTSCU036 000665 77 PAN-VALET PICTURE X(24) VALUE '012DTSCU036 05/25/07'. DTSCU036 00067 SKIP3 DTSCU036 00068 01 WRK-AREA. DTSCU036 00069 05 WRK-ABEND-CODE PIC X(04) VALUE 'U036'. DTSCU036 00070 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU036 00071 EJECT DTSCU036 00072 01 C036-LITERALS. DTSCU036 00073 ++INCLUDE DTSIC036 DTSCU036 00074 EJECT DTSCU036 00075 LINKAGE SECTION. DTSCU036 00076 SKIP3 DTSCU036 00077 01 DFHCOMMAREA. DTSCU036 00078 ++INCLUDE DTSIL036 DTSCU036 00079 EJECT DTSCU036 00080 PROCEDURE DIVISION. DTSCU036 00081 SKIP2 DTSCU036 00082 MOVE '2' TO L036-RESULT-IND. DTSCU036 00083 MOVE 'NOT VALID' TO L036-SHORT-DSCR DTSCU036 00084 L036-LONG-DSCR. DTSCU036 00085 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSCU036 00086 SKIP2 DTSCU036 00087 EXEC CICS DTSCU036 00088 RETURN DTSCU036 00089 END-EXEC. DTSCU036 00090 SKIP2 DTSCU036 00091 GOBACK. DTSCU036 00092 EJECT DTSCU036 00093 P1000-PROCESS. DTSCU036 00094 GO TO P1000-01 DTSCU036 00095 P1000-02 DTSCU036 00096 P1000-03 DTSCU036 00097 P1000-04 DTSCU036 00098 P1000-05 DTSCU036 00099 P1000-06 DTSCU036 00100 DEPENDING ON L036-OPTION. DTSCU036 00101 SKIP1 DTSCU036 00102 PERFORM S899-ABEND THRU S899-EXIT. DTSCU036 00103 SKIP3 DTSCU036 00104 P1000-01. DTSCU036 00105 SET C036-01-IDX TO 1. DTSCU036 00106 SEARCH C036-01-ENTRY DTSCU036 00107 VARYING DTSCU036 00108 C036-01-IDX DTSCU036 00109 WHEN L036-CD-1 = C036-01-CD (C036-01-IDX) DTSCU036 00110 MOVE '1' TO L036-RESULT-IND DTSCU036 00111 MOVE C036-01-SHORT-DSCR (C036-01-IDX) DTSCU036 00112 TO L036-SHORT-DSCR DTSCU036 00113 MOVE C036-01-LONG-DSCR (C036-01-IDX) DTSCU036 00114 TO L036-LONG-DSCR. DTSCU036 00115 SKIP1 DTSCU036 00116 GO TO P1000-EXIT. DTSCU036 00117 SKIP3 DTSCU036 00118 P1000-02. DTSCU036 00119 SET C036-02-IDX TO 1. DTSCU036 00120 SEARCH C036-02-ENTRY DTSCU036 00121 VARYING DTSCU036 00122 C036-02-IDX DTSCU036 00123 WHEN L036-CD-1 = C036-02-CD (C036-02-IDX) DTSCU036 00124 MOVE '1' TO L036-RESULT-IND DTSCU036 00125 MOVE C036-02-SHORT-DSCR (C036-02-IDX) DTSCU036 00126 TO L036-SHORT-DSCR DTSCU036 00127 MOVE C036-02-LONG-DSCR (C036-02-IDX) DTSCU036 00128 TO L036-LONG-DSCR. DTSCU036 00129 SKIP1 DTSCU036 00130 GO TO P1000-EXIT. DTSCU036 00131 SKIP3 DTSCU036 00132 P1000-03. DTSCU036 00133 SET C036-03-IDX TO 1. DTSCU036 00134 SEARCH C036-03-ENTRY DTSCU036 00135 VARYING DTSCU036 00136 C036-03-IDX DTSCU036 00137 WHEN L036-CD-2 = C036-03-CD (C036-03-IDX) DTSCU036 00138 MOVE '1' TO L036-RESULT-IND DTSCU036 00139 MOVE C036-03-SHORT-DSCR (C036-03-IDX) DTSCU036 00140 TO L036-SHORT-DSCR DTSCU036 00141 MOVE C036-03-LONG-DSCR (C036-03-IDX) DTSCU036 00142 TO L036-LONG-DSCR. DTSCU036 00143 SKIP1 DTSCU036 00144 GO TO P1000-EXIT. DTSCU036 00145 SKIP3 DTSCU036 00146 P1000-04. DTSCU036 00147 SET C036-04-IDX TO 1. DTSCU036 00148 SEARCH C036-04-ENTRY DTSCU036 00149 VARYING DTSCU036 00150 C036-04-IDX DTSCU036 00151 WHEN L036-CD-1 = C036-04-CD (C036-04-IDX) DTSCU036 00152 MOVE '1' TO L036-RESULT-IND DTSCU036 00153 MOVE C036-04-SHORT-DSCR (C036-04-IDX) DTSCU036 00154 TO L036-SHORT-DSCR DTSCU036 00155 MOVE C036-04-LONG-DSCR (C036-04-IDX) DTSCU036 00156 TO L036-LONG-DSCR. DTSCU036 00157 SKIP1 DTSCU036 00158 GO TO P1000-EXIT. DTSCU036 00159 SKIP3 DTSCU036 00160 P1000-05. DTSCU036 00161 SET C036-05-IDX TO 1. DTSCU036 00162 SEARCH C036-05-ENTRY DTSCU036 00163 VARYING DTSCU036 00164 C036-05-IDX DTSCU036 00165 WHEN L036-CD-2 = C036-05-CD (C036-05-IDX) DTSCU036 00166 MOVE '1' TO L036-RESULT-IND DTSCU036 00167 MOVE C036-05-SHORT-DSCR (C036-05-IDX) DTSCU036 00168 TO L036-SHORT-DSCR DTSCU036 00169 MOVE C036-05-LONG-DSCR (C036-05-IDX) DTSCU036 00170 TO L036-LONG-DSCR. DTSCU036 00171 SKIP1 DTSCU036 00172 GO TO P1000-EXIT. DTSCU036 00173 SKIP3 DTSCU036 00174 P1000-06. DTSCU036 00175 SET C036-06-IDX TO 1. DTSCU036 00176 SEARCH C036-06-ENTRY DTSCU036 00177 VARYING DTSCU036 00178 C036-06-IDX DTSCU036 00179 WHEN L036-CD-1 = C036-06-CD (C036-06-IDX) DTSCU036 00180 MOVE '1' TO L036-RESULT-IND DTSCU036 00181 MOVE C036-06-SHORT-DSCR (C036-06-IDX) DTSCU036 00182 TO L036-SHORT-DSCR DTSCU036 00183 MOVE C036-06-LONG-DSCR (C036-06-IDX) DTSCU036 00184 TO L036-LONG-DSCR. DTSCU036 00185 SKIP1 DTSCU036 00186 GO TO P1000-EXIT. DTSCU036 00187 SKIP3 DTSCU036 00188 SKIP3 DTSCU036 00189 P1000-EXIT. DTSCU036 00190 EXIT. DTSCU036 00191 EJECT DTSCU036 00192 S899-ABEND. DTSCU036 00193 SKIP1 DTSCU036 00194 EXEC CICS DTSCU036 00195 ABEND DTSCU036 00196 ABCODE (WRK-ABEND-CODE) DTSCU036 00197 END-EXEC. DTSCU036 00198 SKIP1 DTSCU036 00199 S899-EXIT. DTSCU036 00200 EXIT. DTSCU036