DataMuseum.dk

top - download

    Length: 10451 (0x28d3)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »RENTE.B«

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

SPC/1 COMAL-BIN

0090 DIM OP1$(12),OP2$(12),RES$(15),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$(E),DSALDO2$(12),DSALDO3$(12),DSALDO4$(12)
0140 DIM DEBLK$(E),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$(E),TKO$(E),K6$(17)
0170 DIM TORENTE$(12),TEKST$(25),T1(W),T2(W),BLB2$(12),DV$(10)
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=-E
0270 OUTPUT P
0280 LINIE=E;SUM1$="0+";SUM2$="0+";SUM3$="0+";SALDO$="0+";FSALDO$="0+"
0281 RENTE$="0+"
0290 FOR RENNR1=E TO REN
0300 IF LINIE=40 THEN
0310 PRINT CHR(10);CHR(10);CHR(10)
0320 LINIE=E;SIDE=SIDE+E
0330 ENDIF
0340 IF LINIE=E THEN
0345 PRINT TAB(67);DV$;" "
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(E,E,K5$)
0440 IF KONTO=B THEN RENNR1=RENNR1+E;SALDO$="0+";FSALDO$="0+";RENTE$="0+"
0450 UNTIL KONTO<>B OR RENNR1=REN+E
0455 IF KONTO=B THEN EXIT
0460 EXEC CALC(B,SUM1$,SALDO$,SUM1$)
0470 EXEC CALC(B,SUM2$,FSALDO$,SUM2$)
0480 EXEC CALC(B,SUM3$,RENTE$,SUM3$)
0490 EXEC TUD(SALDO$,UBELØB1$,E,B)
0500 EXEC TUD(FSALDO$,UBELØB2$,E,B)
0510 EXEC TUD(RENTE$,UBELØB3$,E,B)
0520 PRINT USING "#### ###### ":RENNR1,KONTO;
0530 PRINT NAVN$;TAB(37);UBELØB1$;UBELØB2$;UBELØB3$
0540 LINIE=LINIE+E
0550 NEXT RENNR1
0555 IF REN=B THEN
0556 PRINT CHR(10);CHR(10);CHR(10)
0557 PRINT " "
0558 ENDIF
0560 FOR LINIE=LINIE TO 40
0570 PRINT " "
0580 NEXT LINIE
0600 EXEC TUD(SUM1$,UBELØB1$,E,B)
0610 EXEC TUD(SUM2$,UBELØB2$,E,B)
0620 EXEC TUD(SUM3$,UBELØB3$,E,B)
0630 PRINT TAB(10);CHR(14);"Total";CHR(15);TAB(34);UBELØB1$;UBELØB2$;UBELØB3$
0640 PRINT " "
0645 PRINT " "
0650 OUTPUT T
0660 CLEAR
0670 SIDE=SIDE+E;P=-8
0680 IF TYPE=G 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=B THEN UBLB1$=UBLB1$(E:13)
0755 IF TEGN=E AND UBLB1$(LEN(UBLB1$))="+" THEN UBLB1$(LEN(UBLB1$))=" "
0756 IF STØR=E THEN UBLB1$=UBLB1$(4:LEN(UBLB1$)-V)
0757 ENDPROC
0760 PROC SYSGEM
0770 T2(E)=BHPOSTNR;T1(W)=RENRAPSIDE;T2(8)=REN
0780 OPEN K6$,W
0790 EXEC FEJL(V,E,K6$)
0800 PUT K6$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
0810 EXEC FEJL(V,G,K6$)
0820 PUT K6$,13:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
0830 EXEC FEJL(V,V,K6$)
0840 CLOSE K6$
0850 EXEC FEJL(V,4,K6$)
0860 ENDPROC
0870 PROC DATOUD(DA1,DA2)
0880 DA3=DA1
0890 DA2$="        "
0900 FOR J=8 TO E STEP -E
0910 IF J MOD V=B 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=E TO PIL1
1020 H=(I-E)*8+E
1030 GET L7$,I:Z(H),Z(H+E),Z(H+G),Z(H+V),Z(H+4),Z(H+5),Z(H+6),Z(H+7)
1040 EXEC FEJL(G,E,L7$)
1050 NEXT I
1060 ENDPROC
1070 PROC NRTEST(NUM1)
1080 P=B;TEST2=B;KTAL=B;L=LEN(NUM1$)
1090 IF L>6 THEN EXIT
1100 CASE L OF
1110 FOR I=E TO L
1120 P1=INT(ORD(NUM1$(I))-48)
1130 IF P1<B OR P1>W THEN TEST2=E
1140 P=P*10+P1
1150 NEXT I
1160 KTAL=P DIV 10000
1170 WHEN B
1180 P=-E
1190 WHEN E
1200 CASE NUM1$ OF
1210 P=INT(ORD(NUM1$)-48)
1220 WHEN "D","d"
1230 P=-G
1240 WHEN "A","a"
1250 P=-V
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=E THEN EXIT
1390 PIL1=(PIL1+E) DIV G;PIL10=PIL10+PIL1*(E-G*(NØGL6<TAB5(PIL10)))
1400 IF PIL10<E THEN PIL10=E
1410 IF PIL10>MANT3 THEN PIL10=MANT3
1420 UNTIL PIL1=B
1430 IF TAB5(PIL10)>NØGL6 THEN PIL10=PIL10-E*(PIL10>E)
1440 ENDPROC
1450 PROC CALC(AR3,B1,B2,ES)
1460 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
1470 CALL "P641210: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$)<>B 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(E,E),U(E,G),U(G,E),U(G,G),U(V,E),U(V,G),U(4,E),U(4,G)
1620 EXEC FEJL(E,E,K2$)
1630 ENDPROC
1640 PROC HENTDPOST
1650 S=DTAB3(DPIL3,G)
1660 GET K3$,S:KONTO,DEBNAVN$,DSALDO1$,DEBKGR$
1670 EXEC FEJL(8,E,K3$)
1680 GET K3$,S+E:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
1690 EXEC FEJL(8,G,K3$)
1700 GET K3$,S+G:DEBGADE$,DEBTLF$,HPOST,HKUNDE
1710 EXEC FEJL(8,V,K3$)
1720 GET K3$,S+V:DEBBY$,ÅRKØB$,MDNKØB$
1730 EXEC FEJL(8,4,K3$)
1740 ENDPROC
1750 K1$="P641220:SYSTEM1"
1760 OPEN K1$,R
1770 EXEC FEJL(W,E,K1$)
1780 GET K1$,E:MFANTAL,MDANTAL,MKANTAL,MVANTAL
1790 EXEC FEJL(W,G,K1$)
1800 GET K1$,G:MKAS,MPOS,MBHPOST,MFMID
1810 EXEC FEJL(W,V,K1$)
1820 GET K1$,V:MDMID
1830 EXEC FEJL(W,4,K1$)
1840 GET K1$,7:INDMOMS,RENTENR
1850 EXEC FEJL(W,5,K1$)
1855 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
1856 EXEC FEJL(W,51,K1$)
1860 GET K1$,10:N$
1870 EXEC FEJL(W,6,K1$)
1880 GET K1$,12:K2$
1890 EXEC FEJL(W,7,K1$)
1900 GET K1$,16:K3$
1910 EXEC FEJL(W,8,K1$)
1920 GET K1$,21:K4$
1930 EXEC FEJL(W,W,K1$)
1940 GET K1$,36:K6$
1950 EXEC FEJL(W,10,K1$)
1960 CLOSE K1$
1970 EXEC FEJL(W,11,K1$)
1980 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K6$=N$+K6$;K5$=N$+"10:RENPOST"
1990 DIM DTAB(MDANTAL DIV 4),DTAB3(4,G)
2000 IF MDMID>MBHPOST THEN MDMID=MBHPOST
2010 CREATE K5$,MDMID,70
2020 IF STATUS(K5$)>G THEN STOP
2030 OPEN K6$,R
2040 EXEC FEJL(W,12,K6$)
2050 GET K6$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
2060 EXEC FEJL(W,13,K6$)
2070 GET K6$,13:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
2080 EXEC FEJL(W,14,K6$)
2082 GET K6$,20:DV$
2084 EXEC FEJL(W,22,K6$)
2090 CLOSE K6$
2100 EXEC FEJL(W,15,K6$)
2110 DATO=T1(7);BHPOSTNR=T2(E);RENRAPSIDE=T1(W);REN=T2(8);TAH$="0+"
2111 TAL3$="100+"
2120 OPEN K2$,R
2130 EXEC FEJL(W,16,K2$)
2140 OPEN K3$,R
2150 EXEC FEJL(W,17,K3$)
2160 OPEN K4$,W
2170 EXEC FEJL(W,18,K4$)
2180 OPEN K5$,W
2190 EXEC FEJL(W,19,K5$)
2200 EXEC INDTAB1(DTAB,MDANTAL,K2$)
2210 EXEC DATOUD(DATO,DAT$)
2220 TXT1$(E)="Beregning af rente"
2230 TXT1$(G)="Bogføring af rente"
2240 TXT1$(V)="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,E
2320 PRINT "Renteberegning"
2330 CURSOR 16,4
2340 PRINT "0 :Færdig"
2350 FOR I=E TO 4
2360 CURSOR 15,(I-E)*G+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=>B AND P<5 AND TEST2=B
2440 TYPE=P
2450 IF TYPE=B THEN EXIT
2470 CLEAR
2480 CURSOR 18,8
2490 PRINT TXT1$(TYPE)
2500 CASE TYPE OF
2510 STOP
2520 WHEN E
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=B) AND TEST2=B
2600 FRANR=P
2610 IF P=B THEN
2620 FRA=E;TIL=MDANTAL DIV 4;TILNR=(DTAL+E)*10000
2630 ELSE
2640 EXEC FINDPOST2(DTAB,MDANTAL,P,FRA)
2650 IF DTAB(FRA)=1000000 THEN FRA=B
2660 ENDIF
2670 UNTIL FRA>B
2680 IF P>B THEN
2690 REPEAT
2700 REPEAT
2710 CURSOR 18,12
2720 INPUT "Til kundenr : ",A$
2730 EXEC NRTEST(A$)
2740 UNTIL KTAL=DTAL AND TEST2=B
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=B
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=B
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=B OR P=E) AND TEST2=B
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=E TO 4
3120 IF DTAB3(DPIL3,E)=>FRANR AND DTAB3(DPIL3,E)<=TILNR THEN
3130 EXEC HENTDPOST
3140 SALDO$="0+";SALDO1$="0+"
3150 EXEC CALC(B,DSALDO4$,DSALDO3$,SALDO$)
3160 EXEC CALC(B,DSALDO1$,DSALDO2$,SALDO1$)
3170 EXEC CALC(B,SALDO1$,SALDO$,SALDO1$)
3180 IF FØR=B THEN EXEC CALC(B,SALDO$,DSALDO2$,SALDO$)
3190 IF SALDO$(LEN(SALDO$))="+" THEN
3200 EXEC CALC(G,SALDO$,RENPRO$,RENTE$)
3210 EXEC CALC(V,RENTE$,TAL3$,RENTE$)
3220 EXEC CALC(4,RENTE$,MINREN$,TAL3$)
3230 IF SI<>E THEN
3240 REN=REN+E
3250 PUT K5$,REN:KONTO,DEBNAVN$,SALDO1$,SALDO$,RENTE$
3260 EXEC FEJL(G,E,K5$)
3265 ENDIF
3270 ENDIF
3280 ENDIF
3290 IF DTAB3(DPIL3,E)>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=-E
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 G
3480 MUL$="4";TKO$=CHR(23+48);TORENTE$="0+"
3490 FOR RENNR1=E TO REN
3500 GET K5$,RENNR1:KONTO,NAVN$,SALDO1$,SALDO$,RENTE$
3510 EXEC FEJL(4,E,K5$)
3520 IF KONTO<>B THEN
3530 BHPOSTNR=BHPOSTNR+E
3540 PUT K4$,BHPOSTNR:KONTO,DATO,RENNR1,TKO$,RENTE$,MUL$
3550 EXEC FEJL(4,G,K4$)
3560 EXEC CALC(E,TORENTE$,RENTE$,TORENTE$)
3570 ENDIF
3580 NEXT RENNR1
3590 BHPOSTNR=BHPOSTNR+G;TKO$=CHR(10+48);TEKST$="Samlet rentepostering"
3600 PUT K4$,BHPOSTNR-E:RENTENR,DATO,RENRAPSIDE,TKO$,TORENTE$,MUL$
3610 EXEC FEJL(4,V,K4$)
3620 PUT K4$,BHPOSTNR:RENTENR,TEKST$
3630 EXEC FEJL(4,4,K4$)
3640 EXEC SKRIVLIST(TXT1$(6),RENRAPSIDE)
3650 REN=B
3660 EXEC SYSGEM
3670 FOR I=E TO RENNR1-E
3680 PUT K5$,I:B,TAH$,TAH$,TAH$
3690 EXEC FEJL(4,5,K5$)
3700 NEXT I
3710 WHEN V
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=B
3790 FRA=P
3800 IF P<>-E THEN
3810 IF P=B THEN
3820 FRA=E;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=B AND P<=REN
3885 TIL=P
3890 ENDIF
3900 FOR RENNR1=FRA TO TIL
3910 GET K5$,RENNR1:KONTO,NAVN$,SALDO$,FSALDO$,RENTE$
3920 EXEC FEJL(V,E,K5$)
3930 PUT K5$,RENNR1:B,NAVN$,SALDO$,FSALDO$,RENTE$
3940 EXEC FEJL(V,G,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=G OR TYPE=B
4090 CLOSE K4$
4100 EXEC FEJL(W,20,K4$)
4110 CLOSE K5$
4120 EXEC FEJL(W,21,K5$)
4130 CLOSE
4140 CLEAR
4200 IF TYPE=G THEN CHAIN "P641210:BJ"
4210 EXEC SYSGEM
4220 CHAIN "P641210:OPSTART"