00001 IDENTIFICATION DIVISION. 05/20/13 00002 PROGRAM-ID. DTSBU033. DTSBU033 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005 00004 DATE-WRITTEN. MARCH 1994. DTSBU033 00005 DATE-COMPILED. DTSBU033 00006 SKIP3 DTSBU033 00007 ***** DTSBU033 00008 * DTSBU033 00009 * FUNCTION: CURRENT RTP/PURSUED/DESCRIPTION. DTSBU033 00010 * DTSBU033 00011 * DTSBU033 00012 * MODIFICATION LOG: DTSBU033 00013 * DTSBU033 00014 * 09/22/94 INITIAL DEVELOPMENT. DTSBU033 00015 * WORK ORDER: PROGRAMMER: JLB DTSBU033 00016 * DTSBU033 00017 * 11/09/1998 REVIEWED AND MODIFIED FOR DC. DTSBU033 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU033 00019 * DTSBU033 00020 * 05/17/1999 RECOMPILED FOR PICKUP MODIFICATIONS TO DTSBU033 00021 * DTSIC033. DTSBU033 00022 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBU033 00023 * DTSBU033 00024 * 11/19/2012 RECOMPILED FOR CLAIMANT WAGE REPORTS DTSBU033 00025 * REFERENCE: PROGRAMMER: GD DTSBU033 00026 * DTSBU033 00027 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU033 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU033 00029 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU033 00030 * DTSBU033 00031 * DTSBU033 00032 * DESCRIPTION: DTSBU033 00033 * DTSBU033 00034 * DTSCU033 EDITS ACCOUNTING CODES AND INDICATORS. DTSBU033 00035 * DTSBU033 00036 * DTSCU033 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION DTSBU033 00037 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSBU033 00038 * VALUE. DTSBU033 00039 * DTSBU033 00040 * IF L033-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN DTSBU033 00041 * ABEND CODE OF 'U033'. DTSBU033 00042 * DTSBU033 00043 * GO TO DEPENDING ON L033-OPTION TO GET TO THE PARAGRAPH DTSBU033 00044 * THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED DTSBU033 00045 * BY L033-OPTION. USE A SEARCH STATEMENT TO DETERMINE THE DTSBU033 00046 * VALIDITY OF L033-CD-*. DTSBU033 00047 * DTSBU033 00048 * IF L033-CD-* IS A VALID VALUE DTSBU033 00049 * MOVE '1' TO L033-RESULT-IND DTSBU033 00050 * MOVE THE APPROPRIATE C033-*-SHORT-DSCR DTSBU033 00051 * TO L033-SHORT-DSCR DTSBU033 00052 * MOVE THE APPROPRIATE C033-*-LONG-DSCR DTSBU033 00053 * TO L033-LONG-DSCR DTSBU033 00054 * ELSE DTSBU033 00055 * MOVE '2' TO L033-RESULT-IND DTSBU033 00056 * MOVE 'NOT VALID' TO L033-SHORT-DSCR DTSBU033 00057 * L033-LONG-DSCR. DTSBU033 00058 * DTSBU033 00059 ***** DTSBU033 00060 SKIP3 DTSBU033 00061 ENVIRONMENT DIVISION. DTSBU033 00062 SKIP3 DTSBU033 00063 DATA DIVISION. DTSBU033 00064 SKIP3 DTSBU033 00065 WORKING-STORAGE SECTION. DTSBU033 000655 77 PAN-VALET PICTURE X(24) VALUE '005DTSBU033 05/20/13'. DTSBU033 00066 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU033 11/19/12'. DTSBU033 00067 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU033 05/17/99'. DTSBU033 00068 SKIP3 DTSBU033 00069 01 WRK-AREA. DTSBU033 00070 05 WRK-ABEND-CODE PIC S9(04) COMP VALUE +33. DTSBU033 00071 EJECT DTSBU033 00072 01 C033-LITERALS. DTSBU033 00073 ++INCLUDE DTSIC033 DTSBU033 00074 EJECT DTSBU033 00075 LINKAGE SECTION. DTSBU033 00076 SKIP3 DTSBU033 00077 01 L033-LINK-AREA. DTSBU033 00078 ++INCLUDE DTSIL033 DTSBU033 00079 EJECT DTSBU033 00080 PROCEDURE DIVISION USING L033-LINK-AREA. DTSBU033 00081 DTSBU033 00082 DTSBU033 00083 SET L033-NOT-VALID TO TRUE. DTSBU033 00084 DTSBU033 00085 MOVE 'NOT VALID' TO L033-SHORT-DSCR DTSBU033 00086 L033-LONG-DSCR. DTSBU033 00087 DTSBU033 00088 MOVE ' NOT VALID' TO L033-SHORT-DSCR-RIGHT. DTSBU033 00089 DTSBU033 00090 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU033 00091 DTSBU033 00092 DTSBU033 00093 GOBACK. DTSBU033 00094 EJECT DTSBU033 00095 P1000-PROCESS. DTSBU033 00096 GO TO P1000-01 DTSBU033 00097 DEPENDING ON L033-OPTION. DTSBU033 00098 DTSBU033 00099 PERFORM S899-ABEND THRU S899-EXIT. DTSBU033 00100 SKIP3 DTSBU033 00101 P1000-01. DTSBU033 00102 SET C033-01-IDX TO 1. DTSBU033 00103 DTSBU033 00104 SEARCH C033-01-ENTRY DTSBU033 00105 VARYING DTSBU033 00106 C033-01-IDX DTSBU033 00107 WHEN L033-CD-2 = C033-01-CD (C033-01-IDX) DTSBU033 00108 MOVE '1' TO L033-RESULT-IND DTSBU033 00109 MOVE C033-01-SHORT-DSCR (C033-01-IDX) DTSBU033 00110 TO L033-SHORT-DSCR DTSBU033 00111 MOVE C033-01-SHORT-DSCR-RIGHT (C033-01-IDX) DTSBU033 00112 TO L033-SHORT-DSCR-RIGHT DTSBU033 00113 MOVE C033-01-LONG-DSCR (C033-01-IDX) DTSBU033 00114 TO L033-LONG-DSCR. DTSBU033 00115 DTSBU033 00116 GO TO P1000-EXIT. DTSBU033 00117 SKIP3 DTSBU033 00118 P1000-EXIT. DTSBU033 00119 EXIT. DTSBU033 00120 EJECT DTSBU033 00121 S899-ABEND. DTSBU033 00122 DTSBU033 00123 CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU033 00124 DTSBU033 00125 S899-EXIT. DTSBU033 00126 EXIT. DTSBU033