DataMuseum.dk

top - download

    Length: 9016 (0x2338)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »ENTBAL.B«

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

SPC/1 COMAL-BIN

0100 REM BALANCE
0110 DIM RES$(15),OP1$(12),OP2$(12),N$(6),K1$(17),A$(6),TAL4$(12),BLANK$(25)
0120 DIM UBELØB1$(14),UBELØB2$(14),STREG$(71),FÅDK$(12),FMDK$(12),GLNAVN$(25)
0130 DIM DAT$(8),FNAVN$(25)
0140 DIM ENAVN$(29),SALDO13$(12),SALDO3$(12)
0150 DIM SALDO2$(12),SALDO11$(12),SALDO1$(12),SALDO12$(12),SALDO14$(12)
0160 DIM K2$(17),K3$(17),K4$(17),K5$(17),T1(W),LAND$(W,12),DV$(10)
0170 DIM GLNAVN1$(25),SALDO4$(12),EMREG$(12),EÅREG$(12)
0180 PROC CALC(ART,B1,B2,ES)
0190 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=B;FLAG=B
0200 CALL "P641210:REGN"
0210 ES$=RES$
0220 IF FLAG<>B THEN STOP
0230 ENDPROC
0240 PROC DATOUD(DA1,DA2)
0250 DA3=DA1
0260 DA2$="        "
0270 FOR J=8 TO E STEP -E
0280 IF J MOD V=B THEN
0290 DA2$(J)="."
0300 ELSE
0310 DA2$(J)=CHR(DA3 MOD 10+48)
0320 DA3=DA3 DIV 10
0330 ENDIF
0340 NEXT J
0350 ENDPROC
0360 PROC INDTAB(T,MANTAL,L10)
0370 J=MANTAL DIV 32+E
0380 FOR I=J TO MANTAL DIV 4+J-E
0390 H=(I-J)*4+E;H1=H+E;H2=H+G;H3=H+V
0400 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)
0410 EXEC FEJL(E,E,L10$)
0420 NEXT I
0430 ENDPROC
0440 PROC FINDPOST(TAB1,MANT1,NØGL1,PIL3)
0450 PIL1=MANT1 DIV G;PIL3=PIL1;CEKS=E
0460 REPEAT
0470 IF NØGL1=TAB1(PIL3,E) OR PIL1=E THEN EXIT
0480 PIL1=(PIL1+E) DIV G;PIL3=PIL3+PIL1*(E-G*(NØGL1<TAB1(PIL3,E)))
0490 IF PIL3<E THEN PIL3=E
0500 IF PIL3>MANT1 THEN PIL3=MANT1
0510 UNTIL PIL1=B
0520 IF NØGL1>TAB1(PIL3,E) THEN PIL3=PIL3+E*(PIL3<MANT1)
0530 IF NØGL1=TAB1(PIL3,E) THEN CEKS=B
0540 ENDPROC
0550 PROC NRTEST(NUM1)
0560 P,TEST2,KTAL=B;L=LEN(NUM1$)
0570 CASE L OF
0580 FOR I=E TO L
0590 P1=INT(ORD(NUM1$(I))-48)
0600 IF P1=>B AND P1<=W THEN
0610 P=P*10+P1
0620 ELSE
0630 TEST2=E
0640 ENDIF
0650 NEXT I
0660 KTAL=P DIV 10000;KTAL9=P DIV 1000
0670 IF KTAL9=KRTAL THEN KTAL=KRTAL
0680 WHEN B
0690 P=-E
0700 WHEN E
0710 CASE NUM1$ OF
0720 P=INT(ORD(NUM1$)-48)
0730 WHEN "j","J"
0740 P=-7
0750 WHEN "n","N"
0760 P=-8
0770 ENDCASE
0780 ENDCASE
0790 ENDPROC
0800 PROC FEJL(NR1,NR2,NR3)
0810 IF STATUS(NR3$)<>B THEN
0820 PRINT STATUS(NR3$),NR1,NR2,NR3$
0830 STOP
0840 ENDIF
0850 ENDPROC
0860 PROC TUD(BLB1,UBLB1,TEGN,STØR)
0870 EXEC CALC(5,BLB1$,TAL4$,UBLB1$)
0880 IF TEGN=B THEN
0890 UBLB1$=UBLB1$(E:13)
0900 ELSE
0910 IF TEGN=E AND UBLB1$(LEN(UBLB1$))="+" THEN
0920 UBLB1$(LEN(UBLB1$))=" "
0930 ENDIF
0940 ENDIF
0950 IF STØR=E THEN
0960 UBLB1$=UBLB1$(4:LEN(UBLB1$)-V)
0970 ENDIF
0980 ENDPROC
0990 PROC HOVEDUD(UDATO,USIDE)
1000 EXEC DATOUD(UDATO,DAT$)
1010 PRINT TAB(67);DV$;" "
1020 PRINT TAB(10);CHR(14);"Entreprisebalance";CHR(15);TAB(34);"Dato: ";DAT$;
1030 PRINT USING "   Side :###":USIDE
1040 PRINT " "
1050 PRINT USING "  Entreprise: ####### ":ENR;
1060 PRINT ENAVN$
1070 PRINT " "
1080 PRINT TAB(40);"Månedens";TAB(66);"Årets"
1090 PRINT TAB(V);"Nr    Kontonavn";TAB(35);"Debet      Kredit       Debet";
1100 PRINT "       Kredit"
1110 PRINT TAB(8);STREG$
1120 ENDPROC
1130 PROC LINIEUD(NR4,NAVN1,SAL1,SAL2)
1140 PRINT USING "###### ":NR4;
1150 EXEC TUD(SAL1$,UBELØB1$,B,B)
1160 EXEC TUD(SAL2$,UBELØB2$,B,B)
1170 PRINT NAVN1$;TAB(33+10*(SAL1$(LEN(SAL1$))="-"));UBELØB1$(G:12);
1180 PRINT TAB(56+11*(SAL2$(LEN(SAL2$))="-"));UBELØB2$(G:12)
1190 ENDPROC
1200 PROC NYSIDE(GFNR9,GLNAVN9)
1210 FOR LINIE=LINIE TO 41
1220 PRINT CHR(10);
1230 NEXT LINIE
1240 PRINT " "
1250 BSIDE=BSIDE+E
1260 EXEC HOVEDUD(T1(7),BSIDE)
1270 PRINT " "
1280 IF GFNR9>B THEN
1290 PRINT USING "###### ":GFNR9;
1300 EXEC CALC(4,SALDO12$,TAL4$,TAL4$)
1310 IF SI<>B THEN
1320 PRINT GLNAVN9$;" Fortsat"
1330 ELSE
1340 PRINT GLNAVN9$
1350 ENDIF
1360 PRINT TAB(8);STREG$(E:25+7*(SI<>B))
1370 LINIE=7
1380 ELSE
1390 LINIE=5
1400 ENDIF
1410 PRINT " "
1420 ENDPROC
1430 K1$="P641220:SYSTEM1"
1440 OPEN K1$,R
1450 EXEC FEJL(W,E,K1$)
1460 GET K1$,W:KRTAL,VTAL,MEANTAL,MUNKANT
1470 EXEC FEJL(W,6,K1$)
1480 GET K1$,10:N$
1490 EXEC FEJL(W,7,K1$)
1500 GET K1$,38:K2$
1510 EXEC FEJL(W,8,K1$)
1520 GET K1$,37:K3$
1530 EXEC FEJL(W,W,K1$)
1540 GET K1$,36:K4$
1550 EXEC FEJL(W,10,K1$)
1560 GET K1$,39:K5$
1570 EXEC FEJL(99,8,K1$)
1580 GET K1$,43:METOT
1590 EXEC FEJL(99,W,K1$)
1600 CLOSE K1$
1610 EXEC FEJL(W,11,K1$)
1620 K2$=N$+K2$;K3$=N$+K3$;K5$=N$+K5$
1630 K4$=N$+K4$
1640 DIM ETAB(MEANTAL,G),UNR(METOT+MUNKANT),EU$(METOT+MUNKANT)
1650 DIM MBEV$(MUNKANT,12),ÅBEV$(MUNKANT,12),UNAVN$(METOT+MUNKANT,25)
1660 OPEN K4$,R
1670 EXEC FEJL(W,12,K4$)
1680 GET K4$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
1690 EXEC FEJL(W,13,K4$)
1700 GET K4$,20:DV$
1710 EXEC FEJL(W,30,K4$)
1720 GET K4$,21:AENT,AUNK,ETOT
1730 EXEC FEJL(W,31,K4$)
1740 CLOSE K4$
1750 EXEC FEJL(W,15,K4$)
1760 OPEN K2$,R
1770 EXEC FEJL(W,16,K2$)
1780 OPEN K3$,R
1790 EXEC FEJL(W,17,K3$)
1800 OPEN K5$,R
1810 EXEC FEJL(99,11,K5$)
1820 FOR X=E TO METOT+MUNKANT
1830 GET K5$,X:UNR(X),EU$(X),UNAVN$(X)
1840 EXEC FEJL(99,12,K5$)
1850 NEXT X
1860 CLOSE K5$
1870 EXEC INDTAB(ETAB,MEANTAL,K2$)
1880 BLANK$="                        "
1890 STREG$="------------------------------------";STREG$=STREG$+STREG$
1900 REPEAT
1910 OUTPUT T
1920 CLEAR
1930 CURSOR 15,7
1940 PRINT "Entreprisebalancer"
1950 REPEAT
1960 REPEAT
1970 CURSOR 15,13
1980 PRINT "Fra entreprisenr      (0:Alle)"
1990 CURSOR 32,13
2000 INPUT A$
2010 EXEC NRTEST(A$)
2020 UNTIL ((P>99 AND P<1000) OR P=B) AND TEST2=B
2030 IF P=B THEN
2040 FRA=E;TIL=AENT
2050 ELSE
2060 KONT=P
2070 EXEC FINDPOST(ETAB,MEANTAL,P,EPIL3)
2080 IF ETAB(EPIL3,E)<KONT THEN EPIL3=EPIL3+E
2090 FRA=EPIL3
2100 ENDIF
2110 UNTIL FRA<=AENT
2120 IF P>B THEN
2130 REPEAT
2140 CURSOR 15,15
2150 PRINT "Til entreprisenr              "
2160 CURSOR 32,15
2170 INPUT A$
2180 EXEC NRTEST(A$)
2190 UNTIL P>99 AND P<1000 AND P=>KONT AND TEST2=B
2200 EXEC FINDPOST(ETAB,MEANTAL,P,EPIL3)
2210 IF ETAB(EPIL3,E)>P THEN EPIL3=EPIL3-E
2220 TIL=EPIL3
2230 ENDIF
2240 CLEAR
2250 REPEAT
2260 CURSOR 15,13
2270 INPUT "Monter papir til udskrift af balance og tast RETURN",A$
2280 UNTIL ORD(A$)=255
2285 OUTPUT P
2290 FOR EPIL3=FRA TO TIL
2300 S1=ETAB(EPIL3,G)
2310 GET K3$,S1:ENR,EMREG$,EÅREG$
2320 EXEC FEJL(99,E,K3$)
2330 GET K3$,S1+E:ENAVN$
2340 EXEC FEJL(99,G,K3$)
2350 FOR X=E TO MUNKANT
2360 GET K3$,S1+X+E:NR9,MBEV$(X),ÅBEV$(X)
2370 EXEC FEJL(99,V,K3$)
2380 NEXT X
2390 BSIDE=E;GLNAVN$=BLANK$;LINIE=V;SALDO1$="0+";SALDO2$="0+";SALDO3$="0+"
2400 SALDO3$="0+";SALDO11$="0+";SALDO12$="0+";SALDO13$="0+";TAL4$="0+";GFNR=B
2410 SALDO4$="0+";SALDO14$="0+";GFNR1=B;GLNAVN1$=BLANK$;EPIL2=E
2430 EXEC HOVEDUD(T1(7),BSIDE)
2440 FOR EPIL1=E TO ETOT+AUNK+E
2450 IF EPIL1<ETOT+AUNK+E THEN
2460 FNR=UNR(EPIL1);FGRUP=INT(ORD(EU$(EPIL1)))-48;FNAVN$=UNAVN$(EPIL1)
2470 IF FGRUP=B THEN FMDK$=MBEV$(EPIL2);FÅDK$=ÅBEV$(EPIL2);EPIL2=EPIL2+E
2480 ELSE
2490 FNR=99;FGRUP=B;FMDK$=EMREG$;FÅDK$=EÅREG$;FNAVN$="Regulering"
2500 ENDIF
2510 CASE FGRUP OF
2520 STOP
2530 WHEN B
2540 IF LINIE>39 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2550 EXEC LINIEUD(FNR,FNAVN$,FMDK$,FÅDK$)
2560 LINIE=LINIE+E
2570 EXEC CALC(B,SALDO1$,FMDK$,SALDO1$)
2580 EXEC CALC(B,SALDO11$,FÅDK$,SALDO11$)
2590 EXEC CALC(B,SALDO2$,FMDK$,SALDO2$)
2600 EXEC CALC(B,SALDO12$,FÅDK$,SALDO12$)
2610 EXEC CALC(B,SALDO3$,FMDK$,SALDO3$)
2620 EXEC CALC(B,SALDO13$,FÅDK$,SALDO13$)
2630 EXEC CALC(B,SALDO4$,FMDK$,SALDO4$)
2640 EXEC CALC(B,SALDO14$,FÅDK$,SALDO14$)
2650 WHEN E
2660 IF LINIE>39 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2670 EXEC LINIEUD(FNR,FNAVN$,SALDO1$,SALDO11$)
2680 SALDO1$="0+";SALDO11$="0+"
2690 PRINT " "
2700 LINIE=LINIE+G
2710 WHEN G
2720 IF GFNR>B THEN
2730 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
2740 PRINT " "
2750 PRINT TAB(8);STREG$(E:71)
2760 EXEC LINIEUD(GFNR,GLNAVN$,SALDO2$,SALDO12$)
2770 LINIE=LINIE+V
2780 ENDIF
2790 SALDO2$="0+";SALDO12$="0+"
2800 SALDO1$="0+";SALDO11$="0+"
2810 GLNAVN$=FNAVN$;GFNR=FNR
2820 IF LINIE>34 THEN
2830 EXEC NYSIDE(GFNR,GLNAVN$)
2840 ELSE
2850 PRINT CHR(10)
2860 PRINT CHR(10)
2870 PRINT USING "###### ":FNR;
2880 PRINT GLNAVN$
2890 PRINT TAB(8);STREG$(E:LEN(GLNAVN$))
2900 PRINT " "
2910 LINIE=LINIE+5
2920 ENDIF
2930 WHEN V
2940 IF LINIE>37 AND GFNR>B THEN EXEC NYSIDE(GFNR,GLNAVN$)
2950 IF GFNR>B THEN
2960 PRINT " "
2970 PRINT TAB(8);STREG$(E:71)
2980 EXEC LINIEUD(GFNR,GLNAVN$,SALDO2$,SALDO12$)
2990 SALDO2$="0+";SALDO12$="0+";LINIE=LINIE+V;GFNR=B
3000 ENDIF
3010 IF LINIE>36 THEN EXEC NYSIDE(GFNR,GLNAVN$)
3020 PRINT " "
3030 PRINT TAB(8);STREG$(E:71)
3040 EXEC LINIEUD(FNR,FNAVN$,SALDO3$,SALDO13$)
3050 SALDO1$="0+";SALDO11$="0+"
3060 PRINT TAB(8);STREG$(E:71)
3070 PRINT " "
3080 LINIE=LINIE+5
3090 WHEN 4
3100 IF GFNR>B THEN
3110 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
3120 PRINT " "
3130 PRINT TAB(8);STREG$(E:71)
3140 EXEC LINIEUD(GFNR,GLNAVN$,SALDO2$,SALDO12$)
3150 LINIE=LINIE+V;GFNR=B;GLNAVN$=BLANK$
3160 ENDIF
3170 IF GFNR1>B THEN
3180 IF LINIE>37 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
3190 PRINT " "
3200 PRINT TAB(8);STREG$(E:71)
3210 EXEC LINIEUD(GFNR1,GLNAVN1$,SALDO4$,SALDO14$)
3220 LINIE=LINIE+V;GFNR1=B;GLNAVN1$=BLANK$
3230 ENDIF
3240 SALDO1$="0+";SALDO11$="0+";SALDO2$="0+";SALDO12$="0+";SALDO4$="0+"
3250 SALDO14$="0+"
3260 GLNAVN1$=FNAVN$;GFNR1=FNR
3270 IF LINIE>34 THEN
3280 EXEC NYSIDE(GFNR1,GLNAVN1$)
3290 ELSE
3300 PRINT CHR(10)
3310 PRINT CHR(10)
3320 PRINT USING "###### ":FNR;
3330 PRINT GLNAVN1$
3340 PRINT TAB(8);STREG$(E:LEN(GLNAVN$))
3350 PRINT " "
3360 LINIE=LINIE+5
3370 ENDIF
3380 ENDCASE
3390 NEXT EPIL1
3400 IF GFNR>B THEN
3410 IF LINIE>37 THEN EXEC NYSIDE(GFNR,GLNAVN$)
3420 PRINT " "
3430 PRINT TAB(8);STREG$(E:71)
3440 EXEC LINIEUD(GFNR,GLNAVN$,SALDO2$,SALDO12$)
3450 SALDO2$="0+";SALDO12$="0+";LINIE=LINIE+V;GFNR=B
3460 SALDO1$="0+";SALDO11$="0+"
3470 ENDIF
3480 IF GFNR1>B THEN
3490 IF LINIE>37 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
3500 PRINT " "
3510 PRINT TAB(8);STREG$(E:71)
3520 EXEC LINIEUD(GFNR1,GLNAVN1$,SALDO4$,SALDO14$)
3530 LINIE=LINIE+V
3540 ENDIF
3550 IF LINIE>36 THEN EXEC NYSIDE(GFNR1,GLNAVN1$)
3560 GLNAVN$="Difference";GFNR=100000
3570 PRINT " "
3580 PRINT TAB(8);STREG$(E:71)
3590 EXEC LINIEUD(GFNR,GLNAVN$,SALDO3$,SALDO13$)
3600 PRINT TAB(8);STREG$(E:71)
3610 FOR LINIE=LINIE TO 37
3620 PRINT " "
3630 NEXT LINIE
3640 PRINT " "
3650 NEXT EPIL3
3660 OUTPUT T
3670 CLEAR
3680 REPEAT
3690 CURSOR 15,13
3700 INPUT "Ønskes yderligere balancer (J/N) ",A$
3710 EXEC NRTEST(A$)
3720 UNTIL P=-7 OR P=-8
3730 UNTIL P=-8
3740 OUTPUT T
3750 CHAIN "P641210:OPSTART"