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
/
CPMUG044.ARK
/
G_L050.BAS
< prev
next >
Wrap
BASIC Source File
|
1985-02-10
|
12KB
|
378 lines
REMARK **************************************************************
REMARK * GENERAL LEDGER ACCOUNT FILE MAINTENANCE PROGRAM *
REMARK * (G/L050) VERS. OF 3.00 PM 8/8/79 *
REMARK **************************************************************
MASKA$="#####.#"
MASKB$=" #########.##"
MASKC$="######.#/##"
DIM D(7),G3(5),G2$(5)
%INCLUDE CURSOR
DATA "REGULAR", "TITLE ","TOTAL ","HEADING","INCOME STMT. "
DATA "BALANCE SHEET","DB","CR","NO ","YES"
GOTO 6000
%INCLUDE SUBS1
%INCLUDE BINSERCH
%INCLUDE GENINFO
%INCLUDE ACCTFILE
%INCLUDE G/L-INFO
825 IF LINE.COUNT%<55 THEN RETURN REMARK LINE PRINTER ROUTINE
PAGE.COUNT%=PAGE.COUNT%+1
PRINT CHR$(12);TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
X0=G3(1):GOSUB 680.5
PRINT
PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
PRINT
PRINT "ACCOUNT";TAB(10);"NAME";
IF F2<>1 THEN \
PRINT TAB(46);"THIS MO THIS YEAR THIS QTR PREV QTR-1";:\
PRINT" PREV QTR-2 PREV QTR-3 LAST YEAR";
PRINT:PRINT
LINE.COUNT%=6
RETURN
4100 X1=A1:GOSUB 210 REMARK SET CRT LOCATION TO A1
4120 RESTORE REMARK DISPLAY LABEL #X0+1 FROM DATA TABLE
REMARK AT CURRENT CRT LOCATION
FOR I%=1 TO X0+1
READ X0$
NEXT I%
PRINT X0$
RETURN
4140 RESTORE REMARK PRINT LABEL #X0+1 FROM DATA TABLE
REMARK AT TAB POSITION X1
FOR I%=1 TO X0+1
READ X0$
NEXT I%
PRINT TAB(X1);X0$;
RETURN
REMARK ACCOUNT NO. & SUB-ACCOUNT NO. ENTRY ROUTINE
5000 X1=266:X2=7:X3=0:X4=99999.9:GOSUB 345 REMARK ENTER ACCOUNT NUMBER
L1=X0
IF L1=0 THEN RETURN
IF L1<10000 THEN 5000
X1=274:X2=2:X3=0:X4=99:GOSUB 345 REMARK ENTER SUB-ACCOUNT NUMBER
L2=X0
REMARK LOCATE RECORD IN EITHER ACCOUNT FILE OR ADDFILE
RECORD.COUNT%=ACCOUNT.FILE.EXTENT%
Y2=2
K1=L1 + (L2/1000)
GOSUB 10.60 REMARK LOOK IN ACCOUNT FILE FOR RECORD
IF H=-1 THEN \ REMARK LOOK IN ADDFILE FOR RECORD
RECORD.COUNT%=ADDFILE.EXTENT%:\
Y2=3:\
GOSUB 10.60
RETURN
5100 IF F%<1 OR F%>8 THEN 5300 REMARK BRANCH TO ENTER THE VALUE FOR FIELD F%
ON F% GOTO 5120,5140,5180,5200,5220,5240,5260,5280
5120 X1=330:X2=31:X3=0:X4=0:GOSUB 345 REMARK ENTER ACCOUNT NAME
L1$=X0$
RETURN
5140 IF L2=0 THEN L3%=0:X1=401:GOSUB 210:PRINT"0":GOTO 5160 REMARK IF SUB-ACCOUNT NO. IS ZERO, TYPE MUST BE ZERO
X1=401:X2=1:X3=1:X4=3:GOSUB 345 REMARK ENTER ACCOUNT TYPE
L3%=X0
5160 A1=403:X0=L3%:GOSUB 4100
RETURN
5180 X1=465:X2=1:X3=1:X4=2:GOSUB 345 REMARK ENTER REPORT TYPE
L4%=X0
A1=467:X0=L4%+3:GOSUB 4100
RETURN
5200 X1=529:X2=1:X3=1:X4=2:GOSUB 345 REMARK ENTER NORMAL BALANCE
L5%=X0
A1=531:X0=L5%+5:GOSUB 4100
RETURN
5220 X1=593:X2=1:X3=0:X4=9:GOSUB 345 REMARK ENTER TOTAL LEVEL
L6%=X0
RETURN
5240 X1=657:X2=1:X3=0:X4=9:GOSUB 345 REMARK ENTER EXTRA LINE ADVANCE
L7%=X0
RETURN
5260 X1=721:X2=1:X3=0:X4=1:GOSUB 345 REMARK ENTER WHETHER THIS IS A SALES ACCOUNT
L8%=X0
A1=723:X0=L8%+8:GOSUB 4100
RETURN
5280 X1=785:X2=1:X3=0:X4=1:GOSUB 345 REMARK ENTER WHETHER THIS IS ON THE SPECIAL REPORT
L9%=X0
A1=787:X0=L9%+8:GOSUB 4100
RETURN
5300 X1=64*F%-141:X2=13:X3=-999999999.99:X4=999999999.99:GOSUB 345 REMARK ENTER ONE OF THE AMOUNT FIELDS
D(F%-8)=X0
RETURN
REMARK DISPLAY ACCOUNT DATA
5400 X1=265:GOSUB 210
PRINT USING MASKC$;L1;L2 REMARK DISPLAY ACCOUNT NUMBER FIELD
X1=11:GOSUB 215
PRINT L1$;TAB(64) REMARK DISPLAY ACCOUNT NAME FIELD
X1=17:GOSUB 215
PRINT L3%; REMARK DISPLAY ACCOUNT TYPE FIELD
X0=L3%:GOSUB 4120
X1=17:GOSUB 215
PRINT L4%; REMARK DISPLAY REPORT TYPE FIELD
X0=L4%+3:GOSUB 4120
X1=17:GOSUB 215
PRINT L5%; REMARK DISPLAY NORMAL BALANCE FIELD
X0=L5%+5:GOSUB 4120
X1=17:GOSUB 215
PRINT L6% REMARK DISPLAY TOTAL LEVEL FIELD
X1=17:GOSUB 215
PRINT L7% REMARK DISPLAY EXTRA LINE ADVANCE FIELD
X1=17:GOSUB 215
PRINT L8%; REMARK DISPLAY SALES ACCOUNT FLAG FIELD
X0=L8%+8:GOSUB 4120
X1=17:GOSUB 215
PRINT L9%; REMARK DISPLAY SPECIAL REPORT FLAG FIELD
X0=L9%+8:GOSUB 4120
X1=384:GOSUB 210
FOR I%=1 TO 7 REMARK DISPLAY AMOUNT FIELDS
X1=52:GOSUB 215
PRINT USING MASKB$;D(I%)
NEXT I%
RETURN
REMARK MAIN PROGRAM BEGINS HERE
6000 OPEN "G/I0F010.DAT" AS 1,"G/L0F110.DAT" RECL 157 AS 2,\ REMARK OPEN FILES
"G/L0F130.DAT" AS 4,"CRT" RECL 1100 AS 19
CREATE "ADDFILE.DAT" RECL 157 AS 3
FILE.NO%=1:GOSUB 700 REMARK RETRIEVE GENERAL INFORMATION
FILE.NO%=4:GOSUB .314 REMARK RETRIEVE EXTENT INFORMATION
6020 X0=4:GOSUB 260 REMARK DISPLAY CRT MASK
X2$="ENTER OPERATION CODE (0=EXIT; 1=ADD; 2=CHANGE/DELETE; 3=PRINT)"
X2=1:X3=0:X4=3:GOSUB 665 REMARK ENTER OPERATION CODE
C=X0
ON C+1 GOTO 6500,6040,6180,6280 REMARK BRANCH ON OPERATION CODE
6040 X0=4:GOSUB 260
X1=30:GOSUB 210 REMARK OPERATION IS ADD
PRINT "ADD ";
6060 GOSUB 5000 REMARK ENTER ACCOUNT AND SUB-ACCOUNT NUMBERS
IF L1=0 THEN 6020
IF H>-1 AND VAR3=-1 THEN REUSE.DELETED.RECORD%=1:GOTO 6080
IF H<>-1 THEN X2$="ALREADY ON FILE":GOSUB 615:GOTO 6060
6080 FOR F%=1 TO 8 REMARK ENTER DATA FOR NEW ACCOUNT
GOSUB 5100
NEXT F%
IF L3%=0 THEN \
FOR F%=9 TO 15:\
GOSUB 5100:\
NEXT F%\
ELSE\
FOR F%=1 TO 7:\
D(F%)=0:\
NEXT F%
IF REUSE.DELETED.RECORD%=1 THEN \ REMARK DELETED RECORD IN CORRECT FILE POSTITION: USE IT
FILE.NO%=Y2:\
RECORD.NO%=L:\
GOSUB 3550:\
REUSE.DELETED.RECORD%=0:\
GOTO 6240
IF L > ADDFILE.EXTENT% THEN 6100 REMARK PLACE NEW RECORD IN CORRECT POSITION ON FILE
FOR I=ADDFILE.EXTENT% TO L STEP -1
READ #3,I;LINE X0$
PRINT USING "&";#3,I+1;X0$
NEXT I
6100 ADDFILE.EXTENT%=ADDFILE.EXTENT%+1
FILE.NO%=3:RECORD.NO%=L:GOSUB 3550
CLOSE 3 REMARK CLOSE AND RE-OPEN THE FILE FOR DISASTER PROTECTION
OPEN "ADDFILE.DAT" RECL 157 AS 3
GOTO 6240
6160 X2=3:X3=0:X4=0:X2$="ENTER DELETE CODE":GOSUB 665 REMARK OPERATION IS DELETE
IF X0$<>"DEL" THEN 6240
L3%=-1
FILE.NO%=Y2:RECORD.NO%=L:GOSUB 3550 REMARK RESAVE DELETED RECORD
X2$="RECORD DELETED":GOSUB 615
X0=4:GOSUB 260
ON C GOTO 6040,6180 REMARK RETURN TO EITHER THE ADD OR CHANGE OPERATION
6180 X0=4:GOSUB 260
X1=30:GOSUB 210 REMARK OPERATION IS CHANGE/DELETE
PRINT "CHANGE";
6200 GOSUB 5000 REMARK ENTER ACCOUNT AND SUB-ACCOUNT NUMBERS
IF L1=0 THEN 6020
IF H=-1 OR VAR3=-1 THEN X2$="NOT ON FILE":GOSUB 615:GOTO 6200
FILE.NO%=Y2:RECORD.NO%=L:GOSUB 3500 REMARK RETRIEVE ACCOUNT DATA
6240 GOSUB 5400 REMARK DISPLAY ACCOUNT DATA
REMARK ALLOW CHANGES TO DISPLAYED DATA
X2=2:X3=0:X4=99:X2$="ENTER FIELD TO CHANGE (99=DELETE)":GOSUB 665
F%=X0
IF F%=0 THEN 6260 REMARK NO MORE CHANGES
IF F%=99 THEN 6160 REMARK DELETE WAS SELECTED
IF F%>15 THEN 6240
GOSUB 5100 REMARK ENTER VALUE FOR FIELD TO CHANGE
GOTO 6240
6260 GOSUB 3550 REMARK RESAVE RECORD ON FILE
ON C GOTO 6040,6180
6280 X0=4:GOSUB 260
X1=30:GOSUB 210 REMARK OPERATION IS PRINT
PRINT "PRINT "
6300 OLD.READ%=0
NEW.READ%=0
CONSOLE
X2$="ENTER REPORT TYPE (0=NONE; 1=DESCRIPTIONS; 2=AMOUNTS; 3=BOTH)"
X2=1:X3=0:X4=3:GOSUB 665 REMARK ENTER REPORT TYPE
F2=X0
IF F2=0 THEN 6020
PAGE.COUNT%=0 REMARK RESET PRINT VARIABLES
LINE.COUNT%=66
LPRINTER
GOSUB 6800 REMARK FIND FIRST RECORD ON ACCOUNT FILE
GOSUB 6810 REMARK FIND FIRST RECORD AN ADDFILE
6320 IF OLD.READ% > ACCOUNT.FILE.EXTENT% \
AND NEW.READ% > ADDFILE.EXTENT% THEN 6300 REMARK PRINTOUT COMPLETE
IF NEW.RECORD > OLD.RECORD OR NEW.READ% > ADDFILE.EXTENT% THEN \
FILE.NO%=2:RECORD.NO%=OLD.READ%:GOSUB 6400:\ REMARK PRINT RECORD FROM ACCOUNT FILE
OLD.RECORD=100000:\
GOSUB 6800
IF NEW.RECORD=100000 THEN 6320
IF OLD.RECORD>NEW.RECORD OR OLD.READ%>ACCOUNT.FILE.EXTENT% THEN \
FILE.NO%=3:RECORD.NO%=NEW.READ%:GOSUB 6400:\ REMARK PRINT RECORD FROM ADDFILE
NEW.RECORD=100000:\
GOSUB 6810
GOTO 6320
REMARK - - - PRINT ROUTINE - - -
6400 GOSUB 3500 REMARK RETRIEVE RECORD TO BE PRINTED
IF F2=2 AND L2<>0 THEN RETURN REMARK ON "AMOUNTS ONLY" PRINTOUTS,
REMARK INCLUDE ONLY REGULAR ACCOUNTS
A1=110:X4$="GENERAL LEDGER ACCOUNTS":GOSUB 825
PRINT USING MASKA$;L1;
PRINT TAB(9);L1$;
IF F2=2 THEN 6460
IF L2<>0 THEN PRINT TAB(41);"SUB";L2;
X0=L3%:X1=49:GOSUB 4140
X0=L4%+3:X1=61:GOSUB 4140
X0=L5%+5:X1=76:GOSUB 4140
PRINT TAB(80);"LEVEL";L6%;
IF L7%=9 THEN PRINT TAB(89);"TOP/PAGE";
IF L7%>0 AND L7%<9 THEN PRINT TAB(88);L7%;"LINES";
IF L8%=1 THEN PRINT TAB(99);"SALES ACCT";
IF L9%=1 THEN PRINT TAB(111);"SPECIAL REPT";
PRINT
LINE.COUNT%=LINE.COUNT%+1
6460 IF L2<>0 OR F2=1 THEN RETURN
PRINT TAB(40);
PRINT USING MASKB$;D(1);D(2);D(3);D(4);D(5);D(6);D(7)
LINE.COUNT%=LINE.COUNT%+1
RETURN
REMARK END OF MAINLINE CODE
REMARK START OF MERGE ROUTINE
6500 PRINT CLEAR.SCREEN$:PRINT:PRINT"WORKING... DO NOT INTERRUPT"
IF ACCOUNT.FILE.EXTENT%=0 THEN\ REMARK NO PREVIOUS RECORDS - SWITCH FILE NAMES
DELETE 2:\
CLOSE 3:\
A=RENAME("G/L0F110.DAT","ADDFILE.DAT"):\
OUTPUT.COUNT%=ADDFILE.EXTENT%:\
GOTO 9000
CLOSE 1,2,3,19
OPEN "G/L0F110.DAT" RECL 157 AS 2,"ADDFILE.DAT" RECL 157 AS 3
CREATE "WORKFILE.DAT" RECL 157 AS 5
IF ADDFILE.EXTENT%>0 THEN 6550 REMARK IF NO NEW ACCOUNTS, GIVE OPTION TO REORGANIZE
PRINT CLEAR.SCREEN$
X2$="ENTER 'Y' TO REORGANIZE ACCOUNT FILE; ANY OTHER KEY TO EXIT PROGRAM"
X2=1:X3=0:X4=0:GOSUB 665
IF X0$<>"Y" THEN 9005
PRINT CURSOR.HOME$:PRINT:PRINT"WORKING... DO NOT INTERRUPT"
6550 GOSUB 6800 REMARK GET THE FIRST ACCOUNT FILE RECORD
GOSUB 6810 REMARK GET THE FIRST ADDFILE RECORD
6600 IF OLD.READ% > ACCOUNT.FILE.EXTENT% \ REMARK WHEN BOTH ENDS-OF-FILE ARE REACHED,
AND NEW.READ% > ADDFILE.EXTENT% THEN 8999 REMARK EXIT PROGRAM
IF NEW.RECORD > OLD.RECORD OR NEW.READ% > ADDFILE.EXTENT% THEN \
FILE.NO%=2:\
RECORD.NO%=OLD.READ%:\
GOSUB 3500:\ REMARK RETRIEVE ACCOUNT FILE RECORD
GOSUB 6900:\ REMARK WRITE RECORD TO WORKFILE
OLD.RECORD=100000:\
GOSUB 6800 REMARK READ THE NEXT RECORD FROM THE ACCOUNT FILE
IF NEW.RECORD=100000 THEN 6600
IF OLD.RECORD > NEW.RECORD OR OLD.READ% > ACCOUNT.FILE.EXTENT% THEN\
FILE.NO%=3:\
RECORD.NO%=NEW.READ%:\
GOSUB 3500:\ REMARK RETRIEVE ADDFILE RECORD
GOSUB 6900:\ REMARK WRITE RECORD TO WORKFILE
NEW.RECORD=100000:\
GOSUB 6810 REMARK READ THE NEXT RECORD FROM THE ADDFILE
GOTO 6600
6800 IF END #2 THEN 6800.1 REMARK READ RECORD FROM ACCOUNT FILE
OLD.READ%=OLD.READ%+1
READ #2,OLD.READ%;VAR1,VAR2,VAR3
OLD.RECORD=VAR1 + VAR2/1000
IF VAR3=-1 THEN 6800 REMARK IF RECORD IS DELETED, READ NEXT RECORD
RETURN
6800.1 OLD.READ%=ACCOUNT.FILE.EXTENT%+1 REMARK END OF FILE ENCOUNTERED
OLD.RECORD=100000
RETURN
6810 IF END #3 THEN 6810.1 REMARK READ RECORD FROM ADDFILE
NEW.READ%=NEW.READ%+1
READ #3,NEW.READ%;VAR1,VAR2,VAR3
NEW.RECORD=VAR1 + VAR2/1000
IF VAR3=-1 THEN 6810 REMARK IF RECORD IS DELETED, READ NEXT RECORD
RETURN
6810.1 NEW.READ%=ADDFILE.EXTENT%+1 REMARK END OF FILE ENCOUNTERED
NEW.RECORD=100000
RETURN
6900 OUTPUT.COUNT%=OUTPUT.COUNT%+1 REMARK WRITE RECORD TO WORKFILE
FILE.NO%=5
RECORD.NO%=OUTPUT.COUNT%
GOSUB 3550
RETURN
8999 DELETE 2 REMARK DELETE ACCOUNT FILE
DELETE 3 REMARK DELETE ADDFILE
CLOSE 5 REMARK CLOSE WORKFILE BEFORE RENAMING IT
A=RENAME("G/L0F110.DAT","WORKFILE.DAT") REMARK WORKFILE BECOMES ACCOUNT FILE
9000 ACCOUNT.FILE.EXTENT%=OUTPUT.COUNT%
CLOSE 4
OPEN "G/L0F130.DAT" AS 4
FILE.NO%=4
GOSUB .315 REMARK RE-WRITE ACCOUNT FILE EXTENT
9005 PRINT CLEAR.SCREEN$;"G/L ACCOUNT F/M LOADING MENU"
CHAIN "G/L000" REMARK TERMINATE PROGRAM AND CHAIN TO THE MENU
TURN
6810 IF END #3 THEN 6810.1 REMARK READ RECORD FROM ADDFILE
NEW.READ%=NEW.READ%+1
READ #3,NEW.READ%;VAR1,VAR2,VA