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_R330.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
5KB
|
174 lines
REMARK **********************************\
* P/R330.BAS JOB CLOSE *\
* 5/09/79 10:00 AM *\
**********************************
%INCLUDE CURSOR
DIM W(2),W1(2),W2(14),W2$(2),G3(5),G2$(5),JOB.GRID(2,25),K(14),R(14)
DEF FNR(A1)=INT(A1*100+.5)/100 REMARK ROUNDING FUNCTION
DEF FNEXACT(M1,M2)=M1*1000+M2 REMARK KEY LOCATOR FUNCTION
GOTO 6000
%INCLUDE SUBS1
%INCLUDE GENINFO
%INCLUDE PR-SEARC
%INCLUDE JOBFILE
5300 W2$(1)="1" REMARK SET AN ACTIVE JOB TO 'COMPLETE' STATUS
W1(2)=G3(1)
X0=L
GOSUB 1110
RETURN
5310 W2$(1)="9" REMARK SET ANY JOB TO 'CANCELLED' STATUS
X0=L
GOSUB 1110
RETURN
5320 W2$(1)="9" REMARK CANCEL AND REDISTRIBUTE AMONG LIKE JOBS
X0=L
GOSUB 1110 REMARK REWRITE HEADER WITH 'CANCELLED' STATUS
J$=W2$(2)
5325 L=L+1 REMARK READ EACH DETAIL RECORD, ACCUMULATING COST AMOUNTS
X0=L
IF X0 > JOB.RECORDS THEN GOTO 5340
GOSUB 1100
IF W(1)=JOB.GRID(1,J%)\ REMARK IF NOT A NEW JOB, KEEP ADDING TO DISTRIBUTION TOTAL
THEN\
FOR I%=1 TO 14:\
K(I%)=K(I%)+W2(I%):\
R(I%)=R(I%)+W2(I%):\
NEXT I%:\
GOTO 5325
5340 FILE.POINTER% = 1
X0=1
GOSUB 1100
5350 IF W(2)<>0 THEN\ REMARK PRINT ERROR MESSAGE IF NO HEADER RECORD WAS FOUND
LPRINTER:\
PRINT "NO HEADER ON JOB";W(1):\
RETURN
Z=W(1) REMARK SET CURRENT JOB NUMBER TO NEW JOB NUMBER
5370 FILE.POINTER%=FILE.POINTER%+1
IF FILE.POINTER% > JOB.RECORDS THEN GOTO 5400
X0=FILE.POINTER%:GOSUB 1100
IF W(1)<>Z THEN 5350
IF W2$(1)="9" OR W2$(1)="D" THEN GOTO 5370 REMARK IF JOB IS CANCELLED, DELETED, NOT THE SAME TYPE
IF JOB.GRID(2,J)=4 AND W2$(2)<>J$ THEN GOTO 5370 REMARK OR A NON-OVERHEAD JOB, DO NOT ACCUMULATE IT
IF JOB.GRID(2,J)=3 AND W2$(2) < "2" THEN GOTO 5370
IF W2(3)=-1 THEN GOTO 5370
FOR I%=1 TO 14 REMARK ACCUMULATE TOTAL FOR REDISTRIBUTION
R(I%)=R(I%)+W2(I%)
NEXT I%
GOTO 5370
5400 FILE.POINTER%=1:X0=FILE.POINTER% REMARK GO BACK THROUGH THE FILE TO PRO-RATE JOBS
GOSUB 1100
IF W(2)<>0 THEN GOSUB 5350
5410 Z=W(1)
IF W2$(1)="9" OR W2$(1)="D" THEN GOTO 5440 REMARK IF JOB IS DELETED, CANCELLED, NOT SAME TYPE
IF JOB.GRID(2,J)=4 AND W2$(2)<>J$ THEN GOTO 5440 REMARK OR NON-OVERHEAD, PRO-RATE NO FUNDS TO IT
IF JOB.GRID(2,J)=3 AND W2$(2)<"2" THEN GOTO 5440
5425 FILE.POINTER%=FILE.POINTER% + 1 REMARK READ SEQUENTIALLY THROUGH JOB FILE
X0=FILE.POINTER%
IF X0>JOB.RECORDS THEN RETURN
GOSUB 1100
IF W(1)<>Z THEN 5410 REMARK IF NEW JOB WAS JUST READ, BRANCH BACK TO CHECK IT
5435 FOR I%=1 TO 14
IF R(I%)>0 THEN W2(I%)=W2(I%)+FNR(W2(I%)/R(I%)*K(I%))
5437 NEXT I%
X0=FILE.POINTER%:GOSUB 1110 REMARK REWRITE JOB DETAIL RECORD WITH PRORATED TOTALS
GOTO 5425
5440 FILE.POINTER%=FILE.POINTER% + 1 REMARK READ THROUGH INELIGIBLE JOBS
X0=FILE.POINTER%
IF X0>JOB.RECORDS THEN RETURN
GOSUB 1100
IF W(1)=Z THEN 5440
GOTO 5410
6000 Y9=2
Y6=1:Y2=Y6
CTRL.C%=1
OPEN "JOB0F100.DAT" RECL 160 AS 1,\
"G/I0F010.DAT" RECL 200 AS 2,\ REMARK OPEN DATA FILES
"CRT" RECL 1100 AS 19
GOSUB 700 REMARK LOAD GENERAL INFORMATION FILE
RECORD.COUNT=JOB.RECORDS
6015 X0=16:GOSUB 260 REMARK DISPLAY CRT MASK FOR JOB CLOSE
6020 FOR J%=1 TO 25 REMARK ENTER GRID OF JOB NUMBERS AND ACTION CODES
Z=375+INT((J%-1)/5)*4+12*J%
6025 X1=Z:X2=6:X3=0:X4=999999:GOSUB 345 REMARK ENTER JOB NUMBER
IF X%=3 THEN GOTO 6120 REMARK IF CTRL-C WAS DEPRESSED, EXIT PROGRAM
IF X0=0 THEN 6045 REMARK END ROUTINE IF ZERO ENTERED
JOB.GRID(1,J%)=X0
6030 K=FNEXACT(JOB.GRID(1,J%),0) REMARK SEARCH FOR A VALID JOB HEADER
GOSUB 1060
IF H <> -1 THEN X0=L:GOSUB 1100 REMARK IF A VALID JOB WAS NOT FOUND, REJECT IT
IF H=-1 OR W2$(1)="D"\
THEN\
X2$="NOT ON FILE":GOSUB 615:\
GOTO 6025
X1=Z+9:X2=1:X3=0:X4=4:GOSUB 345 REMARK ENTER ACTION CODE
JOB.GRID(2,J%)=X0
6040 NEXT J%
6045 X2=1:X3=0:X4=5:X2$="ENTER ROW TO CHANGE (0=NONE)":GOSUB 665 REMARK PROMPT OPERATOR FOR CHANGES TO GRID
IF X0=0 THEN 6100 REMARK IF FIELD ENTERED=0, START PROCESSING
I%=X0
6050 X2=1:X3=1:X4=5:X2$="ENTER COLUMN TO CHANGE":GOSUB 665 REMARK PROMPT OPERATOR FOR COLUMN TO CHANGE ON GRID
J%=X0
Z=311+I%*64+J%*12
6055 X1=Z:X2=6:X3=0:X4=999999:GOSUB 345 REMARK ENTER NEW JOB NUMBER
JOB.GRID(1,J%+(I%-1)*5)=X0
6060 K=FNEXACT(X0,0):GOSUB 1060 REMARK CHECK JOB FILE FOR A VALID ENTRY
IF H<>-1 THEN X0=L:GOSUB 1100
IF H=-1 OR W2$(1) = "D"\ REMARK IF AN INVALID JOB NUMBER WAS ENTERED, REJECT IT
THEN\
X2$="NOT ON FILE":GOSUB 615:\
GOTO 6055
6070 X1=Z+9:X2=1:X3=0:X4=4:GOSUB 345 REMARK ENTER ACTION CODE
JOB.GRID(2,J%+(I%-1)*5)=X0
GOTO 6045
6100 Z=-1 REMARK BEGIN JOB CLOSE PROCESSING
PRINT "WORKING...DO NOT INTERRUPT"
FOR J%=1 TO 25
IF JOB.GRID(1,J%)=0 THEN 6117
6105 K=FNEXACT(JOB.GRID(1,J%),0):GOSUB 1060 REMARK SEARCH FOR GRID ENTRY ON FILE
X0=L
GOSUB 1100 REMARK READ HEADER RECORD
6115 IF JOB.GRID(2,J%) < 1 THEN GOTO 6117
IF JOB.GRID(2,J%)=1 THEN GOSUB 5300
IF JOB.GRID(2,J%)=2 THEN GOSUB 5310
IF JOB.GRID(2,J%)=3 THEN GOSUB 5320
IF JOB.GRID(2,J%)=4 THEN GOSUB 5320
6117 NEXT J%
6120 CONSOLE REMARK TERMINATE PROGRAM AND LOAD MENU
PRINT CLEAR.SCREEN$;"JOB CLOSE LOADING MENU"
CHAIN "P/R000"