DataMuseum.dk

top - download

    Length: 12874 (0x324a)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »KREVEDL.B«

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

SPC/1 COMAL-BIN

0090 DIM RES$(15),OP1$(12),OP2$(12)
0100 DIM PNR$(6),TY$(E),TA$(12),TB$(14),DAT$(8)
0110 DIM KSALDI$(12),LK$(V),KG$(V),KTN$(6),VTAB2(5)
0120 DIM BLB2$(12),UBLB2$(14),UD1$(14),UD2$(14),KSALDO1$(12),KSALDO2$(12)
0130 DIM K1$(17),K2$(17),KRENAVN$(25),KREGR$(E),STREG$(71)
0140 DIM KRELK$(E),KREGADE$(25),N$(6),DV$(10)
0150 DIM T2(W),BLANK$(77),A$(E),TAL4$(14),TAH$(12),KREBY$(20)
0160 DIM UD3$(14),UD4$(14),K3$(17),K4$(17),K5$(17),K6$(17),T1(W),LAND$(W,12)
0170 ART=B
0180 PROC CALC(AT,B1,B2,ES)
0190 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=B;FLAG=B;ART=AT
0200 CALL "P641210:REGN"
0210 ES$=RES$
0220 IF FLAG THEN STOP
0230 ENDPROC
0240 PROC FEJL(NR1,NR2,NR3)
0250 IF STATUS(NR3$)<>B THEN
0260 PRINT STATUS(NR3$),NR1,NR2,NR3$
0270 STOP
0280 ENDIF
0290 ENDPROC
0300 PROC INDTAB(T,MANTAL,K10)
0310 J=MANTAL DIV 32+E
0320 FOR I=J TO MANTAL DIV 4+J-E
0330 H=(I-J)*4+E;J2=H+E;J3=H+G;J4=H+V
0340 GET K10$,I:T(H,E),T(H,G),T(J2,E),T(J2,G),T(J3,E),T(J3,G),T(J4,E),T(J4,G)
0350 EXEC FEJL(E,E,K10$)
0360 NEXT I
0370 ENDPROC
0380 PROC UDTAB(U,MANTAL1,K9)
0390 J=MANTAL1 DIV 32+E
0400 FOR I=E TO J-E
0410 H=(I-E)*32+E;J1=H+4;J2=H+8;J3=H+12;J4=H+16;J5=H+20;J6=H+24;J7=H+28
0420 PUT K9$,I:U(H,E),U(J1,E),U(J2,E),U(J3,E),U(J4,E),U(J5,E),U(J6,E),U(J7,E)
0430 EXEC FEJL(G,E,K9$)
0440 NEXT I
0450 FOR I=J TO MANTAL1 DIV 4+J-E
0460 H=(I-J)*4+E;J1=H+E;J2=H+G;J3=H+V
0470 PUT K9$,I:U(H,E),U(H,G),U(J1,E),U(J1,G),U(J2,E),U(J2,G),U(J3,E),U(J3,G)
0480 EXEC FEJL(G,G,K9$)
0490 NEXT I
0500 ENDPROC
0510 PROC FINDPOST(TAB1,MANT1,NØGL1,PIL3)
0520 PIL1=MANT1 DIV G;PIL3=PIL1;CEKS=E
0530 REPEAT
0540 IF NØGL1=TAB1(PIL3,E) THEN
0550 CEKS=B
0560 ELSE
0570 IF PIL1=E THEN PIL1=B
0580 PIL1=INT((PIL1+E)/G)
0590 IF NØGL1>TAB1(PIL3,E) THEN
0600 PIL3=PIL3+PIL1
0610 ELSE
0620 PIL3=PIL3-PIL1
0630 ENDIF
0640 IF PIL3<E THEN PIL3=E
0650 IF PIL3>MANT1 THEN PIL3=MANT1
0660 ENDIF
0670 UNTIL CEKS=B OR PIL1=B
0680 ENDPROC
0690 PROC SLETDPOST(NØGLE3)
0700 EXEC FINDPOST(KTAB,MKANTAL,NØGLE3,KPIL3)
0710 IF CEKS=E THEN STOP
0720 KRENR=B
0730 KRENAVN$=BLANK$(E:25)
0740 KSALDO1$=BLANK$(E:12)
0750 KSALDO2$=BLANK$(E:12)
0760 KREGR$="0"
0770 KREPOSTNR=B
0780 KRELK$="0"
0790 KREGADE$=BLANK$(E:25)
0800 KREBY$=BLANK$(E:20)
0810 EXEC GEMKPOST
0820 EXEC SLETPOST(KTAB,AKRE,NØGLE3,KPIL3)
0830 ENDPROC
0840 PROC INDSÆT(TAB2,ANTAL2,NØGL2,PIL4)
0850 IF CEKS=E THEN
0860 POSTNR=TAB2(ANTAL2+E,G)
0870 IF NØGL2>TAB2(PIL4,E) AND TAB2(PIL4,E)<>1000000 THEN PIL4=PIL4+E
0880 FOR J=ANTAL2+E TO PIL4+E STEP -E
0890 TAB2(J,E)=TAB2(J-E,E)
0900 TAB2(J,G)=TAB2(J-E,G)
0910 NEXT J
0920 TAB2(PIL4,E)=NØGL2
0930 TAB2(PIL4,G)=POSTNR
0940 ANTAL2=ANTAL2+E
0950 ENDIF
0960 ENDPROC
0970 PROC SLETPOST(TAB3,ANTAL3,NØGL3,PIL5)
0980 IF CEKS=B THEN
0990 POSTNR=TAB3(PIL5,G)
1000 FOR I=PIL5 TO ANTAL3-E
1010 TAB3(I,E)=TAB3(I+E,E)
1020 TAB3(I,G)=TAB3(I+E,G)
1030 NEXT I
1040 TAB3(ANTAL3,E)=1000000
1050 TAB3(ANTAL3,G)=POSTNR
1060 ANTAL3=ANTAL3-E
1070 ENDIF
1080 ENDPROC
1090 PROC HENTKPOST
1100 S=KTAB(KPIL3,G)
1110 GET K3$,S:KRENR,KRENAVN$,KREGADE$
1120 EXEC FEJL(8,G,K3$)
1130 IF KRENR<>KTAB(KPIL3,E) THEN STOP
1140 GET K3$,S+E:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$
1150 EXEC FEJL(8,V,K3$)
1160 ENDPROC
1170 PROC GEMKPOST
1180 S=KTAB(KPIL3,G)
1190 PUT K3$,S:KRENR,KRENAVN$,KREGADE$
1200 EXEC FEJL(W,V,K3$)
1210 PUT K3$,S+E:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$
1220 EXEC FEJL(W,4,K3$)
1230 ENDPROC
1240 PROC DINDTAST(KSTYR,CÆND,KRENR2)
1250 IF CÆND<>E THEN
1260 CLEAR
1270 CURSOR 21,E
1280 PRINT "Kreditoroplysninger"
1290 EXEC VERSKRIFT
1300 CURSOR G,V
1310 PRINT "1:Kreditornr:";KRENR2
1320 ENDIF
1330 REPEAT
1340 CASE KSTYR OF
1350 STOP
1360 WHEN G
1370 IF CÆND<>E THEN
1380 CURSOR G,4
1390 PRINT "2:Navn      :"
1400 KSTYR=V
1410 ENDIF
1420 IF CÆND<>G THEN
1430 CURSOR V,23
1440 PRINT "Navn";BLANK$(E:33);"(max 25 tegn)";BLANK$(E:26)
1450 CURSOR 13,23
1460 INPUT KRENAVN$
1470 ENDIF
1480 CURSOR 16,4
1490 PRINT BLANK$(E:25)
1500 CURSOR 16,4
1510 PRINT KRENAVN$
1520 WHEN V
1530 IF CÆND<>E THEN
1540 CURSOR G,5
1550 PRINT "3:Gade      :"
1560 KSTYR=4
1570 ENDIF
1580 IF CÆND<>G THEN
1590 CURSOR V,23
1600 PRINT "Gade";BLANK$(E:33);"(max 25 tegn)";BLANK$(E:26)
1610 CURSOR 13,23
1620 INPUT KREGADE$
1630 ENDIF
1640 CURSOR 16,5
1650 PRINT BLANK$(E:25)
1660 CURSOR 16,5
1670 PRINT KREGADE$
1680 WHEN 4
1690 IF CÆND<>E THEN
1700 CURSOR G,6
1710 PRINT "4:Postnr    :"
1720 KSTYR=5
1730 ENDIF
1740 IF CÆND<>G THEN
1750 REPEAT
1760 CURSOR V,23
1770 PRINT "Postnr";BLANK$(E:12);"(max 6 tegn)";BLANK$(E:45)
1780 CURSOR 13,23
1790 INPUT PNR$
1800 EXEC NRTEST(PNR$)
1810 UNTIL ((L>V AND L<7) OR (P=-E AND CÆND=E)) AND TEST2=B
1820 IF P<>-E THEN KREPOSTNR=P
1830 ENDIF
1840 CURSOR 16,6
1850 PRINT BLANK$(E:6)
1860 CURSOR 16,6
1870 PRINT KREPOSTNR
1880 WHEN 5
1890 IF CÆND<>E THEN
1900 CURSOR G,7
1910 PRINT "5:By        :"
1920 KSTYR=6
1930 ENDIF
1940 IF CÆND<>G THEN
1950 CURSOR V,23
1960 PRINT "BY";BLANK$(E:30);"(max 20 tegn)";BLANK$(E:31)
1970 CURSOR 13,23
1980 INPUT KREBY$
1990 ENDIF
2000 CURSOR 16,7
2010 PRINT BLANK$(E:20)
2020 CURSOR 16,7
2030 PRINT KREBY$
2040 WHEN 6
2050 IF CÆND<>E THEN
2060 CURSOR G,8
2070 PRINT "6:Landekode :     Land:"
2080 KSTYR=7
2090 ENDIF
2100 IF CÆND<>G THEN
2110 REPEAT
2120 CURSOR V,23
2130 PRINT "Landekode";BLANK$(E:W);"0:for Danmark, max 2 cifre)";BLANK$(E:30)
2140 CURSOR 13,23
2150 INPUT LK$
2160 EXEC NRTEST(LK$)
2170 UNTIL (P>-E AND P<10 AND TEST2=B) OR (P=-E AND CÆND=E)
2180 ENDIF
2190 CURSOR 16,8
2200 PRINT BLANK$(E:V)
2210 CURSOR 27,8
2220 PRINT BLANK$(E:15)
2230 CURSOR 16,8
2240 IF P<10 AND CÆND<>G THEN
2250 KRELK$=CHR(P+48)
2260 ENDIF
2270 P=ORD(KRELK$)-48
2280 PRINT USING "###":P
2290 CURSOR 27,8
2300 IF P=B THEN
2310 PRINT "Danmark"
2320 ELSE
2330 PRINT LAND$(P)
2340 ENDIF
2350 WHEN 7
2360 IF CÆND<>E THEN
2370 CURSOR G,W
2380 PRINT "7:Kreditorgr:"
2390 KSTYR=8
2400 ENDIF
2410 IF CÆND<>G THEN
2420 REPEAT
2430 CURSOR V,23
2440 PRINT "Kreditorgr:   (max 1 ciffer)";BLANK$(E:45)
2450 CURSOR 13,23
2460 INPUT KG$
2470 EXEC NRTEST(KG$)
2480 UNTIL (P>B AND TEST2=B AND P<=MKRGR) OR (P=-E AND CÆND=E)
2490 ENDIF
2500 CURSOR 16,W
2510 IF P>B AND CÆND<>G THEN
2520 KREGR$=CHR(P+48)
2530 ENDIF
2540 PRINT USING "###":INT(ORD(KREGR$)-48)
2550 ENDCASE
2560 IF CÆND=E THEN
2570 KSTYR=8
2580 ENDIF
2590 UNTIL KSTYR=8
2600 IF CÆND<>E THEN
2610 EXEC CALC(B,KSALDO1$,KSALDO2$,KSALDI$)
2620 CURSOR 4,12
2630 PRINT "Saldo      :"
2640 CURSOR 17,12
2650 EXEC TUD(KSALDI$,TAL4$,E,B)
2660 PRINT TAL4$
2670 CURSOR 4,14
2680 PRINT " 0-30 Dage :"
2690 CURSOR 17,14
2700 EXEC TUD(KSALDO1$,TAL4$,E,B)
2710 PRINT TAL4$
2720 CURSOR 4,16
2730 PRINT "Ældre      :"
2740 CURSOR 17,16
2750 EXEC TUD(KSALDO2$,TAL4$,E,B)
2760 PRINT TAL4$
2770 ENDIF
2780 ENDPROC
2790 PROC TUD(BLB1,UBLB1,TEGN,STØR)
2800 BLB2$=BLB1$;UBLB2$=UBLB1$
2810 EXEC CALC(5,BLB2$,TAH$,UBLB2$)
2820 UBLB1$=UBLB2$
2830 IF TEGN=B THEN
2840 UBLB1$=UBLB1$(E:13)
2850 ELSE
2860 IF TEGN=E AND UBLB1$(LEN(UBLB1$))="+" THEN
2870 UBLB1$(LEN(UBLB1$))=" "
2880 ENDIF
2890 ENDIF
2900 IF STØR=E THEN
2910 UBLB1$=UBLB1$(4:LEN(UBLB1$)-V)
2920 ENDIF
2930 ENDPROC
2940 PROC NRTEST(NUM1)
2950 P=B;TEST2=B;KTAL=B;L=LEN(NUM1$)
2960 CASE L OF
2970 FOR I=E TO L
2980 P1=INT(ORD(NUM1$(I))-48)
2990 IF P1=>B AND P1<=W THEN
3000 P=P*10+P1
3010 ELSE
3020 TEST2=E
3030 ENDIF
3040 NEXT I
3050 KTAL=P DIV 10000;KTAL9=P DIV 1000
3060 IF KTAL9=KRTAL THEN KTAL=KTAL9
3070 WHEN B
3080 P=-E
3090 WHEN E
3100 CASE NUM1$ OF
3110 P=INT(ORD(NUM1$)-48)
3120 WHEN "J","j"
3130 P=-7
3140 WHEN "N","n"
3150 P=-8
3160 ENDCASE
3170 ENDCASE
3180 ENDPROC
3190 PROC VERSKRIFT
3200 CURSOR 45,E
3210 CASE TYPE OF
3220 WHEN E
3230 PRINT "Oprettelse"
3240 WHEN G
3250 PRINT "Ændring"
3260 WHEN V
3270 PRINT "Sletning"
3280 WHEN 4
3290 PRINT "Udskrift"
3300 WHEN 5
3310 PRINT "Kreditorkontoliste"
3320 ENDCASE
3330 ENDPROC
3340 K1$="P641220:SYSTEM1"
3350 OPEN K1$,R
3360 EXEC FEJL(W,E,K1$)
3370 GET K1$,E:MFANTAL,MDANTAL,MKANTAL
3380 EXEC FEJL(W,G,K1$)
3390 GET K1$,5:MKRGR
3400 EXEC FEJL(W,V,K1$)
3410 GET K1$,W:KRTAL
3420 EXEC FEJL(W,4,K1$)
3430 GET K1$,10:N$
3440 EXEC FEJL(W,5,K1$)
3450 GET K1$,13:K2$
3460 EXEC FEJL(W,6,K1$)
3470 GET K1$,17:K3$
3480 EXEC FEJL(W,7,K1$)
3490 GET K1$,36:K5$
3500 EXEC FEJL(W,W,K1$)
3510 CLOSE K1$
3520 EXEC FEJL(W,10,K1$)
3530 DIM KTAB(MKANTAL,G)
3540 K5$=N$+K5$
3550 OPEN K5$,W
3560 EXEC FEJL(W,11,K5$)
3570 GET K5$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),DATO
3580 EXEC FEJL(W,12,K5$)
3590 FOR I=E TO V
3600 J=(I-E)*V+E
3610 GET K5$,I+G:LAND$(J),LAND$(J+E),LAND$(J+G)
3620 EXEC FEJL(W,13,K5$)
3630 NEXT I
3640 GET K5$,14:AFIN,ADEB,AKRE,VTAB2(E),VTAB2(G),VTAB2(V),VTAB2(4),VTAB2(5)
3650 EXEC FEJL(W,14,K5$)
3660 GET K5$,17:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
3670 EXEC FEJL(W,15,K5$)
3680 T2(5)=E
3690 PUT K5$,17:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
3700 EXEC FEJL(W,16,K5$)
3702 GET K5$,20:DV$
3704 EXEC FEJL(W,22,K5$)
3710 CLOSE K5$
3720 EXEC FEJL(W,17,K5$)
3730 K3$=N$+K3$
3740 OPEN K3$,W
3750 EXEC FEJL(W,18,K3$)
3760 K2$=N$+K2$
3770 OPEN K2$,W
3780 EXEC FEJL(W,19,K2$)
3790 EXEC INDTAB(KTAB,MKANTAL,K2$)
3800 BLANK$="                                      ";BLANK$=BLANK$+BLANK$+" "
3810 TAH$="0+";TAL4$="0+"
3820 STREG$="-----------------------------------";STREG$=STREG$+STREG$
3830 REPEAT
3840 CLEAR
3850 CURSOR 21,E
3860 PRINT "Kreditorvedligeholdelse"
3870 CURSOR G,V
3880 PRINT "0:Færdig"
3890 CURSOR G,5
3900 PRINT "1:Oprettelse"
3910 CURSOR G,7
3920 PRINT "2:Ændring"
3930 CURSOR G,W
3940 PRINT "3:Sletning"
3950 CURSOR G,11
3960 PRINT "4:Udskrift"
3970 CURSOR G,13
3980 PRINT "5:Kreditorkontoliste"
3990 REPEAT
4000 CURSOR 4,15
4010 PRINT "Vælg type     (0-5)"
4020 CURSOR 14,15
4030 INPUT TY$
4040 EXEC NRTEST(TY$)
4050 UNTIL P>-E AND P<6
4060 TYPE=P
4070 IF TYPE=B THEN EXIT
4080 REPEAT
4090 EXEC VERSKRIFT
4100 TEST=B;KONT=E
4110 IF TYPE<5 THEN
4120 REPEAT
4130 REPEAT
4140 CURSOR V,23
4150 PRINT "Indtast kreditornr         (0:for færdig)";BLANK$(E:35)
4160 CURSOR 22,23
4170 INPUT KTN$
4180 EXEC NRTEST(KTN$)
4190 UNTIL (TEST2=B AND KTAL=KRTAL AND KRTAL*1000+MKRGR<P) OR P=B
4200 KONT=P
4210 IF KONT=B THEN EXIT
4220 EXEC FINDPOST(KTAB,MKANTAL,P,KPIL3)
4230 REPEAT
4240 CURSOR 44,23
4250 IF (CEKS=B AND TYPE<>E) OR (CEKS=E AND TYPE=E AND AKRE<MKANTAL) THEN
4260 PRINT BLANK$(E:35)
4270 P=-E
4280 ELSE
4290 IF CEKS=E AND TYPE=E AND AKRE=>MKANTAL THEN
4300 CURSOR V,23
4310 INPUT "Ikke plads til flere kreditorer,tast RETURN               ",A$
4320 ELSE
4330 IF CEKS=B THEN
4340 INPUT "Kreditor eksisterer , tast RETURN  ",A$
4350 ELSE
4360 INPUT "Kreditor eksisterer ikke,tast RETURN",A$
4370 ENDIF
4380 ENDIF
4390 EXEC NRTEST(A$)
4400 ENDIF
4410 UNTIL P=-E
4420 UNTIL (CEKS=B AND TYPE<>E) OR (CEKS=E AND TYPE=E AND AKRE<MKANTAL)
4430 IF KONT=B THEN EXIT
4440 IF TYPE<>E THEN
4450 FNR=KONT;TEST=B
4460 EXEC HENTKPOST
4470 IF TYPE=V THEN EXEC SALDOTEST
4480 EXEC DINDTAST(2,2,FNR)
4490 ELSE
4500 KRENR=KONT
4510 KRENAVN$=BLANK$(E:25)
4520 KSALDO1$="0+"
4530 KSALDO2$="0+"
4540 KREGADE$=BLANK$(E:25)
4550 KREPOSTNR=B
4560 KRELK$="0"
4570 KREGR$="0"
4580 KREBY$=BLANK$(E:20)
4590 EXEC DINDTAST(2,0,KRENR)
4600 ENDIF
4610 ENDIF
4620 IF KONT=B THEN EXIT
4630 IF TEST=B THEN
4640 CASE TYPE OF
4650 STOP
4660 WHEN E,G
4670 REPEAT
4680 REPEAT
4690 CURSOR V,23
4700 PRINT "Hvilket felt ønskes ændret      (Indtast feltnr 2-7, 0:færdig)  "
4710 CURSOR 32,23
4720 INPUT LK$
4730 EXEC NRTEST(LK$)
4740 UNTIL P=B OR (P>E AND P<8)
4750 STYR1=P
4760 IF STYR1=B THEN EXIT
4770 EXEC DINDTAST(STYR1,1,KRENR)
4780 UNTIL STYR1=B
4790 EXEC FINDPOST(KTAB,MKANTAL,KRENR,KPIL3)
4800 IF TYPE=E THEN
4810 EXEC INDSÆT(KTAB,AKRE,KRENR,KPIL3)
4820 ENDIF
4830 EXEC GEMKPOST
4840 WHEN V
4850 REPEAT
4860 CURSOR V,23
4870 PRINT "Er det rigtigt at denne konto skal slettes";
4880 PRINT "      (J/N)";BLANK$(E:23)
4890 CURSOR 48,23
4900 INPUT A$
4910 EXEC NRTEST(A$)
4920 UNTIL P=-7 OR P=-8
4930 IF P=-7 THEN
4940 EXEC SLETDPOST(KRENR)
4950 ENDIF
4960 WHEN 4
4970 WHEN 5
4980 REPEAT
4990 REPEAT
5000 CURSOR V,23
5010 PRINT "Fra kreditornr        (0: Alle)"
5020 CURSOR 18,23
5030 INPUT KTN$
5040 EXEC NRTEST(KTN$)
5050 UNTIL L=5 AND P>9999 AND TEST2=B OR P=B
5060 IF P=B THEN
5070 FRA=E;TIL=AKRE
5080 ELSE
5090 KONT=P
5100 EXEC FINDPOST(KTAB,MKANTAL,P,KPIL3)
5110 FRA=KPIL3
5120 ENDIF
5130 UNTIL FRA<=AKRE
5140 IF P>B THEN
5150 REPEAT
5160 CURSOR V,23
5170 PRINT "Til kreditornr                  "
5180 CURSOR 18,23
5190 INPUT KTN$
5200 EXEC NRTEST(KTN$)
5210 UNTIL L=5 AND P>9999 AND TEST2=B AND P=>KONT
5220 EXEC FINDPOST(KTAB,MKANTAL,P,KPIL3)
5230 IF CEKS=E THEN KPIL3=KPIL3-E
5240 TIL=KPIL3
5250 ENDIF
5260 CLEAR
5270 REPEAT
5280 CURSOR 8,13
5290 INPUT "Monter papir til udskrift af kreditorkontoliste , tast RETURN",A$
5300 UNTIL ORD(A$)=255
5310 OUTPUT P
5320 SIDE=E;DA1=DATO;DAT$="        "
5330 FOR J=8 TO E STEP -E
5340 IF J MOD V=B THEN
5350 DAT$(J)="."
5360 ELSE
5370 DAT$(J)=CHR(DA1 MOD 10+48);DA1=DA1 DIV 10
5380 ENDIF
5390 NEXT J
5400 FOR I=FRA TO TIL STEP 6
5405 PRINT TAB(67);DV$;" "
5410 PRINT TAB(10);CHR(14);"Kreditorkontoliste";CHR(15);TAB(32);"Dato : ";
5420 PRINT DAT$;
5430 PRINT USING "   Side :####":SIDE
5440 PRINT " "
5450 SIDE=SIDE+E
5460 FOR KPIL3=I TO I+5
5470 IF KTAB(KPIL3,E)>B THEN
5480 EXEC HENTKPOST
5490 EXEC TUD(KSALDO1$,UD1$,E,B)
5500 EXEC TUD(KSALDO2$,UD2$,E,B)
5510 PRINT TAB(W);STREG$
5520 PRINT TAB(W);"NAVN OG ADRESSE";TAB(42);"0-30 DAGE         ÆLDRE"
5530 PRINT " "
5540 PRINT USING "######  ":KRENR;
5550 PRINT KRENAVN$;TAB(38);UD1$;" ";UD2$
5560 PRINT TAB(W);KREGADE$;" "
5570 PRINT USING "       ####### ":KREPOSTNR;
5580 PRINT KREBY$;TAB(39);
5590 DLK=ORD(KRELK$)-48;DKGR=ORD(KREGR$)-48
5600 PRINT USING "LANDEKODE:###    KREDITORGRUPPE:###":DLK,DKGR
5610 PRINT " "
5620 ENDIF
5630 IF KPIL3=TIL THEN EXIT
5640 NEXT KPIL3
5650 PRINT CHR(10);CHR(10)
5660 IF KPIL3=TIL AND KPIL3<I+6 THEN EXIT
5670 NEXT I
5680 FOR J=KPIL3+E TO I+5
5690 PRINT CHR(10);CHR(10);CHR(10);CHR(10);CHR(10)
5695 PRINT " "
5730 NEXT J
5740 OUTPUT T
5750 KONT=B
5760 ENDCASE
5770 ELSE
5780 REPEAT
5790 CURSOR V,23
5800 PRINT "Denne konto kan ikke slettes, da saldoen ikke er udlignet,";
5810 PRINT "tryk RETURN";BLANK$(E:6)
5820 INPUT A$
5830 EXEC NRTEST(A$)
5840 UNTIL P=-E
5850 ENDIF
5860 UNTIL KONT=B
5870 UNTIL TYPE=B
5880 EXEC UDTAB(KTAB,MKANTAL,K2$)
5890 CLOSE K2$
5900 EXEC FEJL(W,20,K2$)
5910 CLOSE K3$
5920 EXEC FEJL(W,21,K3$)
5930 T2(5)=B
5940 OPEN K5$,W
5950 EXEC FEJL(W,22,K5$)
5960 PUT K5$,14:AFIN,ADEB,AKRE,VTAB2(E),VTAB2(G),VTAB2(V),VTAB2(4),VTAB2(5)
5970 EXEC FEJL(W,23,K5$)
5980 PUT K5$,17:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
5990 EXEC FEJL(W,24,K5$)
6000 CLOSE K5$
6010 EXEC FEJL(W,25,K5$)
6020 CHAIN "P641210:OPSTART"
6030 PROC SALDOTEST
6040 EXEC CALC(4,KSALDO1$,TAH$,TAH$)
6050 IF SI=B THEN
6060 EXEC CALC(4,KSALDO2$,TAH$,TAH$)
6070 IF SI<>B THEN TEST=E
6080 ELSE
6090 TEST=E
6100 ENDIF
6110 ENDPROC