DataMuseum.dk

top - download

    Length: 7898 (0x1eda)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »BALANCE.B«

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

SPC/1 COMAL-BIN

0090 REM BALANCE
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),SALDO14$(12)
0150 DIM K2$(17),K3$(17),K4$(17),K5$(17),T1(W),LAND$(W,12),DV$(10)
0160 DIM GLNAVN1$(25),SALDO4$(12)
0170 PROC CALC(ART,B1,B2,ES)
0180 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=B;FLAG=B
0190 CALL "P641210:REGN"
0200 ES$=RES$
0210 IF FLAG<>B THEN STOP
0220 ENDPROC
0230 PROC DATOUD(DA1,DA2)
0240 DA3=DA1
0250 DA2$="        "
0260 FOR J=8 TO E STEP -E
0270 IF J MOD V=B THEN
0280 DA2$(J)="."
0290 ELSE
0300 DA2$(J)=CHR(DA3 MOD 10+48)
0310 DA3=DA3 DIV 10
0320 ENDIF
0330 NEXT J
0340 ENDPROC
0350 PROC INDTAB(T,MANTAL,L10)
0360 J=MANTAL DIV 32+E
0370 FOR I=J TO MANTAL DIV 4+J-E
0380 H=(I-J)*4+E;H1=H+E;H2=H+G;H3=H+V
0390 GET L10$,I:T(H,E),T(H,G),T(H1,E),T(H1,G),T(H2,E),T(H2,G),T(H3,E),T(H3,G)
0400 EXEC FEJL(E,E,L10$)
0410 NEXT I
0420 ENDPROC
0430 PROC HENTPOST
0440 S1=FTAB(FPIL3,G)
0450 GET K3$,S1:FNR,FNAVN$
0460 EXEC FEJL(G,G,K3$)
0470 GET K3$,S1+E:FMKODE$,FMDEBET$,FMKREDIT$
0480 EXEC FEJL(G,V,K3$)
0490 GET K3$,S1+G:FUKODE$,FÅDEBET$,FÅKREDIT$
0500 EXEC FEJL(G,4,K3$)
0510 ENDPROC
0520 PROC FEJL(NR1,NR2,NR3)
0530 IF STATUS(NR3$)<>B THEN
0540 PRINT STATUS(NR3$),NR1,NR2,NR3$
0550 STOP
0560 ENDIF
0570 ENDPROC
0580 PROC TUD(BLB1,UBLB1,TEGN,STØR)
0590 EXEC CALC(5,BLB1$,TAL4$,UBLB1$)
0600 IF TEGN=B THEN
0610 UBLB1$=UBLB1$(E:13)
0620 ELSE
0630 IF TEGN=E AND UBLB1$(LEN(UBLB1$))="+" THEN
0640 UBLB1$(LEN(UBLB1$))=" "
0650 ENDIF
0660 ENDIF
0670 IF STØR=E THEN
0680 UBLB1$=UBLB1$(4:LEN(UBLB1$)-V)
0690 ENDIF
0700 ENDPROC
0710 PROC HOVEDUD(UDATO,USIDE)
0720 EXEC DATOUD(UDATO,DAT$)
0730 PRINT TAB(67);DV$;" "
0740 PRINT TAB(10);CHR(14);"Balance";CHR(15);TAB(44);"Dato : ";DAT$;
0750 PRINT USING "   Side :###":USIDE
0760 PRINT " "
0770 PRINT TAB(40);"Månedens";TAB(66);"Årets"
0780 PRINT TAB(V);"Nr    Kontonavn";TAB(35);"Debet      Kredit       Debet";
0790 PRINT "       Kredit"
0800 PRINT TAB(8);STREG$
0810 ENDPROC
0820 PROC LINIEUD(NR4,NAVN1,SAL1,SAL2)
0830 PRINT USING "###### ":NR4;
0840 EXEC TUD(SAL1$,UBELØB1$,B,B)
0850 EXEC TUD(SAL2$,UBELØB2$,B,B)
0860 PRINT NAVN1$;TAB(33+W*(SAL1$(LEN(SAL1$))="-"));UBELØB1$;
0870 PRINT TAB(56+10*(SAL2$(LEN(SAL2$))="-"));UBELØB2$
0880 ENDPROC
0890 PROC NYSIDE(GFNR9,GLNAVN9)
0900 FOR LINIE=LINIE TO 41
0910 PRINT " "
0920 NEXT LINIE
0930 PRINT " "
0940 BSIDE=BSIDE+E
0950 EXEC HOVEDUD(T1(7),BSIDE)
0960 PRINT " "
0970 IF GFNR9>B THEN
0980 PRINT USING "###### ":GFNR9;
0990 EXEC CALC(4,SALDO12$,TAL4$,TAL4$)
1000 IF SI<>B THEN
1010 PRINT GLNAVN9$;" Fortsat"
1020 ELSE
1030 PRINT GLNAVN9$
1040 ENDIF
1050 PRINT TAB(8);STREG$(E:25+7*(SI<>B))
1060 LINIE=5
1070 ELSE
1080 LINIE=V
1090 ENDIF
1100 PRINT " "
1110 ENDPROC
1120 K1$="P641220:SYSTEM1"
1130 OPEN K1$,R
1140 EXEC FEJL(W,E,K1$)
1150 GET K1$,E:MFANTAL
1160 EXEC FEJL(W,G,K1$)
1170 GET K1$,4:MKPOST,MFAK,MVGR,MKGR
1180 EXEC FEJL(W,V,K1$)
1190 GET K1$,5:MKRGR
1200 EXEC FEJL(W,4,K1$)
1210 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
1220 EXEC FEJL(W,5,K1$)
1230 GET K1$,W:KRTAL
1240 EXEC FEJL(W,6,K1$)
1250 GET K1$,10:N$
1260 EXEC FEJL(W,7,K1$)
1270 GET K1$,11:K2$
1280 EXEC FEJL(W,8,K1$)
1290 GET K1$,15:K3$
1300 EXEC FEJL(W,W,K1$)
1310 GET K1$,36:K4$
1320 EXEC FEJL(W,10,K1$)
1330 CLOSE K1$
1340 EXEC FEJL(W,11,K1$)
1350 K2$=N$+K2$;K3$=N$+K3$
1360 K4$=N$+K4$
1370 DIM FTAB(MFANTAL,G)
1380 OPEN K4$,R
1390 EXEC FEJL(W,12,K4$)
1400 GET K4$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
1410 EXEC FEJL(W,13,K4$)
1420 GET K4$,14:AFIN
1430 EXEC FEJL(W,14,K4$)
1440 GET K4$,20:DV$
1450 EXEC FEJL(W,30,K4$)
1460 CLOSE K4$
1470 EXEC FEJL(W,15,K4$)
1480 OPEN K2$,R
1490 EXEC FEJL(W,16,K2$)
1500 OPEN K3$,R
1510 EXEC FEJL(W,17,K3$)
1520 EXEC INDTAB(FTAB,MFANTAL,K2$)
1530 BLANK$="                        "
1540 STREG$="------------------------------------";STREG$=STREG$+STREG$
1550 REPEAT
1560 OUTPUT T
1570 CLEAR
1580 CURSOR 30,G
1590 PRINT "Balanceprogram"
1600 CURSOR 15,5
1610 PRINT "0: Færdig"
1620 CURSOR 15,7
1630 PRINT "1: Totalbalance"
1640 CURSOR 15,W
1650 PRINT "2: Gruppebalance"
1660 REPEAT
1670 CURSOR 18,12
1680 PRINT "Vælg type        "
1690 CURSOR 28,12
1700 INPUT A$
1710 TOTAL=ORD(A$)-48
1720 UNTIL TOTAL>-E AND TOTAL<V
1730 IF TOTAL=B THEN EXIT
1740 CLEAR
1750 REPEAT
1760 CURSOR 15,13
1770 INPUT "Monter papir til udskrift af balance og tast RETURN",A$
1780 UNTIL ORD(A$)=255
1790 BSIDE=E;GLNAVN$=BLANK$;LINIE=E;SALDO1$="0+";SALDO2$="0+";SALDO3$="0+"
1800 SALDO3$="0+";SALDO11$="0+";SALDO12$="0+";SALDO13$="0+";TAL4$="0+";GFNR=B
1810 SALDO4$="0+";SALDO14$="0+";GFNR1=B;GLNAVN1$=BLANK$
1820 OUTPUT P
1830 EXEC HOVEDUD(T1(7),BSIDE)
1840 FOR FPIL3=E TO AFIN
1850 IF FTAB(FPIL3,E)=100000 THEN EXIT
1860 EXEC HENTPOST
1870 FGRUP=INT(ORD(FUKODE$)-48)
1880 EXEC CALC(B,FMDEBET$,FMKREDIT$,FMDK$)
1890 EXEC CALC(B,FÅDEBET$,FÅKREDIT$,FÅDK$)
1900 CASE FGRUP OF
1910 STOP
1920 WHEN B
1930 IF TOTAL=E THEN
1940 IF LINIE>39 THEN EXEC NYSIDE(GFNR,GLNAVN$)
1950 EXEC LINIEUD(FNR,FNAVN$,FMDK$,FÅDK$)
1960 LINIE=LINIE+E
1970 ENDIF
1980 EXEC CALC(B,SALDO1$,FMDK$,SALDO1$)
1990 EXEC CALC(B,SALDO11$,FÅDK$,SALDO11$)
2000 EXEC CALC(B,SALDO2$,FMDK$,SALDO2$)
2010 EXEC CALC(B,SALDO12$,FÅDK$,SALDO12$)
2020 EXEC CALC(B,SALDO3$,FMDK$,SALDO3$)
2030 EXEC CALC(B,SALDO13$,FÅDK$,SALDO13$)
2040 EXEC CALC(B,SALDO4$,FMDK$,SALDO4$)
2050 EXEC CALC(B,SALDO14$,FÅDK$,SALDO14$)
2060 WHEN E
2070 IF LINIE>39 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2080 FNR2=FNR DIV 1000
2090 FNR1=FNR DIV 10000;DTAL1=DTAL*10000+MKGR;KRTAL1=KRTAL*1000+MKRGR
2100 IF FNR1=DTAL AND DTAL1=>FNR OR FNR2=KRTAL AND KRTAL1=>FNR THEN
2110 EXEC CALC(B,SALDO2$,FMDK$,SALDO2$)
2120 EXEC CALC(B,SALDO12$,FÅDK$,SALDO12$)
2130 EXEC CALC(B,SALDO3$,FMDK$,SALDO3$)
2140 EXEC CALC(B,SALDO13$,FÅDK$,SALDO13$)
2150 EXEC CALC(B,SALDO4$,FMDK$,SALDO4$)
2160 EXEC CALC(B,SALDO14$,FÅDK$,SALDO14$)
2170 EXEC LINIEUD(FNR,FNAVN$,FMDK$,FÅDK$)
2180 ELSE
2190 EXEC LINIEUD(FNR,FNAVN$,SALDO1$,SALDO11$)
2200 SALDO1$="0+";SALDO11$="0+"
2210 ENDIF
2220 PRINT " "
2230 LINIE=LINIE+G
2240 WHEN G
2250 IF GFNR>B THEN
2260 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2270 PRINT " "
2280 PRINT TAB(8);STREG$(E:71)
2290 EXEC LINIEUD(GFNR,GLNAVN$,SALDO2$,SALDO12$)
2300 LINIE=LINIE+V
2310 ENDIF
2320 SALDO2$="0+";SALDO12$="0+"
2330 SALDO1$="0+";SALDO11$="0+"
2340 GLNAVN$=FNAVN$;GFNR=FNR
2350 IF LINIE>34 THEN
2360 EXEC NYSIDE(GFNR,GLNAVN$)
2370 ELSE
2375 PRINT " "
2380 PRINT " "
2390 PRINT USING "###### ":FNR;
2400 PRINT GLNAVN$
2410 PRINT TAB(8);STREG$(E:LEN(GLNAVN$))
2420 PRINT " "
2430 LINIE=LINIE+5
2440 ENDIF
2450 WHEN V
2460 IF LINIE>37 AND GFNR>B THEN EXEC NYSIDE(GFNR,GLNAVN$)
2470 IF GFNR>B THEN
2480 PRINT " "
2490 PRINT TAB(8);STREG$(E:71)
2500 EXEC LINIEUD(GFNR,GLNAVN$,SALDO2$,SALDO12$)
2510 SALDO2$="0+";SALDO12$="0+";LINIE=LINIE+V;GFNR=B
2520 ENDIF
2530 IF LINIE>36 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2540 PRINT " "
2550 PRINT TAB(8);STREG$(E:71)
2560 EXEC LINIEUD(FNR,FNAVN$,SALDO3$,SALDO13$)
2570 SALDO1$="0+";SALDO11$="0+"
2580 PRINT TAB(8);STREG$(E:71)
2590 PRINT " "
2600 LINIE=LINIE+5
2610 WHEN 4
2620 IF GFNR>B THEN
2630 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2640 PRINT " "
2650 PRINT TAB(8);STREG$(E:71)
2660 EXEC LINIEUD(GFNR,GLNAVN$,SALDO2$,SALDO12$)
2670 LINIE=LINIE+V;GFNR=B;GLNAVN$=BLANK$
2680 ENDIF
2690 IF GFNR1>B THEN
2700 IF LINIE>37 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
2710 PRINT " "
2720 PRINT TAB(8);STREG$(E:71)
2730 EXEC LINIEUD(GFNR1,GLNAVN1$,SALDO4$,SALDO14$)
2740 LINIE=LINIE+V;GFNR1=B;GLNAVN1$=BLANK$
2750 ENDIF
2760 SALDO1$="0+";SALDO11$="0+";SALDO2$="0+";SALDO12$="0+";SALDO4$="0+"
2770 SALDO14$="0+"
2780 GLNAVN1$=FNAVN$;GFNR1=FNR
2790 IF LINIE>34 THEN
2800 EXEC NYSIDE(GFNR1,GLNAVN1$)
2810 ELSE
2815 PRINT " "
2820 PRINT " "
2830 PRINT USING "###### ":FNR;
2840 PRINT GLNAVN1$
2850 PRINT TAB(8);STREG$(E:LEN(GLNAVN$))
2860 PRINT " "
2870 LINIE=LINIE+5
2880 ENDIF
2890 ENDCASE
2900 NEXT FPIL3
2910 IF GFNR>B THEN
2920 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2930 PRINT " "
2940 PRINT TAB(8);STREG$(E:71)
2950 EXEC LINIEUD(GFNR,GLNAVN$,SALDO2$,SALDO12$)
2960 SALDO2$="0+";SALDO12$="0+";LINIE=LINIE+V;GFNR=B
2970 SALDO1$="0+";SALDO11$="0+"
2980 ENDIF
2990 IF GFNR1>B THEN
3000 IF LINIE>37 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
3010 PRINT " "
3020 PRINT TAB(8);STREG$(E:71)
3030 EXEC LINIEUD(GFNR1,GLNAVN1$,SALDO4$,SALDO14$)
3040 LINIE=LINIE+V
3050 ENDIF
3060 IF LINIE>36 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
3070 GLNAVN$="Difference";GFNR=100000
3080 PRINT " "
3090 PRINT TAB(8);STREG$(E:71)
3100 EXEC LINIEUD(GFNR,GLNAVN$,SALDO3$,SALDO13$)
3110 PRINT TAB(8);STREG$(E:71)
3120 FOR LINIE=LINIE TO 37
3130 PRINT " "
3140 NEXT LINIE
3150 PRINT " "
3160 UNTIL TOTAL=B
3170 OUTPUT T
3180 CHAIN "P641210:OPSTART"