|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 17696 (0x4520) Notes: Mikados TextFile, Mikados_K Names: »KREVEDL«
└─⟦ec8c1e0b0⟧ Bits:30007442 8" floppy ( MIKPROG vol. 1-3, MIKREL vol. 1-3, PCSE 4.7.80 vol 1-3, GL.SYS ) └─ ⟦this⟧ »KREVEDL«
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