!*************************** 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 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
![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]
! 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
! 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.
! 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.
! 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'DI
SPLAY
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"
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
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
! 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
