Files
DUTAS/CICS/DTSCU057.cob
2025-07-21 11:20:11 -04:00

69 lines
5.4 KiB
COBOL
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

00001 IDENTIFICATION DIVISION. 09/18/98
00002 PROGRAM-ID. DTSCU057. DTSCU057
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008
00004 DATE-WRITTEN. SEPTEMBER 1998. CL**3
00005 DATE-COMPILED. DTSCU057
00006 SKIP3 DTSCU057
00007 ***** DTSCU057
00008 * DTSCU057
00009 * FUNCTION: FORMAT RESERVE RATIO FOR SCREEN. CL**3
00010 * DTSCU057
00011 * DTSCU057
00012 * MODIFICATION LOG: DTSCU057
00013 * DTSCU057
00014 * 09/23/1998 INITIAL DEVELOPMENT. CL**3
00015 * WORK ORDER: PROGRAMMER: TCL CL**3
00016 * DTSCU057
00017 * CL**2
00018 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
00020 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2
00021 * DTSCU057
00022 * DTSCU057
00023 * DESCRIPTION: DTSCU057
00024 * DTSCU057
00025 * DTSCU057 RECEIVES L057-RATIO S9(02)V9(05) COMP-3º. CL**8
00026 * DTSCU057
00027 * DTSCU057 RETURNS L057-DISP-RATIO --9.9º. CL**8
00028 * DTSCU057
00029 * DTSCU057
00030 ***** DTSCU057
00031 SKIP3 DTSCU057
00032 ENVIRONMENT DIVISION. DTSCU057
00033 SKIP3 DTSCU057
00034 DATA DIVISION. DTSCU057
00035 SKIP3 DTSCU057
00036 WORKING-STORAGE SECTION. DTSCU057
000365 77 PAN-VALET PICTURE X(24) VALUE '008DTSCU057 09/18/98'. DTSCU057
00037 SKIP3 DTSCU057
00038 01 WRK-AREA. DTSCU057
00039 05 WRK-ABEND-CODE PIC X(04) VALUE 'U057'. CL**3
00040 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU057
00041 05 WRK-RATIO PIC S9(02)V9 COMP-3. CL**4
00042 05 WRK-DISP-RATIO PIC --9.9. CL**6
00043 CL**2
00044 EJECT DTSCU057
00045 LINKAGE SECTION. DTSCU057
00046 SKIP3 DTSCU057
00047 01 DFHCOMMAREA. DTSCU057
00048 ++INCLUDE DTSIL057 CL**3
00049 EJECT DTSCU057
00050 PROCEDURE DIVISION. DTSCU057
00051 SKIP2 DTSCU057
00052 DTSCU057-MAIN. CL**4
00053 MOVE SPACE TO L057-DISP-RATIO. CL**5
00054 MOVE ZERO TO WRK-RATIO CL**6
00055 WRK-DISP-RATIO. CL**5
00056 CL**2
00057 COMPUTE WRK-RATIO = L057-RATIO * 100. CL**4
00058 MOVE WRK-RATIO TO WRK-DISP-RATIO. CL**5
00059 MOVE WRK-DISP-RATIO TO L057-DISP-RATIO. CL**5
00060 CL**2
00061 DTSCU057-EXIT. CL**4
00062 EXEC CICS DTSCU057
00063 RETURN DTSCU057
00064 END-EXEC. DTSCU057
00065 SKIP2 DTSCU057
00066 GOBACK. DTSCU057
00067 SKIP3 DTSCU057