DataMuseum.dk

top - download

    Length: 10856 (0x2a68)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »ÅRSLUT.B«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »ÅRSLUT.B« 
└─⟦ff7f7aeee⟧ Bits:30009007 NBT	15/3-84
    └─⟦this⟧ »ÅRSLUT.B« 

SPC/1 COMAL-BIN

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