|
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: 16593 (0x40d1)
Types: SPC/1-COMAL-BIN
Notes: Mikados_B
Names: »BJ.B«
└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
└─⟦this⟧ »BJ.B«
0100 REM BJ 0110 DIM K1$(17),K2$(17),K3$(17),K4$(17),B9$(12),UDAGE$(9),T1(9),T2(9),T3(9) 0120 DIM TKODE$(1),BELØB$(12),TEKST$(25),BLANK$(77),BMOMS$(12),INDMOMS$(12) 0130 DIM TFIL$(18,10),N$(6),UDMOMS$(12),TAL4$(14),OP1$(12),OP2$(12),RES$(15) 0140 DIM DEBNAVN$(25),DEBBY$(20),DEBGADE$(25),DEBTLF$(9),DEBKGR$(2),DEBLK$(2) 0150 DIM DSALDO1$(12),DSALDO2$(12),DSALDO3$(12),DSALDO4$(12),ÅRKØB$(12) 0160 DIM MDNKØB$(12),TAL3$(12),MOMS$(12),DMOMS$(12),K5$(17),K6$(17),K7$(17) 0170 DIM FNAVN$(25),FUKODE$(1),FMKODE$(1),FMDEBET$(12),FMKREDIT$(12),K8$(17) 0180 DIM KRENAVN$(25),FÅDEBET$(12),FÅKREDIT$(12),B8$(12),TK$(1),STREG$(77) 0190 DIM K9$(17),K10$(17),K11$(17),K12$(17),K13$(17),KREGADE$(25),KREBY$(20) 0200 DIM KRELK$(1),KRGR$(1),KSALDO1$(12),KSALDO2$(12),TAH$(12),SUM$(12),A$(1) 0210 DIM DV$(10),K14$(17),K15$(17),K16$(17),K17$(17),T4(9),EÅREG$(12) 0211 DIM EMREG$(12),MBEV$(12),YBEV$(12) 0220 PROC CALC(ART,B1,B2,ES) 0230 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0 0240 CALL "P641210:REGN" 0250 ES$=RES$ 0260 IF FLAG THEN STOP 0270 ENDPROC 0280 PROC FEJL(NR1,NR2,NR3) 0290 IF STATUS(NR3$)<>0 THEN 0300 PRINT STATUS(NR3$),NR1,NR2,NR3$ 0310 STOP 0320 ENDIF 0330 ENDPROC 0340 PROC BOGFØRING(KONTNR,EDATO,BLGNR,TEK1,BE2,ENT1) 0350 KTAL=KONTNR DIV 10000;KTAL9=KONTNR DIV 1000 0360 KODE2=0 0370 IF KTAL=DTAL THEN 0380 EXEC FINDPOST1(DTAB1,DTAB,MDANTAL,KONTNR,DPIL3,K3$) 0390 DEBNR=KONTNR 0400 IF CEKS=1 THEN STOP 0410 EXEC HENTDPOST 0420 INDEX=INT(ORD(DEBKGR$)-48)*2 0430 B8$=BE2$ 0440 IF B8$(LEN(B8$))="-" THEN 0450 EXEC CALC(0,KGR$(INDEX),B8$,KGR$(INDEX)) 0460 EXEC NEDSKRIV(B8$,DSALDO4$) 0470 EXEC NEDSKRIV(B8$,DSALDO3$) 0480 EXEC NEDSKRIV(B8$,DSALDO2$) 0490 EXEC NEDSKRIV(B8$,DSALDO1$) 0500 ELSE 0510 EXEC CALC(0,KGR$(INDEX-1),B8$,KGR$(INDEX-1)) 0520 ENDIF 0530 EXEC CALC(0,DSALDO1$,B8$,DSALDO1$) 0540 EXEC GEMDPOST 0550 EXEC GEMMID(DMIDNR,K10$,KONTNR,ENT1) 0560 ELSE 0570 IF KTAL9=KRTAL THEN 0580 EXEC FINDPOST1(KTAB1,KTAB,MKANTAL,KONTNR,KPIL3,K4$) 0590 KRENR=KONTNR 0600 IF CEKS=1 THEN STOP 0610 EXEC HENTKRPOST 0620 INDEX=INT(ORD(KRGR$)-48)*2 0630 B8$=BE2$ 0640 IF B8$(LEN(B8$))="+" THEN 0650 EXEC CALC(0,KREGR$(INDEX-1),B8$,KREGR$(INDEX-1)) 0660 EXEC NEDSKRIV1(B8$,KSALDO2$) 0670 EXEC NEDSKRIV1(B8$,KSALDO1$) 0680 ELSE 0690 EXEC CALC(0,KREGR$(INDEX),B8$,KREGR$(INDEX)) 0700 ENDIF 0710 EXEC CALC(0,KSALDO1$,B8$,KSALDO1$) 0720 EXEC GEMKRPOST 0730 EXEC GEMMID(KRMIDNR,K11$,KONTNR,ENT1) 0740 ELSE 0750 EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,KONTNR,FPIL3,K2$) 0760 FNR=KONTNR 0770 IF CEKS=1 THEN STOP 0780 EXEC HENTPOST 0790 KODE2=ORD(FMKODE$)-48 0800 IF FMKODE$<>"0" THEN 0810 B9$="0+" 0820 BMOMS$="0+" 0830 EXEC CALC(3,DMOMS$,TAL3$,B9$) 0840 EXEC CALC(3,BE2$,B9$,B9$) 0850 EXEC CALC(1,BE2$,B9$,BMOMS$) 0860 IF FMKODE$="1" THEN 0870 EXEC CALC(0,INDMOMS$,BMOMS$,INDMOMS$) 0880 ELSE 0890 EXEC CALC(0,UDMOMS$,BMOMS$,UDMOMS$) 0900 ENDIF 0910 BE2$=B9$ 0920 ENDIF 0930 IF BE2$(LEN(BE2$))="-" THEN 0940 EXEC CALC(0,FMKREDIT$,BE2$,FMKREDIT$) 0950 EXEC CALC(0,FÅKREDIT$,BE2$,FÅKREDIT$) 0960 ELSE 0970 EXEC CALC(0,FMDEBET$,BE2$,FMDEBET$) 0980 EXEC CALC(0,FÅDEBET$,BE2$,FÅDEBET$) 0990 ENDIF 1000 EXEC GEMFPOST 1010 EXEC GEMMID(FMIDNR,K9$,KONTNR,ENT1) 1020 ENDIF 1030 ENDIF 1040 IF ENT1<>1000000 THEN 1050 EPIL2=1 1060 EXEC FINDPOST1(ETAB1,ETAB,MEANTAL,(ENT1 DIV 100),EPIL3,K15$) 1070 IF CEKS=0 THEN 1080 FOR EPIL1=1 TO METOT+MUNKANT 1090 CEKS=0 1100 IF (ENT1 MOD 100)=ENR(EPIL2) AND EU$(EPIL1)="0" THEN EXIT 1110 CEKS=1;EPIL2=EPIL2+1*(EU$(EPIL1)="0") 1120 NEXT EPIL1 1130 IF CEKS=0 THEN 1140 GET K14$,ETAB(EPIL3,2):NR9,EMREG$,EÅREG$ 1150 EXEC FEJL(20,20,K14$) 1160 GET K14$,ETAB(EPIL3,2)+EPIL2+1:NR8,MBEV$,YBEV$ 1170 EXEC FEJL(20,21,K14$) 1180 EXEC CALC(0,MBEV$,BE2$,MBEV$) 1190 EXEC CALC(0,YBEV$,BE2$,YBEV$) 1200 EXEC CALC(1,EMREG$,BE2$,EMREG$) 1210 EXEC CALC(1,EÅREG$,BE2$,EÅREG$) 1220 PUT K14$,ETAB(EPIL3,2):NR9,EMREG$,EÅREG$ 1221 EXEC FEJL(20,25,K14$) 1222 PUT K14$,ETAB(EPIL3,2)+EPIL2+1:NR8,MBEV$,YBEV$ 1223 EXEC FEJL(20,26,K14$) 1224 EXEC GEMMID(EMIDNR,K17$,ENT1,KONTNR) 1225 ELSE 1226 ENT1=1000000 1227 ENDIF 1228 ENDIF 1229 ENDIF 1230 ENDPROC 1240 PROC BJUDSKRIV(BJSNR,BJLNR,TK1) 1250 IF BJLNR=36 OR BJLNR=0 THEN 1260 BJSNR=BJSNR+1 1270 EXEC BJHOVEDUD(DATO,BJSNR) 1280 BJLNR=0 1290 ENDIF 1300 BJLNR=BJLNR+1;KODE1=INT(ORD(TK1$)-48) 1310 EXEC BJLINIEUD(BILAG,TEKSTKODE,KONTO,BELØB$,KODE1,BMOMS$,KODE2,ENTKO) 1320 ENDPROC 1330 PROC BJHOVEDUD(UDAG,BJOSNR) 1340 EXEC UDATO(UDAG,UDAGE$) 1345 OUTPUT T 1350 OUTPUT P 1360 IF BJLNR=36 THEN 1370 FOR BJLNR=BJLNR TO 41 1380 PRINT " " 1390 NEXT BJLNR 1400 ENDIF 1410 PRINT TAB(67);DV$;" " 1420 PRINT TAB(6);CHR(14);"Bogholderijournal";CHR(15);TAB(40);"Dato:";UDAGE$; 1430 PRINT TAB(56); 1440 PRINT USING "Side:#####":BJOSNR 1450 PRINT CHR(10);TAB(73);"Moms" 1460 PRINT TAB(2);"Bilag";TAB(9);"Tekst";TAB(35);"Konto";TAB(42);"Entre"; 1470 PRINT TAB(53);"Beløb";TAB(61);"Kode";TAB(69);"Beløb";TAB(75);"Kode" 1480 PRINT TAB(2);STREG$ 1490 ENDPROC 1500 PROC BJLINIEUD(BLG,TEKKODE,KONT,BELB,KO1,MO,KO2,ENT3) 1510 IF BLG<>-1 THEN 1520 PRINT USING "#######":BLG; 1530 ENDIF 1540 IF TEKKODE<10 AND TEKKODE>0 OR TEKKODE>20 THEN 1550 TEKST$=TFIL$(TEKKODE-10*(TEKKODE>20))+BLANK$(1:15) 1560 ENDIF 1570 IF TEKKODE<>0 THEN 1580 PRINT TAB(9);TEKST$; 1590 ENDIF 1600 PRINT TAB(34); 1610 PRINT USING "###### ######":KONT;ENT3; 1620 PRINT TAB(47); 1630 EXEC CALC(0,BELB$,SUM$,SUM$) 1640 EXEC CALC(5,BELB$,TAL3$,TAL4$) 1650 PRINT TAL4$;TAB(62); 1660 IF KO2<>0 THEN 1670 PRINT USING "##":KO1; 1680 PRINT TAB(64); 1690 EXEC CALC(5,MO$,TAL3$,TAL4$) 1700 PRINT TAL4$(2:13);TAB(78); 1710 PRINT USING "##":KO2 1720 ELSE 1730 PRINT USING "##":KO1 1740 ENDIF 1750 ENDPROC 1760 PROC NEDSKRIV1(PSAL1,KSAL) 1770 IF KSAL$(LEN(KSAL$))="-" THEN 1780 EXEC CALC(0,KSAL$,PSAL1$,KSAL$) 1790 IF KSAL$(LEN(KSAL$))="+" THEN 1800 PSAL1$=KSAL$ 1810 KSAL$="0+" 1820 ELSE 1830 PSAL1$="0+" 1840 ENDIF 1850 ENDIF 1860 ENDPROC 1870 PROC NEDSKRIV(PSAL,DSAL) 1880 IF DSAL$(LEN(DSAL$))="+" THEN 1890 EXEC CALC(0,DSAL$,PSAL$,DSAL$) 1900 IF DSAL$(LEN(DSAL$))="-" THEN 1910 PSAL$=DSAL$ 1920 DSAL$="0+" 1930 ELSE 1940 PSAL$="0+" 1950 ENDIF 1960 ENDIF 1970 ENDPROC 1980 PROC UDATO(DA1,DA2) 1990 DA3=DA1 2000 DA2$=" " 2010 FOR J=8 TO 1 STEP -1 2020 IF J MOD 3=0 THEN 2030 DA2$(J)="." 2040 ELSE 2050 DA2$(J)=CHR(DA3 MOD 10+48) 2060 DA3=DA3 DIV 10 2070 ENDIF 2080 NEXT J 2090 ENDPROC 2100 PROC GEMMID(MIDANTAL,L2,KONTNR1,ENT2) 2110 MIDANTAL=MIDANTAL+1 2120 PUT L2$,MIDANTAL:KONTNR1,DDATO,BILAG,TKODE$,BELØB$,ENT2 2130 EXEC FEJL(1,1,L2$) 2140 IF TEKSTKODE>9 AND TEKSTKODE<20 THEN 2150 MIDANTAL=MIDANTAL+1 2160 PUT L2$,MIDANTAL:KONTNR1,TEKST$ 2170 EXEC FEJL(1,2,L2$) 2180 ENDIF 2190 ENDPROC 2200 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8) 2210 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=1;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32 2220 REPEAT 2230 IF NØGL5=TAB4(PIL6) OR PIL1=1 THEN EXIT 2240 PIL1=(PIL1+1) DIV 2 2250 PIL6=PIL6+PIL1*(1-2*(NØGL5<TAB4(PIL6))) 2260 IF PIL6<1 THEN PIL6=1 2270 IF PIL6>MANT3 THEN PIL6=MANT3 2280 UNTIL PIL1=0 2290 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-1*(PIL6>1) 2300 PIL6=MANT4+PIL6 2310 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) 2320 EXEC FEJL(2,1,L8$) 2330 FOR PIL6=1 TO 4 2340 IF NØGL5=Q(PIL6,1) THEN EXIT 2350 NEXT PIL6 2360 IF PIL6<>5 THEN CEKS=0 2370 ENDPROC 2380 PROC INDTAB1(Z,MANT5,L7) 2390 PIL1=MANT5 DIV 32 2400 FOR I=1 TO PIL1 2410 H=(I-1)*8+1 2420 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) 2430 EXEC FEJL(3,1,L7$) 2440 NEXT I 2450 ENDPROC 2460 PROC HENTDPOST 2470 S=DTAB(DPIL3,2) 2480 GET K6$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$ 2490 EXEC FEJL(8,2,K6$) 2500 IF DEBNR<>DTAB(DPIL3,1) THEN STOP 2510 GET K6$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$ 2520 EXEC FEJL(8,3,K6$) 2530 GET K6$,S+2:DEBGADE$,DEBTLF$,HPOST,HKUNDE 2540 EXEC FEJL(8,4,K6$) 2550 GET K6$,S+3:DEBBY$,ÅRKØB$,MDNKØB$ 2560 EXEC FEJL(8,5,K6$) 2570 ENDPROC 2580 PROC HENTPOST 2590 S=FTAB(FPIL3,2) 2600 GET K5$,S:FNR,FNAVN$ 2610 EXEC FEJL(3,2,K5$) 2620 IF FNR<>FTAB(FPIL3,1) THEN STOP 2630 GET K5$,S+1:FMKODE$,FMDEBET$,FMKREDIT$ 2640 EXEC FEJL(3,3,K5$) 2650 GET K5$,S+2:FUKODE$,FÅDEBET$,FÅKREDIT$ 2660 EXEC FEJL(3,4,K5$) 2670 ENDPROC 2680 PROC HENTKRPOST 2690 S=KTAB(KPIL3,2) 2700 GET K7$,S:KRENR,KRENAVN$,KREGADE$ 2710 EXEC FEJL(4,1,K7$) 2720 GET K7$,S+1:KREBY$,KRELK$,KRGR$,KREPOSTNR,KSALDO1$,KSALDO2$ 2730 EXEC FEJL(4,2,K7$) 2740 ENDPROC 2750 PROC GEMKRPOST 2760 S=KTAB(KPIL3,2) 2770 PUT K7$,S:KRENR,KRENAVN$,KREGADE$ 2780 EXEC FEJL(5,1,K7$) 2790 PUT K7$,S+1:KREBY$,KRELK$,KRGR$,KREPOSTNR,KSALDO1$,KSALDO2$ 2800 EXEC FEJL(5,2,K7$) 2810 ENDPROC 2820 PROC GEMDPOST 2830 S=DTAB(DPIL3,2) 2840 PUT K6$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$ 2850 EXEC FEJL(9,3,K6$) 2860 PUT K6$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$ 2870 EXEC FEJL(9,4,K6$) 2880 ENDPROC 2890 PROC GEMFPOST 2900 S=FTAB(FPIL3,2) 2910 PUT K5$,S:FNR,FNAVN$ 2920 EXEC FEJL(4,3,K5$) 2930 PUT K5$,S+1:FMKODE$,FMDEBET$,FMKREDIT$ 2940 EXEC FEJL(4,4,K5$) 2950 PUT K5$,S+2:FUKODE$,FÅDEBET$,FÅKREDIT$ 2960 EXEC FEJL(4,5,K5$) 2970 ENDPROC 2980 K1$="P641220:SYSTEM1" 2990 OPEN K1$,R 3000 EXEC FEJL(9,1,K1$) 3010 GET K1$,1:MFANTAL,MDANTAL,MKANTAL 3020 EXEC FEJL(9,2,K1$) 3030 GET K1$,2:MKASPOST,MPPOST,MBHPOST,MFPMID 3040 EXEC FEJL(9,3,K1$) 3050 GET K1$,3:MDPMID,MKPMID 3060 EXEC FEJL(9,4,K1$) 3070 GET K1$,4:MKPOST,MFAK,MVGR,MKGR 3080 EXEC FEJL(9,5,K1$) 3090 GET K1$,5:MKRGR 3100 EXEC FEJL(9,6,K1$) 3110 GET K1$,6:KASSENR,GIRONR,BANKNR,UDMOMSNR 3120 EXEC FEJL(9,7,K1$) 3130 GET K1$,7:INDMOMSNR 3140 EXEC FEJL(9,8,K1$) 3150 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL 3160 EXEC FEJL(9,9,K1$) 3170 GET K1$,9:KRTAL,VTAL,MEANTAL,MUNKANT 3180 EXEC FEJL(9,10,K1$) 3190 GET K1$,10:N$ 3200 EXEC FEJL(9,11,K1$) 3210 GET K1$,11:K2$ 3220 EXEC FEJL(9,12,K1$) 3230 GET K1$,12:K3$ 3240 EXEC FEJL(9,13,K1$) 3250 GET K1$,13:K4$ 3260 EXEC FEJL(9,14,K1$) 3270 GET K1$,15:K5$ 3280 EXEC FEJL(9,15,K1$) 3290 GET K1$,16:K6$ 3300 EXEC FEJL(9,16,K1$) 3310 GET K1$,17:K7$ 3320 EXEC FEJL(9,17,K1$) 3330 GET K1$,21:K8$ 3340 EXEC FEJL(9,18,K1$) 3350 GET K1$,22:K9$ 3360 EXEC FEJL(9,19,K1$) 3370 GET K1$,23:K10$ 3380 EXEC FEJL(9,20,K1$) 3390 GET K1$,24:K11$ 3400 EXEC FEJL(9,21,K1$) 3410 GET K1$,28:K12$ 3420 EXEC FEJL(9,22,K1$) 3430 GET K1$,36:K13$ 3440 EXEC FEJL(9,23,K1$) 3450 GET K1$,37:K14$ 3460 EXEC FEJL(20,1,K1$) 3470 GET K1$,38:K15$ 3480 EXEC FEJL(20,2,K1$) 3490 GET K1$,39:K16$ 3500 EXEC FEJL(20,3,K1$) 3510 GET K1$,40:K17$ 3520 EXEC FEJL(20,4,K1$) 3530 GET K1$,43:METOT,MEMID 3540 EXEC FEJL(20,5,K1$) 3550 CLOSE K1$ 3560 EXEC FEJL(9,24,K1$) 3570 DIM FTAB1(MFANTAL DIV 4),DTAB1(MDANTAL DIV 4),KTAB1(MKANTAL DIV 4) 3580 DIM FTAB(4,2),DTAB(4,2),KTAB(4,2),KGR$(MKGR*2,12),KREGR$(MKRGR*2,12) 3590 DIM ETAB1(MEANTAL DIV 4),ETAB(4,2),ENR(MUNKANT+METOT) 3600 DIM EU$(MUNKANT+METOT) 3610 FOR I=1 TO MKGR*2 3620 KGR$(I)="0+" 3630 NEXT I 3640 FOR I=1 TO MKRGR*2 3650 KREGR$(I)="0+" 3660 NEXT I 3670 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$;K6$=N$+K6$;K13$=N$+K13$ 3680 K8$=N$+K8$;K9$=N$+K9$;K10$=N$+K10$;K11$=N$+K11$;K12$=N$+K12$;K7$=N$+K7$ 3690 K14$=N$+K14$;K15$=N$+K15$;K16$=N$+K16$;K17$=N$+K17$ 3700 OPEN K13$,R 3710 EXEC FEJL(9,25,K13$) 3720 GET K13$,1:MOMS$ 3730 EXEC FEJL(9,26,K13$) 3740 GET K13$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9) 3750 EXEC FEJL(9,27,K13$) 3760 FOR I=1 TO 6 3770 H=(I-1)*3+1 3780 GET K13$,I+5:TFIL$(H),TFIL$(H+1),TFIL$(H+2) 3790 EXEC FEJL(9,28,K13$) 3800 NEXT I 3810 GET K13$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9) 3820 EXEC FEJL(9,29,K13$) 3830 GET K13$,13:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9) 3840 EXEC FEJL(9,30,K13$) 3850 GET K13$,20:DV$ 3860 EXEC FEJL(10,50,K13$) 3870 GET K13$,21:T4(1),T4(2),T4(3),T4(4),T4(5),T4(6),T4(7),T4(8),T4(9) 3880 EXEC FEJL(20,6,K13$) 3890 CLOSE K13$ 3900 EXEC FEJL(9,31,K13$) 3910 TAL3$="100+" 3920 EXEC CALC(0,TAL3$,MOMS$,DMOMS$) 3930 BLANK$=" " 3940 TAL4$="0+";SUM$="0+";STREG$="--------------------------------------" 3950 STREG$=STREG$+STREG$+"-";TAH$="0+";BJSIDENR=T1(6);DATO=T1(7) 3960 BHPOSTNR=T3(1);FAKPOSTNR=T2(3);FMIDNR=T3(2);DMIDNR=T3(3);KRMIDNR=T3(4) 3970 EMIDNR=T4(4) 3980 OPEN K2$,R 3990 EXEC FEJL(9,32,K2$) 4000 OPEN K3$,R 4010 EXEC FEJL(9,33,K3$) 4020 OPEN K4$,R 4030 EXEC FEJL(9,34,K4$) 4040 OPEN K5$,W 4050 EXEC FEJL(9,35,K5$) 4060 OPEN K6$,W 4070 EXEC FEJL(9,36,K6$) 4080 OPEN K7$,W 4090 EXEC FEJL(9,37,K7$) 4100 OPEN K8$,R 4110 EXEC FEJL(9,38,K8$) 4120 OPEN K9$,W 4130 EXEC FEJL(9,39,K9$) 4140 OPEN K10$,W 4150 EXEC FEJL(9,40,K10$) 4160 OPEN K11$,W 4170 EXEC FEJL(9,41,K11$) 4175 IF K12$(6)<"9" THEN 4180 OPEN K12$,R 4190 EXEC FEJL(9,42,K12$) 4195 ENDIF 4200 OPEN K14$,W 4210 EXEC FEJL(20,10,K14$) 4220 OPEN K15$,R 4230 EXEC FEJL(20,11,K15$) 4240 OPEN K16$,R 4250 EXEC FEJL(20,12,K16$) 4251 FOR X=1 TO MUNKANT+METOT 4252 GET K16$,X:ENR(X),EU$(X) 4253 EXEC FEJL(20,15,K16$) 4254 NEXT X 4255 CLOSE K16$ 4256 EXEC FEJL(20,16,K16$) 4260 OPEN K17$,W 4270 EXEC FEJL(20,13,K17$) 4280 EXEC INDTAB1(KTAB1,MKANTAL,K4$) 4290 EXEC INDTAB1(FTAB1,MFANTAL,K2$) 4300 EXEC INDTAB1(DTAB1,MDANTAL,K3$) 4310 EXEC INDTAB1(ETAB1,MEANTAL,K15$) 4320 BJLINIENR=0;UDMOMS$="0+";INDMOMS$="0+" 4370 PROC BFØR(PNR,G) 4380 FOR I=1 TO PNR 4390 GET G$,I:KONTO,DDATO,BILAG,TKODE$,BELØB$,TK$,ENTKO 4400 EXEC FEJL(1,4,G$) 4410 TEKSTKODE=ORD(TKODE$)-48 4420 IF TEKSTKODE>9 AND TEKSTKODE<20 THEN 4430 I=I+1 4440 GET G$,I:KONTO,TEKST$ 4450 EXEC FEJL(1,5,G$) 4460 ENDIF 4470 EXEC BOGFØRING(KONTO,DDATO,BILAG,TEKSTKODE,BELØB$,ENTKO) 4480 EXEC BJUDSKRIV(BJSIDENR,BJLINIENR,TK$) 4490 NEXT I 4500 ENDPROC 4510 CLEAR 4520 REPEAT 4530 CURSOR 8,13 4540 INPUT "Monter papir til udskrift af bogholderijournal og tast RETURN",A$ 4550 UNTIL ORD(A$)=255 4560 EXEC BFØR(BHPOSTNR,K8$) 4570 EXEC BFØR(FAKPOSTNR,K12$) 4580 TEKSTKODE=28;TK$="0";ENTKO=1000000 4590 TKODE$=CHR(76) 4600 DDATO=DATO 4610 BILAG=BJSIDENR 4620 KONTO=INDMOMSNR 4630 BELØB$=INDMOMS$ 4640 EXEC BOGFØRING(KONTO,DDATO,BILAG,TEKSTKODE,BELØB$,ENTKO) 4650 TEKSTKODE=10 4660 TEKST$="Samlet indgående afgift" 4670 EXEC BJUDSKRIV(BJSIDENR,BJLINIENR,TK$) 4680 TEKSTKODE=28 4690 KONTO=UDMOMSNR 4700 BELØB$=UDMOMS$ 4710 EXEC BOGFØRING(KONTO,DDATO,BILAG,TEKSTKODE,BELØB$,ENTKO) 4720 TEKSTKODE=10 4730 TEKST$="Samlet udgående afgift" 4740 EXEC BJUDSKRIV(BJSIDENR,BJLINIENR,TK$) 4750 EXEC CALC(4,SUM$,TAH$,TAH$) 4760 IF SI<>0 THEN 4770 TEKSTKODE=10;KONTO=DIFNR;TEKST$="Difference bogholderi" 4780 IF SUM$(LEN(SUM$))="+" THEN 4790 BELØB$=SUM$(1:LEN(SUM$)-1)+"-" 4800 ELSE 4810 BELØB$=SUM$(1:LEN(SUM$)-1)+"+" 4820 ENDIF 4830 EXEC BOGFØRING(KONTO,DDATO,BILAG,TEKSTKODE,BELØB$,ENTKO) 4840 EXEC BJUDSKRIV(BJSIDENR,BJLINIENR,TK$) 4850 ENDIF 4860 FOR I=BJLINIENR TO 35 4870 PRINT " " 4880 NEXT I 4890 PRINT " " 4900 PRINT STREG$ 4910 EXEC CALC(5,SUM$,TAL3$,TAL4$) 4920 IF TAL4$(LEN(TAL4$))="+" THEN TAL4$(LEN(TAL4$))=" " 4930 PRINT TAB(10);CHR(14);"Difference";CHR(15);TAB(36);TAL4$ 4940 PRINT STREG$ 4950 PRINT " " 4960 PRINT " " 4970 PROC GRUPPE(GR,KG1) 4980 FOR I=1 TO 2*GR STEP 2 4990 FNR=FNR+1 5000 EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,FNR,FPIL3,K2$) 5010 IF CEKS=1 THEN STOP 5020 EXEC HENTPOST 5030 EXEC CALC(0,FMDEBET$,KG1$(I),FMDEBET$) 5040 EXEC CALC(0,FÅDEBET$,KG1$(I),FÅDEBET$) 5050 EXEC CALC(0,FMKREDIT$,KG1$(I+1),FMKREDIT$) 5060 EXEC CALC(0,FÅKREDIT$,KG1$(I+1),FÅKREDIT$) 5070 EXEC GEMFPOST 5080 NEXT I 5090 ENDPROC 5100 FNR=DTAL*10000 5110 EXEC GRUPPE(MKGR,KGR$) 5120 FNR=KRTAL*1000 5130 EXEC GRUPPE(MKRGR,KREGR$) 5140 CLOSE K5$ 5150 EXEC FEJL(9,45,K5$) 5160 CLOSE K6$ 5170 EXEC FEJL(9,46,K6$) 5180 CLOSE K7$ 5190 EXEC FEJL(9,47,K7$) 5200 CLOSE K9$ 5210 EXEC FEJL(9,48,K9$) 5220 CLOSE K10$ 5230 EXEC FEJL(9,49,K10$) 5240 CLOSE K11$ 5250 EXEC FEJL(9,50,K11$) 5260 CLOSE K14$ 5270 EXEC FEJL(20,16,K14$) 5280 CLOSE K17$ 5290 EXEC FEJL(20,17,K17$) 5300 CLOSE 5310 T1(6)=BJSIDENR;T3(1)=0;T2(3)=0;T3(2)=FMIDNR;T3(3)=DMIDNR;T3(4)=KRMIDNR 5320 T4(4)=EMIDNR 5330 OPEN K13$,W 5340 EXEC FEJL(9,51,K13$) 5350 PUT K13$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9) 5360 EXEC FEJL(9,52,K13$) 5370 PUT K13$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9) 5380 EXEC FEJL(9,53,K13$) 5390 PUT K13$,13:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9) 5400 EXEC FEJL(9,54,K13$) 5410 PUT K13$,21:T4(1),T4(2),T4(3),T4(4),T4(5),T4(6),T4(7),T4(8),T4(9) 5420 EXEC FEJL(20,18,K13$) 5430 CLOSE K13$ 5440 EXEC FEJL(9,55,K13$) 5450 OUTPUT T 5460 CHAIN "P641210:FSORT"