DataMuseum.dk

top - download

    Length: 10112 (0x2780)
    Notes: Mikados TextFile, Mikados_K
    Names: »ÅRSAFS«

└─⟦ec8c1e0b0⟧ Bits:30007442 8" floppy ( MIKPROG vol. 1-3, MIKREL vol. 1-3, PCSE 4.7.80 vol 1-3, GL.SYS )
    └─ ⟦this⟧ »ÅRSAFS« 

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),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(9),K$(26,11),K6$(17),K7$(17)
0160 PROC CALC(ART,B1,B2,ES)
0170 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0
0180 CALL "P641215:REGN"
0190 ES$=RES$
0200 IF FLAG<>0 THEN STOP 
0210 ENDPROC 
0220 PROC DATOUD(DA1,DA2)
0230 DA3=DA1
0240 DA2$="        "
0250 FOR J=8 TO 1 STEP -1
0260 IF J MOD 3=0 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+1
0360 FOR I=J TO MANTAL DIV 4+J-1
0370 H=(I-J)*4+1;H1=H+1;H2=H+2;H3=H+3
0380 GET L10$,I:T(H,1),T(H,2),T(H1,1),T(H1,2),T(H2,1),T(H2,2),T(H3,1),T(H3,2)
0390 EXEC FEJL(1,1,L10$)
0400 NEXT I
0410 ENDPROC 
0420 PROC UNDIND(V2,U1,Z)
0430 OPEN V2$,R
0440 EXEC FEJL(14,1,V2$)
0450 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)
0460 EXEC FEJL(14,2,V2$)
0470 CLOSE V2$
0480 EXEC FEJL(14,3,V2$)
0490 ENDPROC ;UNDIND
0500 PROC UNDUD(V3,U2,T)
0510 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)
0520 EXEC FEJL(16,1,V3$)
0530 ENDPROC ;UNDUD
0540 PROC HOVUD(V4,MPOSTANTAL4,S)
0550 FOR I=1 TO MPOSTANTAL4 DIV 160
0560 J=(I-1)*4+1;J1=J+1;J2=J+2;J3=J+3
0570 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)
0580 EXEC FEJL(17,2,V4$)
0590 NEXT I
0600 ENDPROC 
0610 PROC HENTPOST
0620 S1=FTAB(FPIL3,2)
0630 GET K3$,S1:FNR,FNAVN$
0640 EXEC FEJL(2,2,K3$)
0650 GET K3$,S1+1:FMKODE$,FMDEBET$,FMKREDIT$
0660 EXEC FEJL(2,3,K3$)
0670 GET K3$,S1+2:FUKODE$,FÅDEBET$,FÅKREDIT$
0680 EXEC FEJL(2,4,K3$)
0690 ENDPROC 
0700 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
0710 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=1;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
0720 REPEAT 
0730 IF NØGL5=TAB4(PIL6) OR PIL1=1 THEN EXIT 
0740 PIL1=(PIL1+1) DIV 2;PIL6=PIL6+PIL1*(1-2*(NØGL5<TAB4(PIL6)))
0750 IF PIL6<1 THEN PIL6=MANT3
0760 UNTIL PIL1=0
0770 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-1*(PIL6>1)
0780 PIL6=MANT4+PIL6
0790 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)
0800 EXEC FEJL(1,1,L8$)
0810 FOR PIL6=1 TO 4
0820 IF NØGL5=Q(PIL6,1) THEN EXIT 
0830 NEXT PIL6
0840 IF PIL6<>5 THEN CEKS=0
0850 ENDPROC 
0860 PROC NRTEST(NUM1)
0870 P=0;TEST2=0;KTAL=0;L=LEN(NUM1$)
0880 IF L>6 THEN EXIT 
0890 CASE L OF 
0900 FOR I=1 TO L
0910 P1=INT(ORD(NUM1$(I))-48)
0920 IF P1<0 OR P1>9 THEN TEST2=1
0930 P=P*10+P1
0940 NEXT I
0950 KTAL=P DIV 10000
0960 WHEN 0
0970 P=-1
0980 WHEN 1
0990 CASE NUM1$ OF 
1000 P=INT(ORD(NUM1$)-48)
1010 WHEN "D","d"
1020 P=-2
1030 WHEN "A","a"
1040 P=-3
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$)<>0 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=0 THEN 
1230 UBLB1$=UBLB1$(1:13)
1240 ELSE 
1250 IF TEGN=1 AND UBLB1$(LEN(UBLB1$))="+" THEN 
1260 UBLB1$(LEN(UBLB1$))=" "
1270 ENDIF 
1280 ENDIF 
1290 IF STØR=1 THEN 
1300 UBLB1$=UBLB1$(4:LEN(UBLB1$)-3)
1310 ENDIF 
1320 ENDPROC 
1330 PROC HOVEDUD(UDATO,USIDE)
1340 EXEC DATOUD(UDATO,DAT$)
1350 PRINT TAB(10);CHR(14);"Balance";CHR(15);TAB(44);"Dato : ";DAT$;
1360 PRINT USING "   Side :###":USIDE
1370 PRINT " "
1380 PRINT TAB(40);"Årets"
1390 PRINT TAB(3);"Nr    Kontonavn";TAB(35);"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$,0,0)
1450 PRINT NAVN1$;TAB(31+12*(SAL1$(LEN(SAL1$))="-"));UBELØB1$(2:12)
1460 ENDPROC 
1470 PROC NYSIDE
1480 FOR LINIE=LINIE TO 42
1490 PRINT CHR(10);
1500 NEXT LINIE
1510 PRINT " "
1520 BSIDE=BSIDE+1
1530 EXEC HOVEDUD(T1(7),BSIDE)
1540 PRINT " "
1550 PRINT USING "###### ":GFNR;
1560 EXEC CALC(4,SALDO12$,TAL4$,TAL4$)
1570 IF SI<>0 THEN 
1580 PRINT GLNAVN$(1:23);" Fortsat"
1590 ELSE 
1600 PRINT GLNAVN$(1:23)
1610 ENDIF 
1620 PRINT TAB(8);STREG$(1:23+7*(SI<>0))
1630 PRINT " "
1640 LINIE=5
1650 ENDPROC 
1660 K1$="P641220:SYSTEM1"
1670 OPEN K1$,R
1680 EXEC FEJL(9,1,K1$)
1690 GET K1$,1:MFANTAL,MDANTAL,MKANTAL
1700 EXEC FEJL(9,2,K1$)
1710 GET K1$,3:DPOST,KPOST,MFPOST,MDPOST
1720 EXEC FEJL(9,21,K1$)
1730 GET K1$,4:MKPOST,MFAK,MVGR,MKGR
1740 EXEC FEJL(9,3,K1$)
1750 GET K1$,5:MKRGR
1760 EXEC FEJL(9,4,K1$)
1770 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
1780 EXEC FEJL(9,5,K1$)
1790 GET K1$,9:KRTAL
1800 EXEC FEJL(9,6,K1$)
1810 GET K1$,10:N$
1820 EXEC FEJL(9,7,K1$)
1830 FOR I=1 TO 26
1840 GET K1$,I+10:K$(I)
1850 EXEC FEJL(9,8,K1$)
1860 NEXT I
1870 CLOSE K1$
1880 EXEC FEJL(9,11,K1$)
1890 K3$=N$+K$(5);K4$=N$+K$(3);K5$=N$+K$(5);K6$=N$+K$(6);K7$=N$+K$(7)
1900 K10$=N$+K$(26);K2$=N$+K$(1)
1910 DIM FTAB(MFANTAL,2)
1920 OPEN K10$,R
1930 EXEC FEJL(9,12,K10$)
1940 GET K10$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
1950 EXEC FEJL(9,13,K10$)
1960 GET K10$,14:AFIN
1970 EXEC FEJL(9,14,K10$)
1980 CLOSE K10$
1990 EXEC FEJL(9,15,K10$)
2000 OPEN K2$,R
2010 EXEC FEJL(9,16,K2$)
2020 OPEN K5$,R
2030 EXEC FEJL(9,17,K5$)
2040 EXEC INDTAB(FTAB,MFANTAL,K2$)
2050 BLANK$="                        "
2060 STREG$="------------------------------------";STREG$=STREG$+STREG$
2070 REPEAT 
2080 OUTPUT T
2090 CLEAR 
2100 REPEAT 
2110 CURSOR 15,13
2120 INPUT "Monter papir til udskrift af balance og tast RETURN",A$
2130 UNTIL ORD(A$)=255
2140 BSIDE=1;GLNAVN$=BLANK$;LINIE=1
2150 SALDO11$="0+";SALDO12$="0+";SALDO13$="0+";TAL4$="0+";GFNR=0
2160 OUTPUT P
2170 EXEC HOVEDUD(T1(7),BSIDE)
2180 FOR FPIL3=1 TO AFIN
2190 IF FTAB(FPIL3,1)=100000 THEN EXIT 
2200 EXEC HENTPOST
2210 FGRUP=INT(ORD(FUKODE$)-48)
2220 EXEC CALC(0,FÅDEBET$,FÅKREDIT$,FÅDK$)
2230 CASE FGRUP OF 
2240 STOP 
2250 WHEN 0
2270 IF LINIE>39 THEN EXEC NYSIDE
2280 EXEC LINIEUD(FNR,FNAVN$(1:23),FÅDK$)
2290 LINIE=LINIE+1
2310 EXEC CALC(0,SALDO12$,FÅDK$,SALDO12$)
2320 EXEC CALC(0,SALDO13$,FÅDK$,SALDO13$)
2330 WHEN 1
2340 IF LINIE>39 THEN EXEC NYSIDE
2345 FNR2=FNR DIV 1000
2350 FNR1=FNR DIV 10000;DTAL1=DTAL*10000+MKGR;KRTAL1=KRTAL*10000+MKRGR
2360 IF FNR1=DTAL AND DTAL1=>FNR OR FNR2=KRTAL AND KRTAL1=>FNR THEN 
2370 EXEC CALC(0,SALDO12$,FÅDK$,SALDO12$)
2380 EXEC CALC(0,SALDO13$,FÅDK$,SALDO13$)
2390 EXEC LINIEUD(FNR,FNAVN$(1:23),FÅDK$)
2400 ELSE 
2410 EXEC LINIEUD(FNR,FNAVN$(1:23),SALDO11$)
2420 SALDO11$="0+"
2430 ENDIF 
2440 PRINT " "
2450 LINIE=LINIE+2
2460 WHEN 2
2470 IF GFNR>0 THEN 
2480 IF LINIE>37 THEN EXEC NYSIDE
2490 PRINT " "
2500 PRINT TAB(8);STREG$(1:71)
2510 EXEC LINIEUD(GFNR,GLNAVN$(1:23),SALDO12$)
2520 SALDO12$="0+";LINIE=LINIE+3
2530 SALDO11$="0+"
2540 ENDIF 
2550 GLNAVN$=FNAVN$;GFNR=FNR
2560 IF LINIE>34 THEN 
2570 EXEC NYSIDE
2580 ELSE 
2590 PRINT CHR(10)
2600 PRINT USING "###### ":FNR;
2610 PRINT GLNAVN$(1:23)
2620 PRINT TAB(8);STREG$(1:LEN(GLNAVN$))
2630 PRINT " "
2640 LINIE=LINIE+5
2650 ENDIF 
2660 WHEN 3
2670 IF LINIE>37 AND GFNR>0 THEN EXEC NYSIDE
2680 IF GFNR>0 THEN 
2690 PRINT " "
2700 PRINT TAB(8);STREG$(1:71)
2710 EXEC LINIEUD(GFNR,GLNAVN$(1:23),SALDO12$)
2720 SALDO12$="0+";LINIE=LINIE+3;GFNR=0
2730 ENDIF 
2740 IF LINIE>36 THEN EXEC NYSIDE
2750 PRINT " "
2760 PRINT TAB(8);STREG$(1:71)
2770 EXEC LINIEUD(FNR,FNAVN$(1:23),SALDO13$)
2780 SALDO11$="0+"
2790 PRINT TAB(8);STREG$(1:71)
2800 PRINT " "
2810 LINIE=LINIE+5
2820 ENDCASE 
2830 NEXT FPIL3
2840 IF GFNR>0 THEN 
2850 IF LINIE>37 THEN EXEC NYSIDE
2860 PRINT " "
2870 PRINT TAB(8);STREG$(1:71)
2880 EXEC LINIEUD(GFNR,GLNAVN$(1:23),SALDO12$)
2890 SALDO12$="0+";LINIE=LINIE+3;GFNR=0
2900 SALDO11$="0+"
2910 ENDIF 
2920 IF LINIE>36 THEN EXEC NYSIDE
2930 GLNAVN$="Difference";GFNR=100000
2940 PRINT " "
2950 PRINT TAB(8);STREG$(1:71)
2960 EXEC LINIEUD(GFNR,GLNAVN$,SALDO13$)
2970 PRINT TAB(8);STREG$(1:71)
2980 FOR LINIE=LINIE TO 38
2990 PRINT CHR(10);
3000 NEXT LINIE
3010 PRINT " "
3020 OUTPUT T
3030 CLEAR 
3040 REPEAT 
3050 CURSOR 15,13
3060 INPUT "Ønskes balance gentaget (J/N)",A$
3070 EXEC NRTEST(A$)
3080 UNTIL P=-7 OR P=-8
3090 UNTIL P=-8
3100 CLOSE 
3110 CHAIN "P641215:ÅKOPI"