40008 IF REALFLG(A) = 2 THEN GOSUB 60200 / IF THERE ARE REALTIME TRANSFERS GOTO OPEN REALTIME FILE SUBROUTINE
40010 GOSUB 13000 / CLEAR SCREEN
40015 IF DATAIN = 1 GOTO 40500 / IF INPUT DESCRIPTION IS ALREADY IN SKIP INPUTTING THE DATA
40017 GOSUB 40020 / GOSUB THE INPUT DATA ROUTINE
40018 GOTO 40500 / SKIP OVER THE INPUT DATA ROUTINE
40020 REM READ INPUT DATA
40021 GOSUB 49000 / SET GLOBAL FLAGS TO 0
40022 GOSUB 10900 / PUT PROGRAM DATA DISK IN DRIVE PROMPT
40025 A$ = STR$(A) / CONVERT THE FILE NUMBER TO A STRING
40027 A$ = MID$(A$,2) / GET RID OF THE LEADING SPACE
40030 N$ = "IPUTD"+A$ / FILE NAME = "IPUTD" PLUS FILE NUMBER
40040 OPEN "I",#2,N$ / OPEN INPUT DATA FILE
40050 INPUT #2,NREC(A) / INPUT NUMBER OF FIELDS IN THIS FILE
40060 FOR N3= 1 TO NREC(A) / FOR EACH FIELD IN THE FILE
40062 N = N3
40070 INPUT #2,IOPT(N) / GET THE INPUT OPTION NUMBER
40080 ON IOPT(N) GOTO 40090,40120,40150,40210,40240,40270,40430,40370,40370,40430,40430,40430,40210 / ON THE INPUT OPTION GOTO
40085 GOTO 40450 / CUSTOM INPUT OPTIONS FALL THROUGH THE ABOVE GOTO
40090 REM OPERATOR ENTRY*
40100 INPUT #2,PROMPT$(N) / INPUT THE PROMPT
40110 GOTO 40450
40120 REM GET FROM ANOTHER FILE*
40130 INPUT #2,IFN(N),IFLD(N),IRNFLD(N) / INPUT DATA FROM THIS FILE, FROM THIS FIELD, RECORD NUMBER EQUALS THE VALUE OF THIS FIELD IN THE SOURCE FILE
40132 GFLG(IFN(N)) = 1 / SET GLOBAL FLAG TO YES
40134 GFLG(IFLD(N)) = 1 / SET GLOBAL FLAG TO YES
40136 GFLG(IRNFLD(N)) = 1 / SET GLOBAL FLAG TO YES
40140 GOTO 40450
40150 REM ADD PREVIOUS FIELDS*
40160 INPUT #2,NOS(N) / INPUT THE NUMBER OF FIELDS TO ADD
40170 FOR T = 1 TO NOS(N) / FOR EACH FIELD TO ADD
40180 INPUT #2,ADDFLD(N,T) / ADD THIS FIELD
40185 GFLG(ADDFLD(N,T)) = 1 / SET GLOBAL FLAG TO YES
40190 NEXT T / END LOOP READING FIELDS TO ADD
40200 GOTO 40450
40210 REM SUBTRACT PREVIOUS FIELDS* / ALSO USED FOR DIVIDE 2 FIELDS
40220 INPUT #2, SUBX(N),SUBY(N) / INPUT THE FIELD NUMBERS TO SUBTRACT
40222 GFLG(SUBX(N)) = 1 / SET GLOBAL FLAG TO YES
40224 GFLG(SUBY(N)) = 1 / SET GLOBAL FLAG TO YES
40230 GOTO 40450
40240 REM MULTIPLY FIELDS*
40250 INPUT #2, MULX(N),MULY(N) / INPUT THE FIELDS TO MULTIPLY
40252 GFLG(MULX(N)) = 1 / SET GLOBAL FLAG TO YES
40254 GFLG(MULY(N)) = 1 / SET GLOBAL FLAG TO YES
40260 GOTO 40450
40270 REM GET FROM A TABLE* / COMPUTE USING TAX TABLE OPTION
40280 INPUT #2,TX(1,N),TX(2,N),TX(3,N),TX(4,N),TX(5,N),TX(6,N) / INPUT DATA FOR COMPUTING TAXES
40282 GFLG(TX(2,N)) = 1 / SET GLOBAL FLAG TO YES
40283 GFLG(TX(4,N)) = 1 / SET GLOBAL FLAG TO YES
40284 GFLG(TX(5,N)) = 1 / SET GLOBAL FLAG TO YES
40285 GFLG(TX(6,N)) = 1 / SET GLOBAL FLAG TO YES
40290 TTBL = 5 / SET TAX TABLE FLAG TO YES
40310 GOTO 40450
40370 REM MAXIMUM* / ALSO USED FOR MINIMUM
40380 INPUT #2,NOS(N) / INPUT THE NUMBER OF ITEMS YOU WANT TO COMPARE
40390 FOR T = 1 TO NOS(N) / FOR ALL FIELDS TO COMPARE
40400 INPUT #2,MAXMIN(N,T) / INPUT THE FIELD TO COMPARE
40405 GFLG(MAXMIN(N,T)) = 1 / SET GLOBAL FLAG TO 1
40410 NEXT T
40420 GOTO 40450
40430 REM CONSTANT*
40440 INPUT #2,KC(N),CFLD(N) / INPUT THE CONSTANT AND THE FIELD OPERATED ON BY THE CONSTANT
40445 GFLG(CFLD(N)) = 1 / SET GLOBAL FLAG TO YES
40450 NEXT N3
40460 CLOSE #2
40470 DATAIN = 1 / SET INPUT DATA IN FLAG TO YES
40480 RETURN
40500 REM OPEN SECOND FILE*
40505 IF TWOOPEN = 1 THEN 40637 / IF SECOND FILE TO INPUT DATA FROM IS ALREADY OPEN THEN SKIP THIS SECTION
40507 TWOOPEN = 1 / SET SECOND FILE OPEN FLAG TO YES
40510 FOR T = 1 TO NREC(A) / FOR EACH FIELD IN THE FILE
40520 IF IOPT(T) = 2 GOTO 40600 / IF INPUT OPTION IS GET DATA FROM ANOTHER FILE THEN OPEN THE SECOND FILE SUBROUTINE
40530 NEXT T
40540 GOTO 40640
40600 B = IFN(T) / B, THE SECOND FILE EQUALS THE NUMBER OF THE FILE TO GET DATA FROM
40602 AHLD = A / HOLD THE VALUE OF THE FIRST FILE
40604 A = B
40610 PRINT F$(B), " SECOND FILE FOR CUSTOM INPUT "
40620 GOSUB 2300 / GET DISK DRIVE THE FILE IS ON SUBROUTINE
40625 A = AHLD / RETURN THE VALUE OF AHLD
40630 GOSUB 2550 / OPEN THE SECOND FILE
40635 GOSUB 7950 / GET THE MAXIMUM RECORD NUMBER OF THE SECOND FILE
40637 IF TAXIN = 1 THEN 41000 / IF TAX TABLES ARE ALREADY IN MEMORY THEN SKIP THIS SECTION
40638 TAXIN = 1 / SET TAX TABLE IN MEMORY FLAG TO YES
40640 FOR T = 1 TO NREC(A)
40650 IF IOPT(T) = 6 GOTO 40800 / IF FILE COMPUTES TAX TABLE DATA THEN READ THE TAXSCH FILE
40660 NEXT T
40670 GOTO 41000 / SKIP READING THE TAX TABLES
40800 GOSUB 45000 / GOTO THE SUBROUTINE THAT READS THE TAX TABLES
41000 REM CUSTOM INPUT ROUTINE*
41010 GOSUB 13000 / CLEAR SCREEN
41012 OFFSET = 0 / INITIALIZE OFFSET TO 0
41014 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61300 / IF THERE ARE REALTIME TRANSFERS AND YOU ARE OVERWRITING A RECORD THEN CORRECT REALTIME TRANSFER FILE
41015 PRINT "***************** FILE NAME :";F$(A);" ";"RECORD NUMBER :";RN;" ****************"
41030 IF CSCR = 1 THEN GOSUB 30000 /IF USING A CUSTOM SCREEN PRINT OVERLAYS
41080 LI = 25 / LINE EQUALS 25
41082 GOSUB 13100 / LOCATE SUBROUTINE
41085 PRINT "[ = SAME AS LAST RECORD , < BACK UP , > ABORT THIS RECORD , ^ EQUALLAST OVER 1]"; / PRINTS MESSAGE AT LINE 25
41087 GOTO 41130 / SKIP THE FOLLOWING SUBROUTINE
41092 LI = 20 / LINE EQUALS 25
41093 GOSUB 13100 / LOCATE SUBRUTINE
41094 PRINT " " / CLEAR LINES 20 TO 24
41095 PRINT " "
41096 PRINT " "
41097 PRINT " "
41100 PRINT " ";
41110 LI = 20 / LINE EQUALS 20
41115 GOSUB 13100 / LOCATE SUBROUTINE
41120 PRINT "ON FIELD NUMBER : ";N;" FIELD NAME : ";FLDN$(A,N);" : " / PRINT FIELD NUMBER AND FIELD NAME
41125 RETURN
41130 N = 1 / INITIALIZE N, THE FIELD NUMBER TO 1
41133 WHILE N <= NREC(A) / WHILE THE FIELD NUMBER IS LESS THEN OR EQUAL TO THE MAXIMUM FIELD NUMBER
41135 REFLG = 0 / INITIALIZE RESTART FLAG TO NO
41137 IF N < 1 THEN N = 1 / FIELD NUMBER CAN'T BE LESS THEN 1
41140 ON IOPT(N) GOSUB 41200,41400,41600,41800,42000,42200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000 / ON INPUT OPTION GOTO
41150 GOSUB 43800 / GOSUB THE PRINT FIELD ON SCREEN, AND SET FILE BUFFER SUBROUTINE
41155 N = N + 1 / INCREMENT THE FIELD NUMBER
41160 WEND / CONTINUE WITH THE LOOP FOR ALL FIELDS
41165 GOTO 44910
41170 REM * BACK UP FIELDS UNTIL IOPT = 1 / BACK UP UNTILL THERE IS AN OPERATOR ENTRY
41175 N = N - 1 / DECREMENT THE FILE NUMBER
41180 IF N < 1 THEN 41133 / CAN'T DECREMENT PAST ONE
41185 IF IOPT(N) <> 1 THEN 41175 / IF INPUT OPTION IS NOT AN OPERATOR ENTRY THEN DECREMENT AGAIN
41190 GOTO 41133 / CONTINUE ENTERING FIELDS
41200 REM * OPERATOR ENTRY
41202 NE = 1 / SET NEW ENTRY FLAG TO YES
41205 GOSUB 41092 / CLEAR THE LINES
41210 PRINT PROMPT$(N) / PRINT THE PROMPT
41215 REFLG = 0 / INITIALIZE RESTART FLAG TO 0
41220 IF FTY(A,N) = 1 GOTO 41300 / IF A STRING THEN GOTO 41300
41230 ON FTY(A,N) GOSUB 15000,14100,14200,14300,14300 / ON THE FIELD TYPE GOTO THE INPUT SUBROUTINE FOR THAT FIELD TYPE
41234 IF REFLG = 1 THEN GOTO 41170 / IF RESTART FLAG EQUALS YES THEN RESTART DATA ENTRY
41235 IF ABORTFLG = 1 GOTO 7000 / IF ABORT FLAG EQUALS YES THEN GOTO 7000
41236 IF MFLG(A) = 2 AND FTY(A,N) <> 1 THEN GOSUB 29200 / IF LIMITS FLAG IS YES AND THE FIELD IS NOT A STRING THEN CHECK THE LIMITS
41237 T2 = KEYLIST(A,N) / KEYLIST NUMBER
41238 T3 = MAXK(T2) / MAXIMUM FOR THE LIST
41239 REM IF KY(A,N) = 2 AND (DT# < 1 OR DT# > T3) GOTO 41230
41240 I# = DT# / SET I# TO THE VALUE ENTERED IN THE SUBROUTINE
41245 NE = 0 / RESET NEW ENTRY FLAG TO NO
41250 RETURN
41298 REFLG = 0 / RESET RESTART FLAG TO NO
41300 Q = N / FIELD NUMBER ALSO EQUALS Q
41302 GOSUB 15000 / INPUT STRING SUBROUTINE
41303 IF ABORTFLG = 1 GOTO 7000 / IF ABORT FLAG EQUALS YES THEN ABORT
41304 I$ = A$ / SET I$ TO THE VALUE RETURNED FROM THE STRING INPUT SUBROUTINE
41306 NE = 0 / RESET NEW ENTRY FLAG TO NO
41308 IF REFLG = 1 GOTO 41170 / IF RESTART FLAG THEN RESTART DATA ENTRY
41310 RETURN
41400 REM GET FROM ANOTHER FILE*
41402 FLD = IFLD(N) / GET DATA FROM THIS FIELD
41404 T = IRNFLD(N) / RECORD NUBER OF THE FIELD TO GET DATA FROM
41406 RN2= X(T) / RECORD NUMBER OF FILE 2 EQUALS THE VALUE OF THIS SOURCE FIELD
41407 IF RN2 > MRNS THEN GOTO 48000 / IF RECORD NUMBER OF THE SECOND FILE IS GREATER THEN MAXIMUM RECORD NUMBER THEN GOTO 48000
41408 GET #2,RN2 / GET THE RECORD FROM THE SECOND FILE
41409 B = IFN(N) / B IS THE FILE NUMBER OF THE SECOND OPENED FIELD
41420 ON FTY(B,FLD) GOTO 41422,41460,41500,41550,41550 / ON THE FIELD TYPE OF THE FIELD IN THE SECOND FILE GOTO
41422 I$ = Y$(FLD) / SET I$ TO THE VALUE OF THE FIELD
41430 RETURN
41460 Y$ = Y$(FLD)
41465 I% = CVI(Y$) / CONVERT FIELD TO A NUMBER
41467 I# = I%
41470 RETURN
41500 I! = CVS(Y$(FLD)) / CONVERT FIELD TO A NUMBER
41505 I# = I!
41510 RETURN
41550 I# = CVD(Y$(FLD)) / CONVERT FIELD TO A NUMBER
41560 GOTO 43800
41600 REM ADD PREVIOUS FIELDS*
41605 I# = 0 / INITIALIZE TO 0
41610 FOR T = 1 TO NOS(N) / FOR ALL THE FIELDS TO ADD
41620 T2 = ADDFLD(N,T) / T2 IS THE FIELD TO ADD
41630 I# = I# + X(T2) / ADD THE VALUE TO THE FIELD TO THE PREVIOUS SUM
41640 NEXT T / END LOOP OF FIELDS TO ADD
41650 RETURN
41800 REM SUBTRACT FIELDS
41810 T1 = SUBX(N) / T1 IS FIELD TO SUBTRACT FROM OR DIVIDE INTO
41820 T2 = SUBY(N) / T2 IS FIELD TO SUBTRACT OR DIVIDE BY
41830 IF IOPT(N) = 4 THEN I# = X(T1) - X(T2) ELSE I# = X(T1)/X(T2) / EITHER SUBTRACT OR DIVIDE DEPENDING ON THE INPUT OPTION
41840 RETURN
42000 REM MULTIPLY FIELDS
42010 T1 = MULX(N) / FIRST FIELD TO MULTIPLY
42020 T2 = MULY(N) / SECOND FIELD TO MULTIPLY
42030 I# = X(T1) * X(T2) / MULTIPLY FIELDS
42040 RETURN
42200 REM GET FROM A TABLE
42210 ON TX(1,N) GOSUB 42400,42450 / IF TAX TABLE IS CONSTANT GOSUB 42400, IF TAX TABLE VARIES GOSUB 42450
42220 ON TX(3,N) GOSUB 42500,42550 / IF PAY PERIOD CONSTANT GOSUB 42500 IF PAY PERIOD VARIES GOSUB 42550
42230 Y = TX(5,N) / MARRIED SINGLE FIELD EQUALS THIS FIELD
42240 MSS = X(Y) / MARRIED SINGLE FIELD
42250 Y = TX(6,N) / PAY EQUALS THIS FIELD
42260 PAY# = X(Y) / PAY
42270 GOSUB 45500 / COMPUTE TAX SUBROUTINE
42272 I# = TTAX# / SET I# TO TTAX# RETURNED FROM COMPUTE TAX SUBROUTINE
42290 RETURN
42400 FSS = TX(2,N) / FEDERAL STATE TAX TABLE NUMBER CONSTANT
42410 RETURN
42450 Y = TX(2,N)
42460 FSS = X(Y) /FEDERAL STATE TAX TABLE NUMBER EQUALS THE VALUE OF THIS FIELD
42470 RETURN
42500 PPS = TX(4,N) / PAY PERIOD CONSTANT
42510 RETURN
42550 Y = TX(4,N)
42560 PPS = X(Y) / PAY PERIOD EQUALS THIS FIELD
42570 RETURN
42600 REM CONSTANT
42610 I# = KC(N) / FILED EQUALS A CONSTANT
42620 RETURN
42800 REM MAXIMUM
42802 T2 = MAXMIN(N,1) / T2 IS THE FIRST FIELD TO COMPARE
42804 I# = X(T2) / INITIALIZE MAXIMUM VALUE TO THE VALUE OF THE FIRST FIELD TO COMPARE
42810 FOR T = 2 TO NOS(N) / FOR THE REST OF THE FIELDS TO COMPARE
42820 T2 = MAXMIN(N,T) / NEXT FIELD TO COMPARE
42830 IF X(T2) > I# THEN I# = X(T2) / IF THE VALUE OF THIS FIELD IS GREATER THEN THE MAXIMUM LET THE MAXIMUM EQUAL THE FIELD
42840 NEXT T
42850 RETURN
43000 REM MINIMUM*
43002 T2 = MAXMIN(N,1) / FIRST FIELD TO COMPARE
43004 I# = X(T2) / INITIALIZE MINIMUM TO THE VALUE OF THE FIRST FIELD
43010 FOR T = 2 TO NOS(N) / FOR THE REST OF THE FIELDS TO COMPARE
43020 T2 = MAXMIN(N,T) / NEXT FIELD TO COMPARE
43030 IF X(T2) < I# THEN I# = X(T2) / IF THE VALUE OF THE FIELD IS LESS THEN THE MINIMUM THEN LET THE MINIMUM EQUAL THE VALUE OF THIS FIELD
43040 NEXT T
43050 RETURN
43200 REM MULTIPLY BY A CONSTANT*
43210 T = CFLD(N) / T IS THE FIELD TO MULTIPLY THE CONSTANT BY
43220 I# = KC(N) * X(T) / MULTIPLY THE CONSTANT BY THE VALUE OF FIELD T
43230 RETURN
43400 REM ADD A CONSTANT*
43410 T = CFLD(N) / T IS THE FIELD TO ADD THE CONSTANT TO
43420 I# = KC(N) + X(T) / ADD THE CONSTANT AND THE FIELD
43430 RETURN
43600 REM SUBTRACT A CONSTANT
43610 T = CFLD(N) / T IS THE FIELD TO SUBTRACT THE CONSTANT FROM
43620 I# = X(T) - KC(N) / SUBTRACT THE CONSTANT FROM THE VALUE OF FIELD T
43630 RETURN
43800 REM LSET
43810 ON FTY(A,N) GOTO 43900,44000,44100,44200,44200 / ON FIELD TYPE GOTO
43900 REM STRING*
43910 LSET X$(N) = I$ / PUT STRINGS IN THE FILE BUFFER
43920 CK$(N) = I$ / HOLD THE STING AS CK$(FIELD NUMBER)
43990 GOTO 44500
44000 REM INTEGER *
44020 LSET X$(N) = MKI$(I#) / PUT INTERGERS IN FILE BUFFER
44030 GOTO 44500
44100 REM SINGLE PRECISION*
44110 I! = I#
44120 LSET X$(N) = MKS$(I#) / PUT SINGLE PRECISION NUMBERS IN FILE BUFFER
44130 GOTO 44500
44200 REM DOUBLE PRECISION*
44210 LSET X$(N) = MKD$(I#) / PUT DOUBLE PRECISON NUMBERS IN FILE BUFFER
44500 IF CSCR = 1 THEN GOSUB 31000 / IF USING A CUSTOM SCREEN THEN PRINT THE FIELD ON THE SCREEN USING THE 31000 SUBROUTINE
44501 IF CSCR = 1 THEN GOTO 44900 / IF USING A CUSTOM SCREEN THEN SKIP THE FOLLOWING SECTION
44502 IF N < 19 THEN HT = N + 1 / IF THE FIELD NUMBER IS LESS THEN 19 THEN THE LINE NUMBER IS THE FIELD NUMBER PLUS ONE
44503 IF N >= 19 THEN HT = N MOD 18 + 2 / IF THE FIELD NUMBER IS EQUAL OR GREATER THEN 19 THEN THE LINE NUMBER IS N MOD 18 + 2
44504 LI = HT / LINE NUMBER
44505 GOSUB 13100 / LOCATE SUBROUTINE
44506 IF N <18 GOTO 44510 / IF FIELD NUMBER LESS THEN 18 SKIP THE NEXT 2 LINES
44507 PRINT " "; / CLEAR LINE
44508 GOSUB 13100 / LOCATE
44510 PRINT N;TAB(5) FLDN$(A,N); / PRINT THE FIELD NUMBER AND THE FIELD NAME
44515 IF KEYLIST(A,N) > 0 GOTO 44800 / IF THERE IS A KEYLIST GOTO 44800
44520 IF FTY(A,N) = 1 GOTO 44600 / IF FIELD IS A STRING GOTO 44600
44525 IF FTY(A,N) = 5 GOTO 44700 / IF FIELD IS A DOLLAR AND CENTS AMOUNT GOTO
44530 PRINT TAB(25) I# / PRINT THE VALUE OF THE FIELD
44535 X(N) = I# / HOLD THE VALUE OF THE FIELD AS X(FIELD NUMBER)
44540 GOTO 44900
44600 PRINT TAB(26) I$ / PRINT STRING FIELDS
44610 GOTO 44900
44700 PRINT TAB(26);
44710 PRINT USING "**$########.##";I# / PRINT DOLLAR AND CENTS AMOUNTS
44715 X(N) = I# / HOLD THE VALUE OF THIS FIELD AS X(N)
44720 GOTO 44900
44800 REM KEYLIST
44810 T1 = KEYLIST(A,N) / THE LIST NUMBER
44820 W$ = L$(T1,I#) / THE KEYLIST TO PRINT
44830 PRINT TAB(25) I#;
44835 X(N) = I# / HOLD THE NUMBER AS X(FIELD)
44840 PRINT TAB(30) "key ";W$ / PRINT THE KEYLIST
44900 RETURN
44910 PUT #1,RN / PUT THE FILE BUFFER ON THE DISK
44912 IF REALFLG(A) = 2 THEN GOSUB 60300 / IF THERE ARE REALTIME TRANSFERS THEN UPDATE THE REALTIME TRANSFER FILE
44913 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61400 / IF THERE ARE REALTIME TRANSFERS AND YOU ARE OVERWRITING A OLD FILE THEN CORRECT REALTIME FILE
44915 IF RN > MRN THEN MRN = RN / IF RECORD NUMBER EXCEEDS THE MAXIMUM RECORD NUMBER THEN LET THE MAXIMUM RECORD EQUAL THE RECORD NUMBER
44962 SPRT = 5 / SURPRESS PRINTING AFTER OPTION IS ENTERED
44965 GOSUB 14000 / INPUT INTEGER LESS THEN 100 SUBROUTINE
44967 IF DT# <0 OR DT# >4 GOTO 44920 / IF OUT OF RANGE REENTER
44970 TH = DT# / TH EQUALS THE VALUE RETURNED FROM THE INPUT SUBROUTINE
44975 IF TH = 2 THEN RETURN / ENTER ANOTHER RECORD
44980 IF TH = 0 THEN GOTO 3010 / BACK TO FILE OPTIONS
44985 IF TH = 3 THEN GOSUB 9000 / CORRECT A RECORD SUBROUTINE
44987 IF TH = 3 THEN GOTO 44920 / AFTER CORRECTION GET ANOTHER OPTION
44988 IF TH = 4 AND RPT <> 2 THEN 44996 / IF REQUEST FOR ENTER A SUBRECORD AND SUBRECORDS ARE NOT SET UP ON THE FILE GOTO 44996
44989 IF TH = 4 THEN GOTO 52000 / ENTER A SUBRECORD OPTION
44990 RN = RN + 1 / INCREMENT RECORD NUMBER
44995 GOTO 41000 / ENTER NEXT RECORD
44996 LI = 24 / LINE 24
44997 GOSUB 13100 / LOCATE SUBROUTINE
44998 PRINT TAB(10) "SUBRECORDS ARE NOT SET UP ON THIS FILE";
44999 GOTO 44920 / ASK FOR ANOTHER OPTION
45000 REM
45001 IF HDISK = 2 THEN GOTO 45010 / IF HARD DISK OPTION THEN SKIP THE PROMPT
45002 GOSUB 13000 / CLEAR SCREEN
45004 PRINT " PUT THE FLOPPY DISK WITH THE TAX SCHEDULE ON IT IN"
45005 PRINT " IN THE DEFAULT DISK DRIVE "
45006 PRINT ""
45007 PRINT " **** THEN PRESS ANY KEY TO CONTINUE **** "
45008 IF INKEY$ = "" THEN GOTO 45008 / LOOP UNTILL ANY KEY IS PRESSED
45010 OPEN "R",#3,"TAXSCH",82 / OPEN THE TAX SCHEDULE FILE
45015 FIELD #3,40 AS D$,2 AS FD$,2 AS PP$,2 AS MS$,8 AS MIN$,8 AS MAX$,8 AS TX$,4 AS PCT$,8 AS OVR$ / FIELD THE TAX SCHEDULE FILE
45018 GOSUB 7900 / GET THE MAXIMUM RECORD NUMBER OF THE FILE
45020 FOR T7 = 1 TO 1000 / START LOOP READING RECORDS
45040 IF T7 > MRN2 GOTO 45160 / IF END OF FILE JUMP OUT OF THE LOOP
45050 GET #3,T7 / GET THE RECORD NUMBER
45070 FS(T7) = CVI(FD$) / CONVERT FEDERAL STATE NUMBER
45080 PP(T7) = CVI(PP$) / CONVERT PAY PERIOD NUMBER
45090 MS(T7) = CVI(MS$) / CONVERT MARRIED SINGLE NUMBER
45100 MIND#(T7) = CVD(MIN$) / CONVERT MINIMUM PAY FOR RATE
45110 MAXD#(T7) = CVD(MAX$) / CONVERT MAXIMUM PAY FOR RATE
45120 TAX#(T7) = CVD(TX$) / CONVERT BASE TAX
45130 PCT!(T7) = CVS(PCT$) / CONVERT PECENT OVER
45140 OVR#(T7) = CVD(OVR$) / CONVERT OVER THIS PAY
45150 NEXT T7 / END LOOP READING TAX RECORDS
45160 REM
45170 GOTO 45200
45200 REM
45210 TMAX = T7 - 1 / MAXIMUM TAX RECORD NUMBER
45215 CLOSE #3 / CLOSE TAX SCHEDULE FILE
45218 TTBL = 5 / FLAG, TAX TABLE IN MEMORY
45220 RETURN
45230 REM
45240 REM
45250 REM
45260 REM
45270 REM
45500 REM
45510 FOR T7 = 1 TO TMAX / START LOOP READING ALL TAX RECORDS FROM MEMORY
45520 IF FS(T7) = FSS THEN GOTO 45530 ELSE GOTO 45610 / IF FEDERAL STATE NUMBERS MATCH THEN CHECK NEXT FIELD ELSE RECORD DOES NOT MATCH
45530 IF PP(T7) = PPS THEN GOTO 45540 ELSE GOTO 45610 / IF PAY PERIODS MATCH THEN CHECK NEXT FIELD ELSE RECORD DOES NOT MATCH
45540 IF MS(T7) = MSS THEN GOTO 45550 ELSE GOTO 45610 / IF MARRIED SINGLE NUMBER MATCH THEN CHECK NEXT FIELD ELSE RECORD DOES NOT MATCH
45550 IF PAY# < MIND#(T7) GOTO 45610 / IF PAY IS LESS THEN MINIMUM FOR THIS TAX BRACKET THEN RECORD DOES NOT MATCH
45560 IF PAY# > MAXD#(T7) GOTO 45610 / IF PAY IS GREATER THEN THE MAXIMUM FOR THIS TAX BRACKET THEN RECORD DOES NOT MATCH
45570 PAYEX# = PAY# - OVR#(T7) / PAY OVER BASE TAX RATE
45580 TXE# = PAYEX# * PCT!(T7) / 100 / TAX ON PAY OVER BASE TAX RATE
45590 TTAX# = TAX#(T7) + TXE# / TOTAL TAX
45600 GOTO 45680
45610 NEXT T7 / CHECK NEXT RECORD
45620 PRINT "++++++ PROPER TAX TABLE NOT FOUND ++++++" / IF TAX TABLE NOT FOUND THIS IS SHOWN ON THE SCREEN
45630 PRINT "CHECK : FEDERAL OR STATE NUMBER ";FSS
45640 PRINT " PAY PERIOD NUMBER ";PPS
45650 PRINT " MARRIED/SINGLE NUMBER ";MSS
45660 PRINT " PAY ";PAY
45670 PRINT "***** PRESS ANY KEY TO CONTINUE ******"
45672 IF INKEY$ = "" GOTO 45672 / STAY HERE UNTILL A KEY IS PRESSED
45674 GOTO 3010 / BACK TO FILE OPTIONS
45680 REM RETURNS TTAX*
45690 RETURN
46000 REM CROSS CHECK FIELD
46010 IF DATAIN >< 1 THEN GOSUB 40020 / IF INPUT OPTIONS ARE NOT IN MEMORY THEN GET THEM
46020 REM
46030 REM
46100 GET #1,RN / GET THE RECORD FROM THE DISK
46130 FOR N2= 1 TO NREC(A) / FOR ALL FIELDS IN THE RECORD
46133 N = N2
46135 REM
46140 ON IOPT(N) GOSUB 46200,46200,41600,41800,42000,46200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000 / ON INPUT OPTION GOSUB
46145 IF CALFLG = 5 THEN 46160 / IF USING THE RECALCULATION OPTION THEN SKIP THE NEXT LINE
46150 GOSUB 43800
46160 NEXT N2 / END OF LOOP ON FIELDS
46162 PUT #1,RN / PUT THE RECORD ON DISK
46165 RETURN
46200 ON FTY(A,N) GOTO 46220,46300,46400,46500,46500 / ON FIELD TYPE GOTO. THIS IS A DUMMY RECALCULATION FOR GET FROM ANOTHER FILE OPTION AND COMPUTE USING TAX TABLE OPTION
46220 I$ = X$(N) / EQUAL TO OLD VALUE
46230 RETURN
46300 I% = CVI(X$(N)) / EQUAL TO OLD VALUE
46310 I# = I%
46320 RETURN
46400 I! = CVS(X$(N)) / EQUAL TO OLD VALUE
46410 I# = I!
46420 RETURN
46500 I# = CVD(X$(N)) / EQUAL TO OLD VALUE
46510 RETURN
47000 REM
47050 CALFLG = 5 / USING THE RECALCULATION OPTION FLAG
47100 GOSUB 13000 / CLEAR SCREEN
47110 PRINT "******* RECALCULATE THE FIELDS IN A FILE OPTION *******"
47120 PRINT ""
47130 PRINT " Use only if you know what you are doing "
47140 PRINT ""
47150 PRINT "MINIMUM RECORD NUMBER : 1 MAXIMUM RECORD NUMBER : ";MRN
47160 PRINT ""
47190 PRINT "*********** DO YOU WANT TO USE THIS OPTION ************"
47200 PRINT " 1 - NO, RETURN TO FILE OPTION"
47300 PRINT " 2 - YES, I WANT TO USE THIS OPTION "
47310 PRINT "********* Enter the number then Press Return **********"
47320 GOSUB 14000 / INPUT INTEGER LESS THEN 100 SUBROUTINE
47330 IF DT# < 1 OR DT# > 2 THEN 47320 / IF OUT OF RANGE THEN REENTER
47340 IF DT# = 1 THEN 3010 / BACK TO FILE OPTIONS
47400 FOR RN = 1 TO MRN / FOR ALL RECORDS
47430 GOSUB 46000 / RECALCULATE THEN
47450 NEXT RN
47470 GOTO 3010 / BACK TO FILE OPTIONS
48000 REM
48100 REM / TRIED TO GET TO LARGE A RECORD FROM THE FILE OPTIONS
48110 PRINT " ++++++ ERROR +++++++"
48120 PRINT "RECORD NUMBER ";RN2;" IN FILE ";F$(B);" DOES NOT EXIST"
48140 PRINT "YOU PROBABLY ENTERED FIELD ";IRNFLD(N);" WRONG"
48160 PRINT "********* PRESS ANY KEY TO CONTINUE ********"
48170 IF INKEY$ = "" GOTO 48170
48180 GOTO 40000 / START NEW ENTRY OVER AGAIN
49000 REM * SET GFLG TO ZERO / IF A GLOBAL FLAG DOES NOT EQUAL 0 THEN IT IS USED IN THE CALCULATION OF ANOTHER FIELD
49100 FOR T = 1 TO 28 / SETS GLOBAL FLAGS TO 0 FOR ALL FIELDS
49110 GFLG(T) = 0
49120 NEXT T
49130 RETURN
50000 REM INTRO
50010 GOSUB 13000 / CLEAR SCREEN
50100 PRINT " M A I N P R O G R A M 3.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions "
50140 PRINT "YOU MUST READ THE LICENSE CONDITIONS PROIR TO USING THIS PROGRAM"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50950 PRINT "***************** PRESS ANY KEY TO CONTINUE ******************";
50960 IF INKEY$ = "" GOTO 50960 / LOOP UNTILL ANY KEY IS PRESSED
50970 RETURN
51000 REM ******* DONE
51100 CLOSE
51105 GOSUB 13000 / CLEAR SCREEN
51110 PRINT " -BYE, Have a nice Day
51120 END / EXITS PROGRAM
52000 REM * SUB RECORD INPUT
52010 LI = 1 / LINE ONE
52020 GOSUB 13100 / LOCATE SUBROUTINE
52030 PRINT TAB(60) "ON SUBRECORD ";(RN+1)
52100 OFFSET = OFFSET + 1 / INCREMENT OFFSET FOR EACH SUBRECORD
52110 RN = RN + 1 / INCREMENT RECORD NUMBER
52115 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61300 / IF THERE ARE REALTIME TRANSFERS AND YOU ARE OVER WRITING A RECORD THEN CORRECT REALTIME TARGET FILE
52120 T2 = LSTE + 1 / FIRST REPEATING FIELD IS T2
52130 FOR N = T2 TO NREC(A) / FOR ALL RECORD NUMBERS
52135 REFLG = 0 / RESTART FLAG SET TO NO
52140 ON IOPT(N) GOSUB 41200,41400,41600,41800,42000,42200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000 / ON INPUT OPTION GOTO
52150 GOSUB 43800 / PRINT ON SCREEN
52160 NEXT N / END LOOP ON FIELDS
52165 GOTO 44910 / PUT DATA ON DISK AND GET NEXT OPTION
53000 REM SPACE FOR CUSTOM INPUT OPTION # 14
53990 RETURN
54000 REM SPACE FOR CUSTOM INPUT OPTION # 15
54990 RETURN
55000 REM SPACE FOR CUSTOM INPUT OPTION # 16
55990 RETURN
56000 REM SPACE FOR CUSTOM INPUT OPTION # 17
56990 RETURN
57000 REM SPACE FOR CUSTOM INPUT OPTION # 18
57990 RETURN
58000 REM SPACE FOR CUSTOM INPUT OPTION # 19
58990 RETURN
59000 REM SPACE FOR CUSTOM INPUT OPTION # 20
59990 RETURN
60000 REM *READ REALTIME OPTIONS
60010 OPEN "I",#1,"REALTIME" / OPEN REALTIME FILE
60020 FOR T = 1 TO MAXF
60030 INPUT #1,REALFLG(T) / FOR EACH FILE READ THE REALTIME OPTION
60040 NEXT T
60050 CLOSE #1
60060 RETURN
60070 REM * READ REALTIME DATA
60080 A$ = STR$(A) / CONVERT FILE NUMBER TO A STRING
60090 A$ = MID$(A$,2) / GET RID OF LEADING SPACE
60100 A$ = "REAL" + A$ / CONCATE "REAL" AND THE FILE NUMBER
60110 OPEN "I",#3,A$ / OPEN THE REALTIME DATA FILE FOR THIS FILE
60120 INPUT #3,TFILE,FLD1,FLD2,TFLD1,TFLD2,TFLD3,TFLD4,ADSUB1,ADSUB2,ADSUB3,ADSUB4,TGTRN / INPUT THE REALTIME DATA
60130 CLOSE #3
60140 RETURN
60200 REM * OPEN REALTIME FILE
60202 IF ROPEN = 5 THEN RETURN / IF THE REALTIME TARGET FILE IS ALREADY OPEN THEN RETURN
60205 GOSUB 13000 / CLEAR SCREEN
60210 AHLD = A / HOLD A
60220 A = TFILE
60230 C = TFILE
60235 PRINT F$(C);" FILE FOR REALTIME TRANSFER "
60240 GOSUB 2300 / GET THE DISK DRIVE THE REALTIME FILE IS ON
60245 C = TFILE
60250 GOSUB 2580 / OPEN AS FILE 3
60260 A = AHLD
60265 ROPEN = 5 / SET OPEN FLAG TO YES
60270 RETURN
60300 REM * PUT DATA ON REALTIME FILE
60310 IF REALFLG(A) >< 2 THEN RETURN / IF REALTIME TRANSFERS NOT SPECIFIED THEN RETURN
60330 REM *** CONTINUE
60340 IF ROPEN < 5 THEN GOSUB 60200 / IF REATIME TARGET FILE IS NOT OPEN THEN OPEN
60400 T3 = X(TGTRN) / THE TARGET RECORD NUMBER
60410 GET #3,T3 / GET THE TARGET RECORD NUMBER
60415 IF CTK = 5 THEN 60600 / IF CORRECT FLAG THEN 60600
60420 T1# = CVD(Z$(TFLD1)) / THE TARGEST FILE INITIAL VALUE
60430 T2# = X(FLD1) / THE VALUE TO ADD TO THE TARGET FILE
60440 IF ADSUB1 = 2 THEN T2# = -1 * T2# / IF SUBTRACT OPTION THEN CHANGE TO A NEGITIVE
60450 LSET Z$(TFLD1) = MKD$(T1# + T2#) / ADD AND PUT RESULT IN FILE BUFFER
60460 IF TFLD2 = 0 THEN 60600 / IF NO SECOND TRANSFER
60520 T1# = CVD(Z$(TFLD2)) / VALUE OF TARGET FIELD
60540 IF ADSUB2 = 2 THEN T2# = -1 * T2# / IF SUBTRACT OPTION THEN MAKE NEGITIVE
60550 LSET Z$(TFLD2) = MKD$(T1# + T2#) / ADD AND PUT SUM IF FILE BUFFER
60600 REM * SECOND TRANSFER
60605 IF CTK = 4 THEN 60900 / IF DO NOT CORRECT THIS TRANSFER FLAG
60610 IF FLD2 = 0 THEN 60900 / IF NO SECOND TRANSFER
60620 T1# = CVD(Z$(TFLD3)) / INITIAL VALUE OF TRANSFER FIELD
60630 T2# = X(FLD2) / SOURCE FIELD
60640 IF ADSUB3 = 2 THEN T2# = -1 * T2# / IF SUBTRACT OPTION THEN MAKE NEGITIVE
60650 LSET Z$(TFLD3) = MKD$(T1# + T2#) / ADD AND PUT SUM IF FILE BUFFER
60660 IF TFLD4 = 0 THEN 60900 / IF NO SECOND TRANSFER
60720 T1# = CVD(Z$(TFLD4)) / INITIAL VALUE OF TARGER FIELD
60740 IF ADSUB4 = 2 THEN T2# = -1 * T2# / IF SUBTRACT OPTION THEN MAKE NEGITIVE
60750 LSET Z$(TFLD4) = MKD$(T1# + T2#) / ADD PUT SUM IN FILE BUFFER
60900 PUT #3,T3 / PUT TARGET RECORD ON DISK
60920 CTK = 1 / RESET CORRECT FLAG TO NO
60980 RETURN
61000 REM * CORECT DATA ON REALTIME FILE
61050 CTK = 4 / SET CORRECT FLAG
61060 XHLD1 = X(N) / HOLD X
61100 X(N) = I# - X(N) / DIFFERENCE BETWEEN OLD VALUE AND CORRECTION
61120 GOSUB 60300 / UPDATE REALTIME FILE
61130 X(N) = XHLD1 / RETURN VALUE OF X
61140 RETURN
61200 XHLD1 = X(N) / HOLD X
61205 X(N) = I# - X(N) / DIFFERENCE BETWEEN OLD VALUE AND CORRECTION
61215 CTK = 5 / SET CORRECT FLAG
61220 GOSUB 60300 / UPDATE REALTIME FILE
61230 X(N) = XHLD1 / RETURN VALUE OF X
61240 RETURN
61300 REM * CORRECT REALTIME FILE FOR OVERWRITE
61330 GET #1,RN / GET OLD RECORD
61340 X1# = CVD(X$(FLD1)) / TRANSFERED FIELD 1
61350 X2# = CVD(X$(FLD2)) / TRANSFERED FIELD 2
61355 X3# = CVI(X$(TGTRN)) / OLD TARGET RECORD NUMBER
