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