⟦b39616022⟧

Text

0090 DIM OP1$(12),OP2$(12),RES$(14)
0100 DIM K1$(17),N$(6),K2$(17),K3$(17),K4$(17),K5$(17),STREG$(77)
0110 DIM SVAR$(1),VARTEKST$(25),VARPRIS$(12),TAH$(12),T2(9),T3(9)
0120 DIM TAL1$(12),TAL4$(14),SVAR1$(1),VARPRI$(12),VARTEK$(25)
0130 DIM TAL2$(12),BLANK$(25),BLB2$(12)
0140 BLANK$="                         ";TAH$="0+"
0150 STREG$="---------------------------------";STREG$=STREG$+STREG$
0160 PROC VALINUD
0170 CURSOR 4,LINIE
0180 PRINT USING "#######":VARENR
0190 CURSOR 16,LINIE
0200 PRINT VARTEKST$
0210 CURSOR 44,LINIE
0220 EXEC TUD(VARPRIS$,TAL4$,0,0)
0225 PRINT TAL4$
0230 CURSOR 59,LINIE
0240 PRINT USING "#######":VARKONT
0250 ENDPROC 
0260 PROC LINTEST
0270 CLEAR 
0280 CURSOR 21,1
0290 PRINT "Varevedligeholdelse. ";
0300 EXEC VARHOVED
0310 EXEC VALINUD
0315 LINIE=LINIE+1
0320 ENDPROC 
0330 PROC VARHOVED
0340 PRINT "Ny vare."
0350 CURSOR 21,2
0360 PRINT "Hvis færdig, tast varenummer 0."
0370 EXEC VARELTEK
0380 ENDPROC 
0390 PROC SLETVPOST
0400 EXEC NULVPOST
0410 VNR2=VARENR;VARENR=0
0420 EXEC GEMVPOST
0430 VARENR=VNR2
0440 EXEC SLETPOST(VTAB,AVARE,VPIL3)
0450 ENDPROC 
0460 PROC GEMVPOST
0470 S=VTAB(VPIL3,2)
0480 PUT K4$,S:VARENR,VARTEKST$,VARPRIS$,VARKONT
0490 EXEC FEJL(2,1,K4$)
0500 ENDPROC 
0510 PROC HENTVPOST
0520 S=VTAB(VPIL3,2)
0530 GET K4$,S:VARENR,VARTEKST$,VARPRIS$,VARKONT
0540 EXEC FEJL(3,1,K4$)
0550 ENDPROC 
0560 PROC NULVPOST
0570 VARTEKST$=BLANK$(1:25);VARPRIS$="0+";VARKONT=0
0580 ENDPROC 
0590 PROC NRTEST(NUM1)
0600 P=0;TEST2=0;KTAL=0;L=LEN(NUM1$)
0610 IF L>6 THEN EXIT 
0620 CASE L OF 
0630 FOR I=1 TO L
0640 P1=INT(ORD(NUM1$(I))-48)
0650 IF P1<0 OR P1>9 THEN TEST2=1
0660 P=P*10+P1
0670 NEXT I
0680 KTAL=P DIV 10000
0690 WHEN 0
0700 P=-1
0710 WHEN 1
0720 CASE NUM1$ OF 
0730 P=INT(ORD(NUM1$)-48)
0740 WHEN "d","D"
0750 P=-2
0760 WHEN "a","A"
0770 P=-3
0780 WHEN "m","M"
0790 P=-4
0800 WHEN "j","J"
0810 P=-7
0820 WHEN "n","N"
0830 P=-8
0840 ENDCASE 
0850 ENDCASE 
0860 ENDPROC 
0870 PROC FEJL(NR1,NR2,NR3)
0880 IF STATUS(NR3$)<>0 THEN 
0890 PRINT STATUS(NR3$),NR1,NR2,NR3$
0900 STOP 
0910 ENDIF 
0920 ENDPROC 
0930 PROC CALC(AR3,B1,B2,ES)
0940 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0;ART=AR3-6*(AR3>5)
0950 CALL "P641210:REGN"
0960 ES$=RES$
0970 IF AR3<6 THEN 
0980 IF FLAG THEN STOP 
0990 ENDIF 
1000 ENDPROC 
1010 PROC TUD(BLB1,UBLB1,TEGN,STØR)
1020 BLB2$=BLB1$
1030 EXEC CALC(5,BLB2$,TAH$,UBLB1$)
1040 IF TEGN=0 THEN UBLB1$=UBLB1$(1:13)
1050 IF TEGN=1 AND UBLB1$(LEN(UBLB1$))="+" THEN UBLB1$(LEN(UBLB1$))="  "
1060 IF STØR=1 THEN UBLB1$=UBLB$(4:LEN(UBLB1$)-3)
1070 ENDPROC 
1080 PROC SLETPOST(TAB3,ANTAL3,PIL5)
1090 POSTNR=TAB3(PIL5,2)
1100 FOR I=PIL5 TO ANTAL3-1
1110 TAB3(I,1)=TAB3(I+1,1);TAB3(I,2)=TAB3(I+1,2)
1120 NEXT I
1130 TAB3(ANTAL3,1)=1000000;TAB3(ANTAL3,2)=POSTNR;ANTAL3=ANTAL3-1
1140 ENDPROC 
1150 PROC INDSÆT1(TAB2,ANTAL2,NØGL2,PIL4)
1160 POSTNR=TAB2(ANTAL2+1,2)
1170 IF NØGL2>TAB2(PIL4,1) THEN PIL4=PIL4+1
1180 FOR I=ANTAL2+1 TO PIL4+1 STEP -1
1190 TAB2(I,1)=TAB2(I-1,1);TAB2(I,2)=TAB2(I-1,2)
1200 NEXT I
1210 TAB2(PIL4,1)=NØGL2;TAB2(PIL4,2)=POSTNR;ANTAL2=ANTAL2+1
1220 ENDPROC 
1230 PROC INDTAB1(Z,MANT5,L7)
1240 PIL1=MANT5 DIV 32
1250 FOR I=1 TO PIL1
1260 H=(I-1)*8+1
1270 GET L7$,I:Z(H),Z(H+1),Z(H+2),Z(H+3),Z(H+4),Z(H+5),Z(H+6),Z(H+7)
1280 EXEC FEJL(2,1,L7$)
1290 NEXT I
1300 ENDPROC 
1310 PROC UDTAB(U,MANTAL1,L9)
1320 MANTAL2=MANTAL1 DIV 32+1;MANTAL3=MANTAL1 DIV 4+MANTAL2-1
1330 FOR I=1 TO MANTAL2-1
1340 H=(I-1)*32+1;H1=H+4;H2=H+8;H3=H+12;H4=H+16;H5=H+20;H6=H+24;H7=H+28
1350 PUT L9$,I:U(H,1),U(H1,1),U(H2,1),U(H3,1),U(H4,1),U(H5,1),U(H6,1),U(H7,1)
1360 EXEC FEJL(3,1,L9$)
1370 NEXT I
1380 FOR I=MANTAL2 TO MANTAL3
1390 H=(I-MANTAL2)*4+1;H1=H+1;H2=H+2;H3=H+3
1400 PUT L9$,I:U(H,1),U(H,2),U(H1,1),U(H1,2),U(H2,1),U(H2,2),U(H3,1),U(H3,2)
1410 EXEC FEJL(3,2,L9$)
1420 NEXT I
1430 ENDPROC 
1440 PROC INDTAB(T,MANTAL,L10)
1450 MANTAL2=MANTAL DIV 32+1;MANTAL3=MANTAL DIV 4+MANTAL2-1
1460 FOR I=MANTAL2 TO MANTAL3
1470 H=(I-MANTAL2)*4+1;H1=H+1;H2=H+2;H3=H+3
1480 GET L10$,I:T(H,1),T(H,2),T(H1,1),T(H1,2),T(H2,1),T(H2,2),T(H3,1),T(H3,2)
1490 EXEC FEJL(4,1,L10$)
1500 NEXT I
1510 ENDPROC 
1520 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
1530 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=1;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
1540 REPEAT 
1550 IF NØGL5=TAB4(PIL6) OR PIL1=1 THEN EXIT 
1560 PIL1=(PIL1+1) DIV 2;PIL6=PIL6+PIL1*(1-2*(NØGL5<TAB4(PIL6)))
1570 IF PIL6<1 THEN PIL6=1
1580 IF PIL6>MANT3 THEN PIL6=MANT3
1590 UNTIL PIL1=0
1600 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-1*(PIL6>1)
1610 PIL6=MANT4+PIL6
1620 GET L8$,PIL6:Q(1,1),Q(1,2),Q(2,1),Q(2,2),Q(3,1),Q(3,2),Q(4,1),Q(4,2)
1630 EXEC FEJL(1,1,L8$)
1640 FOR PIL6=1 TO 4
1650 IF NØGL5=Q(PIL6,1) THEN EXIT 
1660 NEXT PIL6
1670 IF PIL6<>5 THEN CEKS=0
1680 ENDPROC 
1690 PROC FINDPOST(TAB1,MANT1,NØGL1,PIL3)
1700 PIL1=MANT1 DIV 2;PIL3=PIL1;CEKS=1
1710 REPEAT 
1720 IF NØGL1=TAB1(PIL3,1) OR PIL1=1 THEN EXIT 
1730 PIL1=(PIL1+1) DIV 2;PIL3=PIL3+PIL1*(1-2*(NØGL1<TAB1(PIL3,1)))
1740 IF PIL3<1 THEN PIL3=1
1750 IF PIL3>MANT1 THEN PIL3=MANT1
1760 UNTIL PIL1=0
1765 IF NØGL1>TAB1(PIL3,1) THEN PIL3=PIL3+1*(PIL3<MANT1)
1770 IF NØGL1=TAB1(PIL3,1) THEN CEKS=0
1780 ENDPROC 
1790 PROC VAREÆND
1800 VARTEK$=BLANK$
1810 CURSOR 15,LINIE
1820 INPUT " ",VARTEK$
1830 IF LEN(VARTEK$)>0 THEN VARTEKST$=VARTEK$
1840 CURSOR 16,LINIE
1850 PRINT VARTEKST$;BLANK$;BLANK$
1860 REPEAT 
1870 CURSOR 43,LINIE
1880 INPUT " ",VARPRI$
1885 IF LEN(VARPRI$)=0 THEN EXIT 
1890 IF VARPRI$(LEN(VARPRI$))<>"+" THEN VARPRI$=VARPRI$+"+"
1900 EXEC CALC(6,VARPRI$,TAH$,VARPRI$)
1910 UNTIL FLAG=0
1915 IF LEN(VARPRI$)>0 THEN VARPRIS$=VARPRI$
1920 CURSOR 44,LINIE
1930 EXEC TUD(VARPRIS$,TAL4$,0,0)
1935 PRINT TAL4$
1936 VARKONTO=VARKONT
1940 REPEAT 
1950 REPEAT 
1960 CURSOR 60,LINIE
1970 PRINT BLANK$
1980 CURSOR 60,LINIE
1990 INPUT " ",TAL1$
2000 EXEC NRTEST(TAL1$)
2010 UNTIL (P<1 OR KTAL=VTAL) AND TEST2=0
2020 VARKONT=P;CEKS=1
2030 IF P>0 THEN EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,P,FPIL3,K2$)
2040 UNTIL P<1 OR CEKS=0
2050 IF P=0 THEN VARKONT=DIVNR
2055 IF P=-1 THEN VARKONT=VARKONTO
2060 CURSOR 59,LINIE
2070 PRINT USING "#######    ":VARKONT
2080 ENDPROC 
2090 PROC VARELTEK
2100 CURSOR 3,4
2110 PRINT "Varenummer   Varetekst"
2120 CURSOR 47,4
2130 PRINT "Varepris     Varekonto"
2140 LINIE=6
2150 ENDPROC 
2160 PROC OVERSKRI
2170 PRINT TAB(10);CHR(14);"Varefortegnelse";CHR(15);
2180 PRINT TAB(50);"Dato:";TAB(58);
2190 PRINT USING "###.##":(DATO MOD 10000)/100;
2200 PRINT TAB(55);
2210 PRINT USING "###.#":(DATO DIV 1000)/10
2220 PRINT CHR(10)
2230 PRINT "        Varenummer   Varetekst                       Varepris";
2240 PRINT TAB(66);"Varekonto"
2250 PRINT TAB(10);STREG$
2260 ENDPROC 
2270 K1$="P641220:SYSTEM1"
2280 OPEN K1$,R
2290 EXEC FEJL(9,1,K1$)
2300 GET K1$,1:MFANTAL,MDANTAL,MKANTAL,MVANTAL
2310 EXEC FEJL(9,2,K1$)
2320 GET K1$,4:MKPOST,MFAK,MVGR
2330 EXEC FEJL(9,3,K1$)
2340 GET K1$,8:DIVNR
2350 EXEC FEJL(9,21,K1$)
2360 GET K1$,9:KRTAL,VTAL
2370 EXEC FEJL(9,4,K1$)
2380 GET K1$,10:N$
2390 EXEC FEJL(9,5,K1$)
2400 GET K1$,11:K2$
2410 EXEC FEJL(9,6,K1$)
2420 GET K1$,14:K3$
2430 EXEC FEJL(9,7,K1$)
2440 GET K1$,18:K4$
2450 EXEC FEJL(9,8,K1$)
2460 GET K1$,36:K5$
2470 EXEC FEJL(9,9,K1$)
2480 CLOSE K1$
2490 EXEC FEJL(9,10,K1$)
2500 DIM VTAB(MVANTAL,2),FTAB1(MFANTAL DIV 4),FTAB(4,2)
2510 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$
2520 OPEN K5$,W
2530 EXEC FEJL(9,11,K5$)
2540 GET K5$,2:T1,T1,T1,T1,T1,T1,DATO
2550 EXEC FEJL(9,12,K5$)
2560 GET K5$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),AVARE
2570 EXEC FEJL(9,13,K5$)
2580 GET K5$,17:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
2590 EXEC FEJL(9,14,K5$)
2600 T3(6)=1
2610 PUT K5$,17:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
2620 EXEC FEJL(9,15,K5$)
2630 CLOSE K5$
2640 EXEC FEJL(9,16,K5$)
2650 OPEN K2$,R
2660 EXEC FEJL(9,17,K2$)
2670 OPEN K3$,W
2680 EXEC FEJL(9,18,K3$)
2690 OPEN K4$,W
2700 EXEC FEJL(9,19,K4$)
2710 EXEC INDTAB1(FTAB1,MFANTAL,K2$)
2720 EXEC INDTAB(VTAB,MVANTAL,K3$)
2730 REPEAT 
2740 CLEAR 
2750 CURSOR 21,1
2760 PRINT "Varevedligeholdelse."
2770 CURSOR 11,4
2780 PRINT "0: Færdig."
2790 CURSOR 11,6
2800 PRINT "1: Ny vare."
2810 CURSOR 11,8
2820 PRINT "2: Ændring af vare."
2830 CURSOR 11,10
2840 PRINT "3: Sletning af vare."
2850 CURSOR 11,12
2860 PRINT "4: Udskrift af vare."
2870 CURSOR 11,14
2880 PRINT "5: Printerudskrift af vare."
2890 REPEAT 
2900 CURSOR 11,17
2910 INPUT "Vælg 0-5:",SVAR$
2920 UNTIL SVAR$<"6" AND SVAR$=>"0"
2930 CLEAR 
2940 CURSOR 21,1
2950 PRINT "Varevedligeholdelse. ";
2960 CASE SVAR$ OF 
2970 CLEAR 
2980 WHEN "1"
3000 EXEC VARHOVED
3010 REPEAT 
3015 IF AVARE<MVANTAL THEN 
3020 VARTEKST$=BLANK$
3030 REPEAT 
3040 REPEAT 
3050 CURSOR 1,LINIE
3060 PRINT BLANK$
3070 CURSOR 1,LINIE
3080 INPUT "    ",TAL1$
3090 EXEC NRTEST(TAL1$)
3100 UNTIL (P>4 AND P<=999999 OR P=0) AND TEST2=0
3110 VARENR=P
3120 IF VARENR=0 THEN EXIT 
3130 EXEC FINDPOST(VTAB,MVANTAL,VARENR,VPIL3)
3140 IF CEKS=0 THEN 
3150 EXEC HENTVPOST
3160 EXEC VALINUD
3170 LINIE=LINIE+1
3180 IF LINIE>23 THEN EXEC LINIETEST
3190 ENDIF 
3200 UNTIL CEKS=1
3205 IF VARENR=0 THEN EXIT 
3210 CURSOR 4,LINIE
3220 PRINT USING "#######   ":VARENR
3230 CURSOR 15,LINIE
3240 INPUT " ",VARTEKST$
3250 CURSOR 16,LINIE
3260 PRINT VARTEKST$;BLANK$;BLANK$
3270 REPEAT 
3275 REPEAT 
3280 CURSOR 43,LINIE
3290 INPUT " ",VARPRIS$
3295 UNTIL LEN(VARPRIS$)>0
3300 IF VARPRIS$(LEN(VARPRIS$))<>"+" THEN VARPRIS$=VARPRIS$+"+"
3310 EXEC CALC(6,VARPRIS$,TAH$,VARPRIS$)
3320 UNTIL FLAG=0
3330 CURSOR 44,LINIE
3340 EXEC TUD(VARPRIS$,TAL4$,0,0)
3345 PRINT TAL4$
3350 REPEAT 
3360 REPEAT 
3370 CURSOR 60,LINIE
3380 PRINT BLANK$
3390 CURSOR 60,LINIE
3400 INPUT " ",TAL1$
3410 EXEC NRTEST(TAL1$)
3420 UNTIL (KTAL=VTAL OR P=0) AND TEST2=0
3430 VARKONT=P;CEKS=1
3440 IF P>0 THEN EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,P,FPIL3,K2$)
3450 UNTIL P=0 OR CEKS=0
3460 IF P=0 THEN VARKONT=DIVNR
3470 CURSOR 59,LINIE
3480 PRINT USING "#######    ":VARKONT
3490 CURSOR 1,24
3495 EXEC INDSÆT1(VTAB,AVARE,VARENR,VPIL3)
3500 EXEC GEMVPOST
3510 LINIE=LINIE+1
3520 IF LINIE>23 THEN EXEC LINTEST
3540 ELSE 
3550 CURSOR 21,5
3560 INPUT "Der er ikke plads til flere varer. Tast RETURN.",SVAR1$
3565 VARENR=0
3570 ENDIF 
3575 UNTIL VARENR=0
3580 WHEN "2","3","4"
3590 REPEAT 
3600 CLEAR 
3610 CURSOR 21,1
3620 PRINT "Varevedligeholdelse. ";
3630 CASE SVAR$ OF 
3640 WHEN "2"
3650 PRINT "Ændring af vare."
3660 WHEN "3"
3670 PRINT "Sletning af vare."
3680 WHEN "4"
3690 PRINT "Udskrift af vare."
3700 ENDCASE 
3710 REPEAT 
3720 CURSOR 11,4
3730 PRINT BLANK$
3740 CURSOR 11,4
3750 INPUT "Varenummer, 0 for færdig:",TAL1$
3760 EXEC NRTEST(TAL1$)
3770 UNTIL (P>4 AND P<=999999 OR P=0) AND TEST2=0
3780 VARENR=P
3790 CURSOR 11,4
3800 PRINT BLANK$;BLANK$
3810 IF VARENR=0 THEN EXIT 
3820 CURSOR 1,24
3830 EXEC FINDPOST(VTAB,MVANTAL,VARENR,VPIL3)
3840 IF CEKS=0 THEN 
3850 EXEC VARELTEK
3855 EXEC HENTVPOST
3860 EXEC VALINUD
3870 CASE SVAR$ OF 
3880 WHEN "2"
3890 LINIE=7
3900 EXEC VAREÆND
3910 CURSOR 1,24
3920 EXEC GEMVPOST
3930 WHEN "3"
3940 IF T2(4)>0 THEN 
3950 CURSOR 16,11
3960 PRINT "Der er fakturaer til udskrift"
3970 CURSOR 16,13
3980 INPUT "og ingen varer kan slettes. Tast RETURN.",SVAR1$
3990 SVAR1$="N"
4000 ELSE 
4010 REPEAT 
4020 CURSOR 16,11
4030 INPUT "Ønskes varen slettet (J/N):",SVAR1$
4040 UNTIL SVAR1$="J" OR SVAR1$="N"
4050 ENDIF 
4060 IF SVAR1$="J" THEN 
4070 EXEC SLETVPOST
4080 CURSOR 16,11
4090 PRINT USING "Varenummer ####### er slettet. Tast RETURN.":VARENR
4100 INPUT " ",SVAR1$
4110 ENDIF 
4120 WHEN "4"
4130 CURSOR 16,11
4140 INPUT "Tast RETURN",SVAR1$
4150 ENDCASE 
4160 ELSE 
4170 CURSOR 3,4
4180 PRINT USING "Varenummer ####### eksistere ikke.Tast RETURN.":VARENR
4190 INPUT " ",SVAR1$
4200 ENDIF 
4210 UNTIL VARENR=0
4220 WHEN "5"
4230 PRINT "Printerudskrift."
4240 SVARE=999999
4250 REPEAT 
4260 CURSOR 21,3
4270 INPUT "Fra varenummer (0 for alle varer):",TAL1$
4280 EXEC NRTEST(TAL1$)
4290 UNTIL (P>4 AND P<=999999 OR P=0) AND TEST2=0
4300 FVARE=P
4310 IF FVARE>0 THEN 
4320 REPEAT 
4330 CURSOR 21,4
4340 INPUT "Til varenummer                   :",TAL1$
4350 EXEC NRTEST(TAL1$)
4360 UNTIL P=>FVARE AND P<=999999 AND TEST2=0
4370 SVARE=P
4380 ENDIF 
4390 CURSOR 21,6
4400 INPUT "Monter papir. Tast RETURN",SVAR1$
4410 OUTPUT P
4420 STARTV=1
4430 REPEAT 
4440 EXEC OVERSKRI
4450 FOR VPIL3=STARTV TO AVARE
4460 IF VTAB(VPIL3,1)=>FVARE AND VTAB(VPIL3,1)<=SVARE THEN 
4470 EXEC HENTVPOST
4480 PRINT USING "         #######     ":VARENR;
4490 PRINT TAB(22);VARTEKST$;TAB(51);VARPRIS$(1:11);
4500 PRINT USING "    #######":VARKONT
4510 ENDIF 
4520 IF VPIL3 MOD 40=0 THEN EXIT 
4530 NEXT VPIL3
4540 STARTV=STARTV+40
4550 PRINT CHR(10);CHR(10)
4560 UNTIL STARTV>AVARE
4570 REPEAT 
4580 PRINT CHR(10);
4590 VPIL3=VPIL3+1
4600 UNTIL VPIL3 MOD 40=0
4610 PRINT " "
4620 OUTPUT T
4630 ENDCASE 
4640 UNTIL SVAR$="0"
4650 EXEC UDTAB(VTAB,MVANTAL,K3$)
4660 CLOSE K3$
4670 EXEC FEJL(9,30,K3$)
4680 CLOSE K4$
4690 EXEC FEJL(9,31,K4$)
4700 CLOSE K2$
4710 T3(6)=0
4720 OPEN K5$,W
4730 EXEC FEJL(9,32,K5$)
4740 PUT K5$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),AVARE
4750 EXEC FEJL(9,33,K5$)
4760 PUT K5$,17:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
4770 EXEC FEJL(9,34,K5$)
4780 CLOSE K5$
4790 EXEC FEJL(9,35,K5$)
4800 CHAIN "P641210:OPSTART"
DataMuseum.dk

MIKADOS

⟦b39616022⟧

Derivation

Text
