LOGICAL FUNCTION LJNASK (PROMPT, DEFLT, SGLCHR, IRETCH) C***************************************************************************** C C Description : Ask a JA/NEE answer from terminal (Dutch version) C Result is .TRUE. if "J" or "JA" is entered C .FALSE. if "N" or "NEE" is entered C lower case entry is permitted C C Arguments : PROMPT = the prompt string C DEFLT = the default string C SGLCHR = string with characters that can be entered as C single character input C IRETCH = when single character input the ASCII code of the C character entered (output) C C note: all arguments have to be given except SGLCHR and IRETCH C if SGLCHR was empty or not given C strings are closed by a zero-byte C if the default string is empty then there is no default C C Author : R. Beetz C AKZO PHARMA, Oss Holland C dept. SDA C C Version : V1.1 Date : 22-apr-83 C C Module name : LJNASK.FTN C C Package : RSX-LIBRARY C C Compilation/Linking : FOR/F4P/TR:NONE LJNASK C C Updates : name R.Beetz version V1.1 C description : single character input implemented C C***************************************************************************** C BYTE PROMPT(1),DEFLT(1),SGLCHR(1),STR(5) INTEGER*2 IRETCH C IF (.NOT. LARG(2)) GOTO 10 IF (DEFLT(1) .EQ. 0) GOTO 10 CALL SCOPY (DEFLT,STR,4) CALL SCVTLU (STR) IF (ISCOMP(STR,'N') .EQ. 0) GOTO 10 IF (ISCOMP(STR,'NEE') .EQ. 0) GOTO 10 IF (ISCOMP(STR,'J') .EQ. 0) GOTO 10 IF (ISCOMP(STR,'JA') .EQ. 0) GOTO 10 CALL FATAL ('LJNASK','Incorrect default string') 10 IRET=0 CALL SASK (PROMPT,STR,1,3,DEFLT,SGLCHR,IRET) IF (IRET .NE. 0) 15,16,16 C THEN 15 IRETCH=IRET GOTO 40 C ENDIF 16 CALL SCVTLU (STR) IF (ISCOMP(STR,'N') .EQ. 0) GOTO 20 IF (ISCOMP(STR,'NEE') .EQ. 0) GOTO 20 IF (ISCOMP(STR,'J') .EQ. 0) GOTO 30 IF (ISCOMP(STR,'JA') .EQ. 0) GOTO 30 CALL SWRITE (,,'Type Ja of Nee') GOTO 10 20 LJNASK = .FALSE. RETURN 30 LJNASK = .TRUE. 40 RETURN END