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_R210.BAS
< prev
next >
Wrap
BASIC Source File
|
1983-08-29
|
9KB
|
295 lines
REMARK *******************************************\
* P/R210.BAS HISTORY FILE MAINTENANCE *\
* 5/17/79 11:26 PM *\
*******************************************
%INCLUDE CURSOR
DIM H1(3),H2(9),I1(3),I2(9),G2$(5),G3(5)
DEF FNEXACT(X0,X1)=X0*1000000+X1 REMARK FUNCTION TO FORM SEARCH KEY
WRITTEN=999999
YES=1
GOTO 6000
%INCLUDE GENINFO
%INCLUDE SUBS1
%INCLUDE HISTORY
1000 H=0:Y2=1:RECORD.COUNT=HISTORY.RECORDS:GOSUB 1060 REMARK ROUTINE TO SEARCH HISTORY FILE AND HISTORY INPUT FILE
IF H <>-1 OR FINDNEXT=YES THEN RETURN
1010 H=0:Y2=2:RECORD.COUNT=NEW.RECORDS%
SEARCH.FAILURE%=0
GOSUB 1060
IF VAR1 <> INT(K/1000000) THEN SEARCH.FAILURE%=YES
RETURN
%INCLUDE PR-SEARCH
5300 X1=341:X2=6:X3=1:X4=999999:GOSUB 345 REMARK ENTER CHECK NUMBER
H1(3)=X0
RETURN
5310 X1=274+F*64:X2=9:X3=0:X4=999999.99:GOSUB 345 REMARK ENTER HOURS AND PAY SUMMARY FIELDS
H2(F-1)=X0
RETURN
5320 X1=274+F*64:X2=9:X3=0:X4=999999.99:GOSUB 345 REMARK ENTER DEDUCTION AMOUNT
5325 H2(9)=H2(9)-H2(F-1)+X0 REMARK ACCUMULATE TO TOTAL DEDUCTIONS
5330 H2(F-1)=X0
5335 X1=914:GOSUB 210 REMARK RE-DISPLAY TOTAL DEDUCTIONS AFTER FIELD ENTRY
PRINT USING A1$; H2(9)
5340 RETURN
6000 A1$="######.##"
B$="######"
Y2=1
Y9=4
OPEN "P/R0F120.DAT" RECL 102 AS 1 REMARK OPEN PAYROLL HISTORY AND HISTORY INPUT FILES
CREATE "HISTORY.DAT" RECL 102 AS 2
OPEN "CRT" RECL 1100 AS 19 REMARK OPEN CRT MASK FILE
OPEN "G/I0F010.DAT" RECL 200 AS Y9:GOSUB 700 REMARK OPEN AND LOAD GENERAL INFORMATION FILE
X0=9:GOSUB 260 REMARK LOAD HISTORY FILE MAINTENANCE CRT MASK
6015 X2=1:X3=0:X4=2 REMARK ENTER OPERATION CODE
X2$="ENTER OPERATION(0=EXIT;1=ADD;2=INQUIRE,CHANGE OR DELETE)"
GOSUB 665
IF X0 = 0 THEN\ REMARK IF ZERO ENTERED, BRANCH TO WRAPUP ROUTINES
X1=64:GOSUB 210:PRINT "WORKING... DO NOT INTERRUPT!";TAB(70):\
GOTO 9000
IF X0=1 THEN 6200 REMARK BRANCH TO ADD ROUTINE IF CODE =1
REMARK CHANGE HISTORY RECORD ROUTINE
6025 X1=265:X2=3:X3=0:X4=999:GOSUB 345 REMARK ENTER EMPLOYEE NUMBER
IF X0>0 THEN EMPL.NO=X0 ELSE GOTO 6015
FINDNEXT=YES
K=FNEXACT(EMPL.NO,0):GOSUB 1000 REMARK SEARCH HISTORY FILE FOR FIRST RECORD WHICH\
CORRESPONDS TO EMPLOYEE ENTERED
6055 IF VAR1 <> EMPL.NO AND SEARCH.FAILURE% <> YES\
THEN GOSUB 1010
IF VAR1 > EMPL.NO OR L>RECORD.COUNT THEN X2$="NOT ON FILE":\ REMARK IF RECORD NOT FOUND, FLASH BULLETIN TO OPERATOR
GOSUB 615:GOTO 6025
READ #Y2,L;VAR1,VAR2,VAR3
IF VAR3=9999999 THEN\ REMARK IF RECORD HAS BEEN LOGICALLY DELETED, SKIP IT
L=L+1:GOTO 6055
IF VAR1 > EMPL.NO THEN\
X2$="NOT ON FILE":GOSUB 615:GOTO 6025
6060 Y6=Y2:EMPL.RECORD%=L
X0=EMPL.RECORD%
GOSUB 905
6065 X1=265:GOSUB 210 REMARK DISPLAY RECORD ON CRT
GOSUB 7015
6070 X2=2 REMARK ENTER FIELD TO CHANGE ON RECORD
X3=0
X4=99
X2$="ENTER FIELD TO CHANGE (0=NONE; 99=DELETE)"
GOSUB 665
IF X0 > 10 AND X0<99 THEN GOTO 6070 REMARK REJECT INVALID FIELD NUMBER
IF X0=0 THEN 6090 REMARK SAVE RECORD IF CODE=0
IF X0=99 THEN 6150 REMARK BRANCH TO DELETE ROUTINE IF CODE=99
F=X0
ON F GOSUB 5300,5310,5310,5310,5310,5320,5320,5320,5320,5320 REMARK CHANGE FIELD INDICATED BY FIELD NUMBER ENTERED
GOTO 6070
6090 X0=EMPL.RECORD%:GOSUB 910
FINDNEXT=YES
6095 H1(2)=H1(2)+1
K=FNEXACT(H1(1),H1(2))
GOSUB 1000 REMARK FIND NEXT EMPLOYEE HISTORY RECORD
6100 IF VAR1 <> H1(1) OR L > RECORD.COUNT\
AND SEARCH.FAILURE=0 THEN GOSUB 1010 REMARK SEARCH FOR NEXT RECORD ON HISTORY FILE
IF VAR1 <> H1(1) OR L > RECORD.COUNT THEN GOTO 6025 REMARK IF NO MORE RECORDS FOR THIS EMPLOYEE, GET NEW NUMBER
READ #Y2,L;VAR1,VAR2,VAR3
IF VAR3=9999999 THEN GOTO 6095 ELSE GOTO 6060 REMARK IGNORE LOGICALLY DELETED HISTORY RECORDS
6150 X2=3:X3=0:X4=0 REMARK IF VERIFY THE DELETE OPERATION BY ENTERING CODE
X2$="ENTER DELETE CODE"
GOSUB 665
IF X0$ = "DEL" THEN H1(3)=9999999:\
X0=EMPL.RECORD%:GOSUB 910:\
X2$="RECORD DELETED":GOSUB 615:\
GOTO 6095\
ELSE GOTO 6070 REMARK REJECT IMPROPER CODE AND RE-PROMPT FOR EMPLOYEE NUMBER
6200 GOSUB 265
X1=265:X2=3:X3=0:X4=999:GOSUB 345 REMARK ENTER EMPLOYEE NUMBER TO ADD TO HISTORY FILE
FINDNEXT=0
6210 IF X0=0 THEN GOTO 6015 REMARK REQUEST OPERATION CODE IF ZERO EMPLOYEE NUMBER
DIM H1(3),H2(9) REMARK RE-INITIALIZE HISTORY RECORD ARRAY
H1(1)=X0
X1=290
GOSUB 673 REMARK INPUT CHECK DATE
H1(2)=X0
H1(2)=INT(X0/100)*100 REMARK CONVERT DATE TO YYMMDD FROM MMDDYY
H1(2)=(X0-H1(2))*10000+H1(2)/100
K=FNEXACT(H1(1),H1(2))
GOSUB 1000 REMARK CHECK FOR DUPLICATE RECORD ON FILE
IF H=-1 THEN GOTO 6230
READ #Y2,L;VAR1,VAR2,VAR3
IF VAR3 <> 9999999 THEN\ REMARK IF 'NEW' RECORD WAS FOUND ON THE FILE AND IT
X2$="ALREADY ON FILE":GOSUB 615:GOTO 6200\ REMARK HASN'T BEEN DELETED, FLASH ERROR AND RE-PROMPT;
ELSE\ REMARK OTHERWISE, REUSE THE LOGICALLY DELETED RECORD
RE.USE.DELETED.RECORD=YES:Y6=Y2:EMPL.RECORD%=L:GOTO 6240 REMARK TO MAINTAIN PERFECT ORDER IN THE FILE
6230 EMPL.RECORD%=L:Y6=2
6240 GOSUB 5300 REMARK INPUT CHECK NUMBER
6245 FOR F=2 TO 5 REMARK ENTER HOURS AND PAY
GOSUB 5310
NEXT F
6250 FOR F=6 TO 9 REMARK ENTER DEDUCTION AMOUNTS
GOSUB 5320
NEXT F
6255 X2=2:X3=0:X4=99
X2$="ENTER FIELD TO CHANGE (0=NONE, 99=CANCEL)":GOSUB 665 REMARK ALLOW CHANGES TO ENTERED FIELDS
IF X0=0 THEN 6275 REMARK BRANCH IF NO CHANGES
IF X0=99 THEN X2$="CANCEL":GOSUB 615:GOTO 6200 REMARK RESTART DATA ENTRY IF CANCEL CODE WAS ENTERED
IF X0 > 10 AND X0 < 99 THEN GOTO 6255 REMARK REJECT INVALID FIELD NUMBERS
F=X0
ON F GOSUB 5300,5310,5310,5310,5310,5320,5320,5320,5320,5320 REMARK CHANGE FIELDS SPECIFIED BY OPERATOR
GOTO 6255
6275 IF RE.USE.DELETED.RECORD=YES THEN GOTO 6285
IF EMPL.RECORD% > NEW.RECORDS% THEN GOTO 6280 REMARK INSERT OR APPEND NEW RECORD INTO HISTORY INPUT FILE
FOR I%=NEW.RECORDS% TO EMPL.RECORD% STEP -1
READ #2,I%;LINE X0$
PRINT USING "&";#2,I%+1;X0$
NEXT I%
6280 NEW.RECORDS%=NEW.RECORDS%+1
6285 X0=EMPL.RECORD%:GOSUB 910 REMARK WRITE THE NEW RECORD
CLOSE 2:OPEN "HISTORY.DAT" RECL 102 AS 2 REMARK CLOSE AND RE-OPEN FILE TO SAVE FCB CONTENTS
RE.USE.DELETED.RECORD=0
GOTO 6200
7015 X1=265:GOSUB 210 REMARK DISPLAY PAYROLL HISTORY RECORD ON CRT
PRINT USING "###"; H1(1); REMARK DISPLAY EMPLOYEE NUMBER
X1=23:GOSUB 215 REMARK DISLPAY DATE IN MMDDYY FORMAT
X0=H1(2)*100-INT(H1(2)/10000)*(1000000-1)
GOSUB 680.5
PRINT
X1=22:GOSUB 215 REMARK DISPLAY CHECK NUMBER
PRINT USING B$; H1(3)
FOR I%=1 TO 9 REMARK DISPLAY REMAINING PAYROLL HISTORY FIELDS
X1=19:GOSUB 215
PRINT USING A1$; H2(I%)
NEXT I%
RETURN
9000 CLOSE 1,19 REMARK CLOSE ALL OPENED FILES...
IF NEW.RECORDS% = 0 THEN DELETE 2:GOTO 9910
CLOSE 2
9005 OPEN "P/R0F120.DAT" RECL 102 AS 1,"HISTORY.DAT" RECL 102 AS 2 REMARK REOPEN FILES NEEDED FOR MERGE
CREATE "WORKFILE.DAT" RECL 102 AS 3 BUFF 40 RECS 128
GOSUB 9010 REMARK READ FIRST HISTORY RECORD
GOSUB 9020 REMARK READ FIRST HISTORY INPUT RECORD
9007 IF H1(1)=WRITTEN AND I1(1)=WRITTEN THEN GOTO 9900
IF I1(1) = WRITTEN THEN GOTO 9008 REMARK WRITE REMAINING HISTORY RECORDS IF EOF MASTER
IF FNEXACT(H1(1),H1(2)) >= FNEXACT(I1(1),I1(2)) THEN\ REMARK WRITE THE NEW HISTORY RECORD IF IT IS LOWER
OUTPUT.COUNT%=OUTPUT.COUNT%+1:\
PRINT #3;I1(1),I1(2),I1(3),I2(1),I2(2),I2(3),I2(4),\
I2(5),I2(6),I2(7),I2(8),I2(9):I1(1)=WRITTEN:GOSUB 9020
IF H1(1)=WRITTEN THEN GOTO 9007
9008 IF FNEXACT(I1(1),I1(2)) >= FNEXACT(H1(1),H1(2)) THEN\ REMARK WRITE PAYROLL HISTORY RECORD IF IT IS LOWER
GOSUB 9030:H1(1)=WRITTEN:GOSUB 9010
GOTO 9007
9010 IF END #1 THEN 9011 REMARK READ SEQUENTIALLY FROM PAYROLL HISTORY FILE
READ #1;H1(1),H1(2),H1(3),H2(1),H2(2),H2(3),H2(4),\
H2(5),H2(6),H2(7),H2(8),H2(9)
IF H1(3)=9999999 THEN GOTO 9010
RETURN
9011 H1(1)=WRITTEN
RETURN
9020 IF END #2 THEN 9021 REMARK READ FROM PAYROLL HISTORY INPUT FILE
READ #2;I1(1),I1(2),I1(3),I2(1),I2(2),I2(3),I2(4),\
I2(5),I2(6),I2(7),I2(8),I2(9)
IF I1(3)=9999999 THEN GOTO 9020
RETURN
9021 I1(1)=WRITTEN
RETURN
9030 PRINT #3;H1(1),H1(2),H1(3),H2(1),H2(2),H2(3),H2(4),\ REMARK WRITE PAYROLL HISTORY RECORD TO WORKFILE
H2(5),H2(6),H2(7),H2(8),H2(9)
OUTPUT.COUNT%=OUTPUT.COUNT%+1
RETURN
9900 DELETE 1,2 REMARK REPLACE HISTORY FILE WITH WORKFILE
CLOSE 3
A%=RENAME("P/R0F120.DAT","WORKFILE.DAT")
HISTORY.RECORDS=OUTPUT.COUNT%
GOSUB 720 REMARK WRITE OUT NEW FILE LENGTH
9910 PRINT CLEAR.SCREEN$;\
"P/R HISTORY FILE MAINTENANCE LOADING MENU" REMARK DISPLAY EXIT MESSAGE
CHAIN "P/R000"