home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG045.ARK
/
P_R110.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
7KB
|
258 lines
REMARK *********************************************\
* P/R110.BAS DEDUCTION FILE MAINTENANCE *\
* 5/16/79 3:15 PM *\
*********************************************
%INCLUDE CURSOR
%INCLUDE PRNMASK
DEF FNEXACT(X0,X1,X2)=X0*100+X1*10+X2 REMARK BINARY SEARCH KEY FUNCTION
GOTO 6000
%INCLUDE SUBS1.BAS
1000 READ #Y3%,X0;D1,D2,D3,D4,D1$,D5,D6:RETURN REMARK READ DEDUCTION RECORD SUBROUTINE
1010 PRINT #Y3%,X0;D1,D2,D3,D4,D1$,D5,D6:RETURN REMARK WRITE DEDUCTION RECORD SUBRUTINE
1060 H%=0 REMARK BINARY SEARCH ROUTINE FOR DEDUCTION FILE
IF RECORD.COUNT%<1 THEN L%=1:H%=-1:RETURN
READ #Y3%,1;VAR1,VAR2,VAR3 REMARK READ FIRST RECORD IN FILE
VAR1=FNEXACT(VAR1,VAR2,VAR3)
IF K1 < VAR1 THEN H%=-1:L%=1:RETURN REMARK IF KEY IS LOW, RECORD DOES NOT EXIST
IF K1=VAR1 THEN L%=1:RETURN REMARK RETURN IF A MATCH WAS FOUND ON FIRST RECORD
READ #Y3%,RECORD.COUNT%;VAR1,VAR2,VAR3 REMARK READ LAST RECORD IN FILE
VAR1=FNEXACT(VAR1,VAR2,VAR3)
IF K1 > VAR1 THEN H%=-1:L%=RECORD.COUNT%+1:RETURN REMARK IF KEY IS HIGH, RECORD DOES NOT EXIST
IF K1=VAR1 THEN L%=RECORD.COUNT%:RETURN
H%=RECORD.COUNT% REMARK SET SEARCH POINTERS
L%=0
1070 M%=(L%+H%)/2 REMARK DIVIDE DATA SEARCH INTERVAL IN HALF
READ #Y3%,M%;VAR1,VAR2,VAR3
VAR1=FNEXACT(VAR1,VAR2,VAR3)
IF VAR1=K1 THEN L%=M%:RETURN REMARK IF RECORD WAS FOUND, RETURN
IF VAR1>K1 THEN H%=M%
IF VAR1<K1 THEN L%=M%
IF H%=M%+1 THEN H%=-1:L%=M%+1:RETURN REMARK IF SEARCH EXHAUSTED, SET FLAG AND RETURN
GOTO 1070
5300 X1=466:X2=2:X3=0:X4=16:GOSUB 345 REMARK CHANGE DEDUCTION FREQUENCY CODE
IF X0<=6 OR X0>=10 THEN D4=X0:RETURN\
ELSE\
X2$="OUT OF RANGE":GOSUB 615:GOTO 5300 REMARK FLASH ERROR MESSAGE IF FREQUENCY ENTERED WAS INVALID
5350 X1=522:X2=10:X3=0:X4=0:GOSUB 345 REMARK CHANGE DEDUCTION DESCRIPTION
D1$=X0$
RETURN
5400 IF D2 > 1\ REMARK ENTER/CHANGE RATE ON DEDUCTION RECORDS
THEN\
X1=591:X2=5:X3=0:X4=99.99:GOSUB 345\ REMARK ENTER RATE FOR DEDUCTION-TYPE RECORDS ONLY
ELSE\
X2$="INVALID":GOSUB 615:RETURN REMARK PROHIBIT RATE ENTRY ON MISCELLANEOUS INCOME
D5=X0
D6=0 REMARK IF RATE WAS ENTERED, ZERO OUT DEDUCTION AMOUNT
5410 X1=576:GOSUB 210
GOSUB 7045
RETURN
5450 X1=653:X2=7:X3=0:X4=9999.99:GOSUB 345 REMARK CHANGE DEDUCTION OR MISC. INCOME AMOUNT
D6=X0
D5=0 REMARK IF AMOUNT WAS ENTERED, ZERO OUT RATE
GOTO 5410
6000 MASK2$="##"
Y3%=1
OPEN "CRT" RECL 1100 AS 19 REMARK OPEN CRT MASK FILE
RECORD.COUNT%=0
OPEN "P/R0F030.DAT" RECL 38 AS Y3%
IF END #Y3% THEN 6013 REMARK SET EOF BRANCH DESTINATION
6010 READ #Y3%;DUMMY REMARK LOCATE END OF DEDUCTION FILE
IF DUMMY =9000000000 THEN 6013
RECORD.COUNT%=RECORD.COUNT% + 1
GOTO 6010
6013 IF RECORD.COUNT%=0 THEN D1=9000000000:X0=1:GOSUB 1010
X0=7:GOSUB 260 REMARK DISPLAY CRT MASK FOR FILE MAINTENANCE
6014 X2$="ENTER OPERATION(0=EXIT;1=ADD;2=INQUIRE, CHANGE OR DELETE)"
X2=1:X3=0:X4=2:GOSUB 665 REMARK REQUEST OPERATON CODE
IF X0=0\ REMARK LOAD MENU IF ZERO OPERATION CODE WAS ENTERED
THEN\
PRINT CLEAR.SCREEN$;"P/R DEDUCTION F/M LOADING MENU":\
CHAIN "P/R000"
IF X0=1 THEN 6200 REMARK BRANCH TO NEW RECORD ROUTINE IF CODE = 1
6015 X1=273:X2=3:X3=0:X4=999:GOSUB 345 REMARK ENTER EMPLOYEE NUMBER FOR DEDUCTION RECORD
IF X0=0 THEN GOSUB 265:GOTO 6014 REMARK IF EMPLOYEE NUMBER =0, PROMPT FOR OPERATION
D1=X0
K1=FNEXACT(X0,0,0) REMARK USE BINARY SEARCH TO FIND DEDUCTION RECORD
GOSUB 1060
READ #Y3%,L%;VAR1 REMARK READ DEDUCTION RECORD LOCATED BY SEARCH
IF VAR1 <> D1 THEN \
X2$="NOT ON FILE":GOSUB 615:GOTO 6015 REMARK IF RECORD NOT FOUND, FLASH ERROR MESSAGE
REC%=L%
X0=REC%
GOSUB 1000 REMARK READ DEDUCTION RECORD FROM DISK
6045 X1=256
GOSUB 7020 REMARK DISPLAY RECORD ON CRT
6055 X2$="ENTER FIELD TO CHANGE (0=NONE; 99=DELETE)"
X2=2:X3=0:X4=99
GOSUB 665 REMARK ENTER FIELD TO CHANGE; 0=NONE, 99=DELETE
IF X0>4 AND X0<99 THEN 6055 REMARK IF FIELD ENTERED IS INVALID, RE-PROMPT OPERATOR
IF X0=0 THEN GOTO 6075
IF X0=99 THEN GOTO 6080
ON X0 GOSUB 5300,5350,5400,5450:GOTO 6055 REMARK IF A FIELD WAS SELECTED, CHANGE IT
6075 X0=REC%:GOSUB 1010 REMARK SAVE DEDUCTION RECORD
D1.0=D1
REC%=REC%+1:X0=REC%:GOSUB 1000 REMARK READ SEQUENTIALLY FOR NEXT DEDUCTION RECORD
IF D1 > D1.0 THEN GOTO 6015 ELSE GOTO 6045 REMARK IF NO FURTHER RECORD FOR EMPLOYEE, PROMPT\
FOR NEW EMPLOYEE; ELSE, DISPLAY NEXT RECORD
6080 X2$="ENTER DELETE CODE"
X2=3:X3=0:X4=0
GOSUB 665 REMARK ENTER 3-CHARACTER DELETE CODE
IF X0$<>"DEL" THEN 6055 REMARK IF INVALID CODE ENTERED, ABORT OPERATION
FOR I%= REC% TO RECORD.COUNT% REMARK WRITE OVER DELETED RECORD
READ #Y3%,I%+1;LINE DATA$
PRINT USING "&";#Y3%,I%;DATA$
NEXT I%
RECORD.COUNT%=RECORD.COUNT%-1 REMARK DECREMENT ACTIVE RECORD COUNT
X2$="RECORD DELETED":GOSUB 615 REMARK FLASH RECORD DELETION MESSAGE
GOTO 6015
6200 GOSUB 265
D1=0:D2=0:D3=0:D4=0:D5=0:D6=0 REMARK ENTER NEW DEDUCTION RECORD
D1$=""
X1=273:X2=3:X3=0:X4=999:GOSUB 345 REMARK ENTER EMPLOYEE NUMBER
IF X0=0 THEN GOSUB 265:GOTO 6014 REMARK IF EMPLOYEE NUMBER=0, PROMPT FOR OPERATION
D1=X0
6210 X1=339:X2=1:X3=1:X4=4:GOSUB 345 REMARK ENTER RECORD TYPE
D2=X0
X1=403:X2=1:X3=0:X4=9:GOSUB 345 REMARK ENTER TAX/DEDUCTION PRIORITY CODE
D3=X0
GOSUB 5300 REMARK ENTER FREQUENCY CODE
GOSUB 5350 REMARK ENTER DESCRIPTION
IF D2 > 1 THEN GOSUB 5400 REMARK ENTER RATE IF THIS IS A DEDUCTION-TYPE RECORD
IF D5=0 THEN GOSUB 5450 REMARK IF RATE WAS NOT ENTERED, ENTER AMOUNT
6235 X2$="ENTER FIELD TO CHANGE (0=NONE; 99=CANCEL)" REMARK PROMPT FOR FIELD TO CHANGE
X2=2:X3=0:X4=99:GOSUB 665
IF X0=99 THEN X2$="CANCELLED":GOSUB 615:GOTO 6200 REMARK IF CANCEL CODE WAS ENTERED, RESTART OPERATION
IF X0=0 THEN GOTO 6255
ON X0 GOSUB 5300,5350,5400,5450
GOTO 6235
6255 K1=FNEXACT(D1,D2,D3)
GOSUB 1060 REMARK SEARCH FILE FOR INSERTION POINT
FOR I%=RECORD.COUNT%+1 TO L% STEP -1
READ #Y3%,I%;LINE DATA$ REMARK MOVE FILE DOWN TO ALLOW FOR NEW RECORD INSERTION
PRINT USING "&";#Y3%,I%+1;DATA$
NEXT I%
6258 RECORD.COUNT% = RECORD.COUNT% + 1 REMARK INCREMENT ACTIVE RECORD COUNT
X0=L%
GOSUB 1010 REMARK WRITE THE NEW RECORD AT POSITION L
CLOSE 1
OPEN "P/R0F030.DAT" RECL 38 AS 1 REMARK SAVE ALTERED FCB IN CASE OF A FILE CRASH
GOTO 6200 REMARK GO BACK FOR ANOTHER NEW RECORD
7020 X1=270 REMARK DISPLAY DEDUCTION RECORD ON CRT
GOSUB 210
PRINT USING MASK6$;D1 REMARK DISPLAY EMPLOYEE NUMBER
X1=19:GOSUB 215
PRINT D2 REMARK DISPLAY RECORD TYPE
X1=19:GOSUB 215
PRINT D3 REMARK DISPLAY TAX CODE/DEDUCTION PRIORITY
X1=19:GOSUB 215
PRINT USING MASK2$;D4 REMARK DISPLAY FREQUENCY CODE
X1=11:GOSUB 215
PRINT " "
X1=522:GOSUB 210:PRINT D1$ REMARK DISPLAY DEDUCTION DESCRIPTION
7045 X1=16:GOSUB 215
PRINT USING MASK2.2$;D5 REMARK DISPLAY RATE
X1=14:GOSUB 215
PRINT USING MASK4.2$;D6 REMARK DISPLAY AMOUNT
RETURN