113 lines
8.9 KiB
COBOL
113 lines
8.9 KiB
COBOL
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
|