128 lines
10 KiB
COBOL
128 lines
10 KiB
COBOL
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
|