DataMuseum.dk

top - download

    Length: 12171 (0x2f8b)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »VAREVEDL.B«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »VAREVEDL.B« 
└─⟦ff7f7aeee⟧ Bits:30009007 NBT	15/3-84
    └─⟦this⟧ »VAREVEDL.B« 

SPC/1 COMAL-BIN

0090 DIM OP1$(12),OP2$(12),RES$(15),TAL2$(12),BLANK$(25),BLB2$(12)
0100 DIM K1$(17),N$(6),K2$(17),K3$(17),K4$(17),K5$(17),STREG$(77)
0110 DIM SVAR$(E),VARTEKST$(25),VARPRIS$(12),TAH$(12),T2(W),T3(W)
0120 DIM TAL1$(12),TAL4$(14),SVAR1$(E),VARPRI$(12),VARTEK$(25),DV$(10)
0140 BLANK$="                         ";TAH$="0+"
0150 STREG$="--------------------------------------";STREG$=STREG$+STREG$
0160 PROC VALINUD
0170 CURSOR G,LINIE
0180 PRINT USING "#######":VARENR
0190 CURSOR 13,LINIE
0200 PRINT VARTEKST$
0210 CURSOR 45,LINIE
0220 EXEC TUD(VARPRIS$,TAL4$,B,B)
0225 PRINT TAL4$
0230 CURSOR 61,LINIE
0240 PRINT USING "####### #######":VARKONT,UNDKONT
0250 ENDPROC
0260 PROC LINTEST
0270 CLEAR
0280 CURSOR 21,E
0290 PRINT "Varevedligeholdelse. ";
0300 EXEC VARHOVED
0310 EXEC VALINUD
0315 LINIE=LINIE+E
0320 ENDPROC
0330 PROC VARHOVED
0340 PRINT "Ny vare."
0350 CURSOR 21,G
0360 PRINT "Hvis færdig, tast varenummer 0."
0370 EXEC VARELTEK
0380 ENDPROC
0390 PROC SLETVPOST
0400 EXEC NULVPOST
0410 VNR2=VARENR;VARENR=B
0420 EXEC GEMVPOST
0430 VARENR=VNR2
0440 EXEC SLETPOST(VTAB,AVARE,VPIL3)
0450 ENDPROC
0460 PROC GEMVPOST
0470 S=VTAB(VPIL3,G)
0480 PUT K4$,S:VARENR,VARTEKST$,VARPRIS$,VARKONT,UNDKONT
0490 EXEC FEJL(G,E,K4$)
0500 ENDPROC
0510 PROC HENTVPOST
0520 S=VTAB(VPIL3,G)
0530 GET K4$,S:VARENR,VARTEKST$,VARPRIS$,VARKONT,UNDKONT
0540 EXEC FEJL(V,E,K4$)
0550 ENDPROC
0560 PROC NULVPOST
0570 VARTEKST$=BLANK$;VARPRIS$="0+";VARKONT=B;UNDKONT=B
0580 ENDPROC
0590 PROC NRTEST(NUM1)
0600 P,TEST2,KTAL=B;L=LEN(NUM1$)
0610 IF L>6 THEN EXIT
0620 CASE L OF
0630 FOR I=E TO L
0640 P1=INT(ORD(NUM1$(I))-48)
0650 IF P1<B OR P1>W THEN TEST2=E
0660 P=P*10+P1
0670 NEXT I
0680 KTAL=P DIV 10000
0690 WHEN B
0700 P=-E
0710 WHEN E
0720 CASE NUM1$ OF
0730 P=INT(ORD(NUM1$)-48)
0740 WHEN "d","D"
0750 P=-G
0760 WHEN "a","A"
0770 P=-V
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$)<>B 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=B;FLAG=B;ART=AR3-6*(AR3>5)
0950 CALL "P641210:REGN"
0960 ES$=RES$
0970 IF AR3<6 THEN IF FLAG THEN STOP
1000 ENDPROC
1010 PROC TUD(BLB1,UBLB1,TEGN,STØR)
1020 BLB2$=BLB1$
1030 EXEC CALC(5,BLB2$,TAH$,UBLB1$)
1040 IF TEGN=B THEN UBLB1$=UBLB1$(E:13)
1050 IF TEGN=E AND UBLB1$(LEN(UBLB1$))="+" THEN UBLB1$(LEN(UBLB1$))="  "
1060 IF STØR=E THEN UBLB1$=UBLB$(4:LEN(UBLB1$)-V)
1070 ENDPROC
1080 PROC SLETPOST(TAB3,ANTAL3,PIL5)
1090 POSTNR=TAB3(PIL5,G)
1100 FOR I=PIL5 TO ANTAL3-E
1110 TAB3(I,E)=TAB3(I+E,E);TAB3(I,G)=TAB3(I+E,G)
1120 NEXT I
1130 TAB3(ANTAL3,E)=1000000;TAB3(ANTAL3,G)=POSTNR;ANTAL3=ANTAL3-E
1140 ENDPROC
1150 PROC INDSÆT1(TAB2,ANTAL2,NØGL2,PIL4)
1160 POSTNR=TAB2(ANTAL2+E,G)
1170 IF NØGL2>TAB2(PIL4,E) THEN PIL4=PIL4+E
1180 FOR I=ANTAL2+E TO PIL4+E STEP -E
1190 TAB2(I,E)=TAB2(I-E,E);TAB2(I,G)=TAB2(I-E,G)
1200 NEXT I
1210 TAB2(PIL4,E)=NØGL2;TAB2(PIL4,G)=POSTNR;ANTAL2=ANTAL2+E
1220 ENDPROC
1230 PROC INDTAB1(Z,MANT5,L7)
1240 PIL1=MANT5 DIV 32
1250 FOR I=E TO PIL1
1260 H=(I-E)*8+E
1270 GET L7$,I:Z(H),Z(H+E),Z(H+G),Z(H+V),Z(H+4),Z(H+5),Z(H+6),Z(H+7)
1280 EXEC FEJL(G,E,L7$)
1290 NEXT I
1300 ENDPROC
1310 PROC UDTAB(U,MANTAL1,L9)
1320 MANTAL2=MANTAL1 DIV 32+E;MANTAL3=MANTAL1 DIV 4+MANTAL2-E
1330 FOR I=E TO MANTAL2-E
1340 H=(I-E)*32+E;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,E),U(H1,E),U(H2,E),U(H3,E),U(H4,E),U(H5,E),U(H6,E),U(H7,E)
1360 EXEC FEJL(V,E,L9$)
1370 NEXT I
1380 FOR I=MANTAL2 TO MANTAL3
1390 H=(I-MANTAL2)*4+E;H1=H+E;H2=H+G;H3=H+V
1400 PUT L9$,I:U(H,E),U(H,G),U(H1,E),U(H1,G),U(H2,E),U(H2,G),U(H3,E),U(H3,G)
1410 EXEC FEJL(V,G,L9$)
1420 NEXT I
1430 ENDPROC
1440 PROC INDTAB(T,MANTAL,L10)
1450 MANTAL2=MANTAL DIV 32+E;MANTAL3=MANTAL DIV 4+MANTAL2-E
1460 FOR I=MANTAL2 TO MANTAL3
1470 H=(I-MANTAL2)*4+E;H1=H+E;H2=H+G;H3=H+V
1480 GET L10$,I:T(H,E),T(H,G),T(H1,E),T(H1,G),T(H2,E),T(H2,G),T(H3,E),T(H3,G)
1490 EXEC FEJL(4,E,L10$)
1500 NEXT I
1510 ENDPROC
1520 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
1530 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=E;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
1540 REPEAT
1550 IF NØGL5=TAB4(PIL6) OR PIL1=E THEN EXIT
1560 PIL1=(PIL1+E) DIV G;PIL6=PIL6+PIL1*(E-G*(NØGL5<TAB4(PIL6)))
1570 IF PIL6<E THEN PIL6=E
1580 IF PIL6>MANT3 THEN PIL6=MANT3
1590 UNTIL PIL1=B
1600 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-E*(PIL6>E)
1610 PIL6=MANT4+PIL6
1620 GET L8$,PIL6:Q(E,E),Q(E,G),Q(G,E),Q(G,G),Q(V,E),Q(V,G),Q(4,E),Q(4,G)
1630 EXEC FEJL(E,E,L8$)
1640 FOR PIL6=E TO 4
1650 IF NØGL5=Q(PIL6,E) THEN EXIT
1660 NEXT PIL6
1670 IF PIL6<>5 THEN CEKS=B
1680 ENDPROC
1690 PROC FINDPOST(TAB1,MANT1,NØGL1,PIL3)
1700 PIL1=MANT1 DIV G;PIL3=PIL1;CEKS=E
1710 REPEAT
1720 IF NØGL1=TAB1(PIL3,E) OR PIL1=E THEN EXIT
1730 PIL1=(PIL1+E) DIV G;PIL3=PIL3+PIL1*(E-G*(NØGL1<TAB1(PIL3,E)))
1740 IF PIL3<E THEN PIL3=E
1750 IF PIL3>MANT1 THEN PIL3=MANT1
1760 UNTIL PIL1=B
1765 IF NØGL1>TAB1(PIL3,E) THEN PIL3=PIL3+E*(PIL3<MANT1)
1770 IF NØGL1=TAB1(PIL3,E) THEN CEKS=B
1780 ENDPROC
1790 PROC VAREÆND
1800 VARTEK$=BLANK$
1810 CURSOR 12,LINIE
1820 INPUT " ",VARTEK$
1830 IF LEN(VARTEK$)>B THEN VARTEKST$=VARTEK$
1840 CURSOR 13,LINIE
1850 PRINT VARTEKST$;BLANK$;BLANK$
1860 REPEAT
1870 CURSOR 44,LINIE
1880 INPUT " ",VARPRI$
1885 IF LEN(VARPRI$)=B THEN EXIT
1890 IF VARPRI$(LEN(VARPRI$))<>"+" THEN VARPRI$=VARPRI$+"+"
1900 EXEC CALC(6,VARPRI$,TAH$,VARPRI$)
1910 UNTIL FLAG=B
1915 IF LEN(VARPRI$)>B THEN VARPRIS$=VARPRI$
1920 CURSOR 45,LINIE
1930 EXEC TUD(VARPRIS$,TAL4$,B,B)
1935 PRINT TAL4$
1936 VARKONTO=VARKONT
1940 REPEAT
1950 REPEAT
1960 CURSOR 61,LINIE
1970 PRINT BLANK$
1980 CURSOR 61,LINIE
1990 INPUT " ",TAL1$
2000 EXEC NRTEST(TAL1$)
2010 UNTIL (P<E OR KTAL=VTAL) AND TEST2=B
2020 VARKONT=P;CEKS=E
2030 IF P>B THEN EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,P,FPIL3,K2$)
2040 UNTIL P<E OR CEKS=B
2050 IF P=B THEN VARKONT=DIVNR
2055 IF P=-E THEN VARKONT=VARKONTO
2060 CURSOR 61,LINIE
2070 PRINT USING "#######    ":VARKONT
2071 UNDK=UNDKONT
2072 REPEAT
2073 CURSOR 69,LINIE
2074 PRINT BLANK$(E:18)
2075 CURSOR 69,LINIE
2076 INPUT " ",TAL1$
2077 EXEC NRTEST(TAL1$)
2078 UNTIL (P<E OR (P>W AND P<99)) AND TEST2=B
2079 UNDKONT=P
2080 IF P=B THEN UNDKONT=DUNDKONT
2081 IF P=-E THEN UNDKONT=UNDK
2082 CURSOR 69,LINIE
2083 PRINT USING "#######":UNDKONT
2084 ENDPROC
2090 PROC VARELTEK
2100 CURSOR V,4
2110 PRINT "Varenr    Varetekst"
2120 CURSOR 49,4
2130 PRINT "Varepris    Varekonto Underkonto"
2140 LINIE=6
2150 ENDPROC
2160 PROC OVERSKRI
2162 SIDENR=SIDENR+E
2164 IF SIDENR>E THEN PRINT " "
2165 PRINT TAB(67);DV$;" "
2170 PRINT TAB(10);CHR(14);"Varefortegnelse";CHR(15);
2180 PRINT TAB(39);"Dato:";TAB(47);
2190 PRINT USING "###.##":(DATO MOD 10000)/100;
2200 PRINT TAB(44);
2210 PRINT USING "###.#":(DATO DIV 1000)/10;
2211 PRINT TAB(54);"Side:";SIDENR
2230 PRINT "  Varenr    Varetekst";TAB(47);"Varepris    Varekonto Underkonto"
2250 PRINT STREG$
2260 ENDPROC
2270 K1$="P641220:SYSTEM1"
2280 OPEN K1$,R
2290 EXEC FEJL(W,E,K1$)
2300 GET K1$,E:MFANTAL,MDANTAL,MKANTAL,MVANTAL
2310 EXEC FEJL(W,G,K1$)
2320 GET K1$,4:MKPOST,MFAK,MVGR
2330 EXEC FEJL(W,V,K1$)
2340 GET K1$,8:DIVNR
2350 EXEC FEJL(W,21,K1$)
2360 GET K1$,W:KRTAL,VTAL
2370 EXEC FEJL(W,4,K1$)
2380 GET K1$,10:N$
2390 EXEC FEJL(W,5,K1$)
2400 GET K1$,11:K2$
2410 EXEC FEJL(W,6,K1$)
2420 GET K1$,14:K3$
2430 EXEC FEJL(W,7,K1$)
2440 GET K1$,18:K4$
2450 EXEC FEJL(W,8,K1$)
2460 GET K1$,36:K5$
2470 EXEC FEJL(W,W,K1$)
2471 GET K1$,43:I,I,I,DUNDKONT
2472 EXEC FEJL(W,95,K1$)
2480 CLOSE K1$
2490 EXEC FEJL(W,10,K1$)
2500 DIM VTAB(MVANTAL,G),FTAB1(MFANTAL DIV 4),FTAB(4,G)
2510 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$
2520 OPEN K5$,W
2530 EXEC FEJL(W,11,K5$)
2540 GET K5$,G:T1,T1,T1,T1,T1,T1,DATO
2550 EXEC FEJL(W,12,K5$)
2560 GET K5$,12:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),AVARE
2570 EXEC FEJL(W,13,K5$)
2580 GET K5$,17:T3(E),T3(G),T3(V),T3(4),T3(5),T3(6),T3(7),T3(8),T3(W)
2590 EXEC FEJL(W,14,K5$)
2600 T3(6)=E
2610 PUT K5$,17:T3(E),T3(G),T3(V),T3(4),T3(5),T3(6),T3(7),T3(8),T3(W)
2620 EXEC FEJL(W,15,K5$)
2622 GET K5$,20:DV$
2624 EXEC FEJL(W,25,K5$)
2630 CLOSE K5$
2640 EXEC FEJL(W,16,K5$)
2650 OPEN K2$,R
2660 EXEC FEJL(W,17,K2$)
2670 OPEN K3$,W
2680 EXEC FEJL(W,18,K3$)
2690 OPEN K4$,W
2700 EXEC FEJL(W,19,K4$)
2710 EXEC INDTAB1(FTAB1,MFANTAL,K2$)
2720 EXEC INDTAB(VTAB,MVANTAL,K3$)
2725 SIDENR=B
2730 REPEAT
2740 CLEAR
2750 CURSOR 21,E
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,E
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 E,LINIE
3060 PRINT BLANK$
3070 CURSOR E,LINIE
3080 INPUT "    ",TAL1$
3090 EXEC NRTEST(TAL1$)
3100 UNTIL (P>4 AND P<=999999 OR P=B) AND TEST2=B
3110 VARENR=P
3120 IF VARENR=B THEN EXIT
3130 EXEC FINDPOST(VTAB,MVANTAL,VARENR,VPIL3)
3140 IF CEKS=B THEN
3150 EXEC HENTVPOST
3160 EXEC VALINUD
3170 LINIE=LINIE+E
3180 IF LINIE>23 THEN EXEC LINIETEST
3190 ENDIF
3200 UNTIL CEKS=E
3205 IF VARENR=B THEN EXIT
3210 CURSOR G,LINIE
3220 PRINT USING "#######   ":VARENR
3230 CURSOR 12,LINIE
3240 INPUT " ",VARTEKST$
3250 CURSOR 13,LINIE
3260 PRINT VARTEKST$;BLANK$;BLANK$
3270 REPEAT
3275 REPEAT
3280 CURSOR 44,LINIE
3290 INPUT " ",VARPRIS$
3295 UNTIL LEN(VARPRIS$)>B
3300 IF VARPRIS$(LEN(VARPRIS$))<>"+" THEN VARPRIS$=VARPRIS$+"+"
3310 EXEC CALC(6,VARPRIS$,TAH$,VARPRIS$)
3320 UNTIL FLAG=B
3330 CURSOR 45,LINIE
3340 EXEC TUD(VARPRIS$,TAL4$,B,B)
3345 PRINT TAL4$
3350 REPEAT
3360 REPEAT
3370 CURSOR 61,LINIE
3380 PRINT BLANK$
3390 CURSOR 61,LINIE
3400 INPUT " ",TAL1$
3410 EXEC NRTEST(TAL1$)
3420 UNTIL (KTAL=VTAL OR P=B) AND TEST2=B
3430 VARKONT=P;CEKS=E
3440 IF P>B THEN EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,P,FPIL3,K2$)
3450 UNTIL P=B OR CEKS=B
3460 IF P=B THEN VARKONT=DIVNR
3470 CURSOR 60,LINIE
3480 PRINT USING "#######    ":VARKONT
3481 REPEAT
3482 CURSOR 69,LINIE
3483 PRINT BLANK$(E:18)
3484 CURSOR 69,LINIE
3485 INPUT " ",TAL1$
3486 EXEC NRTEST(TAL1$)
3487 UNTIL (P=B OR (P>W AND P<99)) AND TEST2=B
3488 UNDKONT=P
3489 IF P=B THEN UNDKONT=DUNDKONT
3490 CURSOR 68,LINIE
3491 PRINT USING "#######":UNDKONT
3492 CURSOR E,24
3495 EXEC INDSÆT1(VTAB,AVARE,VARENR,VPIL3)
3500 EXEC GEMVPOST
3510 LINIE=LINIE+E
3520 IF LINIE>23 THEN EXEC LINTEST
3540 ELSE
3550 CURSOR 5,21
3560 INPUT "Der er ikke plads til flere varer. Tast RETURN.",SVAR1$
3565 VARENR=B
3570 ENDIF
3575 UNTIL VARENR=B
3580 WHEN "2","3","4"
3590 REPEAT
3600 CLEAR
3610 CURSOR 21,E
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=B) AND TEST2=B
3780 VARENR=P
3790 CURSOR 11,4
3800 PRINT BLANK$;BLANK$
3810 IF VARENR=B THEN EXIT
3820 CURSOR E,24
3830 EXEC FINDPOST(VTAB,MVANTAL,VARENR,VPIL3)
3840 IF CEKS=B 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 E,24
3920 EXEC GEMVPOST
3930 WHEN "3"
3940 IF T2(4)>B 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 V,4
4180 PRINT USING "Varenummer ####### eksistere ikke.Tast RETURN.":VARENR
4190 INPUT " ",SVAR1$
4200 ENDIF
4210 UNTIL VARENR=B
4220 WHEN "5"
4230 REPEAT
4240 REPEAT
4250 SIDENR=B
4260 CURSOR V,23
4270 PRINT "Fra varenummer          (0:Alle)"
4280 CURSOR 17,23
4290 INPUT TAL1$
4300 EXEC NRTEST(TAL1$)
4310 UNTIL P>4 AND TEST2=B OR P=B
4320 IF P=B THEN
4330 FRA=E;TIL=AVARE
4340 ELSE
4350 KONT=P
4360 EXEC FINDPOST(VTAB,MVANTAL,P,VPIL3)
4370 IF VTAB(VPIL3,E)<KONT THEN VPIL3=VPIL3+E
4380 FRA=VPIL3
4381 ENDIF
4382 UNTIL FRA<=AVARE
4383 IF P>B THEN
4384 REPEAT
4385 CURSOR V,23
4386 PRINT "Til varenummer          "
4387 CURSOR 17,23
4388 INPUT TAL1$
4389 EXEC NRTEST(TAL1$)
4390 UNTIL P=>KONT AND TEST2=B
4391 EXEC FINDPOST(VTAB,MVANTAL,P,VPIL3)
4392 IF VTAB(VPIL3,E)>P THEN VPIL3=VPIL3-E
4393 TIL=VPIL3
4394 ENDIF
4395 REPEAT
4396 CLEAR
4399 CURSOR 15,13
4400 INPUT "Monter papir til udskrift og tast RETURN",SVAR1$
4405 UNTIL ORD(SVAR1$)=255
4410 OUTPUT P
4450 FOR I=FRA TO TIL STEP 40
4460 EXEC OVERSKRI
4470 FOR VPIL3=I TO I+39
4472 IF VTAB(VPIL3,E)>B THEN
4473 EXEC HENTVPOST
4480 PRINT USING " #######":VARENR;
4490 PRINT TAB(13);VARTEKST$;TAB(45);VARPRIS$(E:11);TAB(61);
4500 PRINT USING "####### #######":VARKONT,UNDKONT
4510 ENDIF
4520 IF VPIL3=TIL THEN EXIT
4530 NEXT VPIL3
4532 PRINT CHR(10);CHR(10)
4550 IF VPIL3=TIL AND VPIL3<I+40 THEN EXIT
4555 NEXT I
4570 FOR J=VPIL3+E TO I+39
4580 PRINT " "
4600 NEXT J
4620 OUTPUT T
4630 ENDCASE
4640 UNTIL SVAR$="0"
4650 EXEC UDTAB(VTAB,MVANTAL,K3$)
4660 CLOSE K3$
4670 EXEC FEJL(W,30,K3$)
4680 CLOSE K4$
4690 EXEC FEJL(W,31,K4$)
4700 CLOSE K2$
4710 T3(6)=B
4720 OPEN K5$,W
4730 EXEC FEJL(W,32,K5$)
4740 PUT K5$,12:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),AVARE
4750 EXEC FEJL(W,33,K5$)
4760 PUT K5$,17:T3(E),T3(G),T3(V),T3(4),T3(5),T3(6),T3(7),T3(8),T3(W)
4770 EXEC FEJL(W,34,K5$)
4780 CLOSE K5$
4790 EXEC FEJL(W,35,K5$)
4800 CHAIN "P641210:OPSTART"