DataMuseum.dk

Presents historical artifacts from the history of:

MIKADOS

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about MIKADOS

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦d3c78d615⟧

    Length: 17696 (0x4520)
    Notes: Mikados TextFile, Mikados_K
    Names: »KREVEDL«

Derivation

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

Text

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