*******************************************************************************
*									      *
*	Author - Nick Makris - STARTECH SYSTEMS - San Francisco, CA	      *
*	Date -	 July 1990						      *								      *
*	Note:   The database has one field of 80 charcters in length	      *
*	and contains one record with up to 16 four character tokens	      *
*	seperated by one space.  					      *
*									      *
*******************************************************************************

********	 AS PUBLISHED IN DBMS MAGAZINE -- OCTOBER 1990	    ***********

CLEAR
USE SCRNTEST
SVCOLOR='W/N,W+/R'              	&& SYSTEM DEFAULT COLOR
SET COLOR TO W+/W
DO MAKEBOX WITH 11,26,18,54,.F.	&& PARAMETER 5 SOUNDS ALARM
SET COLOR TO W+/W			&& SET COLOR TO EMPHASIS INSIDE BOX
@12,28 SAY "VALID TIME REPORTING CODES"
SET COLOR TO w+/N			&& EMPHASIS ON BORDER
*					&& THE COLOR FOR THE GETS IS NOT 
*					&& AFFECTED BY THIS STATEMENT 
@11,30 SAY "<CTRL-END> TO COMPLETE"
@18,31 SAY "<ESCAPE> TO ABANDON"
X=1
DO WHILE X<16				&& EACH FIELD IS 4 CHARACTERS
*					   PLUS A ONE SPACE DELIMITER
*					   THAT EQUALS ONE 80 CHARACTER LINE
 DISPX=LTRIM(STR(X,2))			&& SET UP NEXT VARIABLE NAME
 x&dispx=SUBSTR(SCRNLINE,1+((X*5)-5),4)
 if MOD(X,3)=1				&& DETERMINE WHAT LINE/COLUMN TO USE
  @13+(x/3),30 get x&dispx		&& 1ST COL
 else
 if MOD(X,3)=2
  @13+(x/3),38 get x&dispx		&& 2ND COL
 else
  @12+(x/3),46 get x&dispx		&& 3RD COL
 endif
 endif
 X=X+1
 loop
ENDDO
read
IF READKEY()#12				&& ABANDON IF <ESCAPE> WAS PRESSED
 X=1
 SVCODES=""				&& RESET VARIABLE
 DO WHILE X<16				&& AND RECONSTRUCT
  DISPX=LTRIM(STR(X,2))			&& SET UP NEXT VARIABLE
  LENFLD=LEN(LTRIM(TRIM(x&dispx)))	&& DETERMINE HOW MANY TRAILING
*					   SPACES ARE NEEDED
  SVCODES=SVCODES+UPPER(TRIM(LTRIM(x&dispx)))+REPLICATE(" ",5-LENFLD)
  X=X+1
 ENDDO
 REPLACE SCRNLINE WITH SVCODES
ENDIF
USE
RETURN

PROCEDURE MAKEBOX
PARAMETERS STLINE,STCOL,ENDLINE,ENDCOL,RINGBELL && ,GETINPUT,STR1,STR2,STR3

IF RINGBELL
 @0,0 SAY CHR(7)
ENDIF
@STLINE,STCOL CLEAR TO ENDLINE,ENDCOL	&& CLEAR A WHITE SPACE ON THE SCREEN
SET COLOR TO &SVCOLOR			&& SET COLORS TO SYSTEM DEFAULT
@STLINE,STCOL TO ENDLINE,ENDCOL DOUBLE	&& MAKE A DOUBLE LINE BOX AROUND IT
RETURN