⟦55bac56cd⟧

Text

0100 DIM OP1$(12),OP2$(12),RES$(14),BLB2$(12),T2(9),K2$(17),K3$(17),K4$(17)
0110 DIM K1$(17),N$(6),K6$(17),K5$(17),DEBNAVN$(25),DSALDO1$(12),DEBKGR$(2)
0120 DIM DSALDO2$(12),DSALDO3$(12),DSALDO4$(12),DEBLK$(2),DEBGADE$(25)
0130 DIM DEBTLF$(9),DEBBY$(20),SALDO$(12),FORS$(12),SVAR2$(1),GTOTAL$(12)
0140 DIM ÅRKØB$(12),MDNKØB$(12),K7$(17),A$(6),TAL1$(12)
0150 DIM MOMS$(12),FTOTAL$(12),KOD1$(1),KOD$(1),TAH$(12),TAL4$(14),T1(9)
0160 DIM VARTEKST$(25),VARPRIS$(12),BELØB$(12),TOTAL$(12),B$(12)
0170 DIM SVAR1$(1),FAKKRE$(1),LEVTEKST$(52),ANTAL$(12),BLANK$(77),LAND$(9,12)
0180 DIM VATEKARR$(25,25),VAPRIARR$(25,12),BELØBARR$(25,12),VAANTARR$(25,5)
0190 DIM ARRKODER(26,2),VANRARR(25)
0200 DIM LTX1$(6),LTX2$(32),LTX3$(47),LTX4$(19),LTX5$(17),LTX6$(31),LTX7$(33)
0210 DIM LTX8$(9),LTX9$(25),LTX10$(26),LTX11$(28),LTX12$(39),LTX13$(33)
0220 TAH$="0+";TAL4$="0+";TOTAL$="0+"
0230 BLANK$="                         ";BLANK$=BLANK$+BLANK$+BLANK$+"  "
0240 LTX1$="Rabat ";LTX3$="Fakturering. Indtast kundenummer, 0 for færdig:"
0250 LTX2$="Korrekt forsendelsesbeløb (J/N):";LTX4$="Rigtig kunde (J/N):"
0260 LTX5$="Ordrenr.:       ";LTX7$="Der er ikke plads til ny faktura."
0270 LTX9$="Linie, som ønskes ændret:";LTX11$="Ønskes linien slettet (J/N):"
0280 LTX8$="Vælg 1-5:";LTX12$="Linie fra hvilken der ønskes udskrevet:"
0290 LTX6$="Fakturahoved godkendes (J/N):  "
0300 LTX13$="Hvilket linienummer for ny linie:"
0310 LTX10$="Linie, som ønskes slettet:"
0320 PROC CALC(AR3,B1,B2,ES)
0330 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0;ART=AR3-6*(AR3>5)
0340 CALL "P641210:REGN"
0350 IF AR3<6 THEN 
0360 IF FLAG THEN STOP 
0370 ENDIF 
0380 ES$=RES$
0390 ENDPROC 
0400 PROC INDPUT1(XPOS1,YPOS1,LN4,LN5,LT1)
0410 REPEAT 
0420 CURSOR XPOS1,YPOS1
0430 PRINT LT1$;BLANK$(77-XPOS1-LEN(LT1$))
0440 CURSOR XPOS1+LEN(LT1$)-1,YPOS1
0450 INPUT " ",A$
0460 EXEC NRTEST(A$)
0470 UNTIL P>LN4 AND P<LN5 AND TEST2=0
0480 ENDPROC 
0490 PROC INDPUT2(XPOS2,YPOS2,LT2,VAR)
0500 REPEAT 
0510 CURSOR XPOS2,YPOS2
0520 PRINT LT2$;BLANK$(77-XPOS2-LEN(LT2$))
0530 CURSOR XPOS2+LEN(LT2$)-1,YPOS2
0540 INPUT " ",VAR$
0550 IF LEN(VAR$)=0 THEN VAR$="0"
0560 VAR$=VAR$+"+"
0570 EXEC CALC(6,VAR$,TAH$,VAR$)
0580 UNTIL FLAG=0
0590 ENDPROC 
0600 PROC FEJL(NR1,NR2,NR3)
0610 IF STATUS(NR3$)<>0 THEN 
0620 PRINT STATUS(NR3$),NR1,NR2,NR3$
0630 STOP 
0640 ENDIF 
0650 ENDPROC 
0660 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
0670 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=1;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
0680 REPEAT 
0690 IF NØGL5=TAB4(PIL6) OR PIL1=1 THEN EXIT 
0700 PIL1=(PIL1+1) DIV 2;PIL6=PIL6+PIL1*(1-2*(NØGL5<TAB4(PIL6)))
0710 IF PIL6<1 THEN PIL6=1
0720 IF PIL6>MANT3 THEN PIL6=MANT3
0730 UNTIL PIL1=0
0740 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-1*(PIL6>1)
0750 PIL6=MANT4+PIL6
0760 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)
0770 EXEC FEJL(1,1,L8$)
0780 FOR PIL6=1 TO 4
0790 IF NØGL5=Q(PIL6,1) THEN EXIT 
0800 NEXT PIL6
0810 IF PIL6<>5 THEN CEKS=0
0820 ENDPROC 
0830 PROC INDTAB1(Z,MANT5,L7)
0840 PIL1=MANT5 DIV 32
0850 FOR I=1 TO PIL1
0860 H=(I-1)*8+1
0870 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)
0880 EXEC FEJL(2,1,L7$)
0890 NEXT I
0900 ENDPROC 
0910 PROC NRTEST(NUM1)
0920 P=0;TEST2=0;KTAL=0;L=LEN(NUM1$)
0930 IF L>6 THEN EXIT 
0940 CASE L OF 
0950 FOR J=1 TO L
0960 P1=INT(ORD(NUM1$(J))-48)
0970 IF P1<0 OR P1>9 THEN 
0980 TEST2=1
0990 ELSE 
1000 P=P*10+P1
1010 ENDIF 
1020 NEXT J
1030 KTAL=P DIV 10000
1040 WHEN 0
1050 P=-1
1060 WHEN 1
1070 CASE NUM1$ OF 
1080 P=INT(ORD(NUM1$)-48)
1090 WHEN "J","j"
1100 P=-7
1110 WHEN "N","n"
1120 P=-8
1130 ENDCASE 
1140 ENDCASE 
1150 ENDPROC 
1160 PROC TUD(BLB1,UBLB1,TEGN,STØR)
1170 BLB2$=BLB1$
1180 EXEC CALC(5,BLB2$,TAH$,UBLB1$)
1190 IF TEGN=0 THEN UBLB1$=UBLB1$(1:13)
1200 IF TEGN=1 AND UBLB1$(LEN(UBLB1$))="+" THEN UBLB1$(LEN(UBLB1$))=" "
1210 IF STØR=1 THEN UBLB1$=UBLB1$(4:LEN(UBLB1$)-3)
1220 PRINT UBLB1$
1230 ENDPROC 
1240 PROC HENTDPOST
1250 S=DTAB(DPIL3,2)
1260 GET K4$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
1270 EXEC FEJL(8,1,K4$)
1280 GET K4$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
1290 EXEC FEJL(8,2,K4$)
1300 GET K4$,S+2:DEBGADE$,DEBTLF$,HPOST,HKUNDE
1310 EXEC FEJL(8,3,K4$)
1320 GET K4$,S+3:DEBBY$,ÅRKØB$,MDNKØB$
1330 EXEC FEJL(8,4,K4$)
1340 ENDPROC 
1350 PROC HENTVPOST
1360 S=VTAB(VPIL3,2)
1370 GET K5$,S:VARENR,VARTEKST$,VARPRIS$,VARKONT
1380 EXEC FEJL(3,1,K5$)
1390 ENDPROC 
1400 PROC KUNDEUD(HO)
1410 CURSOR 9,5
1420 PRINT DEBNAVN$
1430 CURSOR 9,6
1440 PRINT DEBGADE$
1450 CURSOR 6,7
1460 PRINT USING "#######":DEBPOSTNR
1470 CURSOR 14,7
1480 PRINT DEBBY$
1490 IF HO=1 THEN 
1500 EXEC CALC(0,DSALDO1$,DSALDO2$,SALDO$)
1510 EXEC CALC(0,SALDO$,DSALDO3$,SALDO$)
1520 EXEC CALC(0,SALDO$,DSALDO4$,SALDO$)
1530 CURSOR 9,14
1540 PRINT "Saldo: ";
1550 EXEC TUD(SALDO$,TAL4$,1,0)
1560 CURSOR 12,16
1570 PRINT "0-30 dage      30-60 dage      60-90 dage         ældre"
1580 CURSOR 9,18
1590 EXEC TUD(DSALDO1$,TAL4$,1,0)
1600 CURSOR 25,18
1610 EXEC TUD(DSALDO2$,TAL4$,1,0)
1620 CURSOR 41,18
1630 EXEC TUD(DSALDO3$,TAL4$,1,0)
1640 CURSOR 57,18
1650 EXEC TUD(DSALDO4$,TAL4$,1,0)
1660 ENDIF 
1670 ENDPROC 
1680 PROC DATOINDT
1690 REPEAT 
1700 EXEC INDPUT1(64,LINIE,-2,1000000,BLANK$(1))
1710 UNTIL KTAL=>80 AND (P DIV 100) MOD 100<13 AND P MOD 100<32 OR P=-1
1720 DAT=P
1730 IF DAT=-1 THEN DAT=DATO
1740 CURSOR 67,LINIE
1750 EXEC DATOUD(DAT)
1760 ENDPROC 
1770 PROC DATOUD(DA)
1780 PRINT USING "###.##":(DA MOD 10000)/100
1790 CURSOR 64,LINIE
1800 PRINT USING "###.#":(DA DIV 1000)/10
1810 ENDPROC 
1820 PROC FAKHOVED
1830 CLEAR 
1840 CURSOR 2,1
1850 PRINT USING "Kundenr.:#######   ":KUNDENR;
1860 PRINT "    ";DEBNAVN$
1870 CURSOR 54,1
1880 IF FAKKRE$="F" THEN 
1890 PRINT USING "Fakturanr.:     #######":FAKTNR+AFAKT
1900 ELSE 
1910 PRINT USING "Kreditnotanr.:  ######":KREDNR+AKRED
1920 ENDIF 
1930 CURSOR 2,3
1940 PRINT "Linie  Vr.nr.  Antal  Tekst";
1950 CURSOR 56,3
1960 PRINT "Pris          Beløb"
1970 LINIE=5
1980 ENDPROC 
1990 PROC VARELINI
2000 REPEAT 
2010 FEJL6=0;VARTEKST$=BLANK$
2020 CURSOR 3,LINIE
2030 PRINT USING "###":AVALIN;
2040 PRINT BLANK$(1:55)
2050 REPEAT 
2060 EXEC INDPUT1(8,LINIE,-1,1000000,BLANK$(1))
2070 UNTIL NOT (P=3 AND AVALIN=1)
2080 VARENR=P
2090 IF VARENR<>0 THEN 
2100 CURSOR 8,LINIE
2110 IF VARENR=5 THEN 
2120 PRINT BLANK$(1:25)
2130 ELSE 
2140 PRINT USING "#######":VARENR
2150 ENDIF 
2160 CASE VARENR OF 
2170 EXEC FINDPOST1(VTAB1,VTAB,MVANTAL,VARENR,VPIL3,K3$)
2180 IF CEKS<>0 THEN 
2190 CURSOR 17,LINIE
2200 INPUT "Varenummeret eksisterer ikke. Tast RETURN.",SVAR1$
2210 LINIE=LINIE-1;AVALIN=AVALIN-1
2220 ELSE 
2230 EXEC INDPUT2(17,LINIE,BLANK$(1),ANTAL$)
2240 EXEC CALC(4,ANTAL$,TAH$,TAH$)
2250 IF SI=0 THEN FEJL6=1
2260 IF FEJL6=0 THEN 
2270 CURSOR 17,LINIE
2280 PRINT ANTAL$(4:5);BLANK$(1:10)
2290 CURSOR 1,23
2300 EXEC HENTVPOST
2310 CURSOR 23,LINIE
2320 IF ORD(VARTEKST$(1))=255 THEN 
2330 INPUT " ",VARTEKST$
2340 ARRKODER(AVALIN,2)=1
2350 ENDIF 
2360 CURSOR 24,LINIE
2370 PRINT VARTEKST$;BLANK$(1:25)
2380 EXEC CALC(4,VARPRIS$,TAH$,TAH$)
2390 IF SI=0 THEN 
2400 EXEC INDPUT2(50,LINIE,BLANK$(1),VARPRIS$)
2410 ARRKODER(AVALIN,1)=1
2420 ENDIF 
2430 CURSOR 51,LINIE
2440 EXEC TUD(VARPRIS$,TAL4$,1,0)
2450 EXEC CALC(2,VARPRIS$,ANTAL$,BELØB$)
2460 CURSOR 66,LINIE
2470 EXEC TUD(BELØB$,TAL4$,1,0)
2480 EXEC CALC(0,BELØB$,TOTAL$,TOTAL$)
2490 IF FLAG<>0 THEN STOP 
2500 VANRARR(AVALIN)=VARENR;VATEKARR$(AVALIN)=VARTEKST$
2510 VAPRIARR$(AVALIN)=VARPRIS$;VAANTARR$(AVALIN)=ANTAL$(4:5)
2520 BELØBARR$(AVALIN)=BELØB$
2530 ENDIF 
2540 ENDIF 
2550 WHEN 1,2
2560 VARTEKST$=BLANK$
2570 CURSOR 23,LINIE
2580 INPUT " ",VARTEKST$
2590 L2=LEN(VARTEKST$)
2600 IF L2=0 THEN FEJL6=1
2610 IF L2>0 THEN 
2620 CURSOR 24,LINIE
2630 PRINT VARTEKST$;BLANK$(1:25)
2640 IF VARENR=1 THEN 
2650 EXEC INDPUT2(65,LINIE,BLANK$(1),BELØB$)
2660 EXEC CALC(0,BELØB$,TOTAL$,TOTAL$)
2670 CURSOR 66,LINIE
2680 EXEC TUD(BELØB$,TAL4$,1,0)
2690 BELØBARR$(AVALIN)=BELØB$
2700 ELSE 
2710 BELØBARR$(AVALIN)="0+"
2720 ENDIF 
2730 VANRARR(AVALIN)=VARENR;VATEKARR$(AVALIN)=VARTEKST$
2740 ENDIF 
2750 WHEN 3
2760 IF VANRARR(AVALIN-1)<>3 THEN 
2770 EXEC INDPUT2(24,LINIE,LTX1$,VARPRIS$)
2780 EXEC CALC(4,VARPRIS$,TAH$,TAH$)
2790 IF SI=0 THEN FEJL6=1
2800 IF FEJL6=0 THEN 
2810 CURSOR 30,LINIE
2820 PRINT VARPRIS$(7:5);" %";BLANK$(1:25)
2830 EXEC CALC(2,VARPRIS$,BELØBARR$(AVALIN-1),BELØB$)
2840 VATEKARR$(AVALIN)="Rabat "+VARPRIS$(7:5)+" %"
2850 VANRARR(AVALIN)=VARENR;VARPRIS$="100-"
2860 EXEC CALC(3,BELØB$,VARPRIS$,BELØB$)
2870 CURSOR 66,LINIE
2880 EXEC TUD(BELØB$,TAL4$,1,0)
2890 BELØBARR$(AVALIN)=BELØB$
2900 EXEC CALC(0,BELØB$,TOTAL$,TOTAL$)
2910 ENDIF 
2920 ELSE 
2930 LINIE=LINIE-1;AVALIN=AVALIN-1
2940 ENDIF 
2950 WHEN 4
2960 CURSOR 24,LINIE
2970 VARTEKST$="Subtotal                 "
2980 PRINT VARTEKST$
2990 CURSOR 66,LINIE
3000 EXEC TUD(TOTAL$,TAL4$,1,0)
3010 VANRARR(AVALIN)=VARENR;VATEKARR$(AVALIN)=VARTEKST$
3020 BELØBARR$(AVALIN)=TOTAL$
3030 ENDCASE 
3040 ELSE 
3050 VARENR=0
3060 CURSOR 2,LINIE
3070 PRINT BLANK$(1:25)
3080 ENDIF 
3090 UNTIL FEJL6=0
3100 ENDPROC 
3110 PROC LINITEST
3120 IF LINIE>23 THEN 
3130 EXEC FAKHOVED
3140 J=AVALIN-1
3150 EXEC VARLINUD(J)
3160 LINIE=LINIE+1
3170 ENDIF 
3180 ENDPROC 
3190 PROC VARLINUD(LIN)
3200 CURSOR 3,LINIE
3210 PRINT USING "###":LIN
3220 IF VANRARR(LIN)>4 THEN 
3230 CURSOR 8,LINIE
3240 PRINT USING "#######":VANRARR(LIN)
3250 CURSOR 17,LINIE
3260 PRINT VAANTARR$(LIN)
3270 ENDIF 
3280 CURSOR 24,LINIE
3290 PRINT VATEKARR$(LIN)
3300 IF VANRARR(LIN)>4 THEN 
3310 CURSOR 51,LINIE
3320 B$=VAPRIARR$(LIN)
3330 EXEC TUD(B$,TAL4$,1,0)
3340 ENDIF 
3350 CURSOR 66,LINIE
3360 B$=BELØBARR$(LIN)
3370 IF VANRARR(LIN)<>2 THEN EXEC TUD(B$,TAL4$,1,0)
3380 ENDPROC 
3390 PROC FAKTBUND
3400 GTOTAL$=TOTAL$
3410 REPEAT 
3420 EXEC SLET
3430 CURSOR 22,19
3440 PRINT "Forsendelse       Netto"
3450 CURSOR 56,19
3460 PRINT "Moms          Total"
3470 EXEC INDPUT2(20,21,BLANK$(1),FORS$)
3480 CURSOR 21,21
3490 EXEC TUD(FORS$,TAL4$,1,0)
3500 CURSOR 36,21
3510 EXEC CALC(0,FORS$,TOTAL$,TOTAL$)
3520 EXEC TUD(TOTAL$,TAL4$,1,0)
3530 EXEC CALC(2,TOTAL$,MOMS$,FTOTAL$)
3540 ANTAL$="100+"
3550 EXEC CALC(3,FTOTAL$,ANTAL$,ANTAL$)
3560 CURSOR 51,21
3570 EXEC TUD(ANTAL$,TAL4$,1,0)
3580 EXEC CALC(0,ANTAL$,TOTAL$,FTOTAL$)
3590 CURSOR 66,21
3600 EXEC TUD(FTOTAL$,TAL4$,1,0)
3610 TOTAL$=GTOTAL$
3620 EXEC INDPUT1(9,23,-9,-6,LTX2$)
3630 UNTIL P=-7
3640 ENDPROC 
3650 PROC SLET
3660 CURSOR 2,19
3670 PRINT BLANK$
3680 CURSOR 2,21
3690 PRINT BLANK$
3700 CURSOR 2,23
3710 PRINT BLANK$
3720 ENDPROC 
3730 PROC LUD
3740 CLEAR 
3750 EXEC FAKHOVED
3760 FOR LINIE=5 TO 16
3770 EXEC VARLINUD(STARTL)
3780 STARTL=STARTL+1
3790 IF STARTL>SLUTL THEN EXIT 
3800 NEXT LINIE
3810 ENDPROC 
3820 PROC AJOUR
3830 TOTAL$="0+"
3840 FOR M=1 TO AVALIN
3850 CASE VANRARR(M) OF 
3860 EXEC CALC(0,TOTAL$,BELØBARR$(M),TOTAL$)
3870 WHEN 2
3880 WHEN 4
3890 BELØBARR$(M)=TOTAL$
3900 WHEN 3
3910 VARPRIS$="      ,"+VATEKARR$(M,7:2)+VATEKARR$(M,10:2)+"-"
3920 IF VARPRIS$(8)=" " THEN VARPRIS$(8)="0"
3930 IF VARPRIS$(9)=" " THEN VARPRIS$(9)="0"
3940 EXEC CALC(2,BELØBARR$(M-1),VARPRIS$,TAL1$)
3950 BELØBARR$(M)=TAL1$
3960 EXEC CALC(0,TOTAL$,TAL1$,TOTAL$)
3970 ENDCASE 
3980 NEXT M
3990 ENDPROC 
4000 PROC FAKTGEM
4010 I=APOSTER+1
4020 IF FAKKRE$="F" THEN 
4030 AFAKT=AFAKT+1
4040 ELSE 
4050 AKRED=AKRED+1
4060 ENDIF 
4070 OPEN K6$,W
4080 EXEC FEJL(3,1,K6$)
4090 PUT K6$,I:KUNDENR,ORDREDAT,FAKKRE$,DIVD
4100 EXEC FEJL(3,2,K6$)
4110 I=I+2
4120 IF DIVD=1 THEN 
4130 PUT K6$,I:DEBNAVN$(1:13)
4140 EXEC FEJL(3,3,K6$)
4150 PUT K6$,I+1:DEBNAVN$(14:12)
4160 EXEC FEJL(3,4,K6$)
4170 PUT K6$,I+2:DEBGADE$(1:13)
4180 EXEC FEJL(3,5,K6$)
4190 PUT K6$,I+3:DEBGADE$(14:12)
4200 EXEC FEJL(3,6,K6$)
4210 PUT K6$,I+4:DPOSTNR,DEBBY$(1:9)
4220 EXEC FEJL(3,7,K6$)
4230 PUT K6$,I+5:DEBBY$(10:11)
4240 EXEC FEJL(3,8,K6$)
4250 I=I+6
4260 ENDIF 
4270 IF LEVKODE=0 THEN 
4280 FOR J=I TO I+3
4290 PUT K6$,J:LEVTEKST$((J-I)*13+1:13)
4300 EXEC FEJL(3,8,K6$)
4310 NEXT J
4320 I=I+4
4330 ENDIF 
4340 EXEC KODE(1)
4350 KOD1$=KOD$
4360 FOR LINIE=1 TO AVALIN
4370 J=LINIE+1
4380 EXEC KODE(J)
4390 CASE KOD1$ OF 
4400 STOP 
4410 WHEN "A"
4420 EXEC VALINGEM
4430 WHEN "B"
4440 VATEKARR$(LINIE,13)=KOD$
4450 PUT K6$,I:VATEKARR$(LINIE,1:13)
4460 EXEC FEJL(3,9,K6$)
4470 I=I+1
4480 WHEN "C"
4490 EXEC ELØBGEM(BELØBARR$(LINIE))
4500 WHEN "D"
4510 EXEC TEKSTGEM
4520 WHEN "E"
4530 EXEC TEKSTGEM
4540 EXEC ELØBGEM(BELØBARR$(LINIE))
4550 WHEN "F"
4560 EXEC VALINGEM
4570 EXEC ELØBGEM(VAPRIARR$(LINIE))
4580 WHEN "G","H"
4590 EXEC TEKSTGEM
4600 EXEC VALINGEM
4610 IF KOD1$="H" THEN 
4620 EXEC ELØBGEM(VAPRIARR$(LINIE))
4630 ENDIF 
4640 ENDCASE 
4650 KOD1$=KOD$
4660 NEXT LINIE
4670 EXEC ELØBGEM(FORS$)
4680 EXEC ELØBGEM(MOMS$)
4690 EXEC ELØBGEM(FTOTAL$)
4700 I=I-1
4710 EXEC KODE(1)
4720 IF LEVKODE=11 THEN KOD$=CHR(11+ORD(KOD$))
4730 PUT K6$,APOSTER+2:ORDRENR,FDATO,I-APOSTER,KOD$
4740 EXEC FEJL(3,10,K6$)
4750 APOSTER=I
4760 CLOSE K6$
4770 EXEC FEJL(3,11,K6$)
4780 ENDPROC 
4790 PROC TEKSTGEM
4800 PUT K6$,I:VATEKARR$(LINIE,1:13)
4810 EXEC FEJL(4,1,K6$)
4820 TAL4$=VATEKARR$(LINIE,14:12)+KOD$;I=I+2
4830 PUT K6$,I-1:TAL4$(1:13)
4840 EXEC FEJL(4,2,K6$)
4850 ENDPROC 
4860 PROC ELØBGEM(BEL)
4870 TAL4$=BEL$+KOD$;I=I+1
4880 PUT K6$,I-1:TAL4$(1:13)
4890 EXEC FEJL(5,1,K6$)
4900 ENDPROC 
4910 PROC VALINGEM
4920 PUT K6$,I:VANRARR(LINIE),VAANTARR$(LINIE),KOD$
4930 EXEC FEJL(6,1,K6$)
4940 I=I+1
4950 ENDPROC 
4960 PROC KODE(LI)
4970 IF ARRKODER(LI,1)=0 AND ARRKODER(LI,2)=0 THEN 
4980 CASE VANRARR(LI) OF 
4990 KOD$="A"
5000 WHEN 3
5010 KOD$="B"
5020 WHEN 4
5030 KOD$="C"
5040 WHEN 2
5050 KOD$="D"
5060 WHEN 1
5070 KOD$="E"
5080 ENDCASE 
5090 ELSE 
5100 IF ARRKODER(LI,1)=0 THEN 
5110 KOD$="G"
5120 ELSE 
5130 IF ARRKODER(LI,2)=0 THEN 
5140 KOD$="F"
5150 ELSE 
5160 KOD$="H"
5170 ENDIF 
5180 ENDIF 
5190 ENDIF 
5200 ENDPROC 
5210 PROC SYSGEM
5220 T1(1)=FAKTNR;T1(2)=KREDNR;T2(4)=APOSTER;T2(5)=AKRED;T2(6)=AFAKT
5230 T2(7)=AVKONTI;T2(8)=FJPOST
5240 OPEN K7$,W
5250 EXEC FEJL(9,1,K7$)
5260 PUT K7$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
5270 EXEC FEJL(9,2,K7$)
5280 PUT K7$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
5290 EXEC FEJL(9,3,K7$)
5300 CLOSE K7$
5310 EXEC FEJL(9,4,K7$)
5320 ENDPROC 
5330 K1$="P641220:SYSTEM1"
5340 OPEN K1$,R
5350 EXEC FEJL(9,1,K1$)
5360 GET K1$,1:MFANTAL,MDANTAL,MKANTAL,MVANTAL
5370 EXEC FEJL(9,2,K1$)
5380 GET K1$,4:KPOST,MFAK,MVGR,MKGR
5390 EXEC FEJL(9,3,K1$)
5400 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
5410 EXEC FEJL(9,4,K1$)
5420 GET K1$,10:N$
5430 EXEC FEJL(9,5,K1$)
5440 GET K1$,12:K2$
5450 EXEC FEJL(9,6,K1$)
5460 GET K1$,14:K3$
5470 EXEC FEJL(9,7,K1$)
5480 GET K1$,16:K4$
5490 EXEC FEJL(9,8,K1$)
5500 GET K1$,18:K5$
5510 EXEC FEJL(9,9,K1$)
5520 GET K1$,29:K6$
5530 EXEC FEJL(9,10,K1$)
5540 GET K1$,36:K7$
5550 EXEC FEJL(9,11,K1$)
5560 CLOSE K1$
5570 EXEC FEJL(9,12,K1$)
5580 DIM VTAB1(MVANTAL DIV 4),DTAB1(MDANTAL DIV 4),VTAB(4,2),DTAB(4,2)
5590 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$;K6$=N$+K6$;K7$=N$+K7$
5600 OPEN K7$,R
5610 EXEC FEJL(9,13,K7$)
5620 GET K7$,1:MOMS$
5630 EXEC FEJL(9,14,K7$)
5640 GET K7$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
5650 EXEC FEJL(9,15,K7$)
5660 FOR I=1 TO 3
5670 H=(I-1)*3+1
5680 GET K7$,I+2:LAND$(H),LAND$(H+1),LAND$(H+2)
5690 EXEC FEJL(9,16,K7$)
5700 NEXT I
5710 GET K7$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
5720 EXEC FEJL(9,17,K7$)
5730 CLOSE K7$
5740 EXEC FEJL(9,18,K7$)
5750 OPEN K2$,R
5760 EXEC FEJL(9,19,K2$)
5770 OPEN K3$,R
5780 EXEC FEJL(9,20,K3$)
5790 OPEN K4$,R
5800 EXEC FEJL(9,21,K4$)
5810 OPEN K5$,R
5820 EXEC FEJL(9,22,K5$)
5830 EXEC INDTAB1(VTAB1,MVANTAL,K3$)
5840 EXEC INDTAB1(DTAB1,MDANTAL,K2$)
5850 FAKTNR=T1(1);KREDNR=T1(2);DATO=T1(7);APOSTER=T2(4)
5860 AKRED=T2(5);AFAKT=T2(6);AVKONTI=T2(7);FJPOST=T2(8)
5870 REPEAT 
5880 TOTAL$="0+";AVALIN=1
5890 REPEAT 
5900 REPEAT 
5910 REPEAT 
5920 CLEAR 
5930 REPEAT 
5940 EXEC INDPUT1(9,1,-1,100000,LTX3$)
5950 UNTIL KTAL=DTAL OR P=0
5960 KUNDENR=P
5970 IF KUNDENR=0 THEN EXIT 
5980 CURSOR 56,1
5990 PRINT USING "#######            ":KUNDENR
6000 IF KUNDENR<>DIVDNR THEN 
6010 DIVD=0
6020 EXEC FINDPOST1(DTAB1,DTAB,MDANTAL,KUNDENR,DPIL3,K2$)
6030 IF CEKS=1 THEN 
6040 CURSOR 9,3
6050 INPUT "Kunden eksisterer ikke. Tast RETURN.",SVAR1$
6060 ELSE 
6070 EXEC HENTDPOST
6080 ENDIF 
6090 ELSE 
6100 DIVD=1;CEKS=0
6110 EXEC FINDPOST1(DTAB1,DTAB,MDANTAL,DIVDNR,DPIL3,K2$)
6120 IF CEKS=1 THEN STOP 
6130 EXEC HENTDPOST
6140 CURSOR 34,5
6150 PRINT "Navn."
6160 CURSOR 8,5
6170 INPUT " ",DEBNAVN$
6180 CURSOR 9,5
6190 PRINT DEBNAVN$;BLANK$(1:25)
6200 CURSOR 34,6
6210 PRINT "Gade."
6220 CURSOR 8,6
6230 INPUT " ",DEBGADE$
6240 CURSOR 9,6
6250 PRINT DEBGADE$;BLANK$(1:25)
6260 CURSOR 13,7
6270 PRINT "Postnummer."
6280 REPEAT 
6290 CURSOR 8,7
6300 INPUT " ",TAL1$
6310 EXEC NRTEST(TAL1$)
6320 UNTIL TEST2=0 AND P>999
6330 DPOSTNR=P
6340 CURSOR 13,7
6350 PRINT BLANK$(1:25);TAB(22);"By."
6360 CURSOR 13,7
6370 INPUT " ",DEBBY$
6380 CURSOR 34,7
6390 PRINT BLANK$(1:25)
6400 ENDIF 
6410 UNTIL CEKS=0
6420 IF KUNDENR=0 THEN EXIT 
6430 EXEC KUNDEUD(1)
6440 EXEC INDPUT1(9,21,-9,-6,LTX4$)
6450 UNTIL P=-7
6460 IF KUNDENR=0 THEN EXIT 
6470 IF APOSTER>MFAK*20-130 OR FJPOST+AFAKT+AKRED=>MFAK THEN 
6480 EXEC INDPUT1(9,23,-2,0,LTX7$)
6490 ELSE 
6500 REPEAT 
6510 CURSOR 9,23
6520 INPUT "Faktura/kreditnota (F/K):",FAKKRE$
6530 UNTIL FAKKRE$="F" OR FAKKRE$="K" OR FAKKRE$="f" OR FAKKRE$="k"
6540 IF FAKKRE$="f" THEN FAKKRE$="F"
6550 IF FAKKRE$="k" THEN FAKKRE$="K"
6560 CLEAR 
6570 EXEC KUNDEUD(2)
6580 CURSOR 50,4
6590 IF FAKKRE$="F" THEN 
6600 PRINT USING "Fakturanr.:     #######":FAKTNR+AFAKT
6610 ELSE 
6620 PRINT USING "Kreditnotanr.:  #######":KREDNR+AKRED
6630 ENDIF 
6640 CURSOR 50,6
6650 PRINT USING "Kundenr.:       #######":KUNDENR
6660 CURSOR 50,8
6670 PRINT "Ordredato:"
6680 LINIE=8
6690 EXEC DATOINDT
6700 ORDREDAT=DAT
6710 EXEC INDPUT1(50,10,0,1000000,LTX5$)
6720 ORDRENR=P
6730 CURSOR 66,10
6740 PRINT USING "#######     ":ORDRENR
6750 CURSOR 50,12
6760 PRINT "Dato:"
6770 LINIE=12
6780 EXEC DATOINDT
6790 FDATO=DAT
6800 CURSOR 9,14
6810 INPUT "Levering: ",LEVTEKST$
6820 LEVKODE=0
6830 IF LEN(LEVTEKST$)=0 THEN LEVKODE=11
6840 EXEC INDPUT1(9,17,-9,-6,LTX6$)
6850 ENDIF 
6860 UNTIL P=-7
6870 IF KUNDENR=0 THEN EXIT 
6880 IF APOSTER<=MFAK*20-130 AND FJPOST+AFAKT+AKRED<=MFAK THEN 
6890 EXEC FAKHOVED
6900 AVALIN=1
6910 REPEAT 
6920 ARRKODER(AVALIN,1)=0;ARRKODER(AVALIN,2)=0
6930 EXEC VARELINI
6940 IF VARENR=0 THEN EXIT 
6950 AVALIN=AVALIN+1;LINIE=LINIE+1
6960 EXEC LINITEST
6970 UNTIL VARENR=0 OR AVALIN>25
6980 AVALIN=AVALIN-1
6990 IF AVALIN>0 THEN 
7000 IF LINIE>16 THEN 
7010 EXEC FAKHOVED
7020 FOR LINIE=5 TO 16
7030 J=AVALIN+LINIE-16
7040 EXEC VARLINUD(J)
7050 NEXT LINIE
7060 ENDIF 
7070 REPEAT 
7080 CURSOR 4,19
7090 PRINT "1:Ændring. 2:Sletning. 3:Udskrift. 4:Ny linie. 5:Afslutning."
7100 EXEC INDPUT1(4,21,0,6,LTX8$)
7110 SVAR1$=A$
7120 CASE SVAR1$ OF 
7130 WHEN "1"
7140 EXEC INDPUT1(4,23,0,1+AVALIN,LTX9$)
7150 J=P
7160 CURSOR 4,19
7170 LINIE=19
7180 EXEC SLET
7190 EXEC VARLINUD(J)
7200 CASE VANRARR(J) OF 
7210 EXEC INDPUT2(17,21,BLANK$(1),ANTAL$)
7220 CURSOR 17,21
7230 PRINT ANTAL$(4:5)
7240 CURSOR 24,21
7250 PRINT VATEKARR$(J)
7260 CURSOR 51,21
7270 VARPRIS$=VAPRIARR$(J)
7280 EXEC TUD(VARPRIS$,TAL4$,1,0)
7290 EXEC CALC(2,VARPRIS$,ANTAL$,BELØB$)
7300 CURSOR 66,21
7310 EXEC TUD(BELØB$,TAL4$,1,0)
7320 IF BELØB$<>BELØBARR$(J) THEN 
7330 CURSOR 1,23
7340 VAANTARR$(J)=ANTAL$(4:5);BELØBARR$(J)=BELØB$
7350 EXEC AJOUR
7360 ENDIF 
7370 WHEN 1,2
7380 VARTEKST$=BLANK$;M=J
7390 CURSOR 23,21
7400 INPUT " ",VARTEKST$
7410 IF LEN(VARTEKST$)>0 THEN VATEKARR$(M)=VARTEKST$
7420 CURSOR 24,21
7430 PRINT VATEKARR$(M);BLANK$(1:25)
7440 IF VANRARR(M)=1 THEN 
7450 EXEC INDPUT2(65,21,BLANK$(1),BELØB$)
7460 EXEC CALC(4,BELØB$,TAH$,TAH$)
7470 IF SI=0 THEN 
7480 BELØB$=BELØBARR$(M)
7490 ELSE 
7500 BELØBARR$(M)=BELØB$
7510 EXEC AJOUR
7520 ENDIF 
7530 CURSOR 66,21
7540 EXEC TUD(BELØB$,TAL4$,1,0)
7550 ENDIF 
7560 WHEN 3
7570 M=J
7580 EXEC INDPUT2(24,21,LTX1$,VARPRIS$)
7590 CURSOR 30,21
7600 PRINT VARPRIS$(7:5);" %";BLANK$(1:25)
7610 EXEC CALC(2,VARPRIS$,BELØBARR$(M-1),BELØB$)
7620 VATEKARR$(M,7:5)=VARPRIS$(7:5)
7630 VARPRIS$="100-"
7640 EXEC CALC(3,BELØB$,VARPRIS$,BELØB$)
7650 CURSOR 66,21
7660 EXEC TUD(BELØB$,TAL4$,1,0)
7670 BELØBARR$(M)=BELØB$
7680 EXEC AJOUR
7690 WHEN 4
7700 CURSOR 17,21
7710 INPUT "Linien er en subtotal og kan ikke rettes. Tast RETURN.",SVAR2$
7720 ENDCASE 
7730 WHEN "2"
7740 EXEC INDPUT1(4,23,0,1+AVALIN,LTX10$)
7750 J=P
7760 CURSOR 4,19
7770 LINIE=19
7780 EXEC SLET
7790 EXEC VARLINUD(J)
7800 IF J<AVALIN THEN 
7810 VARENR=VANRARR(J+1)
7820 ELSE 
7830 VARENR=0
7840 ENDIF 
7870 EXEC INDPUT1(4,21,-9,-6,LTX11$)
7880 IF P=-7 AND VARENR<>3 THEN 
7890 AVALIN=AVALIN-1
7900 FOR M=J TO AVALIN
7910 VANRARR(M)=VANRARR(M+1);VAANTARR$(M)=VAANTARR$(M+1)
7920 VATEKARR$(M)=VATEKARR$(M+1);VAPRIARR$(M)=VAPRIARR$(M+1)
7930 BELØBARR$(M)=BELØBARR$(M+1)
7940 ARRKODER(M,1)=ARRKODER(M+1,1);ARRKODER(M,2)=ARRKODER(M+1,2)
7950 NEXT M
7960 EXEC AJOUR
7970 ENDIF 
7980 WHEN "3"
7990 EXEC INDPUT1(4,23,0,1+AVALIN,LTX12$)
8000 J=P
8010 EXEC SLET
8020 STARTL=J
8030 IF AVALIN-J<12 THEN 
8040 SLUTL=AVALIN
8050 ELSE 
8060 SLUTL=J+11
8070 ENDIF 
8080 EXEC LUD
8090 WHEN "4"
8100 IF AVALIN<25 THEN 
8110 LINIE=19;AVALIN=AVALIN+1
8120 EXEC INDPUT1(4,23,0,1+AVALIN,LTX13$)
8130 EXEC SLET
8140 ARRKODER(AVALIN,1)=0;ARRKODER(AVALIN,2)=0
8150 FOR M=AVALIN TO P+1 STEP -1
8160 VANRARR(M)=VANRARR(M-1);VAANTARR$(M)=VAANTARR$(M-1)
8170 VATEKARR$(M)=VATEKARR$(M-1);VAPRIARR$(M)=VAPRIARR$(M-1)
8180 BELØBARR$(M)=BELØBARR$(M-1)
8190 ARRKODER(M,1)=ARRKODER(M-1,1);ARRKODER(M,2)=ARRKODER(M-1,2)
8200 NEXT M
8210 EXEC SLET
8220 GAVALIN=AVALIN;AVALIN=P;M=P
8230 REPEAT 
8240 EXEC VARELINI
8250 UNTIL VARENR<>0
8260 AVALIN=GAVALIN
8270 EXEC AJOUR
8275 ENDIF 
8280 ENDCASE 
8290 IF SVAR1$<>"3" AND SVAR1$<>"5" THEN 
8300 IF AVALIN<=12 THEN 
8310 STARTL=1;SLUTL=AVALIN
8320 ELSE 
8330 IF J<7 THEN 
8340 STARTL=1;SLUTL=12
8350 ELSE 
8360 IF AVALIN-J<7 THEN 
8370 STARTL=AVALIN-12;SLUTL=AVALIN
8380 ELSE 
8390 STARTL=J-5;SLUTL=J+6
8400 ENDIF 
8410 ENDIF 
8420 ENDIF 
8430 EXEC LUD
8440 ENDIF 
8450 UNTIL SVAR1$="5"
8460 EXEC FAKTBUND
8470 CURSOR 9,23
8480 PRINT "Maskinen overfører faktura til fakturaregisteret."
8490 EXEC FAKTGEM
8500 EXEC SYSGEM
8510 ENDIF 
8520 ENDIF 
8530 UNTIL KUNDENR=0
8540 CLEAR 
8550 CURSOR 20,9
8560 PRINT "*****************************************"
8570 PRINT TAB(20);"*";TAB(60);"*"
8580 PRINT TAB(20);"*";TAB(34);"Programvalg.";TAB(60);"*"
8590 PRINT TAB(20);"*";TAB(60);"*"
8600 PRINT TAB(19),"*****************************************"
8610 CHAIN "P641210:OPSTART"
DataMuseum.dk

MIKADOS

⟦55bac56cd⟧

Derivation

Text
