DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
127
Batch/DTSBU033.cob
Normal file
127
Batch/DTSBU033.cob
Normal file
@ -0,0 +1,127 @@
|
||||
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
|
||||
Reference in New Issue
Block a user