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