home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol049 / getd92.pli < prev    next >
Text File  |  1984-04-29  |  2KB  |  76 lines
  1. /*PROGRAM
  2.         GETD92 - GET A DECIMAL NUMBER.
  3.   PROGRAMMER
  4.         ROBERT M. WHITE
  5.   DATE WRITTEN
  6.         APRIL 10, 1981
  7.   PURPOSE
  8.         THIS ROUTINE GETS A DECIMAL NUMBER FROM
  9.         THE TERMINAL OPERATOR, CONVERTS IT TO
  10.         INTERNAL FORM, AND VALIDATES IT.  CONTROL
  11.         IS RETURNED ONLY WHEN A VALID NUMBER HAS
  12.         BEEN ENTERED.
  13.   INPUT
  14.         13-BYTE 9-DIGIT NUMBER W/2-DECIMAL PLACES
  15.   OUTPUT
  16.         5-BYTE 9-DIGIT NUMBER W/2-DECIMAL PLACES (PACKED)
  17.   RETURN CODES
  18.         0=SUCCESSFUL COMPLETION
  19.   REMARKS
  20.         1. ALLOW 13 BYTES ON THE SCREEN FOR THE NUMBER.
  21. */
  22.  
  23. GETD92: PROC (X,Y,NUM,LO,HI,RTN_COD);
  24.     DCL    X BIN(7), /* ROW */
  25.         Y BIN(7), /* COLUMN */
  26.         NUM DEC(9,2), /* RETURNED NUMBER */
  27.         LO DEC(9,2), /* LOW RANGE CHECK */
  28.         HI DEC(9,2), /* HIGH RANGE CHECK */
  29.         RTN_COD BIN(7); /* RETURN CODE */
  30.  
  31.     DCL    V CHAR(13);
  32.     DCL    VW CHAR(13) VARYING;
  33.  
  34.     DCL    GETSTR ENTRY(BIN(7),BIN(7),BIN(7),PTR,BIN(7));
  35.     DCL    PUTERR ENTRY(CHAR(80) VARYING);
  36.     DCL    PUTD92 ENTRY(BIN(7),BIN(7),PTR);
  37.  
  38. /* GET THE NUMBER. */
  39.     ON ERROR        /* HANDLE CONVERSION ERRORS. */
  40.        BEGIN;
  41.          GOTO CONV_ERROR;
  42.        END;
  43.     ON FIXEDOVERFLOW    /* HANDLE CONVERSION ERRORS. */
  44.        BEGIN;
  45.          GOTO CONV_ERROR;
  46.        END;
  47. START:
  48.     CALL GETSTR(X,Y,LENGTH(V),ADDR(V),RTN_COD); /* GET IT. */
  49.     VW=V;
  50.     DO WHILE(SUBSTR(VW,LENGTH(VW),1)=' '); /* REMOVE TRAILING BLANKS. */
  51.        VW=SUBSTR(VW,1,LENGTH(VW)-1);
  52.     END;
  53.  
  54. /* VALIDATE THE NUMBER. */
  55.     NUM = DEC(VW,9,2);
  56.     IF LO=0 & HI=0 THEN  /* DON'T RANGE CHECK. */
  57.        ;
  58.     ELSE
  59.        IF NUM<LO | NUM>HI THEN
  60.          DO;
  61.            SIGNAL ERROR(1);
  62.          END;
  63.  
  64. /* REWRITE DATA ON SCREEN TO CLEAN IT UP. */
  65.     CALL    PUTD92(X,Y,ADDR(NUM));
  66.     RETURN;
  67.  
  68. /* HANDLE ERROR CONDITIONS. */
  69. CONV_ERROR:
  70.     CALL PUTERR('*** INVALID NUMBER ***');
  71.     GOTO START;
  72.  
  73. /* RETURN TO CALLER. */
  74.     END    GETD92;
  75.  
  76.