⟦5b9405f2e⟧

Text

0100 DIM RES$(14),OP1$(12),OP2$(12),N$(6),K1$(17),A$(1),TAL4$(12),BLANK$(25)
0110 DIM UBELØB1$(14),UBELØB2$(14),STREG$(71),FÅDK$(12),FMDK$(12),GLNAVN$(25)
0120 DIM DAT$(8),FÅKREDIT$(12),FÅDEBET$(12),FMKREDIT$(12),FMDEBET$(12)
0130 DIM FMKODE$(1),FNAVN$(25),FUKODE$(1),SALDO13$(12),SALDO3$(12)
0140 DIM SALDO2$(12),SALDO11$(12),SALDO1$(12),SALDO12$(12),SUM$(12),SUM1$(14)
0150 DIM K2$(17),K3$(17),K4$(17),K5$(17),T1(9),LAND$(9,12),DEBNAVN$(25)
0160 DIM DSALDO1$(12),DEBKGR$(1),DSALDO2$(12),DSALDO3$(12),DSALDO4$(12)
0170 DIM DEBLK$(1),DEBBY$(20),ÅRKØB$(12),MDNKØB$(12),TÅRKØB$(12),SALDO$(12)
0180 DIM TOKØB$(12),TOSALDO1$(12),K$(26,11),KREBY$(20)
0190 DIM TOSALDO$(12),KRELK$(1),KREGR$(1),KSALDO1$(12),T2(9)
0200 DIM KSALDO2$(12),K10$(17),K6$(17),K7$(17),K9$(17),K8$(17),TYPE$(1)
0210 DIM BLB2$(12),TILNAVN$(27,8),FRANAVN$(27,8),TEKST$(25)
0220 DIM SUM3$(12),DREVFRA$(2),DREVTIL$(2),TKODE$(1)
0230 PROC CALC(ART,B1,B2,ES)
0240 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0
0250 CALL "P641210:REGN"
0260 ES$=RES$
0270 IF FLAG<>0 THEN STOP 
0280 ENDPROC 
0290 PROC DATOUD(DA1,DA2)
0300 DA3=DA1
0310 DA2$="        "
0320 FOR J=8 TO 1 STEP -1
0330 IF J MOD 3=0 THEN 
0340 DA2$(J)="."
0350 ELSE 
0360 DA2$(J)=CHR(DA3 MOD 10+48)
0370 DA3=DA3 DIV 10
0380 ENDIF 
0390 NEXT J
0400 ENDPROC 
0410 PROC UDLIN
0420 EXEC TUD(SUM$,SUM1$,1,0)
0430 PRINT TAB(5);GR;TAB(12);UBELØB1$;TAB(37);UBELØB2$;TAB(57);SUM1$
0440 ENDPROC 
0450 PROC INDTAB1(Z,MANT5,L7)
0460 PIL1=MANT5 DIV 32
0470 FOR I=1 TO PIL1
0480 H=(I-1)*8+1
0490 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)
0500 EXEC FEJL(2,1,L7$)
0510 NEXT I
0520 ENDPROC 
0530 PROC UNDIND(V2,U1,Z)
0540 OPEN V2$,R
0550 EXEC FEJL(14,1,V2$)
0560 GET V2$,U1:Z(1,1),Z(1,2),Z(2,1),Z(2,2),Z(3,1),Z(3,2),Z(4,1),Z(4,2)
0570 EXEC FEJL(14,2,V2$)
0580 CLOSE V2$
0590 EXEC FEJL(14,3,V2$)
0600 ENDPROC ;UNDIND
0610 PROC TABINIT(K31,K32,MPOSTANTAL3,HTAB2,UTAB2)
0620 OPEN K31$,R
0630 EXEC FEJL(15,1,K31$)
0640 OPEN K32$,W
0650 EXEC FEJL(15,2,K32$)
0660 H=1
0670 FOR I=1 TO MPOSTANTAL3 DIV 40
0680 GET K31$,H:KONR
0690 EXEC FEJL(15,3,K31$)
0700 HTAB2(I,1)=KONR
0710 FOR J=1 TO 4
0720 GET K31$,H:KONR
0730 EXEC FEJL(15,4,K31$)
0740 UTAB2(J,1)=KONR
0750 H=H+9
0760 GET K31$,H:KONR
0770 EXEC FEJL(15,5,K31$)
0780 UTAB2(J,2)=KONR
0790 H=H+1
0800 NEXT J
0810 HTAB2(I,2)=KONR
0820 K90=I+MPOSTANTAL3 DIV 160
0830 EXEC UNDUD(K32$,K90,UTAB2)
0840 NEXT I
0850 EXEC HOVUD(K32$,MPOSTANTAL3,HTAB2)
0860 CLOSE K31$
0870 EXEC FEJL(15,6,K31$)
0880 CLOSE K32$
0890 EXEC FEJL(15,7,K32$)
0900 ENDPROC ;TABINIT
0910 PROC UNDUD(V3,U2,T)
0920 PUT V3$,U2:T(1,1),T(1,2),T(2,1),T(2,2),T(3,1),T(3,2),T(4,1),T(4,2)
0930 EXEC FEJL(16,1,V3$)
0940 ENDPROC ;UNDUD
0950 PROC HOVUD(V4,MPOSTANTAL4,S)
0960 FOR I=1 TO MPOSTANTAL4 DIV 160
0970 J=(I-1)*4+1;J1=J+1;J2=J+2;J3=J+3
0980 PUT V4$,I:S(J,1),S(J,2),S(J1,1),S(J1,2),S(J2,1),S(J2,2),S(J3,1),S(J3,2)
0990 EXEC FEJL(17,2,V4$)
1000 NEXT I
1010 ENDPROC 
1020 PROC PINIT(K61,MPOSTANTAL8)
1030 OPEN K61$,W
1040 EXEC FEJL(1,1,K61$)
1050 FOR I=1 TO MPOSTANTAL8
1060 PUT K61$,I:100000
1070 EXEC FEJL(1,2,K61$)
1080 NEXT I
1090 CLOSE K61$
1100 EXEC FEJL(1,3,K61$)
1110 ENDPROC 
1120 PROC HENTPOST
1130 S1=FTAB(FPIL3,2)
1140 GET K5$,S1:FNR,FNAVN$
1150 EXEC FEJL(2,2,K5$)
1160 GET K5$,S1+1:FMKODE$,FMDEBET$,FMKREDIT$
1170 EXEC FEJL(2,3,K5$)
1180 GET K5$,S1+2:FUKODE$,FÅDEBET$,FÅKREDIT$
1190 EXEC FEJL(2,4,K5$)
1200 ENDPROC 
1210 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
1220 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=1;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
1230 REPEAT 
1240 IF NØGL5=TAB4(PIL6) OR PIL1=1 THEN EXIT 
1250 PIL1=(PIL1+1) DIV 2;PIL6=PIL6+PIL1*(1-2*(NØGL5<TAB4(PIL6)))
1260 IF PIL6<1 THEN PIL6=MANT3
1270 UNTIL PIL1=0
1280 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-1*(PIL6>1)
1290 PIL6=MANT4+PIL6
1300 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)
1310 EXEC FEJL(1,1,L8$)
1320 FOR PIL6=1 TO 4
1330 IF NØGL5=Q(PIL6,1) THEN EXIT 
1340 NEXT PIL6
1350 IF PIL6<>5 THEN CEKS=0
1360 ENDPROC 
1370 PROC GEMFPOST
1380 S1=FTAB(FPIL3,2)
1390 PUT K5$,S1:FNR,FNAVN$
1400 EXEC FEJL(4,3,K5$)
1410 PUT K5$,S1+1:FMKODE$,FMDEBET$,FMKREDIT$
1420 EXEC FEJL(4,4,K5$)
1430 PUT K5$,S1+2:FUKODE$,FÅDEBET$,FÅKREDIT$
1440 EXEC FEJL(4,4,K5$)
1450 ENDPROC 
1460 PROC NRTEST(NUM1)
1470 P=0;TEST2=0;KTAL=0;L=LEN(NUM1$)
1480 IF L>6 THEN EXIT 
1490 CASE L OF 
1500 FOR I=1 TO L
1510 P1=INT(ORD(NUM1$(I))-48)
1520 IF P1<0 OR P1>9 THEN TEST2=1
1530 P=P*10+P1
1540 NEXT I
1550 KTAL=P DIV 10000
1560 WHEN 0
1570 P=-1
1580 WHEN 1
1590 CASE NUM1$ OF 
1600 P=INT(ORD(NUM1$)-48)
1610 WHEN "D","d"
1620 P=-2
1630 WHEN "A","a"
1640 P=-3
1650 WHEN "M","m"
1660 P=-4
1670 WHEN "J","j"
1680 P=-7
1690 WHEN "N","n"
1700 P=-8
1710 ENDCASE 
1720 ENDCASE 
1730 ENDPROC 
1740 PROC KINIT(K62,K63,TAB1,KM,MANTAL)
1750 OPEN K63$,W
1760 EXEC FEJL(2,1,K63$)
1770 FOR J=1 TO MANTAL DIV 4
1780 K90=J+MANTAL DIV 32
1790 EXEC UNDIND(K62$,K90,TAB1)
1800 FOR I=1 TO 4
1810 IF TAB1(I,1)=1000000 THEN EXIT 
1820 X=TAB1(I,2);SALDO$="0+"
1830 CASE KM OF 
1840 GET K63$,X:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
1850 EXEC FEJL(7,1,K63$)
1860 GET K63$,X+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
1870 EXEC FEJL(7,2,K63$)
1880 GET K63$,X+3:DEBBY$,ÅRKØB$,MDNKØB$
1890 EXEC FEJL(7,3,K63$)
1900 GR=ORD(DEBKGR$)-48;TÅRKØB$=ÅRKØB$
1910 EXEC CALC(0,DSALDO3$,DSALDO4$,SALDO$)
1920 EXEC CALC(0,SALDO$,DSALDO2$,SALDO$)
1930 EXEC CALC(0,SALDO$,DSALDO1$,SALDO$)
1940 EXEC CALC(0,DSALDI$(GR),SALDO$,DSALDI$(GR))
1950 EXEC CALC(0,TÅRKØB$,TOKØB$,TOKØB$)
1960 ÅRKØB$="0+"
1970 PUT K63$,X+3:DEBBY$,ÅRKØB$,MDNKØB$
1980 EXEC FEJL(7,4,K63$)
1990 WHEN 1
2000 GET K63$,X:FNR
2010 EXEC FEJL(7,6,K63$)
2020 GET K63$,X+2:FUKODE$,FÅDEBET$,FÅKREDIT$
2030 EXEC FEJL(7,7,K63$)
2040 GR=ORD(FUKODE$)-48
2050 IF (DTAL=FNR DIV 10000 OR KRTAL=FNR DIV 10000) AND GR=1 THEN 
2060 EXEC CALC(0,FÅDEBET$,FÅKREDIT$,SALDO$)
2070 IF SALDO$(LEN(SALDO$))="-" THEN 
2080 FÅKREDIT$=SALDO$;FÅDEBET$="0+"
2090 ELSE 
2100 FÅDEBET$=SALDO$;FÅKREDIT$="0+"
2110 ENDIF 
2120 EXEC CALC(0,TOSALDO1$,SALDO$,TOSALDO1$)
2130 IF DTAL=FNR DIV 10000 THEN 
2140 DSALDI1$(FNR MOD 10)=SALDO$
2150 ELSE 
2160 KSALDI1$(FNR MOD 10)=SALDO$
2170 ENDIF 
2180 ELSE 
2190 IF GR=0 THEN 
2200 EXEC CALC(0,FÅDEBET$,FÅKREDIT$,SALDO$)
2210 EXEC CALC(0,TOSALDO$,SALDO$,TOSALDO$)
2220 FÅDEBET$="0+";FÅKREDIT$="0+"
2230 ENDIF 
2240 ENDIF 
2250 PUT K63$,X+2:FUKODE$,FÅDEBET$,FÅKREDIT$
2260 EXEC FEJL(7,8,K63$)
2270 WHEN 2
2280 GET K63$,X+1:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$
2290 EXEC FEJL(7,5,K63$)
2300 GR=ORD(KREGR$)-48
2310 EXEC CALC(0,KSALDO1$,KSALDO2$,SALDO$)
2320 EXEC CALC(0,KSALDI$(GR),SALDO$,KSALDI$(GR))
2330 ENDCASE 
2340 NEXT I
2350 IF TAB1(I-1*(I=5),1)=1000000 THEN EXIT 
2360 NEXT J
2370 CLOSE K63$
2380 EXEC FEJL(2,22,K63$)
2390 ENDPROC 
2400 PROC FEJL(NR1,NR2,NR3)
2410 IF STATUS(NR3$)<>0 THEN 
2420 PRINT STATUS(NR3$),NR1,NR2,NR3$
2430 STOP 
2440 ENDIF 
2450 ENDPROC 
2460 PROC TUD(BLB1,UBLB1,TEGN,STØR)
2470 BLB2$=BLB1$
2480 EXEC CALC(5,BLB2$,TAL4$,UBLB1$)
2490 IF TEGN=0 THEN 
2500 UBLB1$=UBLB1$(1:13)
2510 ELSE 
2520 IF TEGN=1 AND UBLB1$(LEN(UBLB1$))="+" THEN 
2530 UBLB1$(LEN(UBLB1$))=" "
2540 ENDIF 
2550 ENDIF 
2560 IF STØR=1 THEN 
2570 UBLB1$=UBLB1$(4:LEN(UBLB1$)-3)
2580 ENDIF 
2590 ENDPROC 
2600 K1$="P641220:SYSTEM1"
2610 OPEN K1$,R
2620 EXEC FEJL(9,1,K1$)
2630 GET K1$,1:MFANTAL,MDANTAL,MKANTAL
2640 EXEC FEJL(9,2,K1$)
2650 GET K1$,3:DPOST,KPOST,MFPOST,MDPOST
2660 EXEC FEJL(9,21,K1$)
2670 GET K1$,4:MKPOST,MFAK,MVGR,MKGR
2680 EXEC FEJL(9,3,K1$)
2690 GET K1$,5:MKRGR
2700 EXEC FEJL(9,4,K1$)
2710 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
2720 EXEC FEJL(9,5,K1$)
2730 GET K1$,9:KRTAL
2740 EXEC FEJL(9,6,K1$)
2750 GET K1$,10:N$
2760 EXEC FEJL(9,7,K1$)
2770 FOR I=1 TO 26
2780 GET K1$,I+10:K$(I)
2790 EXEC FEJL(9,8,K1$)
2800 NEXT I
2810 CLOSE K1$
2820 EXEC FEJL(9,11,K1$)
2830 DIM DSALDI$(MKGR,12),DSALDI1$(MKGR,12),KSALDI1$(MKRGR,12)
2840 DIM KSALDI$(MKRGR,12)
2850 K3$=N$+K$(2);K4$=N$+K$(3);K5$=N$+K$(5);K6$=N$+K$(6);K7$=N$+K$(7)
2860 K8$=N$+K$(15);K9$=N$+K$(22);K2$=N$+K$(1);K10$=N$+K$(26)
2870 DIM FTAB1(MFANTAL DIV 4),DTAB1(MDANTAL DIV 4),KTAB1(MKANTAL DIV 4)
2880 DIM FTAB(4,2),DTAB(4,2),KTAB(4,2),HFTAB(MFPOST DIV 40,2),UFTAB(4,2)
2890 OPEN K10$,R
2900 EXEC FEJL(9,12,K10$)
2910 GET K10$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
2920 EXEC FEJL(9,13,K10$)
2925 GET K10$,13:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
2926 EXEC FEJL(9,14,K10$)
2930 CLOSE K10$
2940 EXEC FEJL(9,15,K10$)
2950 OPEN K2$,R
2960 EXEC FEJL(9,16,K2$)
2970 OPEN K3$,R
2980 EXEC FEJL(9,18,K3$)
2990 OPEN K4$,R
3000 EXEC FEJL(9,19,K4$)
3010 FOR I=1 TO MKGR
3020 DSALDI$(I)="0+";DSALDI1$(I)="0+"
3030 NEXT I
3040 FOR I=1 TO MKRGR
3050 KSALDI$(I)="0+";KSALDI1$(I)="0+"
3060 NEXT I
3070 TOSALDO$="0+";TOSALDO1$="0+";SUM$="0+";SUM3$="0+"
3080 EXEC INDTAB1(FTAB1,MFANTAL,K2$)
3090 EXEC INDTAB1(DTAB1,MDANTAL,K3$)
3100 EXEC INDTAB1(KTAB1,MKANTAL,K4$)
3110 EXEC KINIT(K3$,K6$,DTAB,0,MDANTAL)
3120 EXEC KINIT(K4$,K7$,KTAB,2,MKANTAL)
3130 EXEC KINIT(K2$,K5$,FTAB,1,MFANTAL)
3140 EXEC PINIT(K8$,MFPOST)
3150 EXEC TABINIT(K8$,K9$,MFPOST,HFTAB,UFTAB)
3160 OPEN K5$,W
3170 EXEC FEJL(9,20,K5$)
3180 EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,DIFNR,FPIL3,K2$)
3190 IF CEKS=1 THEN STOP 
3200 EXEC HENTPOST
3210 IF TOSALDO$(LEN(TOSALDO$))="-" THEN 
3220 EXEC CALC(0,FMKREDIT$,TOSALDO$,FMKREDIT$)
3230 EXEC CALC(0,FÅKREDIT$,TOSALDO$,FÅKREDIT$)
3240 ELSE 
3250 EXEC CALC(0,FMDEBET$,TOSALDO$,FMDEBET$)
3260 EXEC CALC(0,FÅDEBET$,TOSALDO$,FÅDEBET$)
3270 ENDIF 
3280 EXEC GEMFPOST
3290 TKODE$=CHR(10+48);TEKST$="Årsafslutnings difference"
3300 OPEN K8$,W
3310 EXEC FEJL(9,21,K8$)
3320 PUT K8$,1:DIFNR,T1(7),-1,TKODE$,TOSALDO$
3330 EXEC FEJL(9,22,K8$)
3340 PUT K8$,2:DIFNR,TEKST$
3350 EXEC FEJL(9,23,K8$)
3360 CLOSE K8$
3370 EXEC FEJL(9,24,K8$)
3380 T2(5)=2
3381 OPEN K10$,W
3382 EXEC FEJL(9,25,K10$)
3383 PUT K10$,13:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
3384 EXEC FEJL(9,26,K10$)
3385 CLOSE K10$
3386 EXEC FEJL(9,27,K10$)
3390 EXEC DATOUD(T1(7),DAT$)
3400 CLEAR 
3410 REPEAT 
3420 CURSOR 15,13
3430 INPUT "Monter papir til udskrift og tast RETURN",A$
3440 EXEC NRTEST(A$)
3450 UNTIL P=-1
3460 OUTPUT P
3470 PRINT TAB(10);CHR(14);"Årsafslutningsjournal";CHR(15);TAB(40);
3480 PRINT "DATO: ";DAT$
3490 PRINT CHR(10)
3500 PRINT TAB(5);"Gr.    Totaler Deb.       ";TAB(37);"Gr.Total Deb.";
3510 PRINT TAB(60);"Difference"
3520 PRINT " "
3530 FOR GR=1 TO MKGR
3540 EXEC CALC(1,DSALDI$(GR),DSALDI1$(GR),SUM$)
3550 EXEC TUD(DSALDI$(GR),UBELØB1$,1,0)
3560 EXEC TUD(DSALDI1$(GR),UBELØB2$,1,0)
3570 EXEC UDLIN
3580 NEXT GR
3590 PRINT CHR(10)
3600 PRINT TAB(5);"Gr.    Totaler Kre.       ";TAB(37);"Gr.Total Kre.";
3610 PRINT TAB(60);"Difference"
3620 PRINT " "
3630 FOR GR=1 TO MKRGR
3640 EXEC CALC(1,KSALDI$(GR),KSALDI1$(GR),SUM$)
3650 EXEC TUD(KSALDI$(GR),UBELØB1$,1,0)
3660 EXEC TUD(KSALDI1$(GR),UBELØB2$,1,0)
3670 EXEC UDLIN
3680 NEXT GR
3690 PRINT CHR(10)
3700 PRINT TAB(5);"Total Deb+Kre.";TAB(40);"Total Fin.";TAB(60);"Difference"
3710 PRINT " "
3720 EXEC CALC(0,TOSALDO1$,TOSALDO$,SUM3$)
3730 EXEC TUD(TOSALDO1$,UBELØB1$,1,0)
3740 EXEC TUD(TOSALDO$,UBELØB2$,1,0)
3750 EXEC TUD(SUM3$,SUM1$,1,0)
3760 PRINT TAB(6);UBELØB1$;TAB(37);UBELØB2$;
3770 PRINT TAB(57);SUM1$
3780 PRINT " "
3790 PRINT TAB(5);"Bogført på difference konto:";TAB(57);UBELØB2$
3800 FOR I=1 TO 48-15-MKGR-MKRGR
3810 PRINT " "
3820 NEXT I
3830 OUTPUT T
3840 CLEAR 
3850 CHAIN "P641210:OPSTART"
DataMuseum.dk

MIKADOS

⟦5b9405f2e⟧

Derivation

Text
