!	PRESEL.DDL
!
!	Written by:	Jack McGregor
!	Of:		G.R.E.A.T. Insurance Services, Inc.
!	Date:		11-OCT-82
!------------------------------------------------------------------------
!	DONATED TO AMUS NETWORK 14-OCT-82
!-------------------------------------------------------------------------
!	An ANDI selection pre-processor that presents prompts and menus
!	that the user can understand, then creates a command file to
!	execute the ANDI selection commands, and chains to it.
!-------------------------------------------------------------------------
!	This program is customized by a parameter file which associates
!	actual field names with prompts to be displayed.  It should be
!	in the format:
!
!	T,SELECTION TITLE
!	N,ANDI FILE NAME
!	F,PROMPT,FIELDNAME{-TYPE CODE}
!	F,PROMPT,FIELDNAME{-TYPE CODE}	 
!	.
!	.				! Specify up to 12 fields to select
!	.				! on.
!	F,PROMPT,FIELDNAME{-TYPE CODE}
!	{A,ACTION}
!----------------------------------------------------------------------
! NOTES:
!	You may include comments at the BEGINNING of the parameter file
!	by putting a semi-colen in column 1.
!
!	SELECTION TITLE displays at the top of the screen the name of 
!		the report or whatever
!	ANDI FILE NAME is the ANDI extended file name
!	PROMPT is a human-readable version of FIELDNAME, which is the
!		actual ANDI DBS fieldname.  For example, if FIELDNAME
!		is "DATESUB", PROMPT might be "Date Submitted".  Maximum
!		size of PROMPT is 24 characters.  You may specify up to
!		12 fields to select on.  (Limitation due to room on screen.)
!	TYPE CODE is an optional 1 character code (must be prededed by
!		a dash) which identifies the variable type.  The intended
!		use is to perform error checking on the selection commands.
!		The established codes are: A(lpha),*(A/N),D(ate),N(umeric)
!	ACTION is the optional action to be performed with the selected
!		records.  It should be entered as a complete command, like
!		"DISPLAY SELECTED RECORDS", "PRINT SELECTED RECORDS USING
!		<rglname>", etc.
!-----------------------------------------------------------------------
! EXTERNAL SUBROUTINES:
!	GETCHR.SBR	(Input 1 character w/o RETURN - supplied by DRAVAC)
!	JOBNAM.SBR	(Return the user's JOB Name - by Jack McGregor)
!	STRIP.SBR	(Strip trailing blanks - AlphaAccounting)
!	SLEEP.SBR	(Like SLEEP.PRG - Jack McGregor)
!------------------------------------------------------------------------
! IDEAS FOR ENHANCEMENTS:
!	1.  Revise input routine to allow input of field PROMPT as well
!	    as the field number (I hate inputting numbers.)
!	2.  Convert the input routines to allow VUE-like editing.  Doesn't
!	    someone have such a module?
!--------------------------------------------------------------------------
! CUSTOMIZATION NOTES:
!	When you are selecting records for a report that has additional
!	input (like report subtitle, printer option, etc.) you can
!	add a routine to this program just before the command file is 
!	closed, to ask for and output the additional report inputs.
!	Then the report program can use BASIC INPUT to retrieve these
!	items.  See CUSTOMIZATION'MODULE.
!-------------------------------------------------------------------------
!


1 FIELD'PARAMETERS(12)
	2 PROMPT,S,20
	2 FIELD,S,11		! 9 + 2 bytes for the -TYPE
	2 TYPE'FLAG,S,1		! D=Date,N=Number,A=Alpha,*=A/N

1 OTHER'PARAMETERS
	2 TITLE$,S,40
	2 ANDI'FILE'NAME,S,32
	2 ACTION$,S,60
	2 PNAME$,S,24		! Name of parameter file
	2 C$,S,20		! Used to input parameters
	2 RESELECT$,S,1
1 MISC
	2 CND$,S,32
	2 STRING1$,S,60


1 RELATIONS			! Set of allowable relations
				!   Each one must be separated by a comma!
	2 TEXT'NUM'RELS$,S,30,"=,<>,<=,>=,<,>"
	2 TEXT'RELS$,S,30,"SOUNDS LIKE,CONTAINS"
	2 DATE'RELS$,S,60,"SAME AS,BEFORE,AFTER,ON OR BEFORE,ON OR AFTER"
	2 NUM'RELS$,S,10,"ABOUT"
	2 VALID'RELS$,S,160	! This one is set by CHECK'CONDITION, based
				! on the above 4 vars & the field type

1 SELECTION(10)			! These are the selection commands entered
	2 A$,S,1			! "" or "0" (OR)
	2 FIELD'NO,B,2			
	2 RELATION,S,32
	2 OPERAND,S,24

!-----------------------------------------------------------------------

	enable controlc
	xcall ECHO

START:
	? tab(-1,0);"Selection Pre-processor for:"
ST2:
	input "Parameter file name: ",PNAME$
	lookup PNAME$,X
	if X=0 ? PNAME$;" not found! " : goto ST2

	input "Are you RE-SELECTING from previously selected records? ",RESELECT$

	call GET'PARAMETERS

	call DISPLAY'SELECTION'FIELDS

	call DISPLAY'RELATIONS

	call GET'SELECTION'COMMANDS

	SEL'CMDS = (I - 1) max SEL'CMDS		! # of selection commands

	call GET'SORT'FIELDS

	call ASK'CHANGES
	

CREATE'COMMAND'FILE:		! Output a command file <job>.CMD to access
				! the ANDI dispatcher for selection, etc.

	? tab(24,1);tab(-1,9);
	xcall JOBNAM,JOB$
	xcall STRIP,JOB$

	CMDFIL$ = JOB$ + ".CMD"
	? tab(23,1);"Creating ";CMDFIL$;
	open #9,CMDFIL$,output
	? ".";
	
	? #9,"ANDI"		: ? ".";
	if ucs(RESELECT$[1,1])="Y" ? #9,"RE";
	? #9,"SELECT FROM ";ANDI'FILE'NAME		: ? ".";
	I = 0
CCF'LOOP:
	I = I + 1
	if I>SEL'CMDS goto CCF2

		? #9,FIELD(FIELD'NO(I));" ";
		if RELATION(I)="CONTAINS" then &
			RELATION(I) = "= %" &
		else &
			RELATION(I) = RELATION(I) + " "
		? #9,RELATION(I);OPERAND(I)
		? ".";
		goto CCF'LOOP
CCF2:
	J = 0
	? #9			! end of selection commands

				! Now the sort commands
CCF'LOOP2:
	J = J + 1
	if J>3 goto OUTPUT'ACTION'COMMAND
	if J>1 then if SF(J-1)=0 then goto OUTPUT'ACTION'COMMAND
	if SF(J)<>0 then &
		? #9,FIELD(SF(J)) &
	else &
		? #9
	? #9,"Y"				! ascending order
	when SF(J)<>0
		if TYPE'FLAG(SF(J))="D" then ? #9,"Y" else ? #9,"N"
	else
		? #9,"N"
	end when
	? ".";
	goto CCF'LOOP2

OUTPUT'ACTION'COMMAND:

	if SF(3)=0 and SF(1)<>0 then ? #9,"Y";	! (yes we are finished sorting)
	? #9,ACTION$	: ? ".";

	call CUSTOMIZATION'MODULE	! input additional options

	close #9
	? tab(24,1);tab(-1,9);"Chaining...";
	chain CMDFIL$

!------------------------------------------------------------------------
!------------------------------------------------------------------------

GET'PARAMETERS:

	open #1,PNAME$,input

				! input a parameter line, check what kind
				! it is, and call appropriate routine
PARAM'LOOP:
	input #1,C$	
	if eof(1)=1 goto NO'MORE'PARAMS

	if C$="" or C$[1,1]=";" goto PARAM'LOOP	! skip comments & blank lines

	if C$="N" call GET'ANDI'NAME &
	else if C$="F" call GET'FIELD'PROMPT &
	else if C$="T" call GET'TITLE &
	else if C$="A" call GET'ACTION &
	else ? tab(-1,9);"Illegal parameter type - ";C$ : xcall SLEEP

	goto PARAM'LOOP

NO'MORE'PARAMS:
	close #1
	MAX'FIELDS = I
	return

GET'TITLE:
	input #1,TITLE$
	? tab(1,40);TITLE$
	return

GET'ANDI'NAME:
	input #1,ANDI'FILE'NAME	
	return

GET'FIELD'PROMPT:
	I = I + 1			! Field number
	input #1,PROMPT(I),FIELD(I)
	when FIELD(I)[-2,-2]="-" 		! set the field type code
		TYPE'FLAG(I) = FIELD(I)[-1,-1]
		FIELD(I)=FIELD(I)[1,-3] 
	end when
	return

GET'ACTION:
	input #1,ACTION$	
	return


!-------------------------------------------------------------------------


DISPLAY'SELECTION'FIELDS:	! Display the human-readable fields available
				! for selection

	? tab(2,1);tab(-1,10);
	? tab(3,1);"SELECTION FIELDS:";tab(-1,11);
	I = 0
	for J = 1 to 3	
		COL = (J-1)*22 + 6
		ROW = 3
		for K = 1 to 4
			I = I + 1
			if PROMPT(I)="" goto NXT			
			ROW = ROW + 1
			? tab(ROW,COL);(J-1)*4+K using "##.";" ";PROMPT(I)
NXT:
		next K
	next J

	return


!------------------------------------------------------------------------

DISPLAY'RELATIONS:	! Display a menu of the valid relations, using
			! the four strings set above, 

	? tab(9,1);tab(-1,12);"RELATIONS: ";tab(-1,11);
	? tab(9,14);"Numbers or Text: ";tab(-1,12);
	STRING1$ = TEXT'NUM'RELS$
	call DISPLAY'STRING1

	? tab(10,14);"Text Only: ";
	STRING1$ = TEXT'RELS$
	call DISPLAY'STRING1

	? tab(11,14);"Numbers Only: ";
	STRING1$ = NUM'RELS$
	call DISPLAY'STRING1

	? tab(12,14);"Dates: ";
	STRING1$ = DATE'RELS$
	call DISPLAY'STRING1

	return
!------------------------------------------------------------------------

GET'SELECTION'COMMANDS:

	? tab(14,40);tab(-1,11);"Selection commands entered: ";tab(-1,12);

OPTION'BLOCK:
	? tab(14,1);"O";tab(-1,11);"r/";tab(-1,12);"E";tab(-1,11);"nd (or ";&
		tab(-1,12);"<";tab(-1,11);"):"
	? tab(15,1);"Field # (or ";tab(-1,12);"0";tab(-1,11);"):"
	? tab(16,1);"Condition:"
	? tab(17,1);"Comparison value:"

	if CHANGE'FLAG=1 then I = C-1 else I = 0

INPUT'LOOP:			! Input a backspace or "E" to terminate.
				! Input 'O' to precede selection command
				!    with 'OR'
	I = I + 1
	? tab(14,20);"_";tab(-1,5);tab(-1,12);
	xcall GETCHR,A$(I)
	if asc(A$(I))=8 or ucs(A$(I))="E" return
	if asc(A$(I))<32 goto GET'FIELD
	xcall GETCHR,B$			! just to input the expected RTN
	A$(I) = ucs(A$(I))
	? tab(14,20);A$(I);" ";
	if asc(A$(I))>32 and ucs(A$(I))<>"O" I = I - 1 : goto INPUT'LOOP

GET'FIELD:		! if 0 entered, go back to INPUT'LOOP

	if CHANGE'FLAG=1 FLAG'HL=1 : call DISPLAY'COMMAND

	? tab(15,20);tab(-1,11);"__";tab(-1,12);tab(15,20);
	input "",FIELD'NO(I)
	if FIELD'NO(I)=0 I = I - 1 : goto INPUT'LOOP
	? tab(15,20);str(FIELD'NO(I));"  "
	if FIELD'NO(I)<1 or FIELD'NO(I)>MAX'FIELDS goto GET'FIELD
	if FLAG'S=1 goto GET'FIELD

GET'CONDITION:
	? tab(16,20);tab(-1,11);"________________";tab(16,20);tab(-1,12);
	input "",RELATION(I)
	RELATION(I) = ucs(RELATION(I))
	? tab(16,20);RELATION(I);space(16-len(RELATION(I)));
	call CHECK'CONDITION		! returns FLAG'C=0 if ok, 1 if not ok
	if FLAG'C=1 goto GET'CONDITION


GET'OPERAND:	
	? tab(17,20);tab(-1,11);"________________";tab(17,20);tab(-1,12);
	input "",OPERAND(I)
	OPERAND(I) = ucs(OPERAND(I))
	when DATE'FLAG=1 and OPERAND(I)<>"TODAY"
		if OPERAND(I)[3,3]<>"/" then &
			OPERAND(I)=OPERAND(I)[1,2]+"/"+OPERAND(I)[3,4]+"/"+OPERAND(I)[5,6]
	end when
	? tab(17,20);OPERAND(I);space(16-len(OPERAND(I)));

	call DISPLAY'COMMAND

	goto INPUT'LOOP

!-------------------------------------------------------------------------

CHECK'CONDITION:		! Verify that the condition entered is valid
				! for the type of field.  Note that if no
				! type was specified in the parameter file,
				! then '*' is assumed.  FLAG'C is returned 0
				! if relation OK, else 1.  Note that to avoid
				! falsely accepting a part of a valid relation,
				! we surround the input relation with commas,
				! and make sure that there are commas between
				! each relation in the check list (VALID'RELS$)

	? tab(24,1);tab(-1,9);
	FLAG'C = 0
	xcall STRIP,RELATION(I)	
   	CND$ = "," + RELATION(I) + ","	
	T$ = TYPE'FLAG(FIELD'NO(I))

					! Set up a string containing all
					! the valid conditions for this
					! field type
	VALID'RELS$ = ","
	
	if T$="N" or T$="" or T$="*" then &
		VALID'RELS$=VALID'RELS$+NUM'RELS$+","+TEXT'NUM'RELS$+","
	if T$="D" or T$="" or T$="*" then &
		VALID'RELS$=VALID'RELS$+DATE'RELS$+","
	if T$="A" or T$="" or T$="*" then &
		VALID'RELS$=VALID'RELS$+TEXT'RELS$+","+TEXT'NUM'RELS$+","

	X = instr(1,VALID'RELS$,CND$)
	when X<1 
		? tab(24,1);tab(-1,12);tab(-1,9);"Error: ";tab(-1,11);
		? "illegal condition! "; 
		FLAG'C = 1 
	end when
					! Check if relation was a date relation
					! for special date operand processing
	X = instr(1,","+DATE'RELS$+",",CND$)
	if X<1 then DATE'FLAG=0 else DATE'FLAG=1	! used by GET'OPERAND

	return

!-------------------------------------------------------------------------
				! Display SELECTION(I)
				! if FLAG'HL=1 then highlight it also
DISPLAY'COMMAND:	
	? tab(14+I,40);tab(-1,9);
	if FLAG'HL=1 then ? tab(-1,12); else ? tab(-1,11);
	? I using "##.";" ";
	if ucs(A$(I))="O" then ? "OR ";
	? PROMPT(FIELD'NO(I));" ";
	? RELATION(I);" ";
	? OPERAND(I)
	FLAG'HL = 0
	return

!-----------------------------------------------------------------------

GET'SORT'FIELDS:	! Accept input of up to 3 sort fields.  
			! OUTPUTS: SF(I) (Sort field #1, #2, #3, set zero
			!   if none entered.)


	? tab(-1,11);
	? tab(19,1);"Enter up to 3 sort field numbers: "
	ROW = 19

	for I = 1 to 3
		ROW = ROW + 1
SO:
		? tab(ROW,5);tab(-1,11);I using "#.";"  __";tab(ROW,9);tab(-1,12);
		if SF(I)<>0 then ? tab(ROW,9);str(SF(I));tab(ROW,9);
		input "",SF(I)
		if SF(I)>MAX'FIELDS goto SO
		? tab(ROW,9);str(SF(I));" "
	next I

					! Check that a zero does not precede
					! a non-zero field
	if SF(1)=0 or SF(2)=0 then &
		if SF(2)<>0 or SF(3)<>0 then &
			? chr(7); : goto GET'SORT'FIELDS

	return

!-----------------------------------------------------------------------

ASK'CHANGES:		! Allow operator to change one or more entries.
			! If operator enters a # (or 'Y' & then a #), it
			! and calls the GET'SELECTION'COMMANDS
			! routine again.  The operator can then
			! change one or more items (in sequence) before
			! entering the backspace to terminate.  Then it
			! calls the GET'SORT'FIELDS routine for a 2nd chance
			! at those, & finally asks if any changes again.
			! When none, it returns

	CHANGE'FLAG = 1		! Tells GET'SELECTION'COMMANDS we are in 
				! change mode now

	? tab(24,1);tab(-1,9);tab(-1,11);"Any Change? ";tab(-1,12);
	xcall GETCHR,C$	
	if ucs(C$)="N" or asc(C$)<33 return
	when val(C$)>0 and val(C$)<=SEL'CMDS 
		C = C$ 
		call GET'SELECTION'COMMANDS		
		goto ASK'CHANGES
	end when
	? tab(-1,11);"  Which #? ";tab(-1,12);
	D$ = ""
LC:
	xcall GETCHR,C$
	if asc(C$)<32 goto LC2
	D$ = D$ + C$
	goto LC	
LC2:
	if val(D$)<1 or val(D$)>SEL'CMDS goto ASK'CHANGES
	C = D$

	call GET'SELECTION'COMMANDS

	call GET'SORT'FIELDS

	goto ASK'CHANGES


!-----------------------------------------------------------------------

DISPLAY'STRING1:		! Displays STRING1, switching to low intensity
				! for commas.  (Intended for displaying the
				! valid relation operators in BOLD, separated
				! by DIM commas).  Leaves terminal in DIM

	? tab(-1,12);
	do L=L+1 until L>len(STRING1$) from L=1
		when STRING1$[L;1]=","
			? tab(-1,11);",";tab(-1,12);
		else
			? STRING1$[L;1];
		end when
	end do
	? tab(-1,11);
	return	

!---------------------------------------------------------------------------



CUSTOMIZATION'MODULE:		! input some custom options & add them
				! to the end of the command file to be
				! used in the target print program

	return


.