GETFIX: PROC(PROMPT_STRING,RANGE) RETURNS(FIXED BINARY(31));

/* ROUTINE PROMPTS FOR A NUMBER CHECKING RANGE AND OTHER ERROR CONDITIONS
   AUTHOR:  AL JAWORSKI
   DATE: 2/17/82 */

DCL VALUE FIXED BINARY(31);
DCL (PROMPT_STRING,RANGE) CHAR(*) VARYING;
DCL ANSWER CHAR(10);
DCL GOT_NUM BIT(1);

ON ERROR GOT_NUM='0'B;

GOT_NUM='0'B;

DO WHILE(^GOT_NUM);

  PUT SKIP;
  GET EDIT(ANSWER)(A(10))
      OPTIONS(PROMPT(PROMPT_STRING));

  GOT_NUM='1'B;

  VALUE=FIXED(ANSWER,31);

  IF GOT_NUM THEN GOT_NUM=RANGE_CHECK(VALUE,RANGE);
  
  IF ^GOT_NUM THEN DO;
    PUT EDIT(COPY(BYTE(7),3),'Invalid answer--Must be numeric in range: ',
             RANGE)
            (SKIP,2 A,SKIP,A);
    GOT_NUM='0'B;
  END;

END;

RETURN(VALUE);

/* END OF MAIN ROUTINE */

RANGE_CHECK:  PROC(VALUE,RANGE) RETURNS(BIT(1));

/* PROCEDURE CHECKS FOR VALUE IN RANGE AND RETURNS LOGICAL VALUE */

DCL VALUE FIXED BINARY(31);
DCL RANGE CHAR(*) VARYING;
DCL TMP_RANGE CHAR(LENGTH(RANGE)) VARYING BASED(P);
DCL P POINTER;
DCL RANGE_ELEMENT CHAR(20) VARYING;
DCL T CHAR(1);
DCL (I,J,HIGH,LOW) FIXED BINARY(31);

ALLOCATE TMP_RANGE SET(P);

ON ERROR BEGIN;
  PUT EDIT('Range incorrectly specified--',RANGE)
          (SKIP,2 A);
  PUT SKIP;
  STOP;
END;

TMP_RANGE=RANGE;

DO WHILE(TMP_RANGE^='');
  RANGE_ELEMENT=LOP(TMP_RANGE,',');
  IF INDEX(RANGE_ELEMENT,'-')=0 THEN DO;    
    LOW=FIXED(RANGE_ELEMENT,31);
    HIGH=LOW;
  END;
  ELSE DO;
    LOW=FIXED(LOP(RANGE_ELEMENT,'-'),31);
    HIGH=FIXED(RANGE_ELEMENT,31);
  END;
  IF LOW<=VALUE & VALUE<=HIGH THEN RETURN('1'B);
END;

RETURN('0'B);

END RANGE_CHECK;



LOP: PROC(R,L) RETURNS(CHAR(*) VARYING);

/* PROCEDURE TRIMS LEAD SEPARATORS (BLANK OR L) AND LOPS OFF
   FIRST CHUNK MARKED BY L */

DCL R CHAR(*) VARYING;
DCL T CHAR(LENGTH(R)) VARYING BASED(P);
DCL P POINTER;
DCL L CHAR(1);
DCL (I,J) FIXED BINARY(31);

ALLOC T SET(P);

DO WHILE(SUBSTR(R,1,1)=' '|SUBSTR(R,1,1)=L);
  J=LENGTH(R);
  R=SUBSTR(R,2,J-1);
END;

I=INDEX(R,L); 
J=LENGTH(R);
IF I=0 | I=J THEN DO;
  T=R;
  R='';
END;
ELSE DO;
  T=SUBSTR(R,1,I-1);
  R=SUBSTR(R,I+1,J-I);
END;

RETURN(T);

END LOP;


END GETFIX;