1 WIDTH 255
2 COMMON date$
5 CLEAR ,,,,512
6 satz%=270
20 REM geschrieben von Graman Engelbert 4020 Linz
25 REM  schneider joyce mit 368k ram, 1 floppy 180k und 1 floppy 720k
30 BUFFERS 24
40 REM escapes definieren
50 GOSUB 50000
60 REM datum holen
70 GOSUB 59000
200 REM men}
210 uber$=" Lagerkartei - Men} "
220 GOSUB 50400
230 z=10:s=24:GOSUB 50100:PRINT inv$" Eintr{ge bearbeiten     ... 1 "
240 z=12:GOSUB 50100:PRINT inv$" Eintr{ge ausdrucken     ... 2 "
250 z=14:GOSUB 50100:PRINT inv$" Neuer Eintrag           ... 3 "
260 z=16:GOSUB 50100:PRINT inv$" Bestelldatei l|schen    ... 4 "
263 z=18:GOSUB 50100:PRINT inv$" Neue Datei anlegen      ... 5 "
270 z=20:GOSUB 50100:PRINT inv$" Zur}ck ins Hauptmen} ... EXIT ";nrm$
280 z=24:GOSUB 50100:PRINT inv$" Ihre Wahl: _";nrm$;lft$;
290 a$=INKEY$:IF (a$<"1" OR a$>"5") AND a$<>CHR$(27) THEN 290
300 IF a$=CHR$(27) THEN WIDTH 87:z=22:s=24:GOSUB 50100:PRINT inv$" BITTE WARTEN !! "nrm$:CHAIN "m:men}",150
305 PRINT inv$;a$;nrm$;
310 a=VAL(a$):  ON a GOTO 1000,3000,4000,400,500
320 GOTO 280
400 REM bestelldatei l|schen
410 ON ERROR GOTO 460
420 KILL "a:Bestell"
430 ON ERROR GOTO 0
440 s=25:z=24:GOSUB 50100:PRINT inv$" Bestelldatei gel|scht ! "nrm$
450 FOR i=0 TO 2000:NEXT i:GOTO 200
460 RESUME NEXT
500 REM neue datei anlegen
510 uber$=" Neue Datei anlegen "
520 GOSUB 50400
530 z=12:s=24:GOSUB 50100:PRINT inv$" Bitte leere Diskette in Laufwerk A einlegen ! "
540 z=14:s=24:GOSUB 50100:PRINT " RETURN f}r weiter ! EXIT f}r Men} ! "nrm$
550 a$=INKEY$:IF a$<>CHR$(13) AND a$<>esc$ THEN 550 
555 IF a$<>CHR$(13) THEN GOTO 200
557 ON ERROR GOTO 700
558 z=20:s=24:GOSUB 50100:PRINT inv$" Datei wird er|ffnet ! "nrm$
560 CREATE 1,"a:lakadat","a:lakaind",2,satz%
570 CLOSE 1
580 ON ERROR GOTO 0
590 GOTO 200
700 REM error behandlung
710 IF ERR=58 THEN er$=" Datei existiert bereits ! "
720 IF ERR=67 OR ERR=61 THEN er$=" Diskette voll ! "
730 z=27:s=24:GOSUB 50100:PRINT inv$" FEHLER :  "er$
740 z=29:s=24:GOSUB 50100:PRINT "Diskfehler aufgetreten ! Bitte RETURN f}r weiter ! "nrm$
750 a$=INKEY$:IF a$<> CHR$(13) THEN 750 ELSE RESUME NEXT
900 REM entrypoint f}r chain
910 GOSUB 50000
920 BUFFERS 24
1000 REM eintr{ge bearbeiten
1010 uber$=" Eintr{ge bearbeiten "
2000 REM
2030 REM maske f}r schl}ssel
2040 GOSUB 51000
2045 IF ex=1 AND re%>7 THEN RETURN
2050 IF re%>7 THEN 200
2060 GOSUB 50400
2070 z=15:s=32:GOSUB 50100:PRINT inv$" Bitte Warten "nrm$ 
2080 meta=INSTR(sch$,"*")
2090 GOSUB 59200
2093 IF re%=2 AND ex=0 THEN 52100
2095 REM suchen mit metacharacter
2100 IF meta<>0 THEN GOSUB 52000:GOTO 2120
2105 REM suchen ohne metacharacter
2107 sch$=sch$+SPACE$(l(re%)-LEN(sch$))
2110 erg=SEEKKEY(1,0,re%,sch$)
2115 GET 1
2120 IF erg<> 0 THEN GOSUB 50500:IF ex=0 THEN 2145 ELSE RETURN 
2130 GOSUB 50600
2135 IF ex=1 THEN 2150
2140 GOSUB 53000
2145 CLOSE 1
2150 IF ex=1 THEN RETURN ELSE 2000
3000 REM ausdruck nach schl}ssel
3005 CLOSE 1
3010 uber$=" Ausdruck nach Schl}ssel ":ex=1
3020 GOSUB 53220
3030 IF a$=esc$ THEN CLOSE 1:ex=0:GOTO 200
3041 GOSUB 2000
3042 IF erg<>0 OR re%>7 THEN 3000
3043 LPRINT:LPRINT
3045 IF dr$="ett" THEN GOSUB 53340 ELSE GOSUB 53300
3050 GOSUB 53800
3060 IF erg<>0 THEN 3000 ELSE 3045
4000 REM neuer eintrag
4010 uber$=" Neuer Eintrag "
4020 ex=1:IF pw$<>"ok" THEN flag=1:pw$="ok" 
4025 GOSUB 59200
4027 REM txt$ l|schen
4030 GOSUB 50800
4040 REM schirmmaske
4050 GOSUB 53000
4055 ex=0:IF flag=1 THEN flag=0:pw$=""
4060 CLOSE 1
4070 GOTO 200
49998 CLOSE 1
49999 END
50000 esc$=CHR$(27)
50005 REM cls$ Schirm l|schen  hom$ Cursor home
50010 hom$=esc$+"H": cls$=hom$+esc$+"E"+esc$+"v"
50015 REM inv$ Invers ein    nrm$ Invers aus
50020 inv$=esc$+"p":nrm$=esc$+"q"
50025 REM und$ Underline ein nun$ Underline  aus
50030 und$=esc$+"r":nun$=esc$+"u"
50035 REM ecl$= erase cursor line  lft$=cursor left
50040 ecl$=esc$+"l":lft$=esc$+"D"
50045 REM rgt$= cursor right  cup$=cursor up
50050 rgt$=esc$+"C":cup$=esc$+"A"
50055 REM dwn$= cursor down   bel$= piepston
50060 dwn$=esc$+"B":bel$=CHR$(7)
50065 REM dimensionierung der div felder
50070 DIM z(20),s(20),l(12),txt$(12),bf$(14,6)
50071 l(0)=30:l(1)=8:l(2)=20
50075 REM wertzuweisungen an die felder
50080 FOR i=0 TO 11: READ s(i):NEXT i
50081 DATA 21,18,20,36,46,24,26,20,20,26,24,179
50090 RETURN
50099 REM position cursor
50100 PRINT esc$+"Y"+CHR$(z+32)+CHR$(s+32);
50110 RETURN
50200 REM titelzeile
50210 PRINT:PRINT cls$:s=1:FOR z=1 TO 3:GOSUB 50100:PRINT inv$;SPACE$(87);nrm$:NEXT z
50225 z=2:s=2:GOSUB 50100:PRINT inv$;txt$(3);nrm$
50227 z=2:s=22:GOSUB 50100:PRINT inv$" Lagerkartei - LAKA - Version 1.1 ",date$;nrm$
50230 RETURN
50300 REM hole text von der tastatur ohne schirmausgabe
50310 txt$=""
50330 a$=INKEY$: IF a$="" THEN 50330
50333 IF a$=CHR$(13) THEN RETURN
50335 PRINT inv$"*"nrm$;
50340 txt$=txt$+a$
50350 GOTO 50330
50400 REM }ber$
50410 GOSUB 50200
50420 z=7:s=39-LEN(uber$)/2:GOSUB 50100:PRINT inv$;uber$;nrm$
50430 RETURN
50500 REM fehler wenn kein weiterer eintrag mehr vorhanden
50501 IF ex=2 THEN RETURN
50505 IF ex=0 THEN z=29:s=10:GOSUB 50100:PRINT ecl$;inv$" Eintrag in der Datei nicht gefunden ! RETURN f}r weiter ! ";nrm$;
50507 IF ex=1 THEN z=29:s=30:GOSUB 50100:PRINT ecl$;inv$" RETURN f}r weiter ! ";nrm$
50510 a$=INKEY$:IF a$<>CHR$(13) THEN 50510
50530 RETURN
50600 REM field variablen in stringvariablen
50610 txt$(0)=prnu$:txt$(1)=genu$:txt$(2)=adr$:txt$(3)=prgu$:txt$(4)=wana$:txt$(5)=wanu$
50620 txt$(6)=voge$:txt$(7)=lgmg$:txt$(8)=mimg$:txt$(9)=prei$:txt$(10)=merk$
50625 txt$(11)=staf$
50630 RETURN
50700 REM txt$ in field
50710 LSET prnu$=txt$(0):LSET genu$=txt$(1):LSET adr$=txt$(2):LSET prgu$=txt$(3)
50720 LSET wana$=txt$(4):LSET wanu$=txt$(5):LSET voge$=txt$(6):LSET lgmg$=txt$(7)
50730 LSET mimg$=txt$(8):LSET prei$=txt$(9):LSET merk$=txt$(10):LSET staf$=txt$(11)
50740 RETURN
50800 REM l|sche txt$ variablen
50805 FOR i=0 TO 11:txt$(i)=SPACE$(s(i)-16):NEXT i
50810 RETURN
51000 REM schl}sselauswahl
51005 GOSUB 50400
51010 z=10:s=29:GOSUB 50100:PRINT inv$" Suchen nach: "
51030 z=12:s=29:GOSUB 50100:PRINT " Warenname     ... 1 "
51040 z=14:GOSUB 50100:PRINT " Warennummer   ... 2 "
51050 z=16:GOSUB 50100:PRINT " Alle Waren (*) .. 3 "
51060 IF ex=0 THEN z=18:GOSUB 50100:PRINT " Kundenkartei  ENTER "
51075 z=20:GOSUB 50100:PRINT " Men}       ... EXIT "
51080 z=24:GOSUB 50100:PRINT " Ihre Wahl: _";nrm$;lft$;
51090 a$=INKEY$:IF (a$<"1" OR a$>"3") AND a$<>esc$ AND a$<>CHR$(13) THEN 51090
51095 IF a$=esc$ THEN re%=8:RETURN
51097 IF a$=CHR$(13) AND ex=0 THEN CLOSE 1:CLOSE:z=22:s=30:GOSUB 50100:PRINT inv$" BITTE WARTEN !! "nrm$:CHAIN"m:kuka",900
51098 IF a$=CHR$(13) THEN 51090
51100 PRINT inv$;a$;nrm$
51110 z=29:s=29:GOSUB 50100:PRINT inv$" Suchbegriff: ";:INPUT "",sch$:PRINT nrm$;:IF sch$=""THEN 51005
51120 re%=VAL(a$)-1
51130 RETURN
52000 REM suchen mit metacharacter
52010 REM erlaubt ist der * als abk}rzungszeichen
52020 erg=SEEKRANK(1,0,re%)
52030 IF erg<>0 THEN RETURN
52040 GET 1
52050 l=meta-1:sch$=LEFT$(sch$,l)
52060 a$=FETCHKEY$(1)
52070 IF sch$=LEFT$(a$,l) THEN erg=0:RETURN
52080 erg=SEEKNEXT(1,0)
52090 IF erg=0 OR erg=101 THEN 52040 ELSE erg=1:RETURN
52100 REM auswahl mit cursor bei produktgruppe
52105 flag=1
52120 IF meta=0 THEN sch$=sch$+SPACE$(l(re%)-LEN(sch$))
52122 IF meta<>0 THEN GOSUB 52000:GOTO 52130
52124 erg=SEEKKEY(1,0,re%,sch$)
52126 GET 1
52130 FOR i=0 TO 14
52140 IF erg<>0 THEN flag=0:i=i-1:GOTO 52200
52150 GOSUB 50600:GOSUB 52500
52160 ex=2:GOSUB 53800:ex=0
52190 NEXT i:flag=1
52200 IF i<0 THEN 52240
52203 IF flag=0 THEN k=i ELSE k=14
52205 GOSUB 50400
52207 z=9:s=0:GOSUB 50100:PRINT inv$" Produktgruppe         Warenname                    Warennr. Vol/Gew   Lagerbestand       "nrm$
52208 GOSUB 61000
52210 FOR i=0 TO k
52220 z=i+11:s=1:GOSUB 50100:FOR j=0 TO 5:PRINT bf$(i,j)" ";:NEXT j
52230 NEXT i
52231 PRINT esc$+"u"
52240 IF flag=0 THEN z=29:s=20:GOSUB 50100:PRINT ecl$" Cursor "inv$" auf/ab "nrm$"  Ausw{hlen "inv$" ENTER "nrm$"  Men} "inv$" EXIT "nrm$
52245 IF flag=1 THEN z=29:s=10:GOSUB 50100:PRINT ecl$" Cursor "inv$" auf/ab "nrm$"  Ausw{hlen "inv$" ENTER "nrm$"  Inhalt weiter "inv$" + "nrm$"  Men} "inv$" EXIT "nrm$
52247 z=11:s=20
52248 GOSUB 50100
52250 a$=INKEY$:IF a$="" THEN 52250
52260 IF a$=esc$ THEN CLOSE 1:GOTO 2000
52270 IF a$=CHR$(22) THEN IF flag=1 THEN 52130
52272 IF a$=CHR$(31) THEN z=z-1:IF z<11 THEN z=11:GOTO 52248
52274 IF a$=CHR$(30) THEN z=z+1:IF z>11+k THEN z=11+k:GOTO 52248
52276 IF a$=CHR$(13) THEN i=z-11:sch$=bf$(i,2):re%=1:flag=0:GOTO 2107
52280 GOTO 52248
52499 CLOSE 1:GOTO 2000
52500 REM copy txt$ in bf$
52510 FOR j=0 TO 4:bf$(i,j)=txt$(j+3):NEXT j
52520 bf$(i,5)=txt$(9)
52530 RETURN
53000 REM ausgabemaske mit cursorsteuerung und {nderungsteil
53005 uber$=" Eintr{ge bearbeiten "
53010 REM 
53020 GOSUB 50400
53030 z=13:s=1:GOSUB 50100:PRINT "Produktnummer:"TAB(20)txt$(0)
53040 z=14:PRINT " Gebindenummer:"TAB(18)txt$(1)
53050 z=16:PRINT " ADR          :"TAB(18)txt$(2)
53060 z=18:PRINT " Produktgruppe:"TAB(18)txt$(3)
53070 z=20:PRINT inv$" Warenname    :"TAB(19)txt$(4)nrm$
53080 z=22:PRINT inv$" Warennummer  :"TAB(19)txt$(5)nrm$
53090 z=24:PRINT " Vol./Gew.    :"TAB(18)txt$(6)
53092      PRINT inv$" Lagermenge   :"TAB(19)txt$(7)nrm$
53094 PRINT inv$" Mindestmenge :"TAB(19)txt$(8)nrm$
53095 PRINT
53098 PRINT " Merkblatt:"TAB(18)txt$(10)
53110 IF ex=0 THEN z=29:s=0:GOSUB 50100:PRINT "Weiter "inv$" ENTER "nrm$" Zuwa."inv$" + "nrm$" Abbu."inv$" - "nrm$"  [ndern "inv$" F1 "nrm$" L|schen "inv$" F3 "nrm$" Ausdruck "inv$" F8 "nrm$" Men} "inv$" EXIT "nrm$
53111 IF ex=1 THEN GOSUB 53600:RETURN
53120 a$=INKEY$:IF a$<CHR$(13) OR a$>CHR$(28) THEN 53120
53130 IF a$=esc$ THEN RETURN
53140 IF a$=CHR$(16) THEN GOSUB 53200:GOTO 53000
53150 IF a$=CHR$(17) THEN GOSUB 53400:GOTO 53000
53160 IF a$=CHR$(26) THEN GOSUB 53600:GOTO 53000
53170 IF a$=CHR$(13) THEN GOSUB 53800:GOTO 53000
53175 IF a$=CHR$(28) OR a$=CHR$(22) THEN GOSUB 54000
53180 GOTO 53000
53200 REM ausdruck eines eintrages
53210 uber$=" Ausdrucken einer Eintragung "
53220 GOSUB 50400
53230 z=12:s=25:GOSUB 50100:PRINT inv$" Auflistung der Daten   . ENTER"
53250 z=20:GOSUB 50100:PRINT " R}ckkehr Bearbeitung ... EXIT"nrm$
53260 a$=INKEY$:IF a$<CHR$(13) OR a$>esc$ THEN 53260
53265 IF ex=1 THEN RETURN
53270 IF a$=esc$ THEN RETURN
53280 IF a$=CHR$(13) THEN 53300 ELSE 53260
53300 REM ausdrucken 
53310 LPRINT "Produktnummer:"TAB(20)txt$(0)
53311 LPRINT "Gebindenummer:"TAB(20)txt$(1)
53312 LPRINT "ADR:"TAB(20)txt$(2)
53313 LPRINT "Produktgruppe:"TAB(20)txt$(3)
53314 LPRINT "Warenname:"TAB(20)txt$(4)
53315 LPRINT "Warennummer:"TAB(20)txt$(5)
53316 LPRINT "Volumen/Gewicht:"TAB(20)txt$(6)
53317 LPRINT "Lagermenge:"TAB(20)txt$(7)
53318 LPRINT "Mindestmenge:"TAB(20)txt$(8)
53320 LPRINT "Merkblattnummer:"TAB(20)txt$(10)
53325 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
53330 RETURN
53400 REM l|schen
53410 z=29:s=0:GOSUB 50100:PRINT inv$;:INPUT "                               Sind Sie sicher (J/N)                                  ",a$:PRINT nrm$;:IF a$<>"J" THEN RETURN
53420 z=29:s=26:GOSUB 50100:PRINT ecl$;inv$" Eintragung  wird   gel|scht !! "nrm$
53430 sn%=FETCHREC(1)
53435 IF sn%=0 THEN RETURN
53440 erg=DELKEY(1,0,0,wana$,sn%)
53450 erg=DELKEY(1,0,1,wanu$,sn%)
53460 erg=DELKEY(1,0,2,prgu$,sn%)
53470 erg=CONSOLIDATE(1)
53480 RETURN
53500 REM datensatz speichern
53510 z=29:s=26:GOSUB 50100:PRINT ecl$;inv$" Datensatz wird  gespeichert !! ";nrm$ 
53520 GOSUB 50700
53530 erg=ADDREC(1,2,0,wana$)
53540 sn%=FETCHREC(1)
53550 erg=ADDKEY(1,0,1,wanu$,sn%)
53560 erg=ADDKEY(1,0,2,prgu$,sn%)
53570 erg=CONSOLIDATE(1)
53580 RETURN
53600 REM datensatz {ndern
53607 z=29:s=2:GOSUB 50100:PRINT ecl$"Edit: "inv$" auf/ab/links/rechts  DEL "CHR$(252)"  DEL "CHR$(253)nrm$ "   Abspeichern "inv$" ENTER "nrm$"  Abbrechen "inv$" EXIT "nrm$
53609 PRINT esc$+"v";
53610 z=13:s=17:ind=0
53620 GOSUB 50100
53630 a$=INKEY$:IF a$="" THEN 53630
53633 IF a$>=" " AND a$<="~" THEN 53700
53634 IF a$=CHR$(7) OR a$=CHR$(127) THEN 53670
53635 IF a$=CHR$(13) THEN 53750
53640 IF a$=CHR$(27) THEN GOSUB 50600:RETURN
53642 IF a$=CHR$(31) THEN IF z=25 THEN z=z-2:s=17:ind=ind-1 ELSE IF z>13 THEN z=z-1:ind=ind-1:s=17 ELSE s=17:z=24:ind=11
53644 IF a$=CHR$(30) THEN IF z<24 THEN z=z+1:ind=ind+1:s=17 ELSE z=13:s=17:ind=0
53646 IF z=24 AND a$=CHR$(6) THEN 53660 ELSE IF z=25 THEN 53664
53647 IF a$=CHR$(1) THEN IF s>17 THEN s=s-1
53648 IF a$=CHR$(6) THEN IF s<s(ind) THEN s=s+1 
53650 IF s>s(ind) THEN s=s(ind)
53652 IF s<17 THEN s=17
53658 GOTO 53620
53660 IF s<89 THEN s=s+1 ELSE s=0:z=z+1
53662 GOTO 53620
53664 IF a$=CHR$(6) THEN IF s<89 THEN s=s+1 
53666 IF a$=CHR$(1) THEN IF s>0 THEN s=s-1 ELSE s=89:z=24
53669 REM deletetasten
53670 IF a$=CHR$(127) AND z<25 AND s>17 THEN txt$(ind)=LEFT$(txt$(ind),s-18)+RIGHT$(txt$(ind),s(ind)-s+1)+" ":s=s-1:GOSUB 53790:GOTO 53620
53680 IF a$=CHR$(7) AND s<s(ind) AND z<25 THEN txt$(ind)=LEFT$(txt$(ind),s-17)+RIGHT$(txt$(ind),s(ind)-s)+" ":GOSUB 53790:GOTO 53620
53685 IF a$=CHR$(7) AND z=25 THEN txt$(ind)=LEFT$(txt$(ind),73+s)+RIGHT$(txt$(ind),s(ind)-s-90)+" ":GOSUB 53790:GOTO 53620
53690 IF a$=CHR$(127) AND z=25 THEN txt$(ind)=LEFT$(txt$(ind),72+s)+RIGHT$(txt$(ind),s(ind)-s-89)+" ":GOSUB 53790:a$=CHR$(1):GOTO 53666
53695 GOTO 53620
53699 REM insertmodus
53700 IF z<25 THEN txt$(ind)=LEFT$(txt$(ind),s-17)+a$+RIGHT$(txt$(ind),s(ind)-s+1):txt$(ind)=LEFT$(txt$(ind),s(ind)-16):GOSUB 53790:a$=CHR$(6):GOTO 53646
53710 IF z=25 THEN txt$(ind)=LEFT$(txt$(ind),73+s)+a$+RIGHT$(txt$(ind),s(ind)-s-89):txt$(ind)=LEFT$(txt$(ind),s(ind)-16):GOSUB 53790:a$=CHR$(6):GOTO 53664
53720 GOTO 53620
53730 REM {ndern ende
53750 GOSUB 53430:GOSUB 53500:RETURN
53780 GOTO 53620
53790 SWAP s,ss:SWAP z,zz:s=17:z=13+ind:PRINT:GOSUB 50100:PRINT txt$(ind):SWAP ss,s:SWAP zz,z:RETURN
53800 REM n{chsten datensatz lesen
53820 erg=SEEKNEXT(1,0)
53825 IF meta<>0 THEN 53900
53830 IF erg<>0 THEN GOSUB 50500:RETURN
53840 GET 1
53850 GOSUB 50600
53860 RETURN
53900 REM suchen mit metachar
53910 IF erg<>0 AND erg<>101 THEN GOSUB 50500:RETURN
53920 GOSUB 52040
53930 IF erg<>0 THEN GOSUB 50500:RETURN
53940 GOSUB 50600
53950 RETURN
53999 RETURN
54000 REM abbuchen mit mindestmengenausdruck 
54010 IF a$=CHR$(28) THEN uber$=" Abbuchen ":ab=1 ELSE uber$=" Zuwachs ":ab=-1
54020 GOSUB 50400
54030 z=10:s=1:GOSUB 50100:PRINT " Warenname: "TAB(20)txt$(4)
54040 z=11:GOSUB 50100:PRINT " Warennummer: "TAB(20)txt$(5)
54050 z=12:GOSUB 50100:PRINT " Vol./Gew. :"TAB(20)txt$(6)
54060 z=13:GOSUB 50100:PRINT inv$" Lagermenge:"TAB(28)txt$(7)nmr$
54065 z=14:GOSUB 50100:PRINT inv$" Mindestmenge:"TAB(28)txt$(8)nrm$
54077 IF VAL(txt$(7))<=VAL(txt$(8)) THEN nb=1 ELSE nb=0
54080 z=20:s=1:GOSUB 50100:PRINT ecl$;:INPUT "St}ckzahl:       ",stz
54085 IF ab<0 THEN 54175
54090 IF stz>VAL(txt$(7)) THEN GOSUB 54500:IF a$=esc$ THEN RETURN ELSE 54080
54100 z=29:s=28:GOSUB 50100:PRINT ecl$" Bitte die Taste "inv$" F1 "nrm$" dr}cken "
54110 a$=INKEY$:IF a$<>CHR$(26)  THEN 54110
54120 IF a$=CHR$(26) THEN GOSUB 54400:GOTO 54150
54140 IF skt>VAL(txt$(9)) THEN GOSUB 54500:IF a$=esc$ THEN RETURN ELSE 54130
54150 stp=VAL(txt$(9))-skt:sum=stp*stz:rest=VAL(txt$(7))-stz
54170 z=24:s=0:GOSUB 50100:PRINT inv$" Restlagermenge:   ";rest nrm$:GOTO 54180
54175 rest=VAL(txt$(7))+stz
54180 z=29:s=23:GOSUB 50100:PRINT ecl$"   Buchen "inv$" ENTER "nrm$"  Abbrechen "inv$" EXIT "nrm$
54190 a$=INKEY$:IF a$<>CHR$(13) AND a$<>esc$ THEN 54190
54200 IF a$=esc$ THEN RETURN
54210 txt$(7)=LEFT$(RIGHT$(STR$(rest),LEN(STR$(rest))-1)+"    ",4)
54215 IF ab<0 THEN 53750
54220 IF rest<=VAL(txt$(8)) AND nb=0 THEN GOSUB 54600
54230 GOTO 53750:LPRINT:LPRINT:
54240 LPRINT "Abbuchung:"
54243 LPRINT
54245 LPRINT "Prodn Gb ADR  Produktgruppe               Warenname               Warenno. St}ck"
54246 LPRINT
54250 LPRINT txt$(0)" "txt$(1)" "txt$(2)" "txt$(3)" "txt$(4)" "txt$(5)" "DEC$(stz,"####")
54255 LPRINT
54260 LPRINT "     St}ckpreis     Summe"
54263 LPRINT
54265 LPRINT USING" ##########  ############";stp;sum
54270 LPRINT:LPRINT:LPRINT:LPRINT
54275 REM abspeichern des ge{nderten Datensatzes
54280 GOTO 53750
54400 REM staffel aus txt$ suchen
54410 skt=0:sl=1
54420 st$=" "+txt$(11)
54430 bl1=INSTR(sl,st$," "):sl=INSTR(sl,st$,"/")
54440 IF sl=0 THEN RETURN
54445 bl2=INSTR(sl,st$," "):sl1=INSTR(sl+1,st$,"/")
54450 stz1=VAL(MID$(st$,bl1,sl-bl1)):IF sl1<>0 THEN stz2=VAL(MID$(st$,bl2,sl1-bl2))
54460 IF stz>=stz1 THEN skt=VAL(MID$(st$,sl+1,bl2-sl)) 
54470 IF stz<stz2 OR sl1=0 THEN RETURN ELSE sl=sl+1:GOTO 54430
54500 REM }berlaufmeldung mit f-tasten abfrage
54510 z=29:s=20:GOSUB 50100:PRINT inv$" Unm|glicher Wert ! "nrm$" Nochmal "inv$" F1 "nrm$"  Abbruch "inv$" EXIT "nrm$
54520 a$=INKEY$:IF a$<>CHR$(26) AND a$<>esc$ THEN 54520
54530 RETURN
54600 REM bestellung ausgeben
54610 LPRINT:LPRINT:LPRINT
54620 LPRINT "Bestellausdruck vom: ";date$
54625 LPRINT "================================"
54630 LPRINT "Prodn Gb   ADR   Produktgruppe       Warenname                 Warennummer "
54633 LPRINT ""
54635 LPRINT txt$(0)" "txt$(1)"   "txt$(2)" "txt$(3)" "txt$(4)" "txt$(5)
54638 LPRINT
54640 LPRINT "Volumen/Gewicht  Merkblatt  "
54643 LPRINT ""
54645 LPRINT  txt$(6)  "       "txt$(10)"   "txt$(9)        
54647 LPRINT
54648 z=25:s=1:GOSUB 50100
54649 PRINT inv$:INPUT " Zu bestellende St}ckzahl :   ", stz  
54650 LPRINT "Lagermenge  Mindestmenge best.St}ck"
54653 LPRINT "==================================="
54655 LPRINT  "   "txt$(7)"        "txt$(8)"       "stz
54660 LPRINT "==================================="
54700 REM bestellung auf bestelldatei schreiben
54710 ON ERROR GOTO 54790
54720 KILL "a:Bestell"
54730 NAME "a:Bestell" AS "a:lakatemp"
54740 ON ERROR GOTO 0
54750 OPEN "o",#2,"a:LAF"
54760 OPEN "i",#3,"a:lakatemp"
54770 WHILE NOT EOF(3):LINE INPUT #3,in$:PRINT #2,in$:WEND
54772 CLOSE 3
54781 PRINT #2,"Nachbestellung f}r:"
54782 PRINT #2,"Produkt No.:"TAB(20)txt$(0)
54783 PRINT #2,"Gebinde No.:"TAB(20)txt$(1)
54784 PRINT #2,"ADR:"TAB(20)txt$(2)
54785 PRINT #2,"Produktguppe:"TAB(20)txt$(3)
54786 PRINT #2,"Warenname:"TAB(20)txt$(4)
54787 PRINT #2,"Waren No.:"TAB(20)txt$(5)
54788 PRINT #2,"Volumen/Gewicht:"TAB(20)txt$(6):PRINT #2,"St}ck:"TAB(20)stz
54789 CLOSE 2:RETURN
54790 RESUME NEXT
54999 RETURN
59000 REM datum holen
59010 OPEN "i",#1,"m:datum.lib"
59020 INPUT #1,tag$,mon$,jahr$
59025 date$=tag$+"."+mon$+"."+jahr$
59030 CLOSE 1
59040 RETURN
59100 OPEN "i",#1,"m:passwd.lib"
59110 WHILE NOT EOF(1)
59120 INPUT #1,n$,passwd$,d$
59130 IF passwd$=pw$ AND name$=n$ THEN 59160
59140 WEND
59150 pw$=""
59160 CLOSE 1
59170  RETURN
59200 REM indexsequentielle datei |ffnen
59210 OPEN "K",1,"a:lakadat","a:lakaind",2,satz%
59220 FIELD 1,5 AS prnu$,2 AS genu$,4 AS adr$,20 AS prgu$,30 AS wana$,8 AS wanu$,10 AS voge$,4 AS lgmg$,4 AS mimg$,10 AS prei$,8 AS merk$,163 AS staf$
59230 RETURN
60000 PRINT"error "erg
60010 CLOSE 1
61000 s=0:PRINT esc$+"p":PRINT esc$+"r"
61200 RETURN
erk$,163 AS staf$
59230 RETURN
60