DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
112
Batch/DTSBU037.cob
Normal file
112
Batch/DTSBU037.cob
Normal file
@ -0,0 +1,112 @@
|
||||
00001 IDENTIFICATION DIVISION. 10/28/98
|
||||
00002 PROGRAM-ID. DTSBU037. DTSBU037
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002
|
||||
00004 DATE-WRITTEN. JULY 1994. DTSBU037
|
||||
00005 DATE-COMPILED. DTSBU037
|
||||
00006 SKIP3 DTSBU037
|
||||
00007 ***** DTSBU037
|
||||
00008 * DTSBU037
|
||||
00009 * FUNCTION: MISCELLANEOUS CODES EDIT/DESCRIPTION. DTSBU037
|
||||
00010 * DTSBU037
|
||||
00011 * DTSBU037
|
||||
00012 * MODIFICATION LOG: DTSBU037
|
||||
00013 * DTSBU037
|
||||
00014 * 07/12/94 CLONED FROM DTSCU037. CL**2
|
||||
00015 * WORK ORDER: PROGRAMMER: RHC DTSBU037
|
||||
00016 * DTSBU037
|
||||
00017 * 10/28/97 MODIFIED TO DUTAS PROGRAMMING CONVENTIONS. CL**2
|
||||
00018 * WORK ORDER: PROGRAMMER: DVS CL**2
|
||||
00019 * CL**2
|
||||
00020 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
||||
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
||||
00022 * WORK ORDER: PROGRAMMER: XXX CL**2
|
||||
00023 * DTSBU037
|
||||
00024 * DESCRIPTION: DTSBU037
|
||||
00025 * DTSBU037
|
||||
00026 * DTSBU037 EDITS MISCELLANEOUS CODES AND INDICATORS. CL**2
|
||||
00027 * DTSBU037
|
||||
00028 * DTSBU037 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION CL**2
|
||||
00029 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSBU037
|
||||
00030 * VALUE. DTSBU037
|
||||
00031 * DTSBU037
|
||||
00032 * IF L037-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN DTSBU037
|
||||
00033 * ABEND CODE OF 'U037'. DTSBU037
|
||||
00034 * DTSBU037
|
||||
00035 * GO TO DEPENDING ON L037-OPTION TO GET TO THE PARAGRAPH DTSBU037
|
||||
00036 * THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED DTSBU037
|
||||
00037 * BY L037-OPTION. USE A SEARCH STATEMENT TO DETERMINE THE DTSBU037
|
||||
00038 * VALIDITY OF L037-CD-*. DTSBU037
|
||||
00039 * DTSBU037
|
||||
00040 * IF L037-CD-* IS A VALID VALUE DTSBU037
|
||||
00041 * MOVE '1' TO L037-RESULT-IND DTSBU037
|
||||
00042 * MOVE THE APPROPRIATE C037-*-SHORT-DSCR DTSBU037
|
||||
00043 * TO L037-SHORT-DSCR DTSBU037
|
||||
00044 * MOVE THE APPROPRIATE C037-*-LONG-DSCR DTSBU037
|
||||
00045 * TO L037-LONG-DSCR DTSBU037
|
||||
00046 * ELSE DTSBU037
|
||||
00047 * MOVE '2' TO L037-RESULT-IND DTSBU037
|
||||
00048 * MOVE 'NOT VALID' TO L037-SHORT-DSCR DTSBU037
|
||||
00049 * L037-LONG-DSCR. DTSBU037
|
||||
00050 * DTSBU037
|
||||
00051 ***** DTSBU037
|
||||
00052 SKIP3 DTSBU037
|
||||
00053 ENVIRONMENT DIVISION. DTSBU037
|
||||
00054 SKIP3 DTSBU037
|
||||
00055 DATA DIVISION. DTSBU037
|
||||
00056 SKIP3 DTSBU037
|
||||
00057 WORKING-STORAGE SECTION. DTSBU037
|
||||
000575 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU037 10/28/98'. DTSBU037
|
||||
00058 SKIP3 DTSBU037
|
||||
00059 01 WRK-AREA. DTSBU037
|
||||
00060 05 WRK-ABEND-CODE PIC S9(04) COMP DTSBU037
|
||||
00061 VALUE +037. DTSBU037
|
||||
00062 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU037
|
||||
00063 EJECT DTSBU037
|
||||
00064 01 C037-LITERALS. DTSBU037
|
||||
00065 ++INCLUDE DTSIC037 CL**2
|
||||
00066 EJECT DTSBU037
|
||||
00067 LINKAGE SECTION. DTSBU037
|
||||
00068 SKIP3 DTSBU037
|
||||
00069 01 L037-LINK-AREA. DTSBU037
|
||||
00070 ++INCLUDE DTSIL037 CL**2
|
||||
00071 EJECT DTSBU037
|
||||
00072 PROCEDURE DIVISION DTSBU037
|
||||
00073 USING L037-LINK-AREA. DTSBU037
|
||||
00074 SKIP2 DTSBU037
|
||||
00075 MOVE '2' TO L037-RESULT-IND. DTSBU037
|
||||
00076 MOVE 'NOT VALID' TO L037-SHORT-DSCR DTSBU037
|
||||
00077 L037-LONG-DSCR. DTSBU037
|
||||
00078 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU037
|
||||
00079 SKIP2 DTSBU037
|
||||
00080 GOBACK. DTSBU037
|
||||
00081 EJECT DTSBU037
|
||||
00082 P1000-PROCESS. DTSBU037
|
||||
00083 GO TO P1000-01 DTSBU037
|
||||
00084 DEPENDING ON L037-OPTION. DTSBU037
|
||||
00085 SKIP1 DTSBU037
|
||||
00086 PERFORM S999-ABEND THRU S999-EXIT. DTSBU037
|
||||
00087 SKIP3 DTSBU037
|
||||
00088 P1000-01. DTSBU037
|
||||
00089 SET C037-01-IDX TO 1. DTSBU037
|
||||
00090 SEARCH C037-01-ENTRY DTSBU037
|
||||
00091 VARYING DTSBU037
|
||||
00092 C037-01-IDX DTSBU037
|
||||
00093 WHEN L037-CD-3 = C037-01-CD (C037-01-IDX) DTSBU037
|
||||
00094 MOVE '1' TO L037-RESULT-IND DTSBU037
|
||||
00095 MOVE C037-01-SHORT-DSCR (C037-01-IDX) DTSBU037
|
||||
00096 TO L037-SHORT-DSCR DTSBU037
|
||||
00097 MOVE C037-01-LONG-DSCR (C037-01-IDX) DTSBU037
|
||||
00098 TO L037-LONG-DSCR. DTSBU037
|
||||
00099 SKIP1 DTSBU037
|
||||
00100 GO TO P1000-EXIT. DTSBU037
|
||||
00101 SKIP3 DTSBU037
|
||||
00102 P1000-EXIT. DTSBU037
|
||||
00103 EXIT. DTSBU037
|
||||
00104 EJECT DTSBU037
|
||||
00105 S999-ABEND. DTSBU037
|
||||
00106 SKIP1 DTSBU037
|
||||
00107 CALL 'DTSBU999' CL**2
|
||||
00108 USING WRK-ABEND-CODE. DTSBU037
|
||||
00109 SKIP1 DTSBU037
|
||||
00110 S999-EXIT. EXIT. DTSBU037
|
||||
00111 EXIT. DTSBU037
|
||||
Reference in New Issue
Block a user