|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 28544 (0x6f80)
Types: TextFile
Names: »VERIFY.BAS«
└─⟦f51bd807e⟧ Bits:30005981/disk5.imd Turn Key Data Entry System/Datenerfassungspaket - Vers. 1.90
└─⟦this⟧ »VERIFY.BAS«
1 REM ************************************************** 2 REM * * 3 REM * MODULE : VERIFY .BAS (TKDES/RC700) * 4 REM * DATE : 01.02.82 * 5 REM * BY : ASE GMBH , 6472 ALTENSTADT * 6 REM * VERSION: 1.90 * 7 REM * * 8 REM ************************************************** 10 REM 11 REM ************************************************************************ 12 REM * SET ERROR-HANDLING-POINTER AND READ WORK-NO. * 13 REM ************************************************************************ 15 ON ERROR GOTO 10000 20 DEPFORM% = 0 : ARBSTATOPEN% = 0 : ARBSTATWRITE% = 0 : USRFORMFOPEN% = 0 : ENTRYSTATERR% = 0 30 ERRFLAG% = 0 : FILENAME$ = "CHAININF.DEP" 40 OPEN "R",#5,FILENAME$,26 60 FIELD #5,12 AS CHAININFO1$,12 AS CHAININFO2$,2 AS CHAININFO3$ 70 ERRFLAG% = 0 : GET #5,1 90 FORMNAME$ = CHAININFO1$ : DATANAME$ = CHAININFO2$ : ARBNR$ = CHAININFO3$ 92 ERRFLAG% = 0 : CLOSE 100 REM *********************************************************************** 102 REM * CHAIN TO SEL. PROGRAMM * 104 REM *********************************************************************** 110 IF VAL(ARBNR$) < 1 OR VAL(ARBNR$) > 11 GOTO 3900 130 IF VAL(ARBNR$) = 6 OR VAL(ARBNR$) = 7 OR VAL(ARBNR$) = 8 THEN GOTO 23000 ELSE GOTO 3900 990 REM ********************************************************************** 995 REM * (ESC) INPUT AFTER ERROR ERRMSG. * 1000 REM ********************************************************************** 1002 PRINT CHR$(7); : ESCINPUT$ = INPUT$(1) : IF ASC(ESCINPUT$) <> 27 GOTO 1002 1004 PRINT SPACE$(76); : RETURN 1980 REM ********************************************************************** 1985 REM * SUB.: POS. CURSOR * 1990 REM ********************************************************************** 1992 PRINT CHR$(13); 1994 PRINT CHR$(6);CHR$(XPOS%+31);CHR$(YPOS%+31); 1998 RETURN 3870 REM ********************************************************************** 3871 REM * PRINT ERRMSG. IN LINE 25 * 3872 REM ********************************************************************** 3874 ERRMSGNR% = 1 : GOSUB 20000 : GOSUB 1000 : GOTO 3900 3900 REM ********************************************************************** 3910 REM * CHAIN TO ENTRY-MENUE * 3920 REM ********************************************************************** 3930 CHAIN "B:CHAININF.COM" 3940 SYSTEM REM *** NO CHAIN-MODUL/WARM BOOT 4750 REM ********************************************************************** 4755 REM * PRINT ERRMSG. IN LINE 25 * 4760 REM ********************************************************************** 4770 ERRMSGNR% = 8 : GOSUB 20000 4790 GOSUB 1000 : GOTO 3900 7230 REM ********************************************************************** 7235 REM * SUB.: TEST GENERALSTATUS (DEP) * 7240 REM ********************************************************************** 7250 GENERALST$ = MID$(ST$,1,2) : PRIMST$ = MID$(ST$,3,2) : SEKST$ = MID$(ST$,5,2) 7260 GENERALST% = VAL(GENERALST$) : PRIMST% = VAL(PRIMST$) : SEKST% = VAL(SEKST$) 7270 ON GENERALST% GOTO 7330,7320,7320,7320,7320,7320,7320 7272 REM ********************************************************************** 7274 REM * PRINT ERRMSG. IN LINE 25 * 7276 REM ********************************************************************** 7280 ERRMSGNR% = 9 : GOSUB 20000 7300 GOSUB 1000 : RETURN 7310 REM ********************************************************************** 7320 PRIMST% = 8 : RETURN 7330 RETURN 7390 REM ********************************************************************** 7395 REM * SUB.: FILE IN ARBSTAT-DIR ? * 7400 REM ********************************************************************** 7410 FILEINDIR% = 0 : DIR2% = 0 : NAME$ = SPACE$(16) 7412 FOR I% = 15 TO 239 STEP 16 7420 IF MID$(ARBSTATDIR1$,I%,12) = FILENAME$ GOTO 7480 7430 NEXT I% 7435 DIR2% = 1 7440 FOR I% = 1 TO 225 STEP 16 7450 IF MID$(ARBSTATDIR2$,I%,12) = FILENAME$ GOTO 7480 7460 NEXT I% 7470 FILEINDIR% = 0 : RETURN 7480 IF DIR2% = 1 THEN NAME$ = MID$(ARBSTATDIR2$,I%,16) ELSE NAME$ = MID$(ARBSTATDIR1$,I%,16) 7485 FILEINDIR% = 1 : RETURN 8000 REM ********************************************************************** 8002 REM * PRINT ERRMSG. IN LINE 25 * 8004 REM ********************************************************************** 8010 ERRMSGNR% = 4 : GOSUB 20000 8030 GOSUB 1000 : GOTO 26120 8050 REM ******************* FATAL SYSTEM ERROR ******************************* 8060 GOTO 8270 8100 REM ******************* DISC I/O ERROR *********************************** 8110 GOTO 8270 8120 REM ******************* DISC FULL **************************************** 8130 GOTO 26120 8140 REM ******************* CP/M DIR FULL ************************************ 8150 GOTO 8270 8160 REM ******************* CLOSE ARBSTAT ************************************ 8170 ERRFLAG% = 0 : CLOSE #1 8190 ARBSTATOPEN% = 0 : ARBSTATWRITE% = 0 : RETURN 8200 REM ******************* CLOSE FORMAT-FILE ******************************** 8210 ERRFLAG% = 0 : USRFORMFOPEN% = 0 8220 CLOSE #2 : RETURN 8230 REM ******************* UPDATE ARBSTAT *********************************** 8240 MID$(NONZ50$,23,3) = "K.." 8241 RSET DRECCOUNT$ = STR$(DRECCOUNT%) 8242 MID$(SM$,1,3) = MID$(DRECCOUNT$,1,3) : MID$(WF$,1,3) = MID$(DRECCOUNT$,4,3) 8244 MID$(VA$,1,4) = MID$(PRECCOUNT$,1,4) : MID$(PC$,1,2) = MID$(PRECCOUNT$,5,2) 8246 MID$(PC$,3,2) = MID$(CRECCOUNT$,1,2) : MID$(FL$,1,4) = MID$(CRECCOUNT$,3,4) 8247 MID$(NONZ50$,36,3) = STR$(VDRECCOUNT%) 8248 LSET NONZ$ = NONZ50$ : LSET SP$ = PSTATUS$ 8250 GOSUB 9550 : RETURN REM *** WRITE ARBSTAT 8260 REM ********************************************************************** 8262 REM * ERROR !!! WRITE ERROR-NO. TO ARBSTAT * 8264 REM ********************************************************************** 8270 IF ARBSTATOPEN% AND ARBSTATWRITE% THEN GOTO 8280 ELSE GOTO 8330 8280 MID$(PSTATUS$,1,2) = STR$(ERR) 8290 MID$(PSTATUS$,3,5) = STR$(ERL) 8295 LSET SP$ = PSTATUS$ 8300 MID$(NONZ50$,23,3) = "ERR" : LSET NONZ$ = NONZ50$ : GOSUB 9550 REM *** WRITE ARBSTAT 8330 GOTO 3900 9000 REM ******************* OPEN ARBSTAT ************************************* 9100 FILENAME$ = "ARBSTAT.DEP" 9120 ERRFLAG% = 0 : OPEN "R",#1,FILENAME$,512 9125 ARBSTATOPEN% = 1 9130 RETURN 9140 REM ******************* FIELD FOR ARBSTAT AND DEP ************************ 9150 FIELD #1,54 AS NONZ$,8 AS SP$,2 AS MO$,3 AS FLN$,3 AS SM$,6 AS ST$,3 AS WF$,4 AS VA$,4 AS FC$,4 AS PC$,4 AS FL$,6 AS EE$,6 AS VE$,6 AS KE$,6 AS KV$,6 AS EC$,6 AS FK$,6 AS VK$,15 AS MR$,225 AS ADDR$,135 AS SUBR$ 9160 RETURN 9170 REM ******************* READ ARBSTAT DIR ********************************* 9180 FIELD #1,255 AS ARBSTATDIR1$,255 AS ARBSTATDIR2$,2 AS NOTUSED$ 9200 ERRFLAG% = 0 : GET #1,1 9202 IF MID$(ARBSTATDIR1$,1,10) = "ARBSTATDIR" THEN RETURN 9210 ERRFLAG% = 8 : RETURN 9220 REM ********************************************************************** 9222 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 9224 REM ********************************************************************** 9230 ERRMSGNR% = 5 : GOSUB 20000 9250 GOSUB 1000 : RETURN 9270 REM ******************* OPEN FORM FILE ********************************* 9280 USRFORMFOPEN% = 1 9340 ERRFLAG% = 0 : OPEN "R",#2,FORMNAME$,1922 9350 RETURN 9360 REM ******************* WRITE ARBSTAT-DIR ******************************** 9370 ERRFLAG% = 0 : PUT #1,1 9420 RETURN 9430 REM ******************* INIT A NEW ARBSTAT ******************************* 9450 LSET NONZ$ = NONZ50$ 9460 LSET SP$ = PSTATUS$ 9470 LSET MO$ = MODE$ : LSET FLN$ = FIELDNO$ : LSET SM$ = SPECMOD$ 9530 RETURN 9540 REM ******************* WRITE ARBSTAT ************************************ 9550 ERRFLAG% = 0 : PUT #1,R1% 9555 ARBSTATWRITE% = 1 9560 RETURN 9562 REM ******************* READ ARBSTAT ************************************* 9564 ERRFLAG% = 0 9566 GET #1,R1% : RETURN 9570 REM ******************* INIT FORMAT-BUFFER ******************************* 9580 FIELD #2,2 AS FB$,80 AS A$,80 AS B$,80 AS C$,80 AS D$,80 AS E$,80 AS F$,80 AS G$,80 AS H$,80 AS I$,80 AS J$,80 AS K$,80 AS L$,80 AS M$,80 AS N$,80 AS O$,80 AS P$,80 AS Q$,80 AS R$,80 AS S$,80 AS T$,80 AS U$,80 AS V$,80 AS W$,80 AS X$ 9585 RETURN 9672 REM ******************* READ FORMREC ************************************* 9674 ERRFLAG% = 0 9676 GET #2,FORMNR% 9678 RETURN 9900 REM ********************************************************************** 9910 REM * ERROR-HANDLING * 9920 REM ********************************************************************** 9930 ON ERRFLAG% GOTO 8060,8060,8060,8060,8110,8130,8150,8010 9940 GOTO 3900 10000 REM ***************************** E R R O R **************************** 10010 REM 10020 REM errflag% = 1 = "file not found" 10030 REM errflag% = 2 = "file already exists" 10040 REM errflag% = 3 = "bad filename" 10050 REM errflag% = 4 = "fatal error" 10060 REM errflag% = 5 = "disc i/o error" 10070 REM errflag% = 6 = "disc full" 10080 REM errflag% = 7 = "cp/m dir full" 10085 REM errflag% = 8 = "no arbstatdir" 10090 IF ERR < 50 OR ERR > 67 GOTO 10110 10100 ON ERR-49 GOTO 10110,10110,10110,10310,10110,10110,10110,10160,10310,10110,10110,10210,10110,10110,10310,10110,10110,10290 10110 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 10120 PRINT CHR$(144);"FEHLER #";ERR;"/";ERL;" DATEI: ";FILENAME$;" (ON ERR) !! (ESC)";CHR$(128);CHR$(13); 10140 GOSUB 1000 : ERRFLAG% = 4 : RESUME 9900 10160 ERRMSGNR% = 10 : GOSUB 20000 10190 GOSUB 1000 : ERRFLAG% = 5 : RESUME 9900 10210 ERRMSGNR% = 11 : GOSUB 20000 10240 GOSUB 1000 : ERRFLAG% = 6 : RESUME 9900 10290 ERRFLAG% = 7 : RESUME 9900 10310 ERRFLAG% = 1 : RESUME 9900 10320 ERRFLAG% = 2 : RESUME 9900 10330 ERRFLAG% = 3 : RESUME 9900 20000 REM ********************************************************************* 20001 REM * PRINT ERRMSG. ON CRT * 20002 REM ********************************************************************* 20070 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 20080 PRINT CHR$(144);" *** "; 20090 ON ERRMSGNR% GOSUB 20120,20130,20140,20150,20160,20170,20180,20190,20200,20210,20220,20230,20240,20250 20095 PRINT " !! (ESC) *** ";CHR$(128);CHR$(30);CHR$(13); 20115 RETURN 20120 PRINT "FORMAT-DATEI NICHT VORHANDEN"; : RETURN REM *** MSG. 01 20130 PRINT "SATZGRØSSE UNGLEICH FORMATGRØSSE"; : RETURN REM *** MSG. 02 20140 PRINT "ERFASSUNGSSTATUS DER ARBEITSDATEI ";MID$(DATANAME$,1,8);" = ";ENTRYSTAT$; : RETURN 20150 PRINT "ARBEITS-STATUS-DATEI NICHT VORHANDEN"; : RETURN REM *** MSG. 04 20160 PRINT "ARBEITS-STATUS-DATEI VOLL"; : RETURN REM *** MSG. 05 20170 PRINT "ERFASSUNGSSTATUS DER FORMATDATEI ";MID$(FORMNAME$,1,8);" = ";ENTRYSTAT$; : RETURN 20180 PRINT "PRÅFSTATUS DER ARBEITSDATEI ";MID$(DATANAME$,1,8);" = ";VERIFYSTAT$; : RETURN 20190 PRINT "KEINE SYSTEM-FORMATE"; : RETURN REM *** MSG. 08 20200 PRINT "DEP FEHLER-STATUS"; : RETURN REM *** MSG. 09 20210 PRINT "SCHREIB- ODER LESEFEHLER AUF DER DISKETTE"; : RETURN REM *** MSG. 10 20220 PRINT "DISKETTE VOLL"; : RETURN REM *** MSG. 11 20230 PRINT "KEINE FORMAT NR. ";CHAINFORMNR$; : RETURN REM *** MSG. 12 20240 PRINT "ENDE DER PRÅFUNG"; : RETURN REM *** MSG. 13 20250 PRINT "ENDE DER DATEI"; : RETURN REM *** MSG. 14 23000 REM ********************************************************************* 23005 REM VERIFY MODE 23010 REM ********************************************************************* 23020 GOSUB 9100 REM *** OPEN ARBSTAT 23030 GOSUB 9170 REM *** READ ARBSTATDIR 23040 FILENAME$ = DATANAME$ 23050 GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 23060 IF FILEINDIR% THEN SNAME$ = NAME$ : GOTO 23090 23070 GOSUB 8170 REM *** CLOSE ARBSTAT 23080 GOTO 3900 23090 IF MID$(FORMNAME$,1,1) <> " " THEN GOTO 23180 23100 R1$ = MID$(SNAME$,13,4) : R1% = VAL(R1$) 23110 GOSUB 9150 : GOSUB 9564 REM *** READ DATA ARBSTAT 23150 MID$(FORMNAME$,1,8) = MID$(NONZ$,11,8) : MID$(FORMNAME$,9,4) = ".FRM" 23160 GOSUB 9170 REM *** READ ARBSTAT-DIR 23180 FILENAME$ = FORMNAME$ 23190 GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 23200 IF FILEINDIR% GOTO 23240 23210 GOSUB 8170 REM *** CLOSE ARBSTAT 23230 GOTO 3874 23240 R1$ = MID$(NAME$,13,4) : R1% = VAL(R1$) 23250 GOSUB 9150 : GOSUB 9564 REM *** READ FORMAT-ARBSTAT 23260 IF MID$(NONZ$,23,1) <> "K" THEN ENTRYSTAT$ = MID$(NONZ$,23,3) : GOSUB 27210 : GOTO 23070 23270 RECLENGTH$ = MID$(NONZ$,19,4) : RECLENGTH% = VAL(RECLENGTH$) 23290 FORMNRBUFFER$ = ADDR$ : FORMCHBUFFER$ = SUBR$ 23300 R1$ = MID$(SNAME$,13,4) : R1% = VAL(R1$) 23310 GOSUB 9564 REM *** READ DATA-ARBSTAT 23322 SRECLENGTH$ = MID$(NONZ$,19,4) : IF VAL(SRECLENGTH$) = RECLENGTH% THEN GOTO 23326 23324 GOSUB 27280 : GOTO 23070 23326 IF MID$(NONZ$,23,1) <> "K" THEN ENTRYSTAT$ = MID$(NONZ$,23,3) : GOSUB 27228 23328 IF VAL(ARBNR$) = 7 THEN IF MID$(NONZ$,26,1) <> "U" THEN VERIFYSTAT$ = MID$(NONZ$,26,3) : GOSUB 27224 : GOTO 23070 23330 NONZ50$ = NONZ$ : IF VAL(ARBNR$) > 7 THEN MID$(NONZ50$,30,1) = "S" ELSE MID$(NONZ50$,26,1) = "S" 23331 MID$(NONZ50$,11,8) = FORMNAME$ : PSTATUS$ = SP$ 23332 DRECCOUNT$ = SPACE$(6) : MID$(DRECCOUNT$,1,3) = SM$ : MID$(DRECCOUNT$,4,3) = WF$ : DRECCOUNT% = VAL(DRECCOUNT$) 23334 IF VAL(ARBNR$) > 6 THEN VDRECCOUNT$ = SPACE$(3) : VDRECCOUNT$ = MID$(NONZ$,36,3) : VDRECCOUNT% = VAL(VDRECCOUNT$) 23340 WRECCOUNT$ = MID$(NONZ$,39,6) : WRECCOUNT% = VAL(WRECCOUNT$) 23342 WRECCOUNT% = WRECCOUNT% + DRECCOUNT% 23343 IF VAL(ARBNR$) = 6 THEN MID$(NONZ50$,45,6) = SPACE$(6) 23344 IF VAL(ARBNR$) = 7 THEN VRECCOUNT$ = MID$(NONZ50$,45,6) : VRECCOUNT% = VAL(VRECCOUNT$) 23346 IF VAL(ARBNR$) = 7 THEN RRECCOUNT% = VDRECCOUNT% + VRECCOUNT% ELSE RRECCOUNT% = 0 23348 PRECCOUNT$ = SPACE$(6) : MID$(PRECCOUNT$,1,4) = VA$ : MID$(PRECCOUNT$,5,2) = MID$(PC$,1,2) 23349 CRECCOUNT$ = SPACE$(6) : MID$(CRECCOUNT$,1,2) = MID$(PC$,3,2) : MID$(CRECCOUNT$,3,4) = FL$ 23350 IF VAL(ARBNR$) > 7 THEN MODE$ = "05" ELSE MODE$ = "01" 23360 GOSUB 9450 : GOSUB 9550 REM *** WRITE ARBSTAT 23370 FILENAME$ = FORMNAME$ 23380 GOSUB 9280 REM *** OPEN FORMAT-FILE 23387 GOSUB 9580 REM *** INIT FORMAT-BUFFER 23390 FILENAME$ = DATANAME$ 23400 GOSUB 26820 REM *** OPEN DATA-FILE 23410 GOSUB 26990 : GOSUB 27020 REM *** INIT AND CLEAR THE DATABUFFER 23420 FIRSTTIMEFLAG% = 1 : IF VAL(ARBNR$) = 6 THEN LSET SM$ = "011" ELSE LSET SM$ = "001" 23430 IF VAL(ARBNR$) > 7 THEN GOTO 27510 ELSE GOTO 26260 25350 REM ********************************************************************* 25355 REM * CALL THE DEP * 25360 REM ********************************************************************* 25362 FIELDNO$ = "000" : LSET FLN$ = FIELDNO$ 25365 F% = VARPTR(#2) : Z% = VARPTR(#1) : D% = VARPTR(#3) : CALL INIT(F%,Z%,D%) 25370 GOSUB 7240 REM *** TEST GENERAL DEP-STAT 25375 IF GENERALST% <> 1 THEN GOSUB 7280 : GOTO 26120 25380 IF VAL(ARBNR$) = 8 THEN GOTO 25430 REM *** ONLY ONE CALL IN PRINT-MODE 25390 FIELDNO$ = "001" : SPECMOD$ = "001" : LSET SM$ = SPECMOD$ : LSET FLN$ = FIELDNO$ 25400 F% = VARPTR(#2) : Z% = VARPTR(#1) : D% = VARPTR(#3) : CALL ENT(F%,Z%,D%) 25410 REM ************************************************************************ 25420 GOSUB 7240 REM *** TEST GENERAL DEP-STAT 25430 ON PRIMST% GOTO 25440,25470,25590,25610,25630,25650,25720,25740,25760,25780,25800,25830,25860,25890 25440 REM --- FIELD END --- 25450 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 25460 GOTO 25400 25470 REM --- FORMAT END / WRITE DATA --- 25484 IF VAL(ARBNR$) = 8 THEN GOTO 27550 ELSE GOSUB 27350 25490 IF FIELDKORRFLAG% THEN SWRECCOUNT% = WRECCOUNT% : WRECCOUNT% = RRECCOUNT% : GOSUB 27080 ELSE GOTO 26260 25510 WRECCOUNT% = SWRECCOUNT% : FIELDKORRFLAG% = 0 : GOTO 26260 25590 REM --- SEND KEY --- 25600 GOTO 25400 25610 REM --- FORWARD RECORD --- 25620 GOTO 26250 25630 REM --- BACKWARD RECORD --- 25640 GOTO 25400 25650 REM --- DELETE RECORD --- 25670 GOTO 25400 25720 REM --- INSERT RECORD --- 25730 GOTO 25400 25740 REM --- USER EXIT --- 25750 IF VAL(ARBNR$) > 7 THEN MID$(NONZ50$,30,1) = "U" ELSE MID$(NONZ50$,26,1) = "U" 25752 GOTO 26130 25760 REM --- CHANGE FORMAT CHAIN KEY --- 25770 SCHAINFORMNR$ = CHAINFORMNR$ 25772 IF VAL(CHAINFORMNR$) = VAL(FCK$) GOTO 25390 25774 CHAINFORMNR$ = FCK$ : GOSUB 26730 : IF FORMNRUSE% = 0 GOTO 27180 25776 GOSUB 9674 25778 GOTO 25362 25780 REM --- SEARCH --- 25790 GOTO 25360 25800 REM --- FIELD FORWARD --- 25810 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 25820 GOTO 25400 25830 REM --- BACKWARD FIELD --- 25840 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 25850 GOTO 25400 25860 REM --- HOME KEY --- 25870 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 25880 GOTO 25400 25890 REM --- CHECK SECONDARY STATUS --- 25900 ON SEKST% GOTO 25910,25940,25970,26000,26020,26040,26070,26100 25910 REM --- FORM-MOD KEY --- 25920 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 25930 GOTO 25400 25940 REM --- FIELD KORR STAT --- 25950 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 25952 FIELDKORRFLAG% = 1 25960 GOTO 25400 25970 REM --- FIELD KORR IN MUL REG --- 25980 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 25990 GOTO 25400 26000 REM --- ERROR FLAG COMPLETE --- 26010 GOTO 26120 26020 REM --- NO ERROR FLAG --- 26030 GOTO 26120 26040 REM --- FILL CHAR. UNCORRECTED --- 26050 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 26060 GOTO 25400 26070 REM --- SEQ. ERROR ON AUTO-INC. FIELD --- 26080 FIELDNO$ = WF$ : LSET FLN$ = FIELDNO$ 26090 GOTO 25400 26100 REM --- DISPLAY SUCCESSFULL --- 26110 GOTO 25400 26120 REM ********************************************************************* 26122 REM * USER EXIT * 26124 REM ********************************************************************* 26130 IF ARBSTATOPEN% = 0 GOTO 26220 26135 IF VAL(ARBNR$) = 8 THEN IF PRINTMODE$ = "E" THEN GOSUB 27660 ELSE GOSUB 27660 : GOSUB 27660 26150 GOSUB 8210 REM *** CLOSE FORMAT-FILE 26180 GOSUB 8241 REM *** WRITE ARBSTAT 26200 GOSUB 8170 REM *** CLOSE ARBSTAT 26220 GOSUB 27160 REM *** CLOSE DATA-FILE 26240 GOTO 3900 26250 REM ********************************************************************* 26252 REM * FORWARD RECORD * 26254 REM ********************************************************************* 26260 IF RRECCOUNT% = WRECCOUNT% THEN GOSUB 26472 : GOTO 26130 26270 RRECCOUNT% = RRECCOUNT% + 1 26280 GOSUB 27130 REM *** READ DATA RECORD 26300 IF VAL(FCK$) = 0 THEN IF VAL(ARBNR$) <> 8 THEN VDRECCOUNT% = VDRECCOUNT% + 1 : GOTO 26260 ELSE GOTO 26260 26310 IF VAL(ARBNR$) = 6 OR VAL(ARBNR$) = 7 THEN IF VAL(CHAINFORMNR$) = VAL(FCK$) GOTO 25390 26320 CHAINFORMNR$ = FCK$ : GOSUB 26730 : IF FORMNRUSE% = 0 GOTO 27180 26330 FIRSTTIMEFLAG% = 0 : GOSUB 9674 REM *** READ FORMAT RECORD 26350 GOTO 25360 26470 REM ********************************************************************* 26472 IF VAL(ARBNR$) > 7 THEN MID$(NONZ50$,30,1) = "K" : GOSUB 27420 : RETURN 26474 MID$(NONZ50$,26,1) = "K" : GOSUB 27264 : GOSUB 27390 : RETURN 26720 REM ******************** GET RANDOM FORMNR ****************************** 26722 REM * SUB.: GET RANDOM FORMAT-NO. * 26724 REM ********************************************************************* 26730 F% = 1 : F1% = 1 : FORMNRUSE% = 0 : CHAINFORMNR% = VAL(CHAINFORMNR$) 26740 FOR FP% = 1 TO 45 26750 OFORMNR$ = MID$(FORMNRBUFFER$,F%,4) : IF VAL(OFORMNR$) = CHAINFORMNR% GOTO 26790 26760 F% = F% + 4 : F1% = F1% + 3 26770 NEXT FP% 26780 RETURN 26790 FORMNRUSE% = 1 : FORMNR% = FP% : FORMCHKEY$ = MID$(FORMCHBUFFER$,F1%,3) 26800 RETURN 26810 REM ****************** CALC DATABUFFER AND OPEN DATAFILE **************** 26820 DB1% = 0 : DB2% = 0 : DB3% = 0 : DB4% = 0 : DB5% = 0 : DB6% = 0 : DB7% = 0 : DB8% = 0 26830 FILENAME$ = DATANAME$ : IF RECLENGTH% =< 255 THEN DB1% = RECLENGTH% : GOTO 26870 26840 FOR I% = 1 TO 7 26850 IF RECLENGTH% > 255 THEN GOSUB 26910 26860 NEXT I% 26870 ERRFLAG% = 0 26880 DB% = DB% + DB1%+DB2%+DB3%+DB4%+DB5%+DB6%+DB7%+DB8%+3 26890 OPEN "R",#3,FILENAME$,DB% + 2 26900 RETURN 26910 ON I% GOTO 26920,26930,26940,26950,26960,26970,26980 26920 DB1% = 255 : RECLENGTH% = RECLENGTH% - 255 : DB2% = RECLENGTH% : RETURN 26930 DB2% = 255 : RECLENGTH% = RECLENGTH% - 255 : DB3% = RECLENGTH% : RETURN 26940 DB3% = 255 : RECLENGTH% = RECLENGTH% - 255 : DB4% = RECLENGTH% : RETURN 26950 DB4% = 255 : RECLENGTH% = RECLENGTH% - 255 : DB5% = RECLENGTH% : RETURN 26960 DB5% = 255 : RECLENGTH% = RECLENGTH% - 255 : DB6% = RECLENGTH% : RETURN 26970 DB6% = 255 : RECLENGTH% = RECLENGTH% - 255 : DB7% = RECLENGTH% : RETURN 26980 DB7% = 255 : RECLENGTH% = RECLENGTH% - 255 : DB8% = RECLENGTH% : RETURN 26990 REM ****************** SET FIELD FOR DATA-BUFFER ************************ 27000 FIELD #3,DB1% AS DATA1$,DB2% AS DATA2$,DB3% AS DATA3$,DB4% AS DATA4$,DB5% AS DATA5$,DB6% AS DATA6$,DB7% AS DATA7$,DB8% AS DATA8$,3 AS FCK$,2 AS CRLF$ 27010 RETURN 27020 REM ****************** CLEAR DATABUFFER ********************************* 27030 LSET DATA1$ = SPACE$(DB1%) : LSET DATA2$ = SPACE$(DB2%) 27040 LSET DATA3$ = SPACE$(DB3%) : LSET DATA4$ = SPACE$(DB4%) 27050 LSET DATA5$ = SPACE$(DB5%) : LSET DATA6$ = SPACE$(DB6%) 27060 LSET DATA7$ = SPACE$(DB7%) : LSET DATA8$ = SPACE$(DB8%) 27070 RETURN 27080 REM ****************** WRITE DATA REC *********************************** 27090 MID$(FCK$,1,3) = CHAINFORMNR$ 27100 ERRFLAG% = 0 : MID$(CRLF$,1,1) = CHR$(13) : MID$(CRLF$,2,1) = CHR$(10) 27110 PUT #3,WRECCOUNT% 27120 RETURN 27130 REM ****************** READ DATA RECORD ********************************* 27140 ERRFLAG% = 0 : GET #3,RRECCOUNT% : RETURN 27150 REM ****************** CLOSE DATAFILE *********************************** 27160 ERRFLAG% = 0 : CLOSE #3 : RETURN 27170 REM ********************************************************************* 27172 REM * PRINT ERRMSG. IN LINE 25 * 27174 REM ********************************************************************* 27180 ERRMSGNR% = 12 : GOSUB 20000 27192 GOSUB 1000 27200 IF FIRSTTIMEFLAG% THEN GOTO 26130 ELSE IF PRIMST% = 9 THEN CHAINFORMNR$ = SCHAINFORMNR$ : GOTO 25400 ELSE GOTO 25400 27202 REM ********************************************************************* 27204 REM * PRINT ERRMSG. IN LINE 25 * 27210 REM ********************************************************************* 27220 ERRMSGNR% = 6 : GOSUB 20000 : GOSUB 1000 : RETURN 27222 REM ********************************************************************* 27224 ERRMSGNR% = 7 : GOSUB 20000 : GOSUB 1000 : RETURN 27226 REM ********************************************************************* 27228 ERRMSGNR% = 3 : GOSUB 20000 : GOSUB 1000 : RETURN 27262 REM ********************************************************************* 27264 ERRMSGNR% = 13 : GOSUB 20000 : GOSUB 1000 : RETURN 27270 REM ********************************************************************* 27280 ERRMSGNR% = 2 : GOSUB 20000 : GOSUB 1000 : RETURN 27300 REM ********************************************************************* 27310 ERRMSGNR% = 14 : GOSUB 20000 : GOSUB 1000 : RETURN 27330 REM ********************************************************************* 27335 REM * SUB.: VERIFY-RECORD-COUNTER + 1 * 27340 REM ********************************************************************* 27350 VRECCOUNT$ = MID$(NONZ50$,45,6) : VRECCOUNT% = VAL(VRECCOUNT$) 27355 VRECCOUNT% = VRECCOUNT% + 1 : VRECCOUNT$ = STR$(VRECCOUNT%) 27360 NVRECCOUNT$ = SPACE$(6) : RSET NVRECCOUNT$ = VRECCOUNT$ 27365 MID$(NONZ50$,45,6) = NVRECCOUNT$ : RETURN 27370 REM ********************************************************************* 27375 REM * SUB.: VERIFY-COUNTER + 1 * 27380 REM ********************************************************************* 27390 VERIFYCOUNTER$ = MID$(NONZ50$,28,1) : VERIFYCOUNTER% = VAL(VERIFYCOUNTER$) 27395 VERIFYCOUNTER% = VERIFYCOUNTER% + 1 : MID$(NONZ50$,27,2) = STR$(VERIFYCOUNTER%) 27400 RETURN 27405 REM ********************************************************************* 27407 REM * SUB.: PRINT-COUNTER + 1 * 27410 REM ********************************************************************* 27420 IF MID$(NONZ50$,32,1) = "." THEN MID$(NONZ50$,31,2) = SPACE$(2) 27430 PRINTCOUNTER$ = MID$(NONZ50$,32,1) : PRINTCOUNTER% = VAL(PRINTCOUNTER$) 27440 PRINTCOUNTER% = PRINTCOUNTER% + 1 : MID$(NONZ50$,31,2) = STR$(PRINTCOUNTER%) 27445 RETURN 27450 REM ********************************************************************* 27452 REM * SUB.: PRINT-RECORD-COUNTER + 1 * 27454 REM ********************************************************************* 27460 PRECCOUNT% = VAL(PRECCOUNT$) : PRECCOUNT% = PRECCOUNT% + 1 27470 RSET PRECCOUNT$ = STR$(PRECCOUNT%) 27480 RETURN 27500 REM ********************************************************************* 27502 REM PRINT MODUL * 27504 REM ********************************************************************* 27510 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 27520 PRINT CHR$(144);"EINZELFORMAT ODER LISTEN (E/L) ?? . ";CHR$(128);CHR$(8);CHR$(8);CHR$(8); 27522 GOSUB 27534 : PRECCOUNT$ = SPACE$(6) 27524 PRINTMODE$ = INPUT$(1) 27530 IF PRINTMODE$ = "E" OR PRINTMODE$ = "L" THEN PRINT PRINTMODE$; : GOTO 26260 ELSE PRINT CHR$(7); : GOTO 27524 27532 REM ****************** SET PAGE/LINECOUNTER ***************************** 27534 PAGE% = 72 : LINECOUNT% = 60 : RETURN 27540 REM ********************************************************************* 27542 REM * PRINT MODE * 27544 REM ********************************************************************* 27550 VA% = VAL(VA$) 27560 FORML! = VA% / 80 : FORML% = INT(FORML!) : R% = FORML% * 80 : IF R% <> VA% THEN FORML% = FORML% + 1 27570 LINECOUNT% = LINECOUNT% - FORML% 27575 IF LINECOUNT% < 0 THEN LINECOUNT% = LINECOUNT% + FORML% : GOSUB 27660 : LINECOUNT% = LINECOUNT% - FORML% 27580 GOSUB 27600 : IF PRINTMODE$ = "E" THEN GOSUB 27660 : GOTO 26260 27585 LPRINT : LPRINT : LPRINT : LINECOUNT% = LINECOUNT% - 3 : GOTO 26260 27590 REM ********************************************************************* 27592 REM * PRINT * 27594 REM ********************************************************************* 27600 FOR I% = 1 TO FORML% 27605 ON I% GOSUB 27610,27612,27614,27616,27618,27620,27622,27624,27625,27626,27627,27628,27629,27630,27631,27632,27633,27634,27635,27636,27637,27638,27639,27640 27606 NEXT I% 27607 GOSUB 27460 : RETURN 27610 LPRINT A$ : RETURN 27612 LPRINT B$ : RETURN 27614 LPRINT C$ : RETURN 27616 LPRINT D$ : RETURN 27618 LPRINT E$ : RETURN 27620 LPRINT F$ : RETURN 27622 LPRINT G$ : RETURN 27624 LPRINT H$ : RETURN 27625 LPRINT I$ : RETURN 27626 LPRINT J$ : RETURN 27627 LPRINT K$ : RETURN 27628 LPRINT L$ : RETURN 27629 LPRINT M$ : RETURN 27630 LPRINT N$ : RETURN 27631 LPRINT O$ : RETURN 27632 LPRINT P$ : RETURN 27633 LPRINT Q$ : RETURN 27634 LPRINT R$ : RETURN 27635 LPRINT S$ : RETURN 27636 LPRINT T$ : RETURN 27637 LPRINT U$ : RETURN 27638 LPRINT V$ : RETURN 27639 LPRINT W$ : RETURN 27640 LPRINT X$ : RETURN 27650 REM ********************************************************************* 27652 REM * TOP OF FORM (TOF) * 27654 REM ********************************************************************* 27660 FOR I% = 1 TO LINECOUNT% + 6 27670 LPRINT 27675 NEXT I% 27680 FOR I% = 1 TO 6 27685 LPRINT 27690 NEXT I% 27695 GOSUB 27534 : RETURN «eof»