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_R160.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
1KB
|
42 lines
REMARK ****************************************\
* P/R160.BAS PAYROLL DEDUCTION RESET *\
* 5/15/79 4:39 PM *\
****************************************
%INCLUDE CURSOR
6000 PRINT CLEAR.SCREEN$;"P/R DEDUCTION RESET"
PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"
6000.1 IF CONSTAT%=0 THEN GOTO 6000.1 REMARK WAIT FOR <RETURN> OR CTRL-C FROM KEYBOARD
A%=CONCHAR%
IF A%=03H THEN GOTO 6130 REMARK IF CTRL-C WAS ENTERED, ABORT PROGRAM
IF A% <> 0DH THEN GOTO 6000.1 REMARK KEEP POLLING KEYBOARD IF NOT <RETURN>
PRINT "WORKING...DO NOT INTERRUPT"
Y3=1
OPEN "P/R0F030.DAT" RECL 38 AS Y3 REMARK OPEN PAYROLL DEDUCTION AND TEMPORARY WORK FILES
CREATE "WORKFILE.DAT" RECL 38 AS 2
IF END #Y3 THEN 6120
6035 READ #Y3;D1,D2,D3,D4,D1$,D5,D6 REMARK READ DEDUCTION RECORD
IF D4>=10 THEN D4=D4-10 REMARK RESET USED DEDUCTION RECORDS
IF D4=0 AND D1<9000000000 THEN 6035 REMARK IF DEDUCTION IS THIS TIME ONLY, DELETE IT
REMARK UNLESS IT'S THE TRAILER RECORD
IF D4=2 THEN D4=3:GOTO 6040 REMARK RESET ALTERNATE PAY PERIOD DEDUCTIONS
IF D4=3 THEN D4=2
6040 PRINT #2;D1,D2,D3,D4,D1$,D5,D6 REMARK REWRITE THE RECORD
GOTO 6035
6120 CLOSE 2:DELETE 1
A%=RENAME("P/R0F030.DAT","WORKFILE.DAT") REMARK DELETE AND RENAME DEDUCTION FILE
6130 PRINT CLEAR.SCREEN$;"P/R DEDUCTION RESET LOADING MENU"
CHAIN "P/R000" REMARK EXIT PROGRAM AND LOAD MENU