|
IDENTIFICATION DIVISION.
*
PROGRAM-ID. GETNUMT.
*
DATE-WRITTEN. 04/04/90.
*
* MODIFIED 10/18/97.
*
* *******************************
* * *
* * Judson D. McClendon *
* * Sun Valley Systems *
* * 329 37th Court N.E. *
* * Birmingham, AL 35215 *
* * 205-853-8440 *
* * *
* *******************************
*
ENVIRONMENT DIVISION.
*
CONFIGURATION SECTION.
*
INPUT-OUTPUT SECTION.
*
FILE-CONTROL.
*
I-O-CONTROL.
*
DATA DIVISION.
*
FILE SECTION.
*
*
WORKING-STORAGE SECTION.
*
77 WS-ESCAPE-FLAG PIC 9(01) COMP VALUE 0.
77 WS-ERR-MSG PIC X(30) VALUE SPACES.
*
******************************************************************
* *
* N U M B E R W O R K A R E A *
* *
******************************************************************
*
01 NUMBER-WORK-AREA.
03 NW-NBR-ERROR-FLAG PIC 9(01).
03 NW-WORK-NBR.
05 NW-WORK-CHAR OCCURS 25 TIMES
INDEXED BY NW-WX
NW-WLIM.
07 NW-WORK-DIGIT PIC 9(01).
03 NW-DEC-PLACES PIC 9(02).
03 NW-BLD-SIGN PIC S9(01).
03 NW-BLD-NBR PIC 9(12)V9(06).
03 NW-BLD-NBR-SPLIT REDEFINES NW-BLD-NBR.
05 NW-BLD-INTEGER PIC 9(12).
05 NW-BLD-DECIMAL PIC V9(06).
88 NW-RESULT-INTEGER VALUE ZERO.
05 NW-BLD-DEC-DIGITS REDEFINES NW-BLD-DECIMAL.
07 NW-BLD-DEC-DIGIT OCCURS 6 TIMES
INDEXED BY NW-BDX
NW-BDLIM
PIC 9(01).
03 NW-EXTRACTED-NBR PIC S9(12)V9(06).
*
SCREEN SECTION.
*
*
* I N P U T S C R E E N
*
01 INPUT-SCREEN
FOREGROUND-COLOR 7
BACKGROUND-COLOR 0.
03 BLANK SCREEN
LINE 01 COLUMN 31 VALUE "G E T N U M B E R".
*
03 LINE 03 COLUMN 01 VALUE "Enter Number: ".
03 PIC X(25) USING NW-WORK-NBR.
*
*
* O U T P U T S C R E E N
*
01 OUTPUT-SCREEN
FOREGROUND-COLOR 7
BACKGROUND-COLOR 0.
*
03 LINE 05 COLUMN 01 VALUE " Result: ".
03 PIC -(13).9(06) FROM NW-EXTRACTED-NBR.
03 COLUMN 41
PIC X(30) FROM WS-ERR-MSG.
/
PROCEDURE DIVISION.
*
*
* C O N T R O L S E C T I O N
*
000000-CONTROL.
*
MOVE SPACES TO NW-WORK-NBR.
DISPLAY INPUT-SCREEN.
*
PERFORM 000100-PROCESS
THRU 000100-EXIT
UNTIL (WS-ESCAPE-FLAG = 1).
*
000000-EXIT.
STOP RUN.
*
* P R O C E S S
*
000100-PROCESS.
*
ACCEPT INPUT-SCREEN
ON ESCAPE
MOVE 1 TO WS-ESCAPE-FLAG
GO TO 000100-EXIT.
*
PERFORM 003000-GET-NBR
THRU 003000-EXIT.
*
IF (NW-NBR-ERROR-FLAG = 1)
MOVE "NUMBER INVALID" TO WS-ERR-MSG
ELSE
MOVE SPACES TO WS-ERR-MSG.
*
DISPLAY OUTPUT-SCREEN.
*
000100-EXIT.
EXIT.
*
******************************************************************
* *
* G E T N U M B E R *
* *
* Judson D. McClendon *
* Sun Valley Systems *
* 329 37th Court NE *
* Birmingham, AL 35215 *
* 205/853-8440 *
* *
* CONVERTS A NUMBER IN FREE FORMAT DISPLAY FORM: *
* FOR EXAMPLE: *
* *
* "999,999,999,999.999999 " *
* "-999,999,999,999.999999" *
* " -23.61 " *
* " 4" *
* "0 " *
* " .000001 " *
* "0000000000123456789.10-" *
* " " BLANK IS VALID = 0 *
* *
* INTO FIXED NUMERIC FORM: *
* *
* PIC S9(12)V9(06) *
* *
* *
* USAGE: MOVE <FREE FORM NUMBER> TO NW-WORK-NBR. *
* PERFORM 003000-GET-NBR *
* THRU 003000-EXIT. *
* *
* RESULT: NW-NBR-ERROR-FLAG = 0 INPUT IS A VALID NUMBER *
* 1 INPUT NOT A VALID NUMBER *
* *
* IF NW-NBR-ERROR-FLAG = 0 THEN: *
* *
* NW-EXTRACTED-NBR = NUMBER AS: PIC S9(12)V9(06) *
* *
* NW-DEC-PLACES = NUMBER OF DIGITS TO THE RIGHT *
* OF THE DECIMAL POINT (0=NONE) *
* *
* NW-BLD-SIGN = +1 OR -1 AS: PIC S9(01) *
* *
* NW-BLD-INTEGER = INTEGER DIGITS AS: PIC 9(12) *
* *
* NW-BLD-DECIMAL = DECIMAL DIGITS AS: PIC V9(06) *
* *
******************************************************************
*
003000-GET-NBR.
*
MOVE 0 TO NW-NBR-ERROR-FLAG.
MOVE ZERO TO NW-EXTRACTED-NBR.
*
MOVE 0 TO NW-DEC-PLACES.
MOVE ZERO TO NW-BLD-NBR.
MOVE +1 TO NW-BLD-SIGN.
SET NW-BDX TO 1.
SET NW-WLIM TO 25.
*
* ** LOCATE LEFTMOST DIGIT OF NUMBER **
*
SET NW-WX TO 1.
SEARCH NW-WORK-CHAR
WHEN NW-WORK-CHAR(NW-WX) NOT = SPACE
PERFORM 003010-DECODE-NBR
THRU 003010-EXIT.
*
IF (NW-WORK-NBR NOT = SPACES)
MOVE 1 TO NW-NBR-ERROR-FLAG
ELSE
COMPUTE NW-EXTRACTED-NBR = NW-BLD-NBR * NW-BLD-SIGN.
*
003000-EXIT.
EXIT.
*
*
* DECODE NUMBER
*
003010-DECODE-NBR.
*
IF (NW-WORK-CHAR(NW-WX) = "-")
MOVE -1 TO NW-BLD-SIGN
MOVE SPACE TO NW-WORK-CHAR(NW-WX)
SET NW-WX UP BY 1.
*
PERFORM 003020-GET-INT-PART
THRU 003020-EXIT
UNTIL (NW-WX > NW-WLIM).
*
SET NW-DEC-PLACES TO NW-BDX.
SUBTRACT 1 FROM NW-DEC-PLACES.
*
003010-EXIT.
EXIT.
*
*
* GET INTEGER PART OF NUMBER
*
003020-GET-INT-PART.
*
IF (NW-WORK-CHAR(NW-WX) NUMERIC)
IF (NW-BLD-INTEGER > 99999999999)
SET NW-WX TO NW-WLIM
ELSE
COMPUTE NW-BLD-INTEGER =
NW-BLD-INTEGER * 10 + NW-WORK-DIGIT(NW-WX)
MOVE SPACE TO NW-WORK-CHAR(NW-WX)
ELSE
IF (NW-WORK-CHAR(NW-WX) = ".")
MOVE SPACES TO NW-WORK-CHAR(NW-WX)
SET NW-WX UP BY 1
PERFORM 003030-GET-DEC-PART
THRU 003030-EXIT
UNTIL (NW-WX > NW-WLIM)
ELSE
IF (NW-WORK-CHAR(NW-WX) = ",")
MOVE SPACE TO NW-WORK-CHAR(NW-WX)
ELSE
SET NW-WX TO NW-WLIM.
*
SET NW-WX UP BY 1.
*
003020-EXIT.
EXIT.
*
*
* GET DECIMAL PART OF NUMBER
*
003030-GET-DEC-PART.
*
IF (NW-WORK-CHAR(NW-WX) NUMERIC)
IF (NW-BDX > 6)
SET NW-WX TO NW-WLIM
ELSE
MOVE NW-WORK-DIGIT(NW-WX) TO NW-BLD-DEC-DIGIT(NW-BDX)
MOVE SPACES TO NW-WORK-CHAR(NW-WX)
SET NW-BDX UP BY 1
ELSE
IF (NW-WORK-CHAR(NW-WX) = "-")
MOVE -1 TO NW-BLD-SIGN
MOVE SPACE TO NW-WORK-CHAR(NW-WX)
SET NW-WX TO NW-WLIM
ELSE
SET NW-WX TO NW-WLIM.
*
SET NW-WX UP BY 1.
*
003030-EXIT.
EXIT.
¤ Dauer der Verarbeitung: 0.28 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
