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