⟦9014f0a1d⟧

Text

0090 DIM OP1$(12),OP2$(12),RES$(14),K2$(17),K4$(17),DEBNAVN$(25)
0100 DIM A$(6),SUM1$(14),SUM2$(12),SUM3$(12),K5$(17),SALDO$(12),FSALDO$(12)
0110 DIM RENTE$(12),UBELØB1$(14),UBELØB2$(14),UBELØB3$(14),NAVN$(25)
0130 DIM DSALDO1$(12),DEBKGR$(1),DSALDO2$(12),DSALDO3$(12),DSALDO4$(12)
0140 DIM DEBLK$(1),DEBGADE$(25),DEBTLF$(10),DEBBY$(20),ÅRKØB$(12),MDNKØB$(12)
0150 DIM K1$(17),N$(6),K3$(17),DAT$(8),TXT1$(6,28),RENPRO$(12),TAH$(12)
0160 DIM MINREN$(12),SALDO1$(12),TAL3$(12),MUL$(1),TKO$(1),K6$(17)
0170 DIM TORENTE$(12),TEKST$(25),T1(9),T2(9),BLB2$(12)
0180 PROC SKRIVLIST(TXT,SIDE)
0190 REPEAT 
0200 OUTPUT T
0210 CLEAR 
0220 REPEAT 
0230 CURSOR 15,13
0240 INPUT "Monter papir til udskrift af liste og tast RETURN",A$
0250 EXEC NRTEST(A$)
0260 UNTIL P=-1
0270 OUTPUT P
0280 LINIE=1;SUM1$="0+";SUM2$="0+";SUM3$="0+";SALDO$="0+";FSALDO$="0+"
0281 RENTE$="0+"
0290 FOR RENNR1=1 TO REN
0300 IF LINIE=40 THEN 
0310 PRINT CHR(10);CHR(10);CHR(10)
0320 LINIE=1;SIDE=SIDE+1
0330 ENDIF 
0340 IF LINIE=1 THEN 
0350 PRINT TAB(10);CHR(14);TXT$;CHR(15);" Dato: ";DAT$;
0360 PRINT USING " side:###":SIDE
0370 PRINT CHR(10)
0380 PRINT " Nr   Konto Navn";TAB(44);"Saldo     Forf.saldo   Rentebeløb"
0390 PRINT " "
0400 ENDIF 
0410 REPEAT 
0420 GET K5$,RENNR1:KONTO,NAVN$,SALDO$,FSALDO$,RENTE$
0430 EXEC FEJL(1,1,K5$)
0440 IF KONTO=0 THEN RENNR1=RENNR1+1;SALDO$="0+";FSALDO$="0+";RENTE$="0+"
0450 UNTIL KONTO<>0 OR RENNR1=REN+1
0455 IF KONTO=0 THEN EXIT 
0460 EXEC CALC(0,SUM1$,SALDO$,SUM1$)
0470 EXEC CALC(0,SUM2$,FSALDO$,SUM2$)
0480 EXEC CALC(0,SUM3$,RENTE$,SUM3$)
0490 EXEC TUD(SALDO$,UBELØB1$,1,0)
0500 EXEC TUD(FSALDO$,UBELØB2$,1,0)
0510 EXEC TUD(RENTE$,UBELØB3$,1,0)
0520 PRINT USING "#### ###### ":RENNR1,KONTO;
0530 PRINT NAVN$;TAB(38);UBELØB1$;UBELØB2$;UBELØB3$
0540 LINIE=LINIE+1
0550 NEXT RENNR1
0560 FOR LINIE=LINIE TO 40
0570 PRINT " "
0580 NEXT LINIE
0590 PRINT ""
0600 EXEC TUD(SUM1$,UBELØB1$,1,0)
0610 EXEC TUD(SUM2$,UBELØB2$,1,0)
0620 EXEC TUD(SUM3$,UBELØB3$,1,0)
0630 PRINT TAB(10);CHR(14);"Total";CHR(15);TAB(34);UBELØB1$;UBELØB2$;UBELØB3$
0640 PRINT CHR(10)
0650 OUTPUT T
0660 CLEAR 
0670 SIDE=SIDE+1;P=-8
0680 IF TYPE=2 THEN EXIT 
0690 REPEAT 
0700 CURSOR 15,13
0710 INPUT "Ønskes ny udskrift (J/N) ",A$
0720 EXEC NRTEST(A$)
0730 UNTIL P=-7 OR P=-8
0740 UNTIL P=-8
0750 ENDPROC 
0751 PROC TUD(BLB1,UBLB1,TEGN,STØR)
0752 BLB2$=BLB1$
0753 EXEC CALC(5,BLB2$,TAH$,UBLB1$)
0754 IF TEGN=0 THEN UBLB1$=UBLB1$(1:13)
0755 IF TEGN=1 AND UBLB1$(LEN(UBLB1$))="+" THEN UBLB1$(LEN(UBLB1$))=" "
0756 IF STØR=1 THEN UBLB1$=UBLB1$(4:LEN(UBLB1$)-3)
0757 ENDPROC 
0760 PROC SYSGEM
0770 T2(1)=BHPOSTNR;T1(9)=RENRAPSIDE;T2(8)=REN
0780 OPEN K6$,W
0790 EXEC FEJL(3,1,K6$)
0800 PUT K6$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
0810 EXEC FEJL(3,2,K6$)
0820 PUT K6$,13:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
0830 EXEC FEJL(3,3,K6$)
0840 CLOSE K6$
0850 EXEC FEJL(3,4,K6$)
0860 ENDPROC 
0870 PROC DATOUD(DA1,DA2)
0880 DA3=DA1
0890 DA2$="        "
0900 FOR J=8 TO 1 STEP -1
0910 IF J MOD 3=0 THEN 
0920 DA2$(J)="."
0930 ELSE 
0940 DA2$(J)=CHR(DA3 MOD 10+48)
0950 DA3=DA3 DIV 10
0960 ENDIF 
0970 NEXT J
0980 ENDPROC 
0990 PROC INDTAB1(Z,MANT5,L7)
1000 PIL1=MANT5 DIV 32
1010 FOR I=1 TO PIL1
1020 H=(I-1)*8+1
1030 GET L7$,I:Z(H),Z(H+1),Z(H+2),Z(H+3),Z(H+4),Z(H+5),Z(H+6),Z(H+7)
1040 EXEC FEJL(2,1,L7$)
1050 NEXT I
1060 ENDPROC 
1070 PROC NRTEST(NUM1)
1080 P=0;TEST2=0;KTAL=0;L=LEN(NUM1$)
1090 IF L>6 THEN EXIT 
1100 CASE L OF 
1110 FOR I=1 TO L
1120 P1=INT(ORD(NUM1$(I))-48)
1130 IF P1<0 OR P1>9 THEN TEST2=1
1140 P=P*10+P1
1150 NEXT I
1160 KTAL=P DIV 10000
1170 WHEN 0
1180 P=-1
1190 WHEN 1
1200 CASE NUM1$ OF 
1210 P=INT(ORD(NUM1$)-48)
1220 WHEN "D","d"
1230 P=-2
1240 WHEN "A","a"
1250 P=-3
1260 WHEN "M","m"
1270 P=-4
1280 WHEN "J","j"
1290 P=-7
1300 WHEN "N","n"
1310 P=-8
1320 ENDCASE 
1330 ENDCASE 
1340 ENDPROC 
1350 PROC FINDPOST2(TAB5,MANT8,NØGL6,PIL10)
1360 PIL1=MANT8 DIV 8;PIL10=PIL1;MANT3=MANT8 DIV 4;MANT4=MANT8 DIV 32
1370 REPEAT 
1380 IF NØGL6=TAB5(PIL10) OR PIL1=1 THEN EXIT 
1390 PIL1=(PIL1+1) DIV 2;PIL10=PIL10+PIL1*(1-2*(NØGL6<TAB5(PIL10)))
1400 IF PIL10<1 THEN PIL10=1
1410 IF PIL10>MANT3 THEN PIL10=MANT3
1420 UNTIL PIL1=0
1430 IF TAB5(PIL10)>NØGL6 THEN PIL10=PIL10-1*(PIL10>1)
1440 ENDPROC 
1450 PROC CALC(AR3,B1,B2,ES)
1460 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0;ART=AR3-6*(AR3>5)
1470 CALL "P641215:REGN"
1480 ES$=RES$
1490 IF AR3<6 THEN 
1500 IF FLAG THEN STOP 
1510 ENDIF 
1520 ENDPROC 
1530 PROC FEJL(NR1,NR2,NR3)
1540 IF STATUS(NR3$)<>0 THEN 
1550 PRINT STATUS(NR3$),NR1,NR2,NR3$
1560 STOP 
1570 ENDIF 
1580 ENDPROC 
1590 PROC INDLÆS1(U,PIL8)
1600 PIL1=MDANTAL DIV 32+PIL8
1610 GET K2$,PIL1:U(1,1),U(1,2),U(2,1),U(2,2),U(3,1),U(3,2),U(4,1),U(4,2)
1620 EXEC FEJL(1,1,K2$)
1630 ENDPROC 
1640 PROC HENTDPOST
1650 S=DTAB3(DPIL3,2)
1660 GET K3$,S:KONTO,DEBNAVN$,DSALDO1$,DEBKGR$
1670 EXEC FEJL(8,1,K3$)
1680 GET K3$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
1690 EXEC FEJL(8,2,K3$)
1700 GET K3$,S+2:DEBGADE$,DEBTLF$,HPOST,HKUNDE
1710 EXEC FEJL(8,3,K3$)
1720 GET K3$,S+3:DEBBY$,ÅRKØB$,MDNKØB$
1730 EXEC FEJL(8,4,K3$)
1740 ENDPROC 
1750 K1$="P641220:SYSTEM1"
1760 OPEN K1$,R
1770 EXEC FEJL(9,1,K1$)
1780 GET K1$,1:MFANTAL,MDANTAL,MKANTAL,MVANTAL
1790 EXEC FEJL(9,2,K1$)
1800 GET K1$,2:MKAS,MPOS,MBHPOST,MFMID
1810 EXEC FEJL(9,3,K1$)
1820 GET K1$,3:MDMID
1830 EXEC FEJL(9,4,K1$)
1840 GET K1$,7:INDMOMS,RENTENR
1850 EXEC FEJL(9,5,K1$)
1855 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
1856 EXEC FEJL(9,51,K1$)
1860 GET K1$,10:N$
1870 EXEC FEJL(9,6,K1$)
1880 GET K1$,12:K2$
1890 EXEC FEJL(9,7,K1$)
1900 GET K1$,16:K3$
1910 EXEC FEJL(9,8,K1$)
1920 GET K1$,21:K4$
1930 EXEC FEJL(9,9,K1$)
1940 GET K1$,36:K6$
1950 EXEC FEJL(9,10,K1$)
1960 CLOSE K1$
1970 EXEC FEJL(9,11,K1$)
1980 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K6$=N$+K6$;K5$=N$+"15:RENPOST"
1990 DIM DTAB(MDANTAL DIV 4),DTAB3(4,2)
2000 IF MDMID>MBHPOST THEN MDMID=MBHPOST
2010 CREATE K5$,MDMID,70
2020 IF STATUS(K5$)>2 THEN STOP 
2030 OPEN K6$,R
2040 EXEC FEJL(9,12,K6$)
2050 GET K6$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
2060 EXEC FEJL(9,13,K6$)
2070 GET K6$,13:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
2080 EXEC FEJL(9,14,K6$)
2090 CLOSE K6$
2100 EXEC FEJL(9,15,K6$)
2110 DATO=T1(7);BHPOSTNR=T2(1);RENRAPSIDE=T1(9);REN=T2(8);TAH$="0+"
2111 TAL3$="100+"
2120 OPEN K2$,R
2130 EXEC FEJL(9,16,K2$)
2140 OPEN K3$,R
2150 EXEC FEJL(9,17,K3$)
2160 OPEN K4$,W
2170 EXEC FEJL(9,18,K4$)
2180 OPEN K5$,W
2190 EXEC FEJL(9,19,K5$)
2200 EXEC INDTAB1(DTAB,MDANTAL,K2$)
2210 EXEC DATOUD(DATO,DAT$)
2220 TXT1$(1)="Beregning af rente"
2230 TXT1$(2)="Bogføring af rente"
2240 TXT1$(3)="Sletning af renteposteringer"
2250 TXT1$(4)="Udskriv renteposteringer"
2260 TXT1$(5)="Renteberegningsoversigt"
2270 TXT1$(6)="Rentebogføringsrapport"
2280 REPEAT 
2290 OUTPUT T
2300 CLEAR 
2310 CURSOR 20,1
2320 PRINT "Renteberegning"
2330 CURSOR 16,4
2340 PRINT "0 :Færdig"
2350 FOR I=1 TO 4
2360 CURSOR 15,(I-1)*2+6
2370 PRINT I;":";TXT1$(I)
2380 NEXT I
2390 REPEAT 
2400 CURSOR 18,14
2410 INPUT "Vælg type (0-4): ",A$
2420 EXEC NRTEST(A$)
2430 UNTIL P=>0 AND P<5 AND TEST2=0
2440 TYPE=P
2450 IF TYPE=0 THEN EXIT 
2470 CLEAR 
2480 CURSOR 18,8
2490 PRINT TXT1$(TYPE)
2500 CASE TYPE OF 
2510 STOP 
2520 WHEN 1
2525 REPEAT 
2530 REPEAT 
2540 CURSOR 18,10
2550 PRINT "Fra kundenr :       (0:Alle)"
2560 CURSOR 31,10
2570 INPUT " ",A$
2580 EXEC NRTEST(A$)
2590 UNTIL (KTAL=DTAL OR P=0) AND TEST2=0
2600 FRANR=P
2610 IF P=0 THEN 
2620 FRA=1;TIL=MDANTAL DIV 4;TILNR=(DTAL+1)*10000
2630 ELSE 
2640 EXEC FINDPOST2(DTAB,MDANTAL,P,FRA)
2650 IF DTAB(FRA)=1000000 THEN FRA=0
2660 ENDIF 
2670 UNTIL FRA>0
2680 IF P>0 THEN 
2690 REPEAT 
2700 REPEAT 
2710 CURSOR 18,12
2720 INPUT "Til kundenr : ",A$
2730 EXEC NRTEST(A$)
2740 UNTIL KTAL=DTAL AND TEST2=0
2750 EXEC FINDPOST2(DTAB,MDANTAL,P,TIL)
2760 TILNR=P
2770 UNTIL FRA<=TIL
2780 ENDIF 
2790 REPEAT 
2800 REPEAT 
2810 CURSOR 18,14
2820 INPUT "Indtast renteprocent: ",RENPRO$
2830 RENPRO$=RENPRO$+"+"
2840 EXEC CALC(6,RENPRO$,TAH$,RENPRO$)
2850 UNTIL FLAG=0
2860 REPEAT 
2870 CURSOR 18,16
2880 PRINT "Er ";RENPRO$(7:5);" % rigtig (J/N)"
2890 CURSOR 42,16
2900 INPUT " ",A$
2910 EXEC NRTEST(A$)
2920 UNTIL P=-7 OR P=-8
2930 UNTIL P=-7
2940 REPEAT 
2950 CURSOR 18,18
2960 INPUT "Indtast minimumsrentebeløb: ",MINREN$
2970 MINREN$=MINREN$+"+"
2980 EXEC CALC(6,MINREN$,TAH$,MINREN$)
2990 UNTIL FLAG=0
3000 REPEAT 
3010 CURSOR 18,20
3020 PRINT "Foretages denne beregning før eller efter månedsafslutning"
3030 CURSOR 18,22
3040 INPUT "Vælg 0:Før , 1:Efter ",A$
3050 EXEC NRTEST(A$)
3060 UNTIL (P=0 OR P=1) AND TEST2=0
3070 FØR=P
3080 FOR DPIL1=FRA TO TIL
3090 IF TILNR<DTAB(DPIL1) OR REN=MDMID THEN EXIT 
3100 EXEC INDLÆS1(DTAB3,DPIL1)
3110 FOR DPIL3=1 TO 4
3120 IF DTAB3(DPIL3,1)=>FRANR AND DTAB3(DPIL3,1)<=TILNR THEN 
3130 EXEC HENTDPOST
3140 SALDO$="0+";SALDO1$="0+"
3150 EXEC CALC(0,DSALDO4$,DSALDO3$,SALDO$)
3160 EXEC CALC(0,DSALDO1$,DSALDO2$,SALDO1$)
3170 EXEC CALC(0,SALDO1$,SALDO$,SALDO1$)
3180 IF FØR=0 THEN EXEC CALC(0,SALDO$,DSALDO2$,SALDO$)
3190 IF SALDO$(LEN(SALDO$))="+" THEN 
3200 EXEC CALC(2,SALDO$,RENPRO$,RENTE$)
3210 EXEC CALC(3,RENTE$,TAL3$,RENTE$)
3220 EXEC CALC(4,RENTE$,MINREN$,TAL3$)
3230 IF SI<>1 THEN 
3240 REN=REN+1
3250 PUT K5$,REN:KONTO,DEBNAVN$,SALDO1$,SALDO$,RENTE$
3260 EXEC FEJL(2,1,K5$)
3265 ENDIF 
3270 ENDIF 
3280 ENDIF 
3290 IF DTAB3(DPIL3,1)>TILNR OR REN=MDMID THEN EXIT 
3300 NEXT DPIL3
3310 NEXT DPIL1
3320 IF REN=MDMID THEN 
3330 CLEAR 
3340 REPEAT 
3350 CURSOR 15,13
3360 INPUT "Ikke plads til flere renteposteringer,tast RETURN",A$
3370 EXEC NRTEST(A$)
3380 UNTIL P=-1
3390 ENDIF 
3400 CLEAR 
3410 REPEAT 
3420 CURSOR 15,13
3430 INPUT "Ønskes liste udskrevet (J/N): ",A$
3440 EXEC NRTEST(A$)
3450 UNTIL P=-7 OR P=-8
3460 IF P=-7 THEN EXEC SKRIVLIST(TXT1$(5),1)
3470 WHEN 2
3480 MUL$="4";TKO$=CHR(23+48);TORENTE$="0+"
3490 FOR RENNR1=1 TO REN
3500 GET K5$,RENNR1:KONTO,NAVN$,SALDO1$,SALDO$,RENTE$
3510 EXEC FEJL(4,1,K5$)
3520 IF KONTO<>0 THEN 
3530 BHPOSTNR=BHPOSTNR+1
3540 PUT K4$,BHPOSTNR:KONTO,DATO,RENNR1,TKO$,RENTE$,MUL$
3550 EXEC FEJL(4,2,K4$)
3560 EXEC CALC(1,TORENTE$,RENTE$,TORENTE$)
3570 ENDIF 
3580 NEXT RENNR1
3590 BHPOSTNR=BHPOSTNR+2;TKO$=CHR(10+48);TEKST$="Samlet rentepostering"
3600 PUT K4$,BHPOSTNR-1:RENTENR,DATO,RENRAPSIDE,TKO$,TORENTE$,MUL$
3610 EXEC FEJL(4,3,K4$)
3620 PUT K4$,BHPOSTNR:RENTENR,TEKST$
3630 EXEC FEJL(4,4,K4$)
3640 EXEC SKRIVLIST(TXT1$(6),RENRAPSIDE)
3650 REN=0
3660 EXEC SYSGEM
3670 FOR I=1 TO RENNR1-1
3680 PUT K5$,I:0,TAH$,TAH$,TAH$
3690 EXEC FEJL(4,5,K5$)
3700 NEXT I
3710 WHEN 3
3720 REPEAT 
3730 CURSOR 18,10
3740 PRINT "Fra posteringsnr :       (0:Alle,RETURN:færdig)"
3750 CURSOR 36,10
3760 INPUT " ",A$
3770 EXEC NRTEST(A$)
3780 UNTIL P<=REN AND TEST2=0
3790 FRA=P
3800 IF P<>-1 THEN 
3810 IF P=0 THEN 
3820 FRA=1;TIL=REN
3830 ELSE 
3840 REPEAT 
3850 CURSOR 18,12
3860 INPUT "Til posteringsnr : ",A$
3870 EXEC NRTEST(A$)
3880 UNTIL P=>FRA AND TEST2=0 AND P<=REN
3890 ENDIF 
3895 TIL=P
3900 FOR RENNR1=FRA TO TIL
3910 GET K5$,RENNR1:KONTO,NAVN$,SALDO$,FSALDO$,RENTE$
3920 EXEC FEJL(3,1,K5$)
3930 PUT K5$,RENNR1:0,NAVN$,SALDO$,FSALDO$,RENTE$
3940 EXEC FEJL(3,2,K5$)
3950 NEXT RENNR1
3960 CLEAR 
3970 REPEAT 
3980 CURSOR 15,13
3990 INPUT "Ønskes liste udskrevet (J/N): ",A$
4000 EXEC NRTEST(A$)
4010 UNTIL P=-7 OR P=-8
4020 IF P=-7 THEN EXEC SKRIVLIST(TXT1$(5),1)
4030 ENDIF 
4040 WHEN 4
4050 EXEC SKRIVLIST(TXT1$(5),1)
4060 ENDCASE 
4080 UNTIL TYPE=2 OR TYPE=0
4090 CLOSE K4$
4100 EXEC FEJL(9,20,K4$)
4110 CLOSE K5$
4120 EXEC FEJL(9,21,K5$)
4130 CLOSE 
4140 CLEAR 
4150 REPEAT 
4160 CURSOR 15,13
4170 INPUT "Isæt plade nr 10 og tast RETURN",A$
4180 EXEC NRTEST(A$)
4190 UNTIL P=-1
4200 IF TYPE=2 THEN CHAIN "P641210:BJ"
4210 EXEC SYSGEM
4220 CHAIN "P641210:OPSTART"
DataMuseum.dk

MIKADOS

⟦9014f0a1d⟧

Derivation

Text
