DataMuseum.dk

top - download

    Length: 8919 (0x22d7)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »ÅRSAFS.B«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »ÅRSAFS.B« 
└─⟦ff7f7aeee⟧ Bits:30009007 NBT	15/3-84
    └─⟦this⟧ »ÅRSAFS.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),K10$(17)
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),K$(26,11),K6$(17),K7$(17)
0155 DIM DV$(10),T2(W),SALDO14$(12),GLNAVN1$(25)
0160 PROC CALC(ART,B1,B2,ES)
0170 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=B;FLAG=B
0180 CALL "P641210:REGN"
0190 ES$=RES$
0200 IF FLAG<>B THEN STOP
0210 ENDPROC
0220 PROC DATOUD(DA1,DA2)
0230 DA3=DA1
0240 DA2$="        "
0250 FOR J=8 TO E STEP -E
0260 IF J MOD V=B THEN
0270 DA2$(J)="."
0280 ELSE
0290 DA2$(J)=CHR(DA3 MOD 10+48)
0300 DA3=DA3 DIV 10
0310 ENDIF
0320 NEXT J
0330 ENDPROC
0340 PROC INDTAB(T,MANTAL,L10)
0350 J=MANTAL DIV 32+E
0360 FOR I=J TO MANTAL DIV 4+J-E
0370 H=(I-J)*4+E;H1=H+E;H2=H+G;H3=H+V
0380 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)
0390 EXEC FEJL(E,E,L10$)
0400 NEXT I
0410 ENDPROC
0420 PROC UNDIND(V2,U1,Z)
0430 OPEN V2$,R
0440 EXEC FEJL(14,E,V2$)
0450 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)
0460 EXEC FEJL(14,G,V2$)
0470 CLOSE V2$
0480 EXEC FEJL(14,V,V2$)
0490 ENDPROC ;UNDIND
0500 PROC UNDUD(V3,U2,T)
0510 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)
0520 EXEC FEJL(16,E,V3$)
0530 ENDPROC ;UNDUD
0540 PROC HOVUD(V4,MPOSTANTAL4,S)
0550 FOR I=E TO MPOSTANTAL4 DIV 160
0560 J=(I-E)*4+E;J1=J+E;J2=J+G;J3=J+V
0570 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)
0580 EXEC FEJL(17,G,V4$)
0590 NEXT I
0600 ENDPROC
0610 PROC HENTPOST
0620 S1=FTAB(FPIL3,G)
0630 GET K3$,S1:FNR,FNAVN$
0640 EXEC FEJL(G,G,K3$)
0650 GET K3$,S1+E:FMKODE$,FMDEBET$,FMKREDIT$
0660 EXEC FEJL(G,V,K3$)
0670 GET K3$,S1+G:FUKODE$,FÅDEBET$,FÅKREDIT$
0680 EXEC FEJL(G,4,K3$)
0690 ENDPROC
0700 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
0710 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=E;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
0720 REPEAT
0730 IF NØGL5=TAB4(PIL6) OR PIL1=E THEN EXIT
0740 PIL1=(PIL1+E) DIV G;PIL6=PIL6+PIL1*(E-G*(NØGL5<TAB4(PIL6)))
0750 IF PIL6<E THEN PIL6=MANT3
0760 UNTIL PIL1=B
0770 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-E*(PIL6>E)
0780 PIL6=MANT4+PIL6
0790 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)
0800 EXEC FEJL(E,E,L8$)
0810 FOR PIL6=E TO 4
0820 IF NØGL5=Q(PIL6,E) THEN EXIT
0830 NEXT PIL6
0840 IF PIL6<>5 THEN CEKS=B
0850 ENDPROC
0860 PROC NRTEST(NUM1)
0870 P=B;TEST2=B;KTAL=B;L=LEN(NUM1$)
0880 IF L>6 THEN EXIT
0890 CASE L OF
0900 FOR I=E TO L
0910 P1=INT(ORD(NUM1$(I))-48)
0920 IF P1<B OR P1>W THEN TEST2=E
0930 P=P*10+P1
0940 NEXT I
0950 KTAL=P DIV 10000
0960 WHEN B
0970 P=-E
0980 WHEN E
0990 CASE NUM1$ OF
1000 P=INT(ORD(NUM1$)-48)
1010 WHEN "D","d"
1020 P=-G
1030 WHEN "A","a"
1040 P=-V
1050 WHEN "M","m"
1060 P=-4
1070 WHEN "J","j"
1080 P=-7
1090 WHEN "N","n"
1100 P=-8
1110 ENDCASE
1120 ENDCASE
1130 ENDPROC
1140 PROC FEJL(NR1,NR2,NR3)
1150 IF STATUS(NR3$)<>B THEN
1160 PRINT STATUS(NR3$),NR1,NR2,NR3$
1170 STOP
1180 ENDIF
1190 ENDPROC
1200 PROC TUD(BLB1,UBLB1,TEGN,STØR)
1210 EXEC CALC(5,BLB1$,TAL4$,UBLB1$)
1220 IF TEGN=B THEN
1230 UBLB1$=UBLB1$(E:13)
1240 ELSE
1250 IF TEGN=E AND UBLB1$(LEN(UBLB1$))="+" THEN
1260 UBLB1$(LEN(UBLB1$))=" "
1270 ENDIF
1280 ENDIF
1290 IF STØR=E THEN
1300 UBLB1$=UBLB1$(4:LEN(UBLB1$)-V)
1310 ENDIF
1320 ENDPROC
1330 PROC HOVEDUD(UDATO,USIDE)
1340 EXEC DATOUD(UDATO,DAT$)
1345 PRINT TAB(67);DV$;" "
1350 PRINT TAB(10);CHR(14);"Balance";CHR(15);TAB(44);"Dato : ";DAT$;
1360 PRINT USING "   Side :###":USIDE
1370 PRINT " "
1380 PRINT TAB(46);"Årets"
1390 PRINT TAB(V);"Nr    Kontonavn";TAB(42);"Debet      Kredit"
1400 PRINT TAB(8);STREG$
1410 ENDPROC
1420 PROC LINIEUD(NR4,NAVN1,SAL1)
1430 PRINT USING "###### ":NR4;
1440 EXEC TUD(SAL1$,UBELØB1$,B,B)
1450 PRINT NAVN1$;TAB(35+15*(SAL1$(LEN(SAL1$))="-"));UBELØB1$
1460 ENDPROC
1470 PROC NYSIDE(GFNR9,GLNAVN9)
1480 FOR LINIE=LINIE TO 40
1490 PRINT CHR(10);
1500 NEXT LINIE
1510 PRINT " "
1520 BSIDE=BSIDE+E
1530 EXEC HOVEDUD(T1(7),BSIDE)
1540 PRINT " "
1545 IF GFNR9>B THEN
1550 PRINT USING "###### ":GFNR9;
1560 EXEC CALC(4,SALDO12$,TAL4$,TAL4$)
1570 IF SI<>B THEN
1580 PRINT GLNAVN9$;" Fortsat"
1590 ELSE
1600 PRINT GLNAVN9$
1610 ENDIF
1620 PRINT TAB(8);STREG$(E:25+7*(SI<>B))
1630 LINIE=5
1640 ELSE
1650 LINIE=V
1651 ENDIF
1652 PRINT " "
1653 ENDPROC
1660 K1$="P641220:SYSTEM1"
1670 OPEN K1$,R
1680 EXEC FEJL(W,E,K1$)
1690 GET K1$,E:MFANTAL,MDANTAL,MKANTAL
1700 EXEC FEJL(W,G,K1$)
1710 GET K1$,V:DPOST,KPOST,MFPOST,MDPOST
1720 EXEC FEJL(W,21,K1$)
1730 GET K1$,4:MKPOST,MFAK,MVGR,MKGR
1740 EXEC FEJL(W,V,K1$)
1750 GET K1$,5:MKRGR
1760 EXEC FEJL(W,4,K1$)
1770 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
1780 EXEC FEJL(W,5,K1$)
1790 GET K1$,W:KRTAL
1800 EXEC FEJL(W,6,K1$)
1810 GET K1$,10:N$
1820 EXEC FEJL(W,7,K1$)
1830 FOR I=E TO 26
1840 GET K1$,I+10:K$(I)
1850 EXEC FEJL(W,8,K1$)
1860 NEXT I
1870 CLOSE K1$
1880 EXEC FEJL(W,11,K1$)
1890 K3$=N$+K$(5);K4$=N$+K$(V);K5$=N$+K$(5);K6$=N$+K$(6);K7$=N$+K$(7)
1900 K10$=N$+K$(26);K2$=N$+K$(E)
1910 DIM FTAB(MFANTAL,G)
1920 OPEN K10$,W
1930 EXEC FEJL(W,12,K10$)
1940 GET K10$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
1950 EXEC FEJL(W,13,K10$)
1960 GET K10$,14:AFIN
1970 EXEC FEJL(W,14,K10$)
1980 GET K10$,17:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
1990 EXEC FEJL(W,18,K10$)
2000 T2(G)=G
2010 PUT K10$,17:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
2020 EXEC FEJL(W,19,K10$)
2021 GET K10$,20:DV$
2022 EXEC FEJL(W,22,K10$)
2030 CLOSE K10$
2040 EXEC FEJL(W,15,K10$)
2050 OPEN K2$,R
2060 EXEC FEJL(W,16,K2$)
2070 OPEN K5$,R
2080 EXEC FEJL(W,17,K5$)
2090 EXEC INDTAB(FTAB,MFANTAL,K2$)
2100 BLANK$="                        "
2110 STREG$="------------------------------------";STREG$=STREG$+STREG$
2120 REPEAT
2130 OUTPUT T
2140 CLEAR
2150 REPEAT
2160 CURSOR 15,13
2170 INPUT "Monter papir til udskrift af balance og tast RETURN",A$
2180 UNTIL ORD(A$)=255
2190 BSIDE=E;GLNAVN$=BLANK$;LINIE=E;SALDO14$="0+";GFNR1=B;GLNAVN1$=BLANK$
2200 SALDO11$="0+";SALDO12$="0+";SALDO13$="0+";TAL4$="0+";GFNR=B
2210 OUTPUT P
2220 EXEC HOVEDUD(T1(7),BSIDE)
2230 FOR FPIL3=E TO AFIN
2240 IF FTAB(FPIL3,E)=100000 THEN EXIT
2250 EXEC HENTPOST
2260 FGRUP=INT(ORD(FUKODE$)-48)
2270 EXEC CALC(B,FÅDEBET$,FÅKREDIT$,FÅDK$)
2280 CASE FGRUP OF
2290 STOP
2300 WHEN B
2310 IF LINIE>39 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2320 EXEC LINIEUD(FNR,FNAVN$,FÅDK$)
2330 LINIE=LINIE+E
2340 EXEC CALC(B,SALDO11$,FÅDK$,SALDO11$)
2350 EXEC CALC(B,SALDO12$,FÅDK$,SALDO12$)
2360 EXEC CALC(B,SALDO13$,FÅDK$,SALDO13$)
2370 EXEC CALC(B,SALDO14$,FÅDK$,SALDO14$)
2380 WHEN E
2390 IF LINIE>39 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2400 FNR2=FNR DIV 1000
2410 FNR1=FNR DIV 10000;DTAL1=DTAL*10000+MKGR;KRTAL1=KRTAL*10000+MKRGR
2420 IF FNR1=DTAL AND DTAL1=>FNR OR FNR2=KRTAL AND KRTAL1=>FNR THEN
2430 EXEC CALC(B,SALDO12$,FÅDK$,SALDO12$)
2440 EXEC CALC(B,SALDO13$,FÅDK$,SALDO13$)
2450 EXEC CALC(B,SALDO14$,FÅDK$,SALDO14$)
2460 EXEC LINIEUD(FNR,FNAVN$,FÅDK$)
2470 ELSE
2480 EXEC LINIEUD(FNR,FNAVN$,SALDO11$)
2490 SALDO11$="0+"
2500 ENDIF
2510 PRINT " "
2520 LINIE=LINIE+G
2530 WHEN G
2540 IF GFNR>B THEN
2550 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2560 PRINT " "
2570 PRINT TAB(8);STREG$(E:71)
2580 EXEC LINIEUD(GFNR,GLNAVN$(1:23),SALDO12$)
2590 LINIE=LINIE+V
2600 ENDIF
2610 GLNAVN$=FNAVN$;GFNR=FNR;SALDO12$="0+";SALDO11$="0+"
2620 IF LINIE>34 THEN
2630 EXEC NYSIDE(GFNR,GLNAVN$)
2640 ELSE
2650 PRINT CHR(10)
2660 PRINT CHR(10)
2670 PRINT USING "###### ":FNR;
2680 PRINT GLNAVN$
2690 PRINT TAB(8);STREG$(E:LEN(GLNAVN$))
2700 PRINT " "
2710 LINIE=LINIE+5
2720 ENDIF
2730 WHEN V
2740 IF LINIE>37 AND GFNR>B THEN EXEC NYSIDE(GFNR,GLNAVN$)
2750 IF GFNR>B THEN
2760 PRINT " "
2770 PRINT TAB(8);STREG$(E:71)
2780 EXEC LINIEUD(GFNR,GLNAVN$,SALDO12$)
2790 SALDO12$="0+";LINIE=LINIE+V;GFNR=B
2800 ENDIF
2810 IF LINIE>36 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2820 PRINT " "
2830 PRINT TAB(8);STREG$(E:71)
2840 EXEC LINIEUD(FNR,FNAVN$,SALDO13$)
2850 SALDO11$="0+"
2860 PRINT TAB(8);STREG$(E:71)
2870 PRINT " "
2880 LINIE=LINIE+5
2890 WHEN 4
2900 IF GFNR>B THEN
2910 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2920 PRINT " "
2930 PRINT TAB(8);STREG$(E:71)
2940 EXEC LINIEUD(GFNR,GLNAVN$,SALDO12$)
2950 LINIE=LINIE+V;GFNR=B;GLNAVN$=BLANK$
2960 ENDIF
2970 IF GFNR1>B THEN
2980 IF LINIE>37 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
2990 PRINT " "
3000 PRINT TAB(8);STREG$(E:71)
3010 EXEC LINIEUD(GFNR1,GLNAVN1$,SALDO14$)
3020 LINIE=LINIE+V;GFNR1=B;GLNAVN1$=BLANK$
3030 ENDIF
3040 SALDO11$="0+";SALDO12$="0+";SALDO14$="0+"
3050 GLNAVN1$=FNAVN$;GFNR1=FNR
3060 IF LINIE>34 THEN
3070 EXEC NYSIDE(GFNR1,GLNAVN1$)
3080 ELSE
3090 PRINT CHR(10)
3100 PRINT CHR(10)
3110 PRINT " "
3120 PRINT USING "###### ":FNR;
3130 PRINT GLNAVN1$
3140 PRINT TAB(8);STREG$(E:LEN(GLNAVN$))
3150 PRINT " "
3160 LINIE=LINIE+5
3170 ENDIF
3180 ENDCASE
3190 NEXT FPIL3
3200 IF GFNR>B THEN
3210 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
3220 PRINT " "
3230 PRINT TAB(8);STREG$(E:71)
3240 EXEC LINIEUD(GFNR,GLNAVN$,SALDO12$)
3250 SALDO12$="0+";LINIE=LINIE+V;GFNR=B
3260 SALDO11$="0+"
3270 ENDIF
3271 IF GFNR1>B THEN
3272 IF LINIE>37 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
3273 PRINT " "
3274 PRINT TAB(8);STREG$(E:71)
3275 EXEC LINIEUD(GFNR1,GLNAVN1$,SALDO14$)
3276 LINIE=LINIE+V
3277 ENDIF
3280 IF LINIE>36 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
3290 GLNAVN$="Difference";GFNR=100000
3300 PRINT " "
3310 PRINT TAB(8);STREG$(E:71)
3320 EXEC LINIEUD(GFNR,GLNAVN$,SALDO13$)
3330 PRINT TAB(8);STREG$(E:71)
3340 FOR LINIE=LINIE TO 37
3350 PRINT CHR(10);
3360 NEXT LINIE
3370 PRINT " "
3380 OUTPUT T
3390 CLEAR
3400 REPEAT
3410 CURSOR 15,13
3420 INPUT "Ønskes balance gentaget (J/N)",A$
3430 EXEC NRTEST(A$)
3440 UNTIL P=-7 OR P=-8
3450 UNTIL P=-8
3460 CLOSE
3470 CHAIN "P641210:ÅKOPI"