!*************************** AMUS Program Label ******************************
! Filename: RSERCH.BAS                                      Date: 10/16/89
! Category: UTIL         Hash Code: 543-753-723-777      Version: 1.0(1)
! Initials: WRI/AM       Name: DAVID FULLER
! Company: W.L. FULLER INC.                        Telephone #: 4014672900
! Related Files: RSERCH.DOC
! Min. Op. Sys.:                               Expertise Level: INT
! Special: Requires MicroSabio's INFLD.SBR renamed to INPUT.SBR
! Description: Allows you to search (and print) records from a random access
! file. You specify a .BSI file which contains the MAP statements for the 
! data record. You can then search on individual fields within the record!
!*****************************************************************************
!
! Generic Search and Report Program which reads INCLUDE Files (with .BSI ext.).
! The MAPPED fields are displayed and you choose the search
! criteria. The selected file will be opened for random access but this
! program will not affect the data in the file. You can choose 
! between having the record displayed on the screen or selecting fields to
! be printed. If the report is printed, the report layout can be saved and
! recalled at any time. The necessary information about each file to be
! accessed is stored in DATA statements at the end of the program.
! The arrays are set up for 100 fields in a file and 15 fields on a
! report. If the user selects output to printer, the report will be sorted
! by up to three fields in the order they appear on the report. 

!-------------------------------------------
! Written by 	David Fuller	on 5/11/89 !
!     		PO Box 8767                !
!		Warwick, R.I. 02888        !
!		401-467-2900		   !
!-------------------------------------------
!
! [SAA] Modifications for "generic" use  - Steve Archuleta AMUS Staff
!
MAP1 FLT				! These Floating and Binary
	MAP2 FLTX,X,6			! variables are used to convert
MAP1 FLOT,@FLT				! unformatted information read
	MAP2 FLOAT,F,6			! from the disk and store it in 
MAP1 BN2				! the proper format. More can be
	MAP2 BN2X,X,2			! added if larger binary variables
MAP1 B2,@BN2				! are used in your files.
	MAP2 BIN2,B,2			!
MAP1 BN3				!
	MAP2 BN3X,X,3			!
MAP1 B3,@BN3				!
	MAP2 BIN3,B,3			!

MAP1 TRUE,F,6,-1			! Logical True
MAP1 FALSE,F,6,0			! Logical False
MAP1 FTYPE,S,1				! Type of Value "F" or "B"
MAP1 CMPTR,S,2				! Holds Comparator Symbol
					! >,<,=,ect.

MAP1 DT,S,45				! String to hold current date [SAA]

MAP1 RPT(16)				! Holds the report layout and
	MAP2 TITLE,S,20			! search criteria so report
	MAP2 FIELD'NUM,B,2		! can be saved and recalled.
	MAP2 WIDTH,B,2			! The 16th varible holds the
	MAP2 DECIMAL,B,2		! report and file number.

MAP1 SRCH(100)				! This Array holds all the information
	MAP2 FLD'NAME,S,30		! read from the MAP Statements in the
	MAP2 FLD'TYPE,S,1		! INCLUDE File. Field name, type and
	MAP2 FLD'LNGTH,B,2		! width along with search string and
	MAP2 START'POS,B,2		! comparator for that field if any 
	MAP2 SRCH'FOR,S,30		! stored.
	MAP2 SRCH'COMPAR,S,2		!

MAP1 SRCH'MAP,X,512			! Random file is read into this.
MAP1 PLINE,S,132			! Holds data to be printed.

MAP1 DASH80,S,80,"--------------------------------------------------------------------------------"
MAP1 DASH132,S,132,"-------------------------------------------------------------------------------------------------------------------------------------"

MAP1 LIN,S,256				! INCLUDE file is read into this.
MAP1 LIN2,S,256				! Used to read further on in INCLUDE
					! file to

MAP1 FILESPEC,S,25			! File descriptions read from
MAP1 DESCR,S,30				! the DATA statements at the end of
MAP1 INCLUDE'FILE,S,25			! the program. 
MAP1 RECORD'SIZE,B,2			!

!---------------------------------------------------------------------------
! The input routines used in this program use INFLD.SBR subroutine
! by Micro Sabio of Woodland Hills, CA    818-710-8437
! The following variables are used by the routine which has been renamed
! to INPUT.SBR. which is used in the ALPHA Accounting Programs

MAP1 CTLX				! The variables for the input subroutine
	MAP2 ROW,S,2			! 	Response row
	MAP2 FIL'ONE,X,1		!	A comma
	MAP2 COL,S,2			! 	Response column
	MAP2 FIL'TWO,X,1		!	A comma
	MAP2 XMAX,S,2			!	Maximum field length
	MAP2 FIL'THREE,X,1		!	A comma
	MAP2 XMIN,S,2			!	Minumum field length
	MAP2 FIL'FOUR,X,1		!	A comma
	MAP2 TYPE,S,24     		!	Expected response type
MAP1 CTL,S,36,@CTLX			!
MAP1 ENTRY,S,30				! Results from INPUT are stored here
	DEFPT = -1 : MAXPT = -1

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

	FILEBASE 1

![SAA]	XCALL RDATE,D : D$ = D USING "#ZZZZZ"	
![SAA]  Use standard ODTIM to retrieve date instead of RDATE
	XCALL ODTIM,DT,0,0,256
![SAA]	DT$ = D$[1,2]+"/"+D$[3,4]+"/"+D$[5,6]

	? TAB(-1,0);TAB(-1,32);" Search Data Bases ";TAB(-1,33);TAB(1,65);"SEARCH";
	? TAB(2,38) DT[1;9];
	GOTO START

!	The next section is the actual search routine. It has been put near
!	the begining of the program so it will run faster.


BEGIN'SEARCH:
	IF PRNT OPEN #103,"SRCH.SRT",OUTPUT
	RC = 0 : LAST = FALSE
	? TAB(3,2);TAB(-1,11);"Searching #";TAB(-1,12):
	? TAB(24,1);TAB(-1,9);

	FOR X = 1 TO BLKS
	REC'NUM = X
	READ #1,SRCH'MAP
	FOR R = 0 TO RNB - 1
	RC = RC + 1
	? TAB(3,14);RC;"   ";
	FOR Z = 1 TO TTL'FLDS
	CMPTR = SRCH'COMPAR(Z) : FTYPE = FLD'TYPE(Z)
	FRST = 1 + (R * RECORD'SIZE)
	ST = START'POS(Z) + (R * RECORD'SIZE)
	IF SRCH'MAP[FRST;1] = "]" GOTO SKIP'RECORD
	IF ASC(SRCH'MAP[FRST;1]) < 32 GOTO SKIP'RECORD
	IF SRCH'FOR(Z)[1,1] = " " GOTO SKIP'SRCH
	IF FTYPE = "B" OR FTYPE = "F" THEN CALL CONVERT'NUM : GOTO COMPARE'NUM
	L = FLD'LNGTH(Z)
	IF CMPTR = "=" AND SRCH'MAP[ST;L] <> SRCH'FOR(Z) GOTO SKIP'RECORD
	IF CMPTR = "<>" AND SRCH'MAP[ST;L] = SRCH'FOR(Z) GOTO SKIP'RECORD
	IF CMPTR = ">" AND SRCH'MAP[ST;L] <= SRCH'FOR(Z) GOTO SKIP'RECORD
	IF CMPTR = "<" AND SRCH'MAP[ST;L] => SRCH'FOR(Z) GOTO SKIP'RECORD
	IF CMPTR = "=>" AND SRCH'MAP[ST;L] < SRCH'FOR(Z) GOTO SKIP'RECORD
	IF CMPTR = "<=" AND SRCH'MAP[ST;L] > SRCH'FOR(Z) GOTO SKIP'RECORD
	IF CMPTR = "I" I = INSTR(1,SRCH'MAP[ST;L],SRCH'FOR(Z))
	IF CMPTR = "I" AND I <= 0 GOTO SKIP'RECORD
SKIP'SRCH:
	NEXT Z
	XX = 1
	IF PRNT = TRUE CALL PRINT'SORT'REC : GOTO SKIP'RECORD
	CALL DISPLAY'REC

SKIP'RECORD:
	NEXT R
	NEXT X	
	LAST = TRUE
 	IF PRNT CLOSE #103 : GOTO SORT'RECORDS
	GOTO SKIP'DISPLAY

!	This is where the program actually begins
!	we clear the rest of the screen and set the starting values

START:
	? TAB(3,1);TAB(-1,10);
	STANDARD = FALSE : SAVED = FALSE
	X = 1 : RW = 5 : CL = 5 : PRNT = FALSE : PG = 0
	RESTORE

!	Ok, now we can read the data and show the user which files can
!	be accessed.

READ'LOOP:
	CALL READ'SELECTIONS
	IF DESCR[1,2] = "XX" MAX'FILES = X-1 : GOTO SELECT'FILE
	? TAB(RW,CL);TAB(-1,11);X USING "##";". ";DESCR;TAB(-1,12);
	RW = RW + 1 : X = X + 1
	IF RW > 22 RW = 5 : CL = 40
	IF X > 34 GOTO SELECT'FILE
	GOTO READ'LOOP

!	The user can now select the database or chose a report that has
!	been previously saved.

SELECT'FILE:
	? TAB(24,10);TAB(-1,9);"Enter Data Base number or S)tandard report";
	CTL = "24,55,02,01,AE" : CALL INPUT
	IF ENTRY[1,3] = "END" GOTO EXIT
	IF ENTRY[1,1] = "S" GOTO STANDARD'REPORT
	DB = VAL(ENTRY[1,2])
	IF DB < 1 OR DB > MAX'FILES GOTO SELECT'FILE

! 	Ok, this is not a standard report so read the data again and get
!	the filenames and record sizes for the selected database.

SKIP'SELECT:
	RESTORE
	FOR X = 1 TO DB
	CALL READ'SELECTIONS
	NEXT X

!	Lets make sure the data file exists, if not, reselect. If it does,
!	figure out the maximum number of records it could hold.

	LOOKUP FILESPEC,F
	IF F = 0 XCALL MESAG,"File "+FILESPEC+" not found !!",1 : GOTO SELECT'FILE
	BLKS = F * -1
	MAX'RECS = F * INT(512/RECORD'SIZE) * -1

!	Ok, we have a data file, now where is that INCLUDE file with all
!	the mapped variables. If we can't find it we go back to SELECT.

	LOOKUP INCLUDE'FILE+".BSI",F
	IF F = 0 XCALL MESAG,"File "+INCLUDE'FILE+" not found !!",1 : &
		GOTO SELECT'FILE

!	We will open the INCLUDE file first.

	IF OPEN101 CLOSE #101
	OPEN #101,INCLUDE'FILE+".BSI",INPUT : OPEN101 = TRUE
	
!	Now we will show the user which files we are using and the
!	number of records we will be searching thru.

	? TAB(5,1);TAB(-1,10);
	? TAB(5,2);FILESPEC;" / Record Size =";RECORD'SIZE; &
		" / include file = ";INCLUDE'FILE;" / Recs =";MAX'RECS;


!	Ok the INCLUDE file is open, now we can begin reading the
!	MAP statements.

	X = 1 : POS = 1	
	LAST'LEVEL = 0 : VAL'DIM = 0
	L1'DIM = FALSE

!	First we input a line of info and check to see if we reached
!	the end of the file. If we did we will display the fields.


READ'MAPS'LOOP:
	L2'DIM = FALSE
	AT'ADDRESS = FALSE
	INPUT LINE #101,LIN
	IF EOF(101) = 1 AND L1'DIM GOTO DO'DIMS
	IF EOF(101) = 1 CLOSE #101 : OPEN101 = FALSE : GOTO DISPLAY'FIELDS

!	Check to see if the input line has a MAP statement. If it doesn't
!	we will go back and get the next line.

SKP1:
	ST = INSTR(1,LIN,"MAP")
	IF ST = 0 GOTO READ'MAPS'LOOP

!	Well, there is a MAP word but let's make sure this is a valid line.

	F = INSTR(1,LIN,"!")
	IF F > 0 AND F < ST GOTO READ'MAPS'LOOP

!	Now we have determined that this is a valid MAP statement, so we
!	can figure out what type and how big it is. One thing that can
!	really screw us up is dimensioned varibles. This program will
!	handle level 1 or level 2 arrays. The next problem is the "@"
!	at address varibles. Because they reside in the same address as
!	a previously defined variable we just ignore them.


	LEVL = VAL(LIN[ST+3;2])
	IF LEVL = 1 AND LAST'LEVEL > 0 AND L1'DIM = TRUE GOTO DO'DIMS
	IF LEVL = 1 AND LAST'LEVEL > 0 CLOSE #101 : OPEN101 = FALSE : &
		GOTO DISPLAY'FIELDS
	C1 = INSTR(ST,LIN,",")
	PEREN = INSTR(1,LIN,"(")
	IF C1 = 0 AND PEREN = 0 GOTO READ'MAPS'LOOP
	IF PEREN PEREN2 = INSTR(1,LIN,")")
	IF PEREN AND C1 = 0 L1'DIM = TRUE
	IF PEREN > 0  AND C1 > 0  AND PEREN < C1 L2'DIM = TRUE
	IF PEREN VAL'DIM = VAL(LIN[PEREN+1,PEREN2-1])

	IF LIN[C1+1;1] = "@" AT'ADDRESS = TRUE

	F = INSTR(ST,LIN," ")
	N1 = F + 1

	F = INSTR(C1+3,LIN," ")
	N2 = F : IF N2 = 0 N2 = LEN(LIN)

	GOTO CHECK'MAPS
	GOTO CHECK'MAPS

BACK'FROM'CHECK:
	IF VAL'DIM VAL'DIM = VAL'DIM - 1
	IF C1 FLD'NAME(X) = LIN[N1,C1-1] ELSE FLD'NAME(X) = LIN[N1,N2]
	IF C1 FLD'TYPE(X) = LIN[C1+1,C1+2]
	FLD'LNGTH(X) = VAL(LIN[C1+3,N2])
	IF FLD'TYPE(X) = "F" FLD'LNGTH(X) = 6
	IF FLD'TYPE(X) = "X" POS = POS + FLD'LNGTH(X) : GOTO READ'MAPS'LOOP
	START'POS(X) = POS
	POS = POS + FLD'LNGTH(X)
	TTL'FLDS = X : X = X + 1
	IF L2'DIM AND VAL'DIM GOTO BACK'FROM'CHECK
	GOTO READ'MAPS'LOOP

CHECK'MAPS:
	LAST'LEVEL = LEVL
	
BYPASS:
	IF AT'ADDRESS INPUT LINE #101,LIN2 : F = INSTR(1,LIN2,"MAP") : &
		LVL = VAL(LIN2[F+3,F+5])
	IF AT'ADDRESS AND LVL > LEVL GOTO BYPASS
	IF AT'ADDRESS AND LVL <= LEVL LIN = LIN2 : AT'ADDRESS = FALSE : &
		 GOTO SKP1
	
	GOTO BACK'FROM'CHECK	


DO'DIMS:
	? : ? "DOING DIMS  ";VAL'DIM
	FOR Z = 1 TO VAL'DIM - 1
	FOR Q = 1 TO TTL'FLDS
	FLD'NAME(Q + (Z * TTL'FLDS)) = FLD'NAME(Q)
	FLD'TYPE(Q + (Z * TTL'FLDS)) = FLD'TYPE(Q)
	FLD'LNGTH(Q + (Z * TTL'FLDS)) = FLD'LNGTH(Q)
	START'POS(Q + (Z * TTL'FLDS)) = POS
	POS = POS + FLD'LNGTH(Q)
	X = X + 1
	NEXT Q
	NEXT Z
	TTL'FLDS = X - 1
	CLOSE #101 : OPEN101 = FALSE

!	Ok the tuff part is done. Now we can show the user what we found 
!	in the INCLUDE File.

DISPLAY'FIELDS:
	? TAB(7,1);TAB(-1,10);
	RW = 7 : FLD = 1
	CALL SHOW'NAMES
	IF PRNT GOTO INPUT'DONE
	GOTO GET'CRITERIA

!	Next we ask the user for the search criteria. We can search on one
!	field or all fields. If nothing is entered and the user presses the
!	the <- , all records will be selected.

GET'CRITERIA:
	RW = 7 : CL = 36 : FLD = 1
	CALL SHOW'INSTRUCT
INPUT'LOOP:
	TYPE = "A235] "
	ROW = RW USING "#Z"
	COL = CL USING "#Z"
	XMIN = 0 : XMAX = FLD'LNGTH(FLD)
	IF FLD'TYPE(FLD) = "B" OR FLD'TYPE(FLD) = "F" XMAX = 9
	DEFLT = 3 : ENTRY = SRCH'FOR(FLD)
	CALL INPUT	
	IF EXITCODE = 2 GOTO INPUT'DONE
	SRCH'FOR(FLD) = ENTRY[1,XMAX]
	IF EXITCODE = 3 GOTO SKP6
	IF ENTRY[1,1] <> " " CALL OPPERAND ELSE SRCH'COMPAR(FLD) = " " : &
		? TAB(RW,36);TAB(-1,9);
SKP6:
	IF RW < 22 AND FLD < TTL'FLDS AND EXITCODE = 5 RW = RW + 1 : &
		FLD = FLD + 1 : GOTO INPUT'LOOP
	IF RW > 7 AND EXITCODE = 3 RW = RW - 1 : FLD = FLD - 1 : &
		GOTO INPUT'LOOP
	IF RW = 7 AND FLD > 1 AND EXITCODE = 3 GOTO CHANGE'PAGE
	IF RW = 22 AND FLD < TTL'FLDS GOTO CHANGE'PAGE
	IF RW = 7 AND EXITCODE = 3 GOTO INPUT'LOOP
	IF FLD < TTL'FLDS RW = RW + 1 : FLD = FLD + 1	
	GOTO INPUT'LOOP

CHANGE'PAGE:
	? TAB(7,1);TAB(-1,10);
	IF EXITCODE = 3 FLD = FLD - 16
	IF FLD < 1 FLD = 1
	IF EXITCODE = 5 FLD = FLD + 1
	RW = 7 : Z = FLD
	CALL SHOW'NAMES
	RW = 7 : FLD = Z
	GOTO INPUT'LOOP

!	Next we ask the user for an Opperand Symbol to apply to the search.

OPPERAND:
	? TAB(24,1);TAB(-1,9);TAB(-1,11);"Enter Comparitor symbol  =  >  <  <>  =>  <=  or I)mbedded";TAB(-1,12);
	TYPE = "A] " : XMIN = 0 : XMAX = 2 : ENTRY = SRCH'COMPAR(FLD)
	CL = 36 + FLD'LNGTH(FLD) + 2 : COL = CL USING "#Z"
	CALL INPUT
	CMPTR = ENTRY[1,2]
	SRCH'COMPAR(FLD) = ENTRY
	IF CMPTR <> "=" AND CMPTR <> "<>" AND CMPTR <> "=>" AND CMPTR <> "<=" &
		AND CMPTR <> ">" AND CMPTR <> "<" AND CMPTR <> "I" GOTO OPPERAND
	IF CMPTR = "I" AND  (FLD'TYPE(FLD) = "B" OR FLD'TYPE(FLD) = "F") &
		XCALL MESAG,"Can not use I)mbedded with values",1 : GOTO OPPERAND
	CL = 36
	CALL SHOW'INSTRUCT
	RETURN

!	The user has selected the search criteria and we have stored it in
!	SRCH array we have set up. Now we can open the Data File. This program
!	opens all the Data Files with a record length of 512 and reads the
!	records as unformated Data (X's). The record is then broken down
!	into its proper length.

INPUT'DONE:
	IF OPEN1 CLOSE #1
	OPEN #1,FILESPEC,RANDOM'FORCED,512,REC'NUM : OPEN1 = TRUE
	RNB= INT(512/RECORD'SIZE)
	IF PRNT GOTO BEGIN'SEARCH

!	Next allow the user to select screen or printer. If print is selected
!	the user will be asked which fields are to be printed. The screen
!	screen display shows all the fields and the search will begin.

SELECT'OUTPUT:
	PRNT = FALSE
	? TAB(24,1);TAB(-1,9);TAB(-1,11);"             Press  S)creen  P)rinter  E)xit";TAB(-1,12);
	CTL = "24,70,01,01,AF2 " : CALL INPUT
	IF EXITCODE = 2 GOTO EXIT
	SEL = INSTR(1,"PES",ENTRY[1,1])
	ON SEL GOTO SELECT'FIELDS,EXIT,BEGIN'SEARCH
	GOTO SELECT'OUTPUT

!	This section stores the first field and record position in a file 
!	to be sorted.

PRINT'SORT'REC:
	FOR P = 1 TO (3 MIN TTL'POS)
	F = FIELD'NUM(P) : S = START'POS(F) + (R * RECORD'SIZE) : &
		L = FLD'LNGTH(F)
	IF FLD'TYPE(F) = "F" OR FLD'TYPE(F) = "B" Z = F : ST = S : &
		CALL CONVERT'NUM : A$ = VL USING "##########" : &
		? #103 A$; : GOTO NUMBER'DONE
	? #103,SRCH'MAP[S;L];

NUMBER'DONE:
	NEXT P	
	? #103,X USING "#####";
	? #103,R USING "##"
	RETURN
	
!	This section sets up numbers to be printed.

PRINT'NUMBER:
	IF DECIMAL(P) = 0  A$ = VL USING "#######"
	IF DECIMAL(P) = 1  A$ = VL/10 USING "######.#"
	IF DECIMAL(P) = 2  A$ = VL/100 USING "######.##"
	IF DECIMAL(P) = 3  A$ = VL/1000 USING "######.###"
	? #104,A$;
	RETURN	

!	The HEADER section opens then print spool file and prints the
!	titles of each field.

HEADER:
	IF PG = 0 OPEN #104,"SRCH.RPT",OUTPUT ELSE ? #104,CHR(12);
	PG = PG + 1
	IF WIDE PLINE = SPACE(132) ELSE PLINE = SPACE(80)
	? #104,"Report Title = ";TITLE(TTL'POS+1);"      Run on ";DT$;"           Page ";PG
	? #104
	FOR T = 1 TO TTL'POS	
	? #104,TITLE(T);
	L = LEN(TITLE(T))
	? #104,SPACE(WIDTH(T)-(L+2));
	IF T <> TTL'POS ? #104,"  ";
	NEXT T
	? #104
	IF WIDE ? #104,DASH132 ELSE ? #104,DASH80
	LN = 4
	RETURN

!	The PRINT'RECS section reads the sort file, retrieves the proper
!	records and sends them to the spool file.

PRINT'RECS:
	? TAB(3,2);TAB(-1,9);"Printing...";
	OPEN #103,"SRCH.SRT",INPUT
	CALL HEADER
N = 1
PRINT'LOOP:
	INPUT LINE #103,LIN	
	IF EOF(103) = 1 CLOSE #103 : CLOSE #104 : &
		XCALL SPOOL,"SRCH.RPT","PRINT1",256 : GOTO SKIP'DISPLAY
	LL = LEN(LIN)
	X = VAL(LIN[LL-6;5])
	IF X <= 0 GOTO PRINT'LOOP
 	R = VAL(LIN[LL-1;2])
	REC'NUM = X
	? TAB(3,15);N;
	READ #1,SRCH'MAP

	FOR P = 1 TO TTL'POS
	F = FIELD'NUM(P) : S = START'POS(F) + (R * RECORD'SIZE) : &
		L = FLD'LNGTH(F)
	IF FLD'TYPE(F) = "F" OR FLD'TYPE(F) = "B" Z = F : ST = S : &
		CALL CONVERT'NUM : CALL PRINT'NUMBER : GOTO SKIP'TXT
	? #104,SRCH'MAP[S;L];
SKIP'TXT:
	IF P <> TTL'POS ? #104,"  ";
	NEXT P
	? #104
	LN = LN + 1 : IF LN > 60 CALL HEADER
	N = N + 1
	GOTO PRINT'LOOP

!	This next section is used to display the record only when the user
!	selects output to screen.

DISPLAY'REC:
	? TAB(7,1);TAB(-1,10);
	RW = 6
	FOR Q = 1 TO 16
	RW = RW + 1
	? TAB(RW,2);TAB(-1,11);FLD'NAME(XX);" ";TAB(-1,12);
	ST = START'POS(XX) + (R * RECORD'SIZE)
	L = FLD'LNGTH(XX)
	FTYPE = FLD'TYPE(XX) : IF FTYPE = "B" OR FTYPE = "F" Z = XX : &
		CALL CONVERT'NUM : ? TAB(RW,36);VL USING "#######"; : &
		GOTO SKP5
	? TAB(RW,36);SRCH'MAP[ST;L];
SKP5:
	XX = XX + 1
	IF XX > TTL'FLDS GOTO SKIP'DISPLAY
	NEXT Q	

!	This sections displays the users options after a record has been
!	diplayed or a printed report has been completed.

SKIP'DISPLAY:
	? TAB(-1,11);
	IF LAST ?TAB(24,1);TAB(-1,9);"     Press  A)nother search  N)ew data base  E)xit"; : &
		GOTO WHAT'NEXT
	IF XX < TTL'FLDS ? TAB(24,2);"   Press RETURN for more or P)age  A)nother search  N)ew data base  E)xit"; &
		ELSE ? TAB(24,2);"     Press RETURN for more or A)nother search  N)ew data base  E)xit";
	? TAB(-1,12);
WHAT'NEXT:
	ENTRY = "  "
	CTL = "24,75,01,00,AF " : CALL INPUT
	IF LAST GOTO SKP7
	IF ENTRY[1,1] = " " RETURN
	IF ENTRY[1,1] = "P" AND XX < TTL'FLDS GOTO DISPLAY'REC
SKP7:
	IF ENTRY[1,1] = "A" CLOSE #1 : OPEN1 = FALSE : CALL CLEAR'SEARCH : &
		GOTO DISPLAY'FIELDS
	IF ENTRY[1,1] = "N" CLOSE #1 : OPEN1 = FALSE : GOTO START
	IF ENTRY[1,1] = "E" CLOSE #1 : OPEN1 = FALSE : GOTO EXIT
	GOTO WHAT'NEXT

EXIT:
	IF OPEN101 CLOSE #101
	IF OPEN1 CLOSE #1
	END	![SAA]  End program instead of chaining to another program
![SAA]	CHAIN "MENU"

SELECT'FIELDS:
	PRNT = TRUE : PRNT'POS = 1
	?TAB(7,1);TAB(-1,10);
	RW = 7 : FLD = 1 : CALL SHOW'NAMES
	?TAB(7,45);TAB(-1,11);"Printer Report Layout:";TAB(-1,12);

COLUMN:
	? TAB(24,1);TAB(-1,9);TAB(-1,11);" Press     A) for 80 columns     B) for 132 columns";TAB(-1,12);
	DEFLT = 0
	CTL = "24,70,01,01,AF " : CALL INPUT
	IF ENTRY[1,2] = "B" WIDE = TRUE : AVAILABLE = 132 : GOTO FIELD
	IF ENTRY[1,2] = "A" WIDE = FALSE : AVAILABLE = 80 : GOTO FIELD
	GOTO COLUMN
FIELD:
	? TAB(8,45); : IF WIDE ? "132 COLUMNS"; ELSE ? "80 COLUMNS";
	FOR X = 1 TO 15 : TITLE(X) = SPACE(30) : FIELD'NUM(X) = 0 : NEXT X
	?TAB(24,1);TAB(-1,9);TAB(-1,11); &
	" Press (UP or DOWN to see fields) (FIELD # to select)  (<- to end)";TAB(-1,12);
FLD1:
	DEFLT = 0
	CTL = "24,75,02,01,A352 " : CALL INPUT
	IF FLD-1 < TTL'FLDS AND EXITCODE = 5 : CALL CLEAR'NAMES : &		
		RW = 7 	: CALL SHOW'NAMES : GOTO FLD1
	IF EXITCODE = 3 FLD = 1 : CALL CLEAR'NAMES : RW = 7 : &
		CALL SHOW'NAMES : GOTO FLD1
	IF EXITCODE = 2 GOTO SELECT'DONE
	X = VAL(ENTRY[1,2]) : IF X < 1 OR X > TTL'FLDS GOTO FLD1	
	Y = FLD'LNGTH(X) + 2 : IF FLD'TYPE(X) = "B" OR FLD'TYPE(X) = "F" &
		Y = 11 
	FIELD'NUM(PRNT'POS) = X : WIDTH(PRNT'POS) = Y 
	AVAILABLE = AVAILABLE - Y
	IF AVAILABLE < 0 ? TAB(8+PRNT'POS,40);"Not enough space !"; : &
		 AVAILBLE = AVAILABLE + Y : GOTO FLD1
	? TAB(8+PRNT'POS,40);"Print Pos ";PRNT'POS USING "##";" = ";X	
	? TAB(8,45);"Available Space = ";AVAILABLE;
	TTL'POS = PRNT'POS
	PRNT'POS = PRNT'POS + 1
	IF PRNT'POS > 15 GOTO SELECT'DONE
	GOTO FLD1:

SELECT'DONE:
	? TAB(24,1);TAB(-1,9);TAB(-1,11); &
		"   Press  R)eselect  or any other key to continue ";TAB(-1,12);
	CTL = "24,60,01,01,AF " : CALL INPUT
	IF ENTRY[1,1] = "R" GOTO SELECT'FIELDS

TITLES:
	? TAB(7,1);TAB(-1,10);	
	RW = 7 : DEFLT = 0
	FOR X = 1 TO TTL'POS
	? TAB(RW,2);TAB(-1,11);"Position ";X USING "##";" ";TAB(-1,12); &
		FLD'NAME(FIELD'NUM(X));
	RW = RW + 1
	NEXT X
	? TAB(24,1);TAB(-1,11);"  Enter Titles to appear on Report UP or DOWN or <- to end";TAB(-1,12);
	RW = 7 : CL = 43 : POS = 1
TTL1:
	TYPE = "A235]" : ROW = RW USING "#Z" : COL = CL USING "#Z"
	XMIN = 1 : XMAX = FLD'LNGTH(FIELD'NUM(POS)) MIN 20
	A$ = FLD'TYPE(FIELD'NUM(POS)) : IF A$ = "B" OR A$ = "F" &
		XMAX = 11
	DEFLT = 3 : ENTRY = TITLE(POS)
	CALL INPUT	
	IF EXITCODE = 2 GOTO TITLES'DONE
	IF EXITCODE = 3 AND RW > 7 RW = RW - 1 : POS = POS - 1 : GOTO TTL1
	IF EXITCODE = 5 AND POS < TTL'POS-1 RW = RW + 1 : POS = POS + 1 : &
		GOTO TTL1
	TITLE(POS) = ENTRY[1,20] : IF A$ = "F" CALL GET'DECIMAL'PLACE
	IF EXITCODE <> 3 AND POS < TTL'POS POS = POS + 1 : RW = RW + 1
	GOTO TTL1

GET'DECIMAL'PLACE:
	? TAB(24,1);TAB(-1,9);"         How many decimal places (0-3)";
	CL = 65 : ROW = RW USING "#Z" : COL = CL USING "#Z"
	TYPE = "# " : DEFLT = 3 : XMIN = 0 : XMAX = 1
	ENTRY = DECIMAL(POS)
	CALL INPUT : A = VAL(ENTRY[1,1])
	IF A < 0 OR A > 3 GOTO GET'DECIMAL'PLACE	
	DECIMAL(POS) = A : CL = 43
	? TAB(24,1);TAB(-1,11);"  Enter Titles to appear on Report UP or DOWN or <- to end";TAB(-1,12);
	RETURN


TITLES'DONE:
	? TAB(24,1);TAB(-1,9);TAB(-1,11); &
		" Press  S)ave layout  G)enerate report  R)eselect layout";TAB(-1,12);
	DEFLT = 0
	CTL = "24,60,01,01,AF " : CALL INPUT
	IF ENTRY[1,1] = "S" GOTO SAVE'REPORT
	IF ENTRY[1,1] = "G" PRNT = TRUE : GOTO BEGIN'SEARCH
	IF ENTRY[1,1] = "R" GOTO SELECT'FIELDS
	GOTO TITLES'DONE

SAVE'REPORT:
	? TAB(24,1);TAB(-1,9);TAB(-1,11); &
		"        Enter name to save report under ";TAB(-1,12);
	DEFLT = 0
SKP10:
	CTL = "24,45,06,01,A] " : CALL INPUT	
	A$ = ENTRY + ".SRP"
	TITLE(16) = A$
	FIELD'NUM(16) = "16"
	WIDTH(16) = DB	
	DECIMAL(16) = 0
	LOOKUP TITLE(16),F
	IF F > 0 CALL REPLACE'REPORT
	OPEN #102,TITLE(16),OUTPUT
	? TAB(24,1);TAB(-1,9);TAB(24,20);"Saving as ";TITLE(16);"...";
	FOR X = 1 TO TTL'POS
	? #102,TITLE(X)
	? #102,FIELD'NUM(X)
	? #102,WIDTH(X)
	? #102,DECIMAL(X)
	NEXT X
	? #102,TITLE(16)
	? #102,FIELD'NUM(16)
	? #102,WIDTH(16)
	? #102,DECIMAL(16)
	FOR X = 1 TO TTL'FLDS
 	IF SRCH'FOR(X)[1,1] <> " " ? #102,X : ? #102,FLD'NAME(X) : &
	? #102,FLD'TYPE(X) : ? #102,FLD'LNGTH(X) : &
	? #102,START'POS(X) : ? #102,SRCH'FOR(X) : &
	? #102,SRCH'COMPAR(X)
	NEXT X
	SAVED = TRUE
	GOTO TITLES'DONE

REPLACE'REPORT:
	? TAB(24,1);TAB(-1,9);
	? TAB(24,20);TITLE(16);" exists..Replace it ?";
	CTL = "24,55,01,00,YN " : CALL INPUT
	IF ENTRY[1,1] = "N" GOTO SAVE'REPORT
	RETURN

STANDARD'REPORT:
	? TAB(24,1);TAB(-1,9);TAB(24,15);" Enter Name of Report ";
	DEFLT = 0
	CTL = "24,40,06,01,A] " : CALL INPUT
	A$ = ENTRY + ".SRP"
	LOOKUP A$,F
	IF F = 0  ? TAB(24,50);" Not Found...Try Again." : GOTO STANDARD'REPORT
	X = 1
	OPEN #102,A$,INPUT
	PRNT = TRUE
READ'TITLES'LOOP:
	INPUT #102,TITLE(X)
	INPUT #102,FIELD'NUM(X)	
	INPUT #102,WIDTH(X)
	INPUT #102,DECIMAL(X)
	IF FIELD'NUM(X) = 16 DB = WIDTH(X) : TTL'POS = X - 1 : &
		 GOTO READ'SRCH'CRITERIA'LOOP
	X = X + 1
	GOTO READ'TITLES'LOOP
READ'SRCH'CRITERIA'LOOP:
 	INPUT #102,X
	IF EOF(102) = 1 GOTO SKIP'SELECT
	INPUT #102,FLD'NAME(X)
	INPUT #102,FLD'TYPE(X) : INPUT #102,FLD'LNGTH(X)
	INPUT #102,START'POS(X) : INPUT #102,SRCH'FOR(X)
	INPUT #102,SRCH'COMPAR(X)
	GOTO READ'SRCH'CRITERIA'LOOP

SHOW'NAMES:
	? TAB(-1,11);
	FOR X = 1 TO 16
	IF FLD > TTL'FLDS RETURN
	? TAB(RW,5);FLD USING "##";". ";FLD'NAME(FLD);" "; &
		FLD'TYPE(FLD);FLD'LNGTH(FLD) USING "###";
	IF (FLD'TYPE(FLD) = "F" OR FLD'TYPE(FLD) = "B") NUMBER = TRUE &
		ELSE NUMBER = FALSE
	IF PRNT AND NUMBER ? TAB(RW,36);"11";
	IF PRNT AND NUMBER = FALSE ? TAB(RW,36);FLD'LNGTH(FLD)+2 USING "##";
	IF PRNT = FALSE ? TAB(RW,36);SRCH'FOR(FLD);"  ";SRCH'COMPAR(FLD);
	RW = RW + 1 : FLD = FLD + 1
	NEXT X
	? TAB(-1,12);
	RETURN

CLEAR'NAMES:
	FOR X = 7 TO 22 : ? TAB(X,1);SPACE(38); : NEXT X
	RETURN

SORT'RECORDS:
	? TAB(3,2);TAB(-1,9);"Sorting...";
	OPEN #103,"SRCH.SRT",INPUT	

	K1S = FLD'LNGTH(FIELD'NUM(1))
	A$ = FLD'TYPE(FIELD'NUM(1))
	IF A$ = "F" OR A$ = "B" K1S = 10

	K1P = 1 : K2S = 0 : K2P = 0 : K3S = 0 : K3P = 0

	IF TTL'POS => 2 K2S = FLD'LNGTH(FIELD'NUM(2)) ELSE GOTO DO'SORT
	A$ = FLD'TYPE(FIELD'NUM(2))
	IF A$ = "F" OR A$ = "B" K2S = 10
	K2P = K1S + 1

	IF TTL'POS => 3 K3S = FLD'LNGTH(FIELD'NUM(3)) ELSE GOTO DO'SORT
	A$ = FLD'TYPE(FIELD'NUM(3))
	IF A$ = "F" OR A$ = "B" K3S = 10
	K3P = K1S + 1 + K2S

DO'SORT:
	SIZ = K1S + K2S + K3S + 7
	XCALL BASORT,103,103,SIZ,K1S,K1P,0,K2S,K2P,0,K3S,K3P,0
	CLOSE #103
	GOTO PRINT'RECS

INPUT:
	IF DEFLT = 3 THEN DEFLT = 1
	XCALL INPUT,ROW,COL,XMAX,XMIN,TYPE,ENTRY,INXCTL,2,DEFLT, &
		EXITCODE,TIMER,CMDFLG,DEFPT,MAXPT,FUNMAP
	RETURN

CONVERT'NUM:
	IF FLD'TYPE(Z) = "B" AND FLD'LNGTH(Z) = 2 BN2X = SRCH'MAP[ST;FLD'LNGTH(Z)] : &
		VL = BIN2
	IF FLD'TYPE(Z) = "B" AND FLD'LNGTH(Z) = 3 BN3X = SRCH'MAP[ST;FLD'LNGTH(Z)] : &
		VL = BIN3
	IF FLD'TYPE(Z) = "F" FLTX = SRCH'MAP[ST;FLD'LNGTH(Z)] : VL = FLOAT
	RETURN

COMPARE'NUM:
	IF CMPTR = "=" AND VL <> VAL(SRCH'FOR(Z)) GOTO SKIP'RECORD
	IF CMPTR = "<>" AND VL = VAL(SRCH'FOR(Z)) GOTO SKIP'RECORD
	IF CMPTR = ">" AND VL <= VAL(SRCH'FOR(Z)) GOTO SKIP'RECORD
	IF CMPTR = "<" AND VL => VAL(SRCH'FOR(Z)) GOTO SKIP'RECORD
	IF CMPTR = "=>" AND VL < VAL(SRCH'FOR(Z)) GOTO SKIP'RECORD
	IF CMPTR = "<=" AND VL > VAL(SRCH'FOR(Z)) GOTO SKIP'RECORD
	GOTO SKIP'SRCH
	
CLEAR'SEARCH:
	FOR X = 1 TO 100
	SRCH'FOR(X) = SPACE(30)
	SRCH'COMPAR(X) = " "
	NEXT X
	RETURN

SHOW'INSTRUCT:
	? TAB(24,1);TAB(-1,9);TAB(-1,11);"          Enter Search Criteria then Press LEFT Arrow"; &
		TAB(-1,12);
	RETURN

READ'SELECTIONS:
	READ DESCR,RECORD'SIZE,INCLUDE'FILE,FILESPEC
	RETURN

!	The DATA statements hold the file description, record size,
!	location and name of the INCLUDE file that contains the MAPPED
!	variables for that file, and the location and name of the
!	data file that will be searched. The program will allow the use
!	to select from up to 34 files.
DATA	Search Data File,128,TEST,PHONE.IDA
!	DATA	Back Orders,256,BAS:ORDMAS,DSK0:ORFIL.IDA
!	DATA	Inspection File,85,BAS:ISPMAS,DSK0:ISPFIL.IDA
DATA	XX,0,XX,XX