Shareware Overload/ShartewareOverload.cdr/database/steel24.zip/REMARKS3.BAS

BASIC Source File | 1980-01-01 | 11KB | 266 lines

20000 REM *****  GET UPPER LIMIT
20010 GOSUB 20050 / GET UPPER AND LOWER LIMITS OF RELATED SUBRECORDS SUBROUTINE
20020 GOSUB 20400 / INITIALIZE SUMS TO ZERO SUBROUTINE
20030 GOTO 21000 / PRINT REPEATING FIELDS SUBROUTINE
20050 RNU = RN / INITIALZE RECORD NUMBER UPPER TO RECORD NUMBER
20060 TESTH$ = TEST$ / TEST HOLD = TEST$ OF THE CURRENT RECORD NUMBER.  THE NON REPEATING PART OF THE RECORD WAS FIELDED AS TEST$.
20100 WHILE TEST$ = TESTH$ / WHILE THERE IS NO CHANGE IN THE NONREPEATING PART OF THE RECORD
20110 RNU = RNU - 1 / DECREMENT RECORD NUMBER UPPER
20115 IF RNU = 0 THEN GOTO 20140 / CAN'T DECREMENT TO ZERO
20120 GET #1,RNU / GET RECORD NUMBER
20130 WEND / END LOOP
20140 RNU = RNU + 1 / ADD ONE TO RECORD NUMBER BECAUSE WE WENT ONE PAST IT
20200 REM * GET LOWER LIMIT
20250 RNL = RN / INITIALIZE RECORD NUMBER LOWER TO CURRENT RECORD NUMBER
20290 GET #1,RNL / GET RECORD NUMBER LOWER
20300 WHILE TEST$ = TESTH$ / WHILE THERE IS NO CHANGE IN THE REPEATING PART OF THE RECORD
20310 RNL = RNL + 1 / INCREMENT RECORD NUMBER LOWER
20315 IF RNL > MRN THEN GOTO 20340 / CAN'T INCREMENT PAST END OF FILE
20320 GET #1,RNL / GET RECORD NUMBER LOWER
20330 WEND
20340 RNL = RNL - 1 / SUBTRACT ONE SINCE WE WENT ONE PAST IT
20350 RETURN
20400 REM * SET SUMS TO ZERO
20410 FOR T = 1 TO 28 / START LOOP.
20420 SUM#(T) = 0 / INITIALIZE SUM TO ZERO
20430 NEXT T
20450 RETURN
21000 REM *  PRINT REPIOTIOUS FIELDS
21050 OFFSET = -1 / INITIALZE OFFSET TO -1
21100 FOR TH = RNU TO RNL / START LOOP TO PRINT ALL RELATED SUBRECORDS
21105 OFFSET = OFFSET + 1 / INCREMENT THE OFFSET BY ONE
21110 GET #1,TH / GET THE RECORD NUMBER
21120 T2 = LSTE + 1 / T2 EQUALS THE FIELD NUMBER OF THE FIRST REPEATING FIELD
21130 FOR N = T2 TO NREC(A) / START LOOP TO PRINT ALL REPEATING FIELDS
21140 GOSUB 34110 / PRINT EACH REPEATING FIELD SUBROUTINE
21150 NEXT N / END EACH FIELD LOOP
21160 NEXT TH / END EACH RECORD NUMBER LOOP
21180 LI = 1 / LINE NUMBER
21182 TB = 47 / COLUMN NUMBER 47
21185 GOSUB 13050 / LOCATE SUBROUTINE
21190 PRINT "RECORDS";RNU;" TO ";RNL;"  *******"
21195 RN = RNL / CHANGE CURRENT RECORD NUMBER TO RECORD NUMBER LOWER
21200 GOTO 8510 / RETURN TO OPTIONS
26000 REM
26100 EFLG = 1 / END OF FILE FLAG EQUALS YES
26200 PRINT "**********  END OF FILE  ***********"
26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26204 IF INKEY$ = "" GOTO 26204 / LOOP UNTILL ANY KEY IS PRESSED
26210 GOTO  3010 / RETURN TO FILE OPTIONS
26500 REM
26600 PRINT "**********  END OF FILE  ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620 / LOOP UNTILL ANY KEY IS PRESSED
26635 EFLG = 1 / END OF FILE FLAG EQUALS YES
26640 RETURN
26800 REM
26900 PRINT "******  RECORD NUMBER REQUESTED DOES NOT EXIST  ******"
26910 GOTO 8020 / ASK FOR ANOTHER RECORD NUMBER
27000 REM * READ SCREEN TEST
27005 GOSUB 10900 / PUT PROGRAM DATA DISK IN DEFAULT DRIVE PROMPT
27010 OPEN "I",#1,"SCTEST" / OPEN THE SCREEN TEST FILE AS A SEQUENTIAL ACCESS FILE
27020 FOR T = 1 TO 40
27030 INPUT #1,SCRN(T) / READ CUSTOM SCREEN FLAG FOR EACH FILE
27040 NEXT T
27050 CLOSE #1
27060 RETURN
27070 REM * READ SCREEN DESCRIPTION
27071 GOSUB 10900 / PUT THE PROGRAM DATA DISK IN DEFAULT DRIVE PROMPT
27072 A$ = STR$(A) / CONVERTS FILE NUMBER TO A STRING
27074 A$ = MID$(A$,2) / GETS RID OF LEADING SPACE
27076 A$ = "SCREEN" + A$ / CONCATE "SCREEN" AND FILE NUMBER
27080 OPEN "I",#2,A$ / OPEN SCREEN DESCRIPTION FILE
27090 FOR T = 1 TO 18
27100 INPUT #2,SW$(T) / INPUT FROM DISK THE 18 OVERLAY LINES
27110 NEXT T
27120 FOR T = 1 TO NREC(A) / START LOOP READING EACH FIELD
27130 INPUT #2,LE(T),CE(T) / INPUT LINE NUMBER AND COLUMN NUMBER FOR EACH FIELD
27140 IF FTY(A,T) = 2 THEN INPUT #2,LEK(T),CEK(T) / IF FIELD IS AN INTEGER THE INPUT THE LINE AND COLUMN TO PRINT THE KEY AT
27150 NEXT T / END LOOP FOR EACH FIELD
27160 INPUT #2,RPT / INPUT REPEATING FIELD OPTION
27170 IF RPT = 2 THEN GOSUB 27200 / IF REPEATING OPTION EQUALS YES THEN GOSUB
27180 CLOSE #2
27190 RETURN
27200 INPUT #2,LSTE / INPUT THE NUMBER OF THE LAST NON REPEATING FIELD
27210 T2 = LSTE + 1 / T2 EQUALS FIRST REPEATING FIELD
27220 FOR T = T2 TO NREC(A) / FOR ALL THE REPEATING FIELDS
27230 INPUT #2,SUMF(T) / INPUT SUM OPTION
27240 NEXT T
27245 H = 0 / INITIALZE H TO 0
27250 FOR T = 1 TO LSTE / FOR T = 1 TO LAST NON REPEATING FIELD
27260 H = FL(A,T) + H
27270 NEXT T
27280 FIELD #1,H AS TEST$ / FIELD THE NOREPEATING FIELDS AS TEST$
27300 RETURN
28000 REM
28100 GOSUB 13000 / CLEAR SCREEN
28110 PRINT "**********  DO YOU WANT TO USE THE STANDARD OR YOUR CUSTOM SCREEN  **********"
28115 PRINT ""
28120 PRINT "                        1 - USE THE CUSTOM SCREEN"
28125 PRINT ""
28130 PRINT "                        2 - USE THE STANDARD SCREEN"
28135 PRINT ""
28140 PRINT "*******************  ENTER THE NUMBER THEN PRESS RETURN  ********************"
28200 GOSUB 14000 / INPUT INTEGER LESS THEN 100 SUBROUTINE
28210 IF DT# < 1 OR DT# > 2 THEN 28200 / IF OPTION OUT OF RANGE THEN REENTER
28220 CSCR = DT# / CLEAR SCREEN OPTION EQUALS THE VALUE RETURNED FROM THE INPUT SUBROUTINE
28230 IF CSCR = 1 THEN GOSUB 27070 / IF USING THE CUSTOM SCREEN THEN READ THE CUSTOM SCREEN DATA
28300 RETURN
29000 REM * READ IDEX SUBROUTINE
29010 OPEN "I",#1,"IDEX"
29020 FOR T = 1 TO MAXF / FOR T = 1 TO MAXIMUM FILE NUMBER
29030 INPUT #1,D,D,D,MFLG(T) / INPUT LIMITS FLAG
29040 NEXT T
29050 CLOSE #1
29060 RETURN
29070 REM * READ MAX MIN DATA
29080 A$ = STR$(A) / CONVERT FILE NUMBER TO A STRING
29090 A$ = MID$(A$,2) / GET RID OF LEADING SPACE
29100 A$ = "MAXMIN" + A$ / SET FILE NAME TO "MAXIMIM" + FILE NUMBER
29110 OPEN "I",#2,A$ / OPEN LIMITS DESCRIPTION FILE
29120 FOR T = 1 TO NREC(A) / FOR EACH FIELD
29130 INPUT #2,MAXC#(T),MINC#(T) / INPUT MAXIMUM AND MINIMUM
29140 NEXT T
29150 CLOSE #2
29160 RETURN
29190 N = D
29200 REM * CHECK MAX LIMITS
29210 IF DT# < MINC#(N) OR DT# > MAXC#(N) THEN GOSUB 29300 / IF NUMBER INPUTED IS OUTSIDE ITS LIMITS THEN GOSUB 29300
29220 RETURN
29300 PRINT CHR$(7) / SOUNDS BUZZER
29310 PRINT CHR$(7) / SOUNDS BUZZER
29329 RETURN
30000 REM * PRINT OVERLAY
30005 GOSUB 20400
30010 OFFSET = 0 / INITIALIZE OFFSET TO 0
30100 FOR T = 1 TO 18
30110 PRINT SW$(T) / PRINT THE OVERLAY LINES
30120 NEXT T
30130 RETURN
31000 REM * PRINT FIELDS
31010 X(N) = I#
31100 IF LE(N) = 0 THEN RETURN / IF LINE NUMBER = 0 THEN RETURN (DO NOT SHOW FIELD OPTION)
31110 LI = LE(N) + 1 + OFFSET / LINE NUMBER EQUALS STANDARD LINE NUMBER PLUS ONE PLUS THE OFFSET
31115 TB = CE(N) / COLUMN NUMBER
31120 GOSUB 13050 / LOCATE SUBROUTINE
31130 ON FTY(A,N) GOSUB 32000,32100,32100,32100,32200 / ON FIELD TYPE GOSUB
31140 IF KEYLIST(A,N) > 0 THEN GOSUB 33000 / IF THERE IS A KEYLIST GOSUB 33000
31145 IF SUMF(N) = 2 THEN GOSUB 39200 / IF THERE ARE SUMS THEN GOSUB 39200
31150 RETURN
32000 REM STRINGS *
32010 PRINT I$ / PRINT THE STRING
32020 RETURN
32100 PRINT I# / PRINT INTEGERS, SINGLE AND DOUBLE PRECISION
32110 RETURN
32200 REM *$$$$
32210 PRINT USING "**$########.##";I# / PRINT DOLLAR AND CENTS AMOUNT
32220 RETURN
33000 REM * PRINT KEYS
33100 IF LEK(N) = 0 THEN RETURN / IF LINE NUMBER OF KEY EQUALS 0 THEN RETURN
33110 LI = LEK(N) + 1 + OFFSET / LINE NUMBER EQUALS STANDARD LINE NUMBER PLUS 1 PLUS OFFSET
33120 REM
33130 TB = CEK(N) / COLUMN NUMBER
33140 GOSUB 13050 / LOCATE SUBROUTINE
33150 T1 = KEYLIST(A,N) / THE LIST NUMBER FOR THIS FIELD
33160 PRINT L$(T1,I#) / PRINTS OUT THE KEY FOR THIS FIELD
33170 RETURN
34000 REM * PRINT FIELDS
34050 GOSUB 30000
34100 FOR N = 1 TO NREC(A) / START LOOP, FOR EACH FIELD
34102 GOSUB 34110 / CONVERT STRINGS TO NUMBER
34104 NEXT N
34110 ON FTY(A,N) GOSUB 34200,34300,34500,34600,34600 / ON FIELD TYPE GOSUB
34120 GOSUB 31000 / PRINT FIELD SUBROUTINE
34140 RETURN
34200 I$ =  X$(N)
34250 RETURN
34300 I#=CVI(X$(N)) / CONVERT STRING TO NUMBER
34310 X(N) = I#
34350 RETURN
34500 I#=CVS(X$(N)) / CONVERT STRING TO NUMBER
34550 RETURN
34600 I#=CVD(X$(N)) / CONVERT STRING TO NUMBER
34610 X(N) = I#
34650 RETURN
35000 REM * PRINT OVERLAY
35010 EFLG = 0 / END OF OVERLAY FLAG = NO
35030 IF RPT = 2 THEN LPRINT "AND SUBRECORDS" ELSE LPRINT "" / IF REPEATING FIELDS THEN PRINT ...
35050 GOSUB 20400 / SET SUMS TO 0
35100 FOR T = 1 TO 18
35110 LPRINT SW$(T); / PRINT OVERLAYS
35115 GOSUB 35200  / PRINT ANY FIELDS ON THIS LINE
35117 IF EFLG = 1 THEN RETURN / IF END OF OVERLAY THEN RETURN
35120 NEXT T
35130 RETURN
35200 REM * LPRINT FIELDS
35210 FOR T2 = 1 TO NREC(A) / FOR ALL FIELDS
35220 IF LE(T2) = T THEN GOSUB 36000 / IF FIELD IS ON THIS LINE GOSUB 36000
35300 IF LEK(T2) = T THEN GOSUB 39000 / IF KEY IS ON THIS LINE GOSUB 39000
35400 NEXT T2
35410 LPRINT ""
35500 RETURN
35600 REM * LPRINT REPEATING FIELDS
35650 GOSUB 20050 / GET UPPER AND LOWER LIMITS
35655 T3 = LSTE + 1 / FIRST REPEATING FIELD
35657 RN = RNL / RECORD NUMBER = RECORD NUMBER LOWER
35660 FOR TH = RNU TO RNL / FOR ALL RELATED RECORDS
35665 GET #1,TH / GET RECORD NUMBER
35670 FOR N = T3 TO NREC(A) / FOR ALL REPEATING FIELDS
35675 T2 = N
35680 GOSUB 36100 / PRINT FIELDS
35685 IF SUMF(N) = 2 THEN SUM#(N) = SUM#(N) + I# / IF SUMS FOR THIS FIELD THEN ADD TO SUM
35687 IF FTY(A,N) = 2 AND LEK(N) > 0 THEN GOSUB 39000 / IF THERE ARE KEYLIST AND THEY ARE SHOWN THEN GOSUB 39000
35690 NEXT N / END LOOP ON FIELDS
35700 LPRINT ""
35710 NEXT TH / END LOOP ON RELATED RECORDS
35750 REM * LPRINT SUMS
35755 EFLG = 1 / END FLAG = YES
35760 FOR N = LSTE TO NREC(A) / FOR ALL REPEATING FIELDS
35770 IF SUMF(N) = 2 THEN GOSUB 35900 / IF SUMS ARE SPECIFIED THEN GOSUB 35900
35780 NEXT N
35790 RETURN
35900 REM
35905 TB = CE(N) / COLUMN
35906 LPRINT TAB(TB); / LPRINT OVER TO THE COLUMN
35907 IF FTY(A,N) = 5 THEN GOTO 35950 / IF DOLLAR AND CENTS AMOUNT GOTO 35950
35910 LPRINT TAB(TB) SUM#(N); / PRINT SUM
35920 RETURN
35950 LPRINT USING "**$########.##";SUM#(N); / PRINT DOLLAR AND CENTS SUMS
35960 RETURN
36000 REM * LPRINT FIELDS
36050 N = T2
36060 IF RPT = 2 AND N > LSTE THEN GOTO 35600 / IF THERE ARE REPEATING FIELDS AND THIS FIELD IS ONE OF THEM THEN GOTO 35600
36100 ON FTY(A,T2) GOSUB 34200,34300,34500,34600,34600 / ON FIELD TYPE GOTO
36200 GOTO 37000
37000 REM * PRINT FIELDS
37115 TB = CE(T2) / COLUMN NUMBER
37125 LPRINT TAB(TB) ""; / LPRINT OVER TO THE COLUMN
37130 ON FTY(A,T2) GOSUB 38010,38100,38100,38100,38200 / ON FIELD TYPE GOTO
37150 RETURN
38000 REM STRINGS *
38010 LPRINT I$; PRINT STRINGS
38020 RETURN
38100 LPRINT I#; PRINT NUMBERS
38110 RETURN
38200 REM * $$$$
38210 LPRINT USING "**$########.##";I#; / PRINT DOLLAR AND CENTS NUMBERS
38220 RETURN
39000 REM  * PRINT KEYS
39010 ON FTY(A,T2) GOSUB 34200,34300,34500,34600,34600 / ON FIELD TYPE GOTO
39090 N = T2
39130 TB = CEK(T2) / COLUMN TO PRINT KEY AT
39140 LPRINT TAB(TB) ""; / PRINT OVER TO THE COLUMN
39150 T1 = KEYLIST(A,T2) / THE LIST NUMBER
39160 LPRINT L$(T1,I#); / PRINT THE KEYLIST
39170 RETURN
39200 REM * PRINT TOTALS
39300 SUM#(N) = SUM#(N) + I# / ADD TO SUM
39310 LI = 19 / LINE 19
39320 GOSUB 13050 / LOCATE SUBROUTINE
39330 IF FTY(A,N) = 5 THEN GOTO 39600 / IF DOLLAR AND CENTS AMOUNT GOTO 39600
39400 PRINT SUM#(N);
39410 RETURN
39600 REM $$$$$
39610 PRINT USING "**$########.##";SUM#(N); / PRINT DOLLAR AND CENTS AMOUNT
39620 RETURN
N);