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