106 lines
8.3 KiB
COBOL
106 lines
8.3 KiB
COBOL
00001 IDENTIFICATION DIVISION. 09/29/98
|
|
00002 PROGRAM-ID. DTSBU991. DTSBU991
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002
|
|
00004 DATE-WRITTEN. JULY 1994. DTSBU991
|
|
00005 DATE-COMPILED. DTSBU991
|
|
00006 CL**2
|
|
00007 ***** DTSBU991
|
|
00008 * DTSBU991
|
|
00009 * FUNCTION: FORMAT HEX DISPLAY. DTSBU991
|
|
00010 * DTSBU991
|
|
00011 * DTSBU991
|
|
00012 * MODIFICATION LOG: DTSBU991
|
|
00013 * DTSBU991
|
|
00014 * 07/07/94 INITIAL DEVELOPMENT. DTSBU991
|
|
00015 * WORK ORDER: PROGRAMMER: RHC DTSBU991
|
|
00016 * DTSBU991
|
|
00017 * 09/29/1998 REVIEWED AND MODIFIED FOR DC. CL**2
|
|
00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2
|
|
00019 * CL**2
|
|
00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2
|
|
00023 * DTSBU991
|
|
00024 * DTSBU991
|
|
00025 * DESCRIPTION: DTSBU991
|
|
00026 * DTSBU991
|
|
00027 * FORM THE FIRST L991-REQ-CHAR-CNT OF L991-REQ-AREA DTSBU991
|
|
00028 * FOR HEX DISPLAY. DTSBU991
|
|
00029 * DTSBU991
|
|
00030 ***** DTSBU991
|
|
00031 CL**2
|
|
00032 ENVIRONMENT DIVISION. DTSBU991
|
|
00033 CL**2
|
|
00034 DATA DIVISION. DTSBU991
|
|
00035 CL**2
|
|
00036 WORKING-STORAGE SECTION. DTSBU991
|
|
000365 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU991 09/29/98'. DTSBU991
|
|
00037 CL**2
|
|
00038 01 WRK-AREA. DTSBU991
|
|
00039 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +991. DTSBU991
|
|
00040 CL**2
|
|
00041 CL**2
|
|
00042 CL**2
|
|
00043 05 CHAR-CNT-MAX PIC S9(04) COMP VALUE +64. DTSBU991
|
|
00044 CL**2
|
|
00045 05 CTR PIC S9(04) COMP. DTSBU991
|
|
00046 CL**2
|
|
00047 05 DEFAULT-CHAR PIC X(01) VALUE '.'. DTSBU991
|
|
00048 CL**2
|
|
00049 05 CHARACTER-AREA. DTSBU991
|
|
00050 10 FILLER PIC X(01) VALUE LOW-VALUE. DTSBU991
|
|
00051 10 REQ-CHAR PIC X(01). DTSBU991
|
|
00052 88 REQ-CHAR-IS-LOW-VALUE VALUE LOW-VALUE. DTSBU991
|
|
00053 88 REQ-CHAR-IS-TO-PRINT VALUE 'A' THRU 'Z' DTSBU991
|
|
00054 SPACE DTSBU991
|
|
00055 '0' THRU '9'. DTSBU991
|
|
00056 CL**2
|
|
00057 05 HEX-IDX REDEFINES CHARACTER-AREA DTSBU991
|
|
00058 PIC S9(04) COMP. DTSBU991
|
|
00059 SKIP3 DTSBU991
|
|
00060 01 C991-AREA. DTSBU991
|
|
00061 ++INCLUDE DTSIC991 CL**2
|
|
00062 EJECT DTSBU991
|
|
00063 LINKAGE SECTION. DTSBU991
|
|
00064 SKIP3 DTSBU991
|
|
00065 01 LINK-AREA. DTSBU991
|
|
00066 ++INCLUDE DTSIL991 CL**2
|
|
00067 EJECT DTSBU991
|
|
00068 PROCEDURE DIVISION USING LINK-AREA. DTSBU991
|
|
00069 SKIP2 DTSBU991
|
|
00070 IF (L991-REQ-CHAR-CNT < +1) DTSBU991
|
|
00071 OR DTSBU991
|
|
00072 (L991-REQ-CHAR-CNT > CHAR-CNT-MAX) DTSBU991
|
|
00073 PERFORM S999-ABEND THRU S999-EXIT DTSBU991
|
|
00074 ELSE DTSBU991
|
|
00075 MOVE SPACE TO L991-REPLY-AREA. DTSBU991
|
|
00076 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBU991
|
|
00077 VARYING CTR FROM 1 BY 1 DTSBU991
|
|
00078 UNTIL CTR GREATER THAN L991-REQ-CHAR-CNT. DTSBU991
|
|
00079 SKIP2 DTSBU991
|
|
00080 GOBACK. DTSBU991
|
|
00081 EJECT DTSBU991
|
|
00082 P0000-PROCESS. DTSBU991
|
|
00083 CL**2
|
|
00084 MOVE L991-REQ-CHAR (CTR) TO REQ-CHAR. DTSBU991
|
|
00085 CL**2
|
|
00086 IF REQ-CHAR-IS-LOW-VALUE DTSBU991
|
|
00087 MOVE '0' TO L991-REPLY-HEX-1-CHAR (CTR) DTSBU991
|
|
00088 MOVE '0' TO L991-REPLY-HEX-2-CHAR (CTR) DTSBU991
|
|
00089 ELSE DTSBU991
|
|
00090 MOVE C991-HEX-1 (HEX-IDX) TO L991-REPLY-HEX-1-CHAR (CTR) DTSBU991
|
|
00091 MOVE C991-HEX-2 (HEX-IDX) TO L991-REPLY-HEX-2-CHAR (CTR).DTSBU991
|
|
00092 CL**2
|
|
00093 IF REQ-CHAR-IS-TO-PRINT DTSBU991
|
|
00094 MOVE REQ-CHAR TO L991-REPLY-AN-CHAR (CTR) DTSBU991
|
|
00095 ELSE DTSBU991
|
|
00096 MOVE DEFAULT-CHAR TO L991-REPLY-AN-CHAR (CTR). DTSBU991
|
|
00097 CL**2
|
|
00098 P0000-EXIT. DTSBU991
|
|
00099 EXIT. DTSBU991
|
|
00100 EJECT DTSBU991
|
|
00101 S999-ABEND. DTSBU991
|
|
00102 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2
|
|
00103 S999-EXIT. DTSBU991
|
|
00104 EXIT. DTSBU991
|