! 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
? #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$ : ? ".";
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
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
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)));
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$)
! 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
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$
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
