VTGETCHAR:  PROC(ROW,COLUMN,PROMPT_STRING,CHARS_NEEDED,VERIFY_STRING)
          RETURNS(CHAR(*) VARYING);

/* PROCEDURE PROMPTS FOR A CHARACTER STRING.
   IF VERIFY_STRING IS NOT NULL PROCEDURES CHECKS TO
   MAKE SURE THAT ALL CHARACTERS ENTERED ARE CONTAINED
   IN THE STRING.  CONVERSION TO UPPER CASE IS ALSO PERFORMED.
   AUTHOR:  AL JAWORSKI
   DATE:    3/15/82 */

DCL (VERIFY_STRING,PROMPT_STRING) CHAR(*) VARYING;
DCL (ROW,COLUMN,PROMPT_COLUMN,CHARS_NEEDED) FIXED BINARY(31);
DCL (P,Q) POINTER;
DCL RETURN_STRING CHAR(CHARS_NEEDED) VARYING BASED(P);
ALLOC RETURN_STRING SET(P);
DCL CHAR_BUF CHAR(CHARS_NEEDED) BASED(Q);
ALLOC CHAR_BUF SET(Q);
DCL (GOT_CHAR,ERROR_FLAG) BIT(1);

DCL TTCHAN FIXED BINARY(15) GLOBALREF;
DCL (IO$_READLBLK,IO$M_TRMNOECHO) FIXED BINARY(31) GLOBALREF VALUE;

DCL 1 IOSB,
      2 VALUE FIXED(15),
      2 BYTES_RECEIVED FIXED(15),
      2 NOT_USED FIXED(31);

DCL IO_SUCCESS BIT(1) ALIGNED BASED(ADDR(IOSB));

%INCLUDE $STSDEF;
%INCLUDE VTDEL;
%INCLUDE VTPUT; 
%INCLUDE VTBRIGHT;
%INCLUDE VTREVERSE;
%INCLUDE VTRESET;
%INCLUDE UPPER;
%INCLUDE SYS$QIOW;

GOT_CHAR='0'B;
ERROR_FLAG='0'B;

DO WHILE(^GOT_CHAR);

  CHAR_BUF=' ';
  CALL VTPUT(ROW,COLUMN,PROMPT_STRING);
  PROMPT_COLUMN=COLUMN+LENGTH(PROMPT_STRING);
  STS$VALUE=SYS$QIOW(,TTCHAN,IO$_READLBLK+IO$M_TRMNOECHO
                     ,IOSB,,,Q,CHARS_NEEDED,,,,);
  IF STS$SUCCESS THEN DO;
    RETURN_STRING=SUBSTR(CHAR_BUF,1,BYTES_RECEIVED);
    RETURN_STRING=UPPER(RETURN_STRING);
  END;
  ELSE DO;
    ERROR_FLAG='1'B;
    CALL VTPUT(23,1,'');
    CALL VTDEL();
    CALL VTPUT(23,1,'Please reenter response');
    RETURN_STRING='';
  END;

  IF VERIFY_STRING='' | VERIFY(RETURN_STRING,UPPER(VERIFY_STRING))=0
    THEN GOT_CHAR='1'B;
  ELSE DO;
    ERROR_FLAG='1'B;
    CALL VTBRIGHT();
    CALL VTREVERSE();
    CALL VTPUT(23,1,'');
    CALL VTDEL();
    CALL VTPUT(23,1,COPY(BYTE(7),3)||'Invalid response--'||RETURN_STRING);
    CALL VTRESET();
    CALL VTPUT(ROW,PROMPT_COLUMN,COPY(' ',CHARS_NEEDED));
    CALL VTPUT(ROW,PROMPT_COLUMN,'');
  END;
END;

IF ERROR_FLAG THEN DO;
  CALL VTPUT(23,1,'');
  CALL VTDEL();
END;

RETURN(RETURN_STRING);

END VTGETCHAR;