|
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: 47488 (0xb980)
Types: TextFile
Names: »ENTRYME.BAS«
└─⟦f51bd807e⟧ Bits:30005981/disk5.imd Turn Key Data Entry System/Datenerfassungspaket - Vers. 1.90
└─⟦this⟧ »ENTRYME.BAS«
1 REM ************************************************** 2 REM * * 3 REM * MODULE : ENTRYME .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 ************************************************** 9 REM 10 REM *********************************************************************** 11 REM * SET ERROR-HANDLING POINTER AND READ WORKNO. FROM CHAININF-FILE * 12 REM *********************************************************************** 13 ON ERROR GOTO 10000 : GOSUB 22200 REM *** SET ERROR-POINTER AND READ ARBNR 14 IF VAL(ARBNR$) < 1 OR VAL(ARBNR$) > 11 GOTO 16 ELSE GOTO 1010 16 REM *********************************************************************** 17 REM * READ MENUE FROM DEP-FORM-FILE * 18 REM *********************************************************************** 20 ERRFLAG% = 0 : DEPFORM% = 0 : ARBSTATOPEN% = 0 : ARBSTATWRITE% = 0 21 USRFORMFOPEN% = 0 25 CLOSE REM *** CLOSE ALL FILES 30 FORMNAME$ = "DEPFORM .DEP" : FILENAME$ = FORMNAME$ 40 GOSUB 9280 REM *** OPEN FORM-FILE 50 GOSUB 9580 REM *** INIT FORMBUFFER-FIELD 55 FORMNR% = 6 : GOSUB 9674 REM *** READ FORMAR-REC. 60 IF FORMBYTES$ = "#&" THEN 70 63 REM *********************************************************************** 64 REM * NO DEP FORMAT ID. !!! PRINT ERRMSG AND STOP THE SYSTEM * 65 REM *********************************************************************** 66 ERRMSGNR% = 4 : GOSUB 20000 68 GOTO 68 REM *** ILLEGAL DISK 1 !! NO DEP-FORMAT !! 69 REM *********************************************************************** 70 REM * INIT AND CALL DEP TO PRINT MENUE ON CRT * 71 REM *********************************************************************** 72 GOSUB 9100 REM *** OPEN ARBSTAT-FILE 74 GOSUB 9150 REM *** INIT ARBSTAT-FIELD 80 FIELDNO$ = "000" : MODE$ = "00" : SPECMOD$ = "000" 85 LSET FLN$ = FIELDNO$ : LSET MO$ = MODE$ : LSET SM$ = SPECMOD$ 90 F% = VARPTR(#2) : Z% = VARPTR(#1) : CALL INIT(F%,Z%) 100 GOSUB 7240 REM *** TEST GENERAL DEP-STATUS 110 ON PRIMST% GOTO 130,90,90,90,90,90,90,7280,90,90,90,90,90,90 120 GOSUB 7280 : GOTO 16 REM *** PRINT ERRMSG. (DEP-ERROR) 130 ERRFLAG% = 0 : CLOSE REM *** CLOSE ALL FILES 131 REM *********************************************************************** 132 REM * INPUT WORKNO. * 133 REM *********************************************************************** 134 ARBSTATOPEN% = 0 : USRFORMFOPEN% = 0 135 ARBNR$ = SPACE$(2) 152 PRINT CHR$(13);CHR$(6);CHR$(80);CHR$(53);"..";CHR$(8);CHR$(8); 170 ARBNR1$=INPUT$(1) 175 IF ASC(ARBNR1$) = 12 GOTO 135 180 IF ASC(ARBNR1$) < 48 OR ASC(ARBNR1$) > 57 GOTO 170 ELSE 190 190 MID$(ARBNR$,1,1)=ARBNR1$:PRINT ARBNR1$; 200 ARBNR2$=INPUT$(1) 310 IF ASC(ARBNR2$) = 13 GOTO 360 320 IF ASC(ARBNR2$) = 12 GOTO 650 330 IF ASC(ARBNR2$) = 8 THEN PRINT CHR$(8); : GOTO 170 350 IF ASC(ARBNR2$) < 48 OR ASC(ARBNR2$) > 57 GOTO 200 360 MID$(ARBNR$,2,1) = ARBNR2$ : PRINT ARBNR2$; 365 IF VAL(ARBNR$) = 12 OR VAL(ARBNR$) = 13 THEN GOSUB 400 : GOTO 135 370 IF VAL(ARBNR$) < 1 OR VAL(ARBNR$) > 15 THEN GOSUB 400 : GOTO 135 ELSE 500 400 REM *********************************************************************** 402 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 404 REM *********************************************************************** 410 ERRMSGNR% = 1 : GOSUB 20000 : GOSUB 1000 420 RETURN 490 REM *********************************************************************** 495 REM * INPUT 'WORKNO. OK ?' * 500 REM *********************************************************************** 505 ARBNROK$ = SPACE$(1) 510 ON VAL(ARBNR$) GOSUB 520,525,530,535,540,545,550,555,560,565,570,132,132,574,577 511 IF ARBNROK$ = "N" GOTO 135 512 ARBNROK$=INPUT$(1) 514 IF ARBNROK$ = "J" THEN PRINT ARBNROK$; : GOTO 1010 515 IF ARBNROK$ = "N" GOTO 510 516 PRINT CHR$(7); : GOTO 512 517 REM *********************************************************************** 518 REM * SET / RESET INVERSE MODE ON CRT * 519 REM *********************************************************************** 520 PRINT CHR$(6);CHR$(75);CHR$(37);CHR$(128); CHR$(6);CHR$(55);CHR$(37); 523 GOSUB 800 524 RETURN 525 PRINT CHR$(6);CHR$(76);CHR$(38);CHR$(128); CHR$(6);CHR$(55);CHR$(38); 528 GOSUB 800 529 RETURN 530 PRINT CHR$(6);CHR$(74);CHR$(39);CHR$(128); CHR$(6);CHR$(55);CHR$(39); 533 GOSUB 800 534 RETURN 535 PRINT CHR$(6);CHR$(86);CHR$(40);CHR$(128); CHR$(6);CHR$(55);CHR$(40); 538 GOSUB 800 539 RETURN 540 PRINT CHR$(6);CHR$(75);CHR$(41);CHR$(128); CHR$(6);CHR$(55);CHR$(41); 543 GOSUB 800 544 RETURN 545 PRINT CHR$(6);CHR$(72);CHR$(42);CHR$(128); CHR$(6);CHR$(55);CHR$(42); 548 GOSUB 800 549 RETURN 550 PRINT CHR$(6);CHR$(84);CHR$(43);CHR$(128);CHR$(6);CHR$(55);CHR$(43); 553 GOSUB 800 554 RETURN 555 PRINT CHR$(6);CHR$(73);CHR$(44);CHR$(128); CHR$(6);CHR$(55);CHR$(44); 558 GOSUB 800 559 RETURN 560 PRINT CHR$(6);CHR$(67);CHR$(45);CHR$(128); CHR$(6);CHR$(55);CHR$(45); 563 GOSUB 800 564 RETURN 565 PRINT CHR$(6);CHR$(77);CHR$(46);CHR$(128); CHR$(6);CHR$(54);CHR$(46); 568 GOSUB 800 569 RETURN 570 PRINT CHR$(6);CHR$(73);CHR$(47);CHR$(128); CHR$(6);CHR$(54);CHR$(47); 571 GOSUB 800 572 RETURN 574 PRINT CHR$(6);CHR$(75);CHR$(50);CHR$(128); CHR$(6);CHR$(54);CHR$(50); 575 GOSUB 800 576 RETURN 577 PRINT CHR$(6);CHR$(82);CHR$(51);CHR$(128); CHR$(6);CHR$(54);CHR$(51); 578 GOSUB 800 579 RETURN 580 REM *********************************************************************** 585 REM * REPLACE DATA-FLOPPY IN DRIVE 1 * 590 REM *********************************************************************** 600 FILENAME$ = "RESET" : RESET REM *** WRITE CP/M DIR. ON DISK 620 ERRMSGNR% = 8 : GOSUB 20000 630 GOSUB 1000 642 RESET REM *** INIT THE NEW DISK 644 GOTO 16 645 REM *********************************************************************** 646 REM * CALL CP/M (WARM BOOT) * 647 REM *********************************************************************** 650 SYSTEM 790 REM *********************************************************************** 795 REM * SUB.: IF ARBNROK$ = N THEN RESET INVERSE VIDEO ELSE SET INVERSE VID.* 800 REM *********************************************************************** 802 IF ARBNROK$ = "N" THEN INVERS% = 128 ELSE INVERS% = 144 804 PRINT CHR$(INVERS%) 810 PRINT CHR$(6);CHR$(81);CHR$(55); 820 RETURN 900 REM *********************************************************************** 902 REM * CHAIN TO USER-PROGRAMM * 904 REM *********************************************************************** 906 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 908 PRINT " BITTE PROGRAMMNAME EINGEBEN : .......... "; 910 XPOS% = 33 : YPOS% = 25 : GOSUB 1990 912 ONE% = 1 : PROGNAME$ = SPACE$(10) 920 FOR I% = ONE% TO 10 925 KEYINPUT$ = INPUT$(1) 930 IF KEYINPUT$ = CHR$(8) THEN GOTO 950 932 IF KEYINPUT$ = CHR$(24) THEN GOTO 960 934 IF KEYINPUT$ = CHR$(13) THEN GOTO 970 936 IF ASC(KEYINPUT$) < 32 OR ASC(KEYINPUT$) > 122 THEN GOTO 925 938 PRINT KEYINPUT$; 940 MID$(PROGNAME$,I%,1) = KEYINPUT$ 942 NEXT I% 944 I% = 10 : PRINT CHR$(8); : ONE% = 8 : GOTO 920 950 REM --- CURSOR BWD --- 952 IF I% = 1 THEN GOTO 925 954 PRINT KEYINPUT$; 956 I% = I% - 1 : GOTO 925 960 REM --- CURSOR FWD --- 962 IF I% = 10 THEN GOTO 925 964 PRINT KEYINPUT$; 966 I% = I% + 1 : GOTO 925 970 REM --- CR KEY --- 972 PROGNAME$ = PROGNAME$ + ".COM" 974 CHAIN PROGNAME$ 976 REM *********************************************************************** 977 REM * PRINT ERRMSG. IN LINE 25 NO CHAIN-MODUL !! * 978 REM *********************************************************************** 980 ERRMSGNR% = 12 : GOSUB 20000 : GOSUB 1000 : GOTO 16 990 REM ********************************************************************** 995 REM SUB.: (ESC) INPUT AFTER A ERRMSG. * 1000 REM ********************************************************************** 1002 PRINT CHR$(7); : ESCINPUT$ = INPUT$(1) : IF ASC(ESCINPUT$) <> 27 GOTO 1002 1004 PRINT SPACE$(76); : RETURN 1006 REM ********************************************************************** 1008 REM * RESET ALL INPUT-BUFFER AND GO TO SEL. PROGRAMM * 1010 REM ********************************************************************** 1011 IF VAL(ARBNR$) = 15 THEN GOTO 1013 1012 IF VAL(ARBNR$) > 2 THEN PRINT CHR$(12) 1013 OVERWRITE% = 0:NFORMNAME% = 0:NDATANAME% = 0:FIELDINPUT$ = SPACE$(8):FORMNAME$ = SPACE$(12):NFORMNAME$ = SPACE$(12):DATANAME$ = SPACE$(12):NDATANAME$ = SPACE$(12) 1014 ON VAL(ARBNR$) GOTO 3886,3886,3080,4050,4200,4300,4400,4500,4536,3915,4565,16,16,900,600 1860 REM ********************************************************************** 1870 REM * PRINT ERRMSG. IN LINE 25 AND RESET THE INPUT-BUFFER * 1872 REM ********************************************************************** 1873 ERRMSGNR% = 3 : GOSUB 20000 : GOSUB 1000 : GOSUB 4560 : GOTO 3127 1980 REM ********************************************************************** 1985 REM * SUB.: POS. CURSOR * 1990 REM ********************************************************************** 1992 PRINT CHR$(13); 1994 PRINT CHR$(6);CHR$(XPOS%+31);CHR$(YPOS%+31); 1996 RETURN 3070 REM ********************************************************************** 3075 REM * PRINT HEADER ON CRT * 3080 REM ********************************************************************** 3082 XPOS% = 52 : YPOS% = 4 : GOSUB 1990 3085 PRINT CHR$(128); 3090 XPOS% = 28:YPOS% = 4:GOSUB 1990 3095 PRINT CHR$(144); 3100 PRINT "*** Daten erfassen ***" 3102 GOSUB 3972 3110 XPOS% = 2:YPOS% = 10:GOSUB 1990 3120 PRINT "Bitte den Namen der Format-Datei eingeben. ........" 3125 XPOS% = 46 : YPOS% = 10 : GOSUB 1990 3127 NKEYINP% = 8 : FORMNAMEINPFLAG% = 1 3130 ONE% = 1 3131 REM ********************************************************************** 3132 REM * TEST THE KEYBOARD-INPUT KEY'S. ARE THE KEY'S OK PRINT IT ON CRT * 3133 REM ********************************************************************** 3134 FOR I% = ONE% TO NKEYINP% 3140 KEYINPUT$ = INPUT$(1) 3150 IF KEYINPUT$ = "<" GOTO 3140 3160 IF KEYINPUT$ = ">" GOTO 3140 3170 IF KEYINPUT$ = "." GOTO 3140 3180 IF KEYINPUT$ = "," GOTO 3140 3190 IF KEYINPUT$ = ";" GOTO 3140 3200 IF KEYINPUT$ = ":" GOTO 3140 3210 IF KEYINPUT$ = "=" GOTO 3140 3220 IF KEYINPUT$ = "?" GOTO 3140 3230 IF KEYINPUT$ = "*" GOTO 3140 3240 IF KEYINPUT$ = "Æ" GOTO 3140 3250 IF KEYINPUT$ = "Å" GOTO 3140 3260 IF KEYINPUT$ = " " GOTO 3400 3262 IF ASC(KEYINPUT$) = 26 GOTO 3140 3264 IF ASC(KEYINPUT$) = 10 GOTO 3140 3266 IF ASC(KEYINPUT$) = 127 GOTO 3420 3268 IF ASC(KEYINPUT$) = 12 GOTO 1013 3270 IF ASC(KEYINPUT$) = 8 GOTO 3500 3280 IF ASC(KEYINPUT$) = 24 GOTO 3600 3290 IF ASC(KEYINPUT$) = 5 GOTO 3450 3300 IF ASC(KEYINPUT$) = 9 GOTO 3470 3305 IF ASC(KEYINPUT$) = 19 GOTO 3700 3310 IF ASC(KEYINPUT$) = 13 GOTO 3700 3315 IF ASC(KEYINPUT$) = 27 GOTO 3140 3316 IF ASC(KEYINPUT$) = 17 GOTO 16 3317 IF ASC(KEYINPUT$) <= 31 GOTO 3140 3318 IF NKEYINP% = 8 GOTO 3320 3319 IF ASC(KEYINPUT$) < 48 OR ASC(KEYINPUT$) > 57 GOTO 3140 3320 PRINT KEYINPUT$; 3330 MID$(FIELDINPUT$,I%,1) = KEYINPUT$ 3340 NEXT I% 3350 I% = NKEYINP% : PRINT CHR$(8); : IF NKEYINP% = 8 THEN ONE% = 8 : GOTO 3132 3352 ONE% = 3 : GOTO 3132 3399 REM --- SPACE KEY --- 3400 IF MID$(FIELDINPUT$,I%,1) = " " GOTO 3140 ELSE 3320 3420 REM --- RUB-OUT KEY --- 3430 IF I% = 1 GOTO 3446 3435 MID$(FIELDINPUT$,I%,1) = " " : LET I% = I% -1 3445 PRINT " "; : PRINT CHR$(8);CHR$(8); : GOTO 3140 3446 MID$(FIELDINPUT$,I%,1) = " " 3447 PRINT " "; : PRINT CHR$(8); : GOTO 3140 3450 REM --- FIELD BACKWARD KEY --- 3452 IF VAL(ARBNR$) = 10 AND FORMNAMEINPFLAG% = 0 AND NDATANAME% THEN MID$(NDATANAME$,1,8) = FIELDINPUT$ : MID$(FIELDINPUT$,1,8) = DATANAME$ : NDATANAME% = 0 : GOTO 3982 3454 IF VAL(ARBNR$) = 10 AND FORMNAMEINPFLAG% AND NFORMNAME% THEN MID$(NFORMNAME$,1,8) = FIELDINPUT$ : MID$(FIELDINPUT$,1,8) = FORMNAME$ : NFORMNAME% = 0 : GOTO 3125 3455 IF FORMNAMEINPFLAG% THEN GOTO 3125 3458 MID$(DATANAME$,1,8) = MID$(FIELDINPUT$,1,8) : IF VAL(ARBNR$) = 4 OR VAL(ARBNR$) = 7 THEN GOTO 3982 3460 MID$(FIELDINPUT$,1,8) = MID$(FORMNAME$,1,8) : GOTO 3125 3470 REM --- FIELD FORWARD KEY --- 3480 IF FORMNAMEINPFLAG% OR NKEYINP% = 8 GOTO 3700 ELSE 3140 3499 REM --- CURSOR BACKWARD KEY --- 3500 IF I% = 1 GOTO 3140 3510 PRINT KEYINPUT$; 3520 LET I% = I% - 1 3530 GOTO 3140 3600 REM --- CURSOR FORWARD KEY --- 3610 IF I% = NKEYINP% GOTO 3140 3620 FOR BLANKTEST% = I% TO NKEYINP% 3630 IF MID$(FIELDINPUT$,BLANKTEST%,1) = " " GOTO 3640 ELSE 3660 3640 NEXT BLANKTEST% 3650 GOTO 3140 3660 PRINT KEYINPUT$; 3670 LET I% = I% + 1 3680 GOTO 3140 3700 REM --- CR KEY --- 3705 BLANKF% = 0 3710 FOR CRBLANK% = 1 TO NKEYINP% 3720 IF MID$(FIELDINPUT$,CRBLANK%,1) = " " THEN BLANKF% = 1:GOTO 3740 3730 IF BLANKF% = 1 GOTO 3760 3740 NEXT CRBLANK% 3742 REM --- ONLEY SPACE IN A FIELD ? --- 3744 FOR SPACE% = 1 TO NKEYINP% 3746 IF MID$(FIELDINPUT$,SPACE%,1) <> " " GOTO 3765 3748 NEXT SPACE% 3750 IF FORMNAMEINPFLAG% AND VAL(ARBNR$) = 3 GOTO 3125 3752 IF VAL(ARBNR$) = 10 AND NFORMNAME% THEN GOSUB 4560 : GOTO 3127 3754 IF VAL(ARBNR$) = 10 AND NDATANAME% THEN GOSUB 4562 : GOTO 3130 3755 GOTO 3982 3756 REM ********************************************************************** 3757 REM * FORMNAME OR DATANAME INPUT ERROR * 3759 REM ********************************************************************** 3760 IF FORMNAMEINPFLAG% GOTO 3800 ELSE 3920 3762 REM ********************************************************************** 3765 REM * INPUT NEXT FIELD OR CHAIN TO SEL. PROGRAMM / MODUL * 3768 REM ********************************************************************** 3780 IF FORMNAMEINPFLAG% = 0 GOTO 3789 3782 IF NFORMNAME% THEN MID$(NFORMNAME$,1,8) = MID$(FIELDINPUT$,1,8) : MID$(NFORMNAME$,9,4) = ".FRM" : GOTO 3787 3785 MID$(FORMNAME$,1,8) = MID$(FIELDINPUT$,1,8) : MID$(FORMNAME$,9,4) = ".FRM" 3786 IF VAL(ARBNR$) = 10 AND NFORMNAME% = 0 THEN GOSUB 4560 : GOTO 3127 3787 IF MID$(FORMNAME$,1,1) <> " " AND VAL(ARBNR$) = 9 OR VAL(ARBNR$) = 10 OR VAL(ARBNR$) = 11 THEN GOTO 3795 ELSE GOTO 3982 3789 IF NDATANAME% THEN MID$(NDATANAME$,1,8) = MID$(FIELDINPUT$,1,8) : MID$(NDATANAME$,9,4) = ".DAT" : GOTO 3795 3790 MID$(DATANAME$,1,8) = MID$(FIELDINPUT$,1,8) : MID$(DATANAME$,9,4) = ".DAT" 3792 IF VAL(ARBNR$) = 10 AND NDATANAME% = 0 THEN GOSUB 4562 : GOTO 3130 3795 ON VAL(ARBNR$) GOTO 3886,3886,22000,22000,22000,22000,22000,22000,4590,22310,20710 3796 REM ********************************************************************** 3798 REM * PRINT ERRMSG. IN LINE 25. POS. CURSOR AND RETURN TO INPUT * 3800 REM ********************************************************************** 3818 ERRMSGNR% = 2 : GOSUB 20000 : GOSUB 1000 3850 LET XPOS% = 46 + CRBLANK% -2 : YPOS% = 10 3860 GOSUB 1990 3870 LET I% = CRBLANK% - 1: GOTO 3140 3872 REM ********************************************************************** 3873 REM * PRINT ERRMSG. IN LINE 25. RESET INPUT-BUFFER AND RETURN TO INPUT * 3876 REM ********************************************************************** 3878 ERRMSGNR% = 5 : GOSUB 20000 3880 GOSUB 1000 3882 FORMNAME$ = SPACE$(12) 3884 FIELDINPUT$ = SPACE$(8) : GOTO 3110 3885 REM ********************************************************************** 3886 REM * WRITE CHAININFO TO CHAININF-FILE AND CHAIN TO PROGRAMM * 3887 REM ********************************************************************** 3888 ERRFLAG% = 0 : FILENAME$ = "CHAININF.DEP" 3890 OPEN "R",#5,FILENAME$,26 3894 FIELD #5,12 AS CHAININFO1$,12 AS CHAININFO2$,2 AS CHAININFO3$ 3895 LSET CHAININFO1$ = SPACE$(12) : LSET CHAININFO2$ = SPACE$(12) : LSET CHAININFO3$ = SPACE$(2) 3896 LSET CHAININFO1$ = FORMNAME$ : LSET CHAININFO2$ = DATANAME$ : LSET CHAININFO3$ = ARBNR$ 3898 ERRFLAG% = 0 : PUT #5,1 3904 ON VAL(ARBNR$) GOTO 3905,3906,3907,3908,3909,3911,3912,3913,3914,3915,3916 3905 CHAIN "B:FORMAT.COM" 3906 CHAIN "B:FORMAT.COM" 3907 CHAIN "B:ENTRY.COM" 3908 CHAIN "B:ENTRY.COM" 3909 CHAIN "B:ENTRY.COM" 3911 CHAIN "B:VERIFY.COM" 3912 CHAIN "B:VERIFY.COM" 3913 CHAIN "B:VERIFY.COM" 3914 GOTO 4590 3915 GOTO 4546 3916 GOTO 20710 3917 REM ********************************************************************** 3918 REM * PRINT ERRMSG. IN LINE 25. POS. CURSOR AND RETURN TO INPUT * 3919 REM ********************************************************************** 3920 ERRMSGNR% = 6 : GOSUB 20000 3930 GOSUB 1000 3950 LET XPOS% = 46 + CRBLANK% - 2 : YPOS% = 14 3960 GOSUB 1990 3970 LET I% = CRBLANK% - 1 : GOTO 3140 3971 REM ********************************************************************** 3972 REM * PRINT TEXT ON CRT AND POS. CURSOR * 3973 REM ********************************************************************** 3974 XPOS% = 2 : YPOS% = 14 3976 GOSUB 1990 3978 PRINT "Bitte den Namen der Arbeitsdatei eingeben. ........" 3980 RETURN 3982 XPOS% = 46 : YPOS% = 14 3984 GOSUB 1990 3985 REM ********************************************************************** 3986 REM * SET INPUT-FIELD TO ENTER THE DATANAME * 3987 REM ********************************************************************** 3988 FORMNAMEINPFLAG% = 0 : NFORMNAME% = 0 : MID$(FIELDINPUT$,1,8) = MID$(DATANAME$,1,8) : GOTO 3130 4000 REM ********************************************************************** 4010 REM * PRINT HEADER ON CRT AND ALLOW INPUT * 4050 REM ********************************************************************** 4060 XPOS% = 58 : YPOS% = 4 : GOSUB 1990 4070 PRINT CHR$(128); : XPOS% = 23 : YPOS% = 4 : GOSUB 1990 4080 PRINT CHR$(144);"*** Daten erfassen, fortsetzen ***" 4090 GOSUB 3974 : NKEYINP% = 8 : GOTO 3982 4092 REM ********************************************************************** 4096 REM * PRINT ERRMSG. IN LINE 25. RESET THE INPUT-FIELD AND ALLOW INPUT * 4100 REM ********************************************************************** 4110 ERRMSGNR% = 7 : GOSUB 20000 4140 GOSUB 1000 4160 DATANAME$ = SPACE$(12) 4170 FIELDINPUT$ = SPACE$(8) : GOSUB 3972 4180 GOTO 3982 4182 REM ********************************************************************** 4183 REM * PRINT ERRMSG. IN LINE 25. RESET INPUT-BUFFER AND ALLOW INPUT * 4185 REM ********************************************************************** 4186 ERRMSGNR% = 11 : GOSUB 20000 : GOSUB 1000 4187 IF VAL(ARBNR$) = 10 THEN GOSUB 4562 : GOTO 3130 4188 DATANAME$ = SPACE$(12) : FIELDINPUT$ = SPACE$(12) : GOSUB 3972 : GOTO 3982 4200 REM ********************************************************************** 4210 REM * PRINT HEADER ON CRT AND ALLOW INPUT * 4215 REM ********************************************************************** 4220 XPOS% = 52 : YPOS% = 4 : GOSUB 1990 4230 PRINT CHR$(128);: XPOS% = 27 : YPOS% = 4 : GOSUB 1990 4240 PRINT CHR$(144);"*** Daten verændern ***" 4250 GOTO 3102 4260 REM ********************************************************************** 4270 REM * PRINT HEADER ON CRT AND ALLOW INPUT * 4300 REM ********************************************************************** 4310 XPOS% = 51 : YPOS% = 4 : GOSUB 1990 4320 PRINT CHR$(128);: XPOS% = 29 : YPOS% = 4 : GOSUB 1990 4330 PRINT CHR$(144);"*** Daten pråfen ***" 4340 GOTO 3102 4390 REM ********************************************************************** 4395 REM * PRINT HEADER ON CRT AND ALLOW INPUT * 4400 REM ********************************************************************** 4410 XPOS% = 57 : YPOS% = 4 : GOSUB 1990 4420 PRINT CHR$(128);: XPOS% = 24 : YPOS% = 4 : GOSUB 1990 4430 PRINT CHR$(144);"*** Daten pråfen, fortsetzen ***" 4440 GOSUB 3974 : NKEYINP% = 8 : GOTO 3982 4490 REM ********************************************************************** 4495 REM * PRINT HEADER ON CRT AND ALLOW INPUT * 4500 REM ********************************************************************** 4510 XPOS% = 51 : YPOS% = 4 : GOSUB 1990 4520 PRINT CHR$(128);: XPOS% = 28 : YPOS% = 4 : GOSUB 1990 4530 PRINT CHR$(144);"*** Datei drucken ***" 4532 GOTO 3102 4533 REM ********************************************************************** 4534 REM * PRINT HEADER ON CRT AND ALLOW INPUT * 4535 REM ********************************************************************** 4536 XPOS% = 48 : YPOS% = 4 : GOSUB 1990 4538 PRINT CHR$(128); : XPOS% = 32 : YPOS% = 4 : GOSUB 1990 4540 PRINT CHR$(144);"*** KATALOG ***" 4542 GOTO 3102 4543 REM ********************************************************************** 4544 REM * PRINT HEADER AND TEXT ON CRT AND ALLOW INPUT * 4545 REM ********************************************************************** 4546 XPOS% = 53 : YPOS% = 4 : GOSUB 1990 4548 PRINT CHR$(128); : XPOS% = 27 : YPOS% = 4 : GOSUB 1990 4550 PRINT CHR$(144);"*** Dateiname ændern ***"; 4552 XPOS% = 2 : YPOS% = 11 : GOSUB 1990 4554 PRINT "Bitte neuen Namen der Format-Datei eingeben ........"; 4555 XPOS% = 2 : YPOS% = 15 : GOSUB 1990 4556 PRINT "Bitte neuen Namen der Arbeitsdatei eingeben ........"; 4558 GOTO 3102 4559 REM **************** POS. CURSOR AND RESET FIELD-INPUT ******************* 4560 XPOS% = 46 : YPOS% = 11 : GOSUB 1990 : NFORMNAME% = 1 : MID$(FIELDINPUT$,1,8) = NFORMNAME$ : RETURN 4561 REM **************** POS. CURSOR AND RESET FIELD-INPUT ******************* 4562 XPOS% = 46 : YPOS% = 15 : GOSUB 1990 : NDATANAME% = 1 : MID$(FIELDINPUT$,1,8) = NDATANAME$ : RETURN 4563 REM ********************************************************************** 4564 REM * PRINT HEADER ON CRT AND ALLOW INPUT * 4565 REM ********************************************************************** 4566 XPOS% = 50 : YPOS% = 4 : GOSUB 1990 4570 PRINT CHR$(128); : XPOS% = 27 : YPOS% = 4 : GOSUB 1990 4575 PRINT CHR$(146);"*** Datei løschen ***" 4580 PRINT CHR$(7);CHR$(7);CHR$(7); : GOTO 3102 4582 REM ********************************************************************** 4584 REM * DISPLAY ARBSTAT-RECORD * 4590 REM ********************************************************************** 4592 IF ARBSTATOPEN% GOTO 4596 ELSE GOSUB 9100 REM *** OPEN ARBSTAT-FILE 4596 GOSUB 9180 REM *** READ ARBSTAT-DIR 4602 IF MID$(DATANAME$,1,1) = " " GOTO 4612 4603 IF DATANAME$ = "KATALOG .DAT" GOTO 4800 4604 FILENAME$ = DATANAME$ : FORMNR% = 1 4606 GOSUB 7410 REM *** SEARCHE FILE IN ARBSTAT-DIR 4608 IF FILEINDIR% GOTO 4620 ELSE 4110 4612 IF MID$(FORMNAME$,1,1) = " " GOTO 1013 4613 IF FORMNAME$ = "KATALOG .FRM" GOTO 4800 4614 FILENAME$ = FORMNAME$ : FORMNR% = 3 4616 GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 4618 IF FILEINDIR% GOTO 4620 ELSE 3873 4620 R1$ = MID$(NAME$,13,4) : R1% = VAL(R1$) 4622 GOSUB 9150 : GOSUB 9564 REM *** READ ARBSTAT 4625 FORMCHAIN$ = FC$:OMODE$ = MO$:STATUS$ = ST$ : PSTATUS$ = SP$ 4626 DRECCOUNT$ = SPACE$(6):MID$(DRECCOUNT$,1,3) = SM$ : MID$(DRECCOUNT$,4,3) = WF$ 4627 PRECCOUNT$ = SPACE$(6) : MID$(PRECCOUNT$,1,4) = VA$ : MID$(PRECCOUNT$,5,2) = MID$(PC$,1,2) 4628 CRECCOUNT$ = SPACE$(6) : MID$(CRECCOUNT$,1,2) = MID$(PC$,3,2) : MID$(CRECCOUNT$,3,4) = FL$ 4629 REM ********************************************************************** 4630 REM * READ ARBSTAT-FORMAT AND CALL THE DEP TO PRINT IT ON CRT * 4631 REM ********************************************************************** 4632 FORMNAME$ = "DEPFORM .DEP" : FILENAME$ = FORMNAME$ 4634 GOSUB 9280 REM *** OPEN DEP-FORMFILE 4636 GOSUB 9580 REM *** INIT FORMBUFFER 4638 GOSUB 9674 REM *** READ FORMREC #1 FROM DEP-FORMFILE 4642 IF FORMBYTES$ <> "#&" GOTO 4770 4644 FIELDNO$ = "000" : MODE$ = "00" : SPECMOD$ = "000" REM *** SET DEP TO ENTRY MODE WITH FIELD 00 4646 LSET FLN$ = FIELDNO$ : LSET MO$ = MODE$ : LSET SM$ = SPECMOD$ 4647 REM ********************************************************************** 4648 REM * CALL THE DEP * 4649 REM ********************************************************************** 4650 F% = VARPTR(#2) : Z% = VARPTR(#1) : CALL INIT(F%,Z%) 4652 REM ********************************************************************** 4654 GOSUB 7240 REM *** TEST GENERAL DEP STAT 4656 ON PRIMST% GOTO 4680,4650,4650,4650,4650,4650,4650,16,4650,4650,4650,4650,4650,4650 4658 GOSUB 7280 REM *** DEP STATUS-ERROR 4660 GOTO 16 4680 IF ARBSTAT% GOTO 4812 4681 XPOS% = 3:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,3,8);:XPOS% = 15:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,11,8);CHR$(13); 4682 XPOS% = 30:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,23,3);CHR$(13); 4683 XPOS% = 41:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,26,3);:XPOS% = 52:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,29,1); 4684 XPOS% = 63:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,30,3);:XPOS% = 73:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,33,3); 4685 XPOS% = 28:YPOS% = 7:GOSUB 1990: 4686 FOR N%=1 TO 6:IF MID$(NONZ$,38+N%,1)=" " THEN PRINT "0"; ELSE PRINT MID$(NONZ$,38+N%,1); 4687 NEXT N% 4688 XPOS% = 61:YPOS% = 7:GOSUB 1990:PRINT PRECCOUNT$;:XPOS% = 72:YPOS% = 7:GOSUB 1990:PRINT CRECCOUNT$; 4691 XPOS% = 25:YPOS% = 10:GOSUB 1990:PRINT MID$(NONZ$,51,4);:XPOS% = 25:YPOS% = 12:GOSUB 1990:PRINT MID$(NONZ$,19,4); 4692 XPOS% = 23:YPOS% = 14:GOSUB 1990:PRINT DRECCOUNT$;CHR$(13); 4693 XPOS% = 25:YPOS% = 16:GOSUB 1990:PRINT FORMCHAIN$;CHR$(13); 4697 XPOS% = 21:YPOS% = 22:GOSUB 1990:PRINT MID$(PSTATUS$,1,2);" ";:PRINT MID$(PSTATUS$,3,5); 4698 XPOS% = 8:YPOS% = 24:GOSUB 1990:PRINT OMODE$;:XPOS% = 19:YPOS% = 24:GOSUB 1990 4700 PRINT MID$(STATUS$,1,2);:XPOS% = 23:YPOS% = 24:GOSUB 1990:PRINT MID$(STATUS$,3,2); 4710 XPOS% = 27:YPOS% = 24:GOSUB 1990:PRINT MID$(STATUS$,5,2);CHR$(13); 4711 IF FORMNR% = 3 THEN GOSUB 4871 : GOTO 4748 4712 XPOS% = 28:YPOS% = 4:GOSUB 1990:PRINT KE$;:XPOS% = 40:YPOS% = 4:GOSUB 1990:PRINT KV$; 4714 XPOS% = 51:YPOS% = 4:GOSUB 1990:PRINT EC$;:XPOS% = 28:YPOS% = 5:GOSUB 1990:PRINT EE$; 4716 XPOS% = 40:YPOS% = 5:GOSUB 1990:PRINT VE$;:XPOS% = 40:YPOS% = 6:GOSUB 1990:PRINT VK$; 4718 XPOS% = 51:YPOS% = 6:GOSUB 1990:PRINT FK$; 4720 XPOS% = 40 : YPOS% = 7 : GOSUB 1990 4721 FOR N% = 1 TO 6 4722 IF MID$(NONZ$,44+N%,1) = " " THEN PRINT "0"; ELSE PRINT MID$(NONZ$,44+N%,1); 4723 NEXT N% 4724 P1% = 36 : P2% = 10 : XPOS% = P1% : YPOS% = P2% : GOSUB 1990 4726 FOR F% = 1 TO 211 STEP 15 4728 PRINT MID$(ADDR$,F%,15); 4730 XPOS% = P1% : P2% = P2% + 1 : YPOS% = P2% : GOSUB 1990 4732 NEXT F% 4734 P1% = 60 : P2% = 10 : XPOS% = P1% : YPOS% = P2% : GOSUB 1990 4736 FOR F% = 1 TO 121 STEP 15 4738 PRINT MID$(SUBR$,F%,15); 4740 XPOS% = P1% : P2% = P2% + 1 : YPOS% = P2% : GOSUB 1990 4742 NEXT F% 4744 XPOS% = 60 : YPOS% = 22 : GOSUB 1990 : PRINT MR$; 4748 XPOS% = 1:YPOS% = 25:GOSUB 1990:PRINT SPACE$(76);CHR$(13);" *** (ESC) *** ";CHR$(13); 4749 GOSUB 1000 : GOSUB 8210 REM *** CLOSE FORMAT-FILE 4755 GOTO 1012 4760 REM ********************************************************************** 4762 REM * PRINT ERRMSG. IN LINE 25 4764 REM ********************************************************************** 4770 ERRMSGNR% = 9 : GOSUB 20000 4790 GOSUB 1000 : GOTO 16 4800 REM ********************************************************************** 4802 REM * PRINT ARBSTAT-DIR ON CRT * 4804 REM ********************************************************************** 4810 FORMNR% = 2 : ARBSTAT% = 1 : GOSUB 9150 : GOTO 4630 REM *** INIT ARBSTAT FIELD TO CALL DEP 4811 REM ****************** PRINT ARBSTAT-DIR ********************************* 4812 GOSUB 9180 REM *** READ ARBSTAT-DIR 4814 ID$ = "FRM" : P1% = 2 : P2% = 2 4815 FOR F% = 1 TO 2 4816 XPOS% = P1% : YPOS% = P2% : GOSUB 1990 4820 FOR I% = 15 TO 127 STEP 16 4825 IF MID$(ARBSTATDIR1$,I%+9,3) = ID$ THEN PRINT MID$(ARBSTATDIR1$,I%,8); 4827 XPOS% = P1% + 10:P1% = XPOS%:YPOS% = P2%:GOSUB 1990 4830 NEXT I% 4832 P1% = 2:XPOS% = P1%:YPOS% = P2% + 1:GOSUB 1990 4834 FOR I% = 143 TO 239 STEP 16 4836 IF MID$(ARBSTATDIR1$,I%+9,3) = ID$ THEN PRINT MID$(ARBSTATDIR1$,I%,8); 4837 XPOS% = P1% + 10:P1% = XPOS%:YPOS% = P2% + 1:GOSUB 1990 4838 NEXT I% 4840 XPOS% = 72:YPOS% = P2% + 1:GOSUB 1990 4842 IF MID$(ARBSTATDIR2$,10,3) = ID$ THEN PRINT MID$(ARBSTATDIR2$,1,8); 4844 P1% = 2:XPOS% = P1%:YPOS% = P2% + 2:GOSUB 1990 4846 FOR I% = 17 TO 129 STEP 16 4850 IF MID$(ARBSTATDIR2$,I%+9,3) = ID$ THEN PRINT MID$(ARBSTATDIR2$,I%,8); 4851 XPOS% = P1% + 10:P1% = XPOS%:YPOS% = P2% + 2:GOSUB 1990 4852 NEXT I% 4854 P1% = 12:XPOS% = P1%:YPOS% = P2% + 3:GOSUB 1990 4856 FOR I% = 145 TO 225 STEP 16 4860 IF MID$(ARBSTATDIR2$,I%+9,3) = ID$ THEN PRINT MID$(ARBSTATDIR2$,I%,8); 4861 XPOS% = P1% + 10:P1% = XPOS%:YPOS% = P2% + 3:GOSUB 1990 4862 NEXT I% 4864 P1% = 2 : P2% = 8 : ID$ = "DAT" 4866 NEXT F% 4867 ARBSTAT% = 0 : XPOS% = 68 : YPOS% = 24 : GOSUB 1990 : PRINT "1"; : GOTO 4748 4868 REM ********************************************************************** 4869 REM PRINT FORMAT-NO. AND FORMAT-CHAIN-KEY ON CRT * 4870 REM ********************************************************************** 4871 P1% = 25 : P2% = 10 : I1% = 1 : I2% = 21 : F1% = 1 4872 FOR I% = 1 TO 8 4874 FOR F% = I1% TO I2% STEP 4 4875 XPOS% = P1% + 8 : YPOS% = P2% : P1% = XPOS% : GOSUB 1990 4876 IF MID$(ADDR$,F%,4) = " " GOTO 4880 4878 PRINT MID$(ADDR$,F%+1,3); : IF MID$(ADDR$,F%,1) = "*" THEN PRINT MID$(ADDR$,F%,1); ELSE PRINT CHR$(24); 4879 PRINT MID$(SUBR$,F1%,3); 4880 F1% = F1% + 3 4881 NEXT F% 4882 ON I% GOTO 4886,4888,4890,4892,4894,4896,4898 4884 RETURN 4886 P1% = 25 : P2% = 12 : I1% = 25 : I2% = 45 : GOTO 4900 4888 P1% = 25 : P2% = 14 : I1% = 49 : I2% = 69 : GOTO 4900 4890 P1% = 25 : P2% = 16 : I1% = 73 : I2% = 93 : GOTO 4900 4892 P1% = 25 : P2% = 18 : I1% = 97 : I2% = 117 : GOTO 4900 4894 P1% = 25 : P2% = 20 : I1% = 121 : I2% = 141 : GOTO 4900 4896 P1% = 25 : P2% = 22 : I1% = 145 : I2% = 165 : GOTO 4900 4898 P1% = 25 : P2% = 24 : I1% = 169 : I2% = 177 : GOTO 4900 4900 NEXT I% 6620 REM ********************************************************************** 6622 REM * SUB.: DECREMENT RECORD-COUNTER * 6624 REM ********************************************************************** 6625 RECCOUNT$ = MID$(NONZ50$,39,6) : RECCOUNT% = VAL(RECCOUNT$) 6630 RECCOUNT% = RECCOUNT% - 1 : RECCOUNT$ = STR$(RECCOUNT%) 6635 NRECCOUNT$ = SPACE$(6) : RSET NRECCOUNT$ = RECCOUNT$ 6640 MID$(NONZ50$,39,6) = NRECCOUNT$ : RETURN 7210 REM ********************************************************************** 7212 REM * SUB.: CLEAR ADD/SUB/MUL REGISTER TO USE IT AS FORMAT-NO. - DIR * 7214 REM ********************************************************************** 7220 MID$(MR$,1,15) = SPACE$(15) : MID$(ADDR$,1,225) = SPACE$(225) : MID$(SUBR$,1,135) = SPACE$(135) 7230 RETURN 7240 REM ********************************************************************** 7242 REM * SUB.: CHECK GENERAL-STATUS (DEP) * 7244 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 7280 ERRMSGNR% = 10 : GOSUB 20000 7300 GOSUB 1000 : RETURN 7310 REM ********************************************************************** 7320 PRIMST% = 8 : RETURN 7330 RETURN 7400 REM ********************************************************************** 7402 REM * SUB.: FILE IN ARBSTAT-DIR. ? * 7404 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% = 16 : GOSUB 20000 8030 GOSUB 1000 : GOTO 16 8050 REM ******************* FATAL SYTEM ERROR ******************************** 8060 GOTO 8270 8100 REM ******************* DISC I/O ERROR *********************************** 8110 GOTO 8270 8120 REM ******************* DISC FULL **************************************** 8130 GOTO 16 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 FORMFILE *********************************** 8210 ERRFLAG% = 0 : USRFORMFOPEN% = 0 8220 CLOSE #2 : RETURN 8260 REM ********************************************************************** 8262 REM * ERROR !!! WRITE ERROR-NO. IN ARBSTAT * 8264 REM ********************************************************************** 8270 IF ARBSTATOPEN% = 1 AND ARBSTATWRITE% = 1 THEN GOTO 8280 ELSE GOTO 16 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 16 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% = 17 : GOSUB 20000 9250 GOSUB 1000 : RETURN 9270 REM ******************** OPEN FORMFILE *********************************** 9280 USRFORMFOPEN% = 1 : ERRFLAG% = 0 9290 OPEN "R",#2,FORMNAME$,1922 9300 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 FORMBUFFER ********************************* 9580 FIELD #2,2 AS FORMBYTES$,255 AS FORMREC1$,255 AS FORMREC2$,255 AS FORMREC3$,255 AS FORMREC4$,255 AS FORMREC5$,255 AS FORMREC6$, 255 AS FORMREC7$,135 AS FORMREC8$ 9585 RETURN 9672 REM ******************** READ FORMREC ************************************ 9674 ERRFLAG% = 0 9676 GET #2,FORMNR% 9678 RETURN 9680 REM ********************************************************************** 9685 REM * SUB.: DECREMENT RECORD-COUNTER * 9688 REM ********************************************************************** 9690 RECCOUNT$ = MID$(NONZ50$,39,6) : RECCOUNT% = VAL(RECCOUNT$) 9700 RECCOUNT% = RECCOUNT% + 1 : RECCOUNT$ = STR$(RECCOUNT%) 9705 NRECCOUNT$ = SPACE$(6) : RSET NRECCOUNT$ = RECCOUNT$ 9710 MID$(NONZ50$,39,6) = NRECCOUNT$ : RETURN 9900 REM ********************************************************************** 9902 REM * ERROR HANDLING * 9904 REM ********************************************************************** 9910 ON ERRFLAG% GOTO 8060,8060,8060,8110,8130,8150,8010 9920 GOTO 16 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 GOSUB 10340 : ERRFLAG% = 4 : RESUME 9900 10112 REM ********************************************************************* 10114 REM * PRINT I/O ERRMSG. IN LINE 25 * 10116 REM ********************************************************************* 10160 ERRMSGNR% = 18 : GOSUB 20000 10190 GOSUB 1000 : ERRFLAG% = 5 : RESUME 9900 10200 REM ********************************************************************* 10202 REM * PRINT I/O ERRMSG. IN LINE 25 * 10204 REM ********************************************************************* 10210 ERRMSGNR% = 19 : GOSUB 1990 10240 GOSUB 1000 : ERRFLAG% = 6 : RESUME 9900 10250 REM ********************************************************************* 10290 GOSUB 10340 : ERRFLAG% = 7 : RESUME 9900 10310 IF VAL(ARBNR$) = 11 THEN GOSUB 10380 : RESUME 20810 10312 IF VAL(ARBNR$) = 14 THEN RESUME 980 10314 ERRFLAG% = 1 : RESUME 9900 10320 ERRFLAG% = 2 : RESUME 9900 10330 ERRFLAG% = 3 : RESUME 9900 10332 REM ********************************************************************* 10334 REM * SUB.: PRINT BASIC OR I/O ERRMSG. IN LINE 25 * 10336 REM ********************************************************************* 10340 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 10350 PRINT CHR$(144);" *** FEHLER #";ERR;"/";ERL;" DATEI: ";FILENAME$;" (ON ERR) !! (ESC) ***";CHR$(128);CHR$(30);CHR$(13); 10360 GOSUB 1000 : RETURN 10370 REM ********************************************************************* 10372 REM * SUB.: PRINT I/O ERRMSG. IN LINE 25 * 10374 REM ********************************************************************* 10380 ERRMSGNR% = 20 : GOSUB 20000 10400 GOSUB 1000 : RETURN 20000 REM ********************************************************************* 20002 REM * SUB.: PRINT ERROR-MSG. ON CRT * 20004 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,20260,20270,20280,20290,20300,20310 20095 PRINT " !! (ESC) *** ";CHR$(128);CHR$(30);CHR$(13); 20115 RETURN 20120 PRINT "ARBEITS NR. FALSCH"; : RETURN REM *** MSG. 01 20130 PRINT "FORMATNAME FALSCH"; : RETURN REM *** MSG. 02 20140 PRINT "FORMATNAME BERIETS VORHANDEN"; : RETURN REM *** MSG. 03 20150 PRINT "KEINE SYSTEM-FORMATE"; : RETURN REM *** MSG. 04 20160 PRINT "FORMAT-DATEI NICHT VORHANDEN"; : RETURN REM *** MSG. 05 20170 PRINT "NAME DER ARBEITSDATEI FALSCH"; : RETURN REM *** MSG. 06 20180 PRINT "ARBEITSDATEI NICHT VORHANDEN"; : RETURN REM *** MSG. 07 20190 PRINT "NEUE DISKETTE IN LAUFWERK 1 EINLEGEN"; : RETURN REM *** MSG. 08 20200 PRINT "KEINE SYSTEM-FORMATE FÅR DIE ARBEITS-STATUS-DATEI"; : RETURN REM *** MSG. 09 20210 PRINT "DEP FEHLER-STATUS"; : RETURN REM *** MSG. 10 20220 PRINT "ARBEITSDATEI BEREITS VORHANDEN"; : RETURN REM *** MSG. 11 20230 PRINT "KEIN PROGRAMM ";MID$(PROGNAME$,1,10); : RETURN REM *** MSG. 12 20240 PRINT "ÆNDERUNG DURCHGEFÅHRT"; : RETURN REM *** MSG. 13 20250 RETURN REM *** MSG. 14 (FREE) 20260 RETURN REM *** MSG. 15 (FREE) 20270 PRINT "ARBEITS-STATUS-DATEI NICHT VORHANDEN"; : RETURN REM *** MSG. 16 20280 PRINT "ARBEITS-STATUS-DATEI VOLL"; : RETURN REM *** MSG. 17 20290 PRINT "SCHREIB- ODER LESEFEHLER AUF DER DISKETTE"; : RETURN REM *** MSG. 18 20300 PRINT "DISKETTE VOLL"; : RETURN REM *** MSG. 19 20310 PRINT "DATEI NICHT IN DER CP/M DATEIVERWALTUNG"; : RETURN REM *** MSG. 20 20700 REM ********************************************************************* 20702 REM * DELETE A FILE * 20704 REM ********************************************************************* 20710 IF ARBSTATOPEN% GOTO 20730 ELSE GOSUB 9100 REM *** OPEN ARBSTAT 20730 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 : PRINT SPACE$(76); 20735 GOSUB 9180 REM *** READ ARBSTAT-DIR 20750 IF MID$(DATANAME$,1,1) = " " GOTO 20760 20755 FILENAME$ = DATANAME$ : GOTO 20770 20760 IF MID$(FORMNAME$,1,1) = " " GOTO 1013 20765 FILENAME$ = FORMNAME$ 20770 GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 20780 IF FILEINDIR% THEN GOTO 20790 ELSE IF MID$(DATANAME$,1,1) = " " THEN GOTO 3873 ELSE GOTO 4110 20790 IF ENTRYSTATERR% THEN GOTO 20810 ELSE ERRFLAG% = 0 : KILL FILENAME$ REM *** KILL THE CP/M FILE 20810 IF DIR2% GOTO 20840 20820 MID$(ARBSTATDIR1$,I%,16) = SPACE$(16) 20830 GOTO 20841 20840 MID$(ARBSTATDIR2$,I%,16) = SPACE$(16) 20841 GOSUB 21020 REM *** DECREMENT ARBSTAT RECCOUNT 20842 GOSUB 9370 REM *** WRITE ARBSTAT-DIR 20850 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 20860 PRINT CHR$(144);"*** ";MID$(FILENAME$,1,8);" GELØSCHT !!! "; 20870 IF VAL(ARBNR$) = 11 THEN PRINT "***";CHR$(128);CHR$(13);CHR$(7); : GOTO 1013 20880 PRINT "ANZAHL SÆTZE = 00 !! (ESC) ";CHR$(128);CHR$(13);CHR$(7); : GOSUB 1000 : GOTO 16 21010 REM ********************************************************************* 21012 REM * SUB.: DECREMENT ARBSTAT-RECORD-COUNTER * 21014 REM ********************************************************************* 21020 ARBSTATRECCOUNT$ = MID$(ARBSTATDIR1$,11,4) : ARBSTATRECCOUNT% = VAL(ARBSTATRECCOUNT$) 21030 ARBSTATRECCOUNT% = ARBSTATRECCOUNT% - 1 : ARBSTATRECCOUNT$ = STR$(ARBSTATRECCOUNT%) 21040 NARBSTATRECCOUNT$ = SPACE$(4) : RSET NARBSTATRECCOUNT$ = ARBSTATRECCOUNT$ 21050 MID$(ARBSTATDIR1$,11,4) = NARBSTATRECCOUNT$ 21060 RETURN 22000 REM ********************************************************************* 22002 REM * FILES ON DISC ? * 22004 REM ********************************************************************* 22010 GOSUB 9100 REM *** OPEN ARBSTAT 22030 GOSUB 9170 REM *** READ ARBSTATDIR 22042 ERRFLAG% = 0 : CLOSE REM *** CLOSE ALL FILES 22044 IF MID$(FORMNAME$,1,1) = " " GOTO 22100 22050 FILENAME$ = FORMNAME$ 22060 GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 22070 IF FILEINDIR% GOTO 22100 22090 GOTO 3873 22100 FILENAME$ = DATANAME$ 22110 GOSUB 7410 REM *** SEARCH FILE ARBSTAT-DIR 22120 IF VAL(ARBNR$) = 3 AND FILEINDIR% GOTO 4185 22122 IF VAL(ARBNR$) = 3 AND FILEINDIR% = 0 GOTO 3886 22124 IF FILEINDIR% GOTO 3886 22150 GOTO 4100 22200 REM ********************************************************************* 22202 REM * READ FROM CHAININF-FILE THE WORK-NO. * 22204 REM ********************************************************************* 22210 ERRFLAG% = 0 : FILENAME$ = "CHAININF.DEP" 22220 OPEN "R",#5,FILENAME$,26 22240 FIELD #5,12 AS CHAININFO1$,12 AS CHAININFO2$,2 AS CHAININFO3$ 22250 ERRFLAG% = 0 : GET #5,1 22270 FORMNAME$ = CHAININFO1$ : DATANAME$ = CHAININFO2$ : ARBNR$ = CHAININFO3$ 22280 ERRFLAG% = 0 : CLOSE REM *** CLOSE ALL FILES 22290 RETURN 22300 REM ********************************************************************* 22302 REM * RENAME A FILE * 22304 REM ********************************************************************* 22310 IF ARBSTATOPEN% THEN GOTO 22330 ELSE GOSUB 9100 REM *** OPEN ARBSTAT 22330 GOSUB 9180 REM *** READ ARBSTAT-DIR 22350 IF MID$(FORMNAME$,1,1) = " " THEN GOTO 22430 22360 FILENAME$ = FORMNAME$ : GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 22370 IF FILEINDIR% = 0 THEN NFORMNAME% = 0 : GOTO 3873 22380 FILENAME$ = NFORMNAME$ : GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 22390 IF FILEINDIR% GOTO 1873 22392 FILENAME$ = FORMNAME$ : GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 22400 IF DIR2% THEN MID$(ARBSTATDIR2$,I%,12) = NFORMNAME$ ELSE MID$(ARBSTATDIR1$,I%,12) = NFORMNAME$ 22420 NFILENAME$ = NFORMNAME$ : GOSUB 22485 : GOSUB 22510 : GOTO 1013 22430 FILENAME$ = DATANAME$ : GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 22440 IF FILEINDIR% = 0 THEN NDATANAME% = 0 : GOTO 4110 22450 FILENAME$ = NDATANAME$ : GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 22460 IF FILEINDIR% GOTO 4186 22462 FILENAME$ = DATANAME$ : GOSUB 7410 REM *** SEARCH FILE IN ARBSTAT-DIR 22470 IF DIR2% THEN MID$(ARBSTATDIR2$,I%,12) = NDATANAME$ ELSE MID$(ARBSTATDIR1$,I%,12) = NDATANAME$ 22474 NFILENAME$ = NDATANAME$ : GOSUB 22485 : GOSUB 22510 : GOTO 1013 22485 ERRFLAG% = 0 : NAME FILENAME$ AS NFILENAME$ REM *** RENAME THE CP/M FILENAME 22487 GOSUB 9370 REM *** WRITE ARBSTAT-DIR 22488 R1$ = MID$(NAME$,13,4) : R1% = VAL(R1$) 22490 GOSUB 9150 : GOSUB 9564 REM *** READ ARBSTAT 22494 IF MID$(FORMNAME$,1,1) = " " THEN MID$(NONZ$,3,8) = NDATANAME$ ELSE MID$(NONZ$,11,8) = NFORMNAME$ 22496 GOSUB 9550 REM *** WRITE ARBSTAT 22498 RETURN 22500 REM ********************************************************************* 22502 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 22504 REM ********************************************************************* 22510 ERRMSGNR% = 13 : GOSUB 20000 22530 GOSUB 1000 : RETURN «eof»