DataMuseum.dk

top - download

    Length: 20224 (0x4f00)
    Notes: Mikados TextFile, Mikados_K
    Names: »DEBVEDL«

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

Text

0100 DIM K1$(17),K2$(17),DEBNAVN$(25),DSALDO1$(12),DEBKGR$(1),UD2$(14),A$(1)
0110 DIM DSALDO2$(12),DSALDO3$(12),DSALDO4$(12),DEBLK$(1),DEBGADE$(25),N$(6)
0120 DIM T2(9),BLANK$(77),TAL4$(14),TAH$(12),DEBTLF$(9),DEBBY$(20),VTAB2(5)
0130 DIM RES$(14),ÅRKØB$(12),MDNKØB$(12),DSALDI$(12),LK$(3),KG$(3),KTN$(6)
0140 DIM PNR$(6),TY$(1),OP1$(12),OP2$(12),TA$(12),TB$(14),TÅRKØB$(12),DAT$(8)
0150 DIM DEBGADE1$(25),DEBTLF1$(9),BLB2$(12),UBLB2$(14),UD1$(14),STREG$(71)
0160 DIM UD3$(14),UD4$(14),K3$(17),K4$(17),K5$(17),K6$(17),T1(9),LAND$(9,12)
0170 PROC CALC(ART,B1,B2,ES)
0180 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0
0190 CALL "P641210:REGN"
0200 ES$=RES$
0210 IF FLAG THEN STOP 
0220 ENDPROC 
0230 PROC FEJL(NR1,NR2,NR3)
0240 IF STATUS(NR3$)<>0 THEN 
0250 PRINT STATUS(NR3$),NR1,NR2,NR3$
0260 STOP 
0270 ENDIF 
0280 ENDPROC 
0290 PROC INDTAB(T,MANTAL,K10)
0300 J=MANTAL DIV 32+1
0310 FOR I=J TO MANTAL DIV 4+J-1
0320 H=(I-J)*4+1;J2=H+1;J3=H+2;J4=H+3
0330 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)
0340 EXEC FEJL(1,1,K10$)
0350 NEXT I
0360 ENDPROC 
0370 PROC UDTAB(U,MANTAL1,K9)
0380 J=MANTAL1 DIV 32+1
0390 FOR I=1 TO J-1
0400 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
0410 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)
0420 EXEC FEJL(2,1,K9$)
0430 NEXT I
0440 FOR I=J TO MANTAL1 DIV 4+J-1
0450 H=(I-J)*4+1;J1=H+1;J2=H+2;J3=H+3
0460 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)
0470 EXEC FEJL(2,2,K9$)
0480 NEXT I
0490 ENDPROC 
0500 PROC FINDPOST(TAB1,MANT1,NØGL1,PIL3)
0510 PIL1=MANT1 DIV 2;PIL3=PIL1;CEKS=1
0520 REPEAT 
0530 IF NØGL1=TAB1(PIL3,1) THEN 
0540 CEKS=0
0550 ELSE 
0560 IF PIL1=1 THEN PIL1=0
0570 PIL1=INT((PIL1+1)/2)
0580 IF NØGL1>TAB1(PIL3,1) THEN 
0590 PIL3=PIL3+PIL1
0600 ELSE 
0610 PIL3=PIL3-PIL1
0620 ENDIF 
0630 IF PIL3<1 THEN PIL3=1
0640 IF PIL3>MANT1 THEN PIL3=MANT1
0650 ENDIF 
0660 UNTIL CEKS=0 OR PIL1=0
0670 ENDPROC 
0680 PROC SLETDPOST(NØGLE3)
0690 EXEC FINDPOST(DTAB,MDANTAL,NØGLE3,DPIL3)
0700 IF CEKS=1 THEN STOP 
0710 DEBNR=0
0720 DEBNAVN$=BLANK$(1:25)
0730 DSALDO1$=BLANK$(1:12)
0740 DSALDO2$=BLANK$(1:12)
0750 DSALDO3$=BLANK$(1:12)
0760 DSALDO4$=BLANK$(1:12)
0770 ÅRKØB$=BLANK$(1:12)
0780 MDNKØB$=BLANK$(1:12)
0790 DEBKGR$="0"
0800 DEBPOSTNR=0
0810 DEBLK$="0"
0820 DEBGADE$=BLANK$(1:25)
0830 DEBTLF$=BLANK$(1:9)
0840 HPOST=0
0850 HKUNDE=0
0860 DEBBY$=BLANK$(1:20)
0870 EXEC GEMDPOST
0880 EXEC SLETPOST(DTAB,ADEB,NØGLE3,DPIL3)
0890 ENDPROC 
0900 PROC INDSÆT(TAB2,ANTAL2,NØGL2,PIL4)
0910 IF CEKS=1 THEN 
0920 POSTNR=TAB2(ANTAL2+1,2)
0930 IF NØGL2>TAB2(PIL4,1) AND TAB2(PIL4,1)<>1000000 THEN PIL4=PIL4+1
0940 FOR J=ANTAL2+1 TO PIL4+1 STEP -1
0950 TAB2(J,1)=TAB2(J-1,1)
0960 TAB2(J,2)=TAB2(J-1,2)
0970 NEXT J
0980 TAB2(PIL4,1)=NØGL2
0990 TAB2(PIL4,2)=POSTNR
1000 ANTAL2=ANTAL2+1
1010 ENDIF 
1020 ENDPROC 
1030 PROC SLETPOST(TAB3,ANTAL3,NØGL3,PIL5)
1040 IF CEKS=0 THEN 
1050 POSTNR=TAB3(PIL5,2)
1060 FOR I=PIL5 TO ANTAL3
1070 TAB3(I,1)=TAB3(I+1,1)
1080 TAB3(I,2)=TAB3(I+1,2)
1090 NEXT I
1100 TAB3(ANTAL3,1)=1000000
1110 TAB3(ANTAL3,2)=POSTNR
1120 ANTAL3=ANTAL3-1
1130 ENDIF 
1140 ENDPROC 
1150 PROC HENTDPOST
1160 S=DTAB(DPIL3,2)
1170 GET K3$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
1180 EXEC FEJL(8,2,K3$)
1190 IF DEBNR<>DTAB(DPIL3,1) THEN STOP 
1200 GET K3$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
1210 EXEC FEJL(8,3,K3$)
1220 GET K3$,S+2:DEBGADE$,DEBTLF$,HPOST,HKUNDE
1230 EXEC FEJL(8,4,K3$)
1240 GET K3$,S+3:DEBBY$,ÅRKØB$,MDNKØB$
1250 EXEC FEJL(8,5,K3$)
1260 ENDPROC 
1270 PROC GEMDPOST
1280 S=DTAB(DPIL3,2)
1290 PUT K3$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
1300 EXEC FEJL(9,3,K3$)
1310 PUT K3$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
1320 EXEC FEJL(9,4,K3$)
1330 PUT K3$,S+2:DEBGADE$,DEBTLF$,HPOST,HKUNDE
1340 EXEC FEJL(9,4,K3$)
1350 PUT K3$,S+3:DEBBY$,ÅRKØB$,MDNKØB$
1360 EXEC FEJL(9,5,K3$)
1370 ENDPROC 
1380 PROC DINDTAST(DSTYR,CÆND,DEBNR2)
1390 IF CÆND<>1 THEN 
1400 CLEAR 
1410 CURSOR 21,1
1420 PRINT "Kundeoplysninger"
1430 EXEC OVERSKRIFT
1440 CURSOR 2,3
1450 PRINT "1:Kundenr   :";DEBNR2
1460 ENDIF 
1470 REPEAT 
1480 CASE DSTYR OF 
1490 STOP 
1500 WHEN 2
1510 IF CÆND<>1 THEN 
1520 CURSOR 2,4
1530 PRINT "2:Navn      :"
1540 DSTYR=3
1550 ENDIF 
1560 IF CÆND<>2 THEN 
1570 CURSOR 3,23
1580 PRINT "Navn";BLANK$(1:33);"(max 25 tegn)";BLANK$(1:26)
1590 CURSOR 13,23
1600 INPUT DEBNAVN$
1610 ENDIF 
1620 CURSOR 16,4
1630 PRINT BLANK$(1:25)
1640 CURSOR 16,4
1650 PRINT DEBNAVN$
1660 WHEN 3
1670 IF CÆND<>1 THEN 
1680 CURSOR 2,5
1690 PRINT "3:Gade      :"
1700 DSTYR=4
1710 ENDIF 
1720 IF CÆND<>2 THEN 
1730 CURSOR 3,23
1740 PRINT "Gade";BLANK$(1:33);"(max 25 tegn)";BLANK$(1:26)
1750 CURSOR 13,23
1760 INPUT DEBGADE$
1770 ENDIF 
1780 CURSOR 16,5
1790 PRINT BLANK$(1:25)
1800 CURSOR 16,5
1810 PRINT DEBGADE$
1820 WHEN 4
1830 IF CÆND<>1 THEN 
1840 CURSOR 2,6
1850 PRINT "4:Postnr    :"
1860 DSTYR=5
1870 ENDIF 
1880 IF CÆND<>2 THEN 
1890 REPEAT 
1900 CURSOR 3,23
1910 PRINT "Postnr";BLANK$(1:12);"(max 6 tegn)";BLANK$(1:45)
1920 CURSOR 13,23
1930 INPUT PNR$
1940 EXEC NRTEST(PNR$)
1950 UNTIL ((L>3 AND L<7) OR (P=-1 AND CÆND=1)) AND TEST2=0
1960 IF P<>-1 THEN DEBPOSTNR=P
1970 ENDIF 
1980 CURSOR 16,6
1990 PRINT BLANK$(1:6)
2000 CURSOR 16,6
2010 PRINT DEBPOSTNR
2020 WHEN 5
2030 IF CÆND<>1 THEN 
2040 CURSOR 2,7
2050 PRINT "5:By        :"
2060 DSTYR=6
2070 ENDIF 
2080 IF CÆND<>2 THEN 
2090 CURSOR 3,23
2100 PRINT "By";BLANK$(1:30);"(max 20 tegn)";BLANK$(1:31)
2110 CURSOR 13,23
2120 INPUT DEBBY$
2130 ENDIF 
2140 CURSOR 16,7
2150 PRINT BLANK$(1:20)
2160 CURSOR 16,7
2170 PRINT DEBBY$
2180 WHEN 6
2190 IF CÆND<>1 THEN 
2200 CURSOR 2,8
2210 PRINT "6:Landekode :     Land:"
2220 DSTYR=7
2230 ENDIF 
2240 IF CÆND<>2 THEN 
2250 REPEAT 
2260 CURSOR 3,23
2270 PRINT "Landekode";BLANK$(1:9);"0:for Danmark,max 2 cifre)";BLANK$(1:30)
2280 CURSOR 13,23
2290 INPUT LK$
2300 EXEC NRTEST(LK$)
2310 UNTIL (P>-1 AND P<10 AND TEST2=0) OR (P=-1 AND CÆND=1)
2320 ENDIF 
2330 CURSOR 16,8
2340 PRINT BLANK$(1:3)
2350 CURSOR 27,8
2360 PRINT BLANK$(1:15)
2370 CURSOR 16,8
2380 IF P<10 AND CÆND<>2 THEN 
2390 DEBLK$=CHR(P+48)
2400 ENDIF 
2410 P=ORD(DEBLK$)-48
2420 PRINT USING "###":P
2430 CURSOR 27,8
2440 IF P=0 THEN 
2450 PRINT "Danmark"
2460 ELSE 
2470 PRINT LAND$(P)
2480 ENDIF 
2490 WHEN 7
2500 IF CÆND<>1 THEN 
2510 CURSOR 2,9
2520 PRINT "7:Telefon   :"
2530 DSTYR=8
2540 ENDIF 
2550 IF CÆND<>2 THEN 
2560 CURSOR 3,23
2570 PRINT "Telefon";BLANK$(1:14);"(max 9 tegn)";BLANK$(1:44)
2580 CURSOR 13,23
2590 INPUT DEBTLF$
2600 ENDIF 
2610 CURSOR 16,9
2620 PRINT BLANK$(1:9)
2630 CURSOR 16,9
2640 PRINT DEBTLF$
2650 WHEN 8
2660 IF CÆND<>1 THEN 
2670 CURSOR 2,10
2680 PRINT "8:Kundegr   :"
2690 DSTYR=9
2700 ELSE 
2710 IF TYPE=2 THEN 
2720 EXEC KSØG(DEBNR2,ORD(DEBKGR$)-48)
2730 EXEC KINDSLET(0)
2740 ENDIF 
2750 ENDIF 
2760 IF CÆND<>2 THEN 
2770 REPEAT 
2780 CURSOR 3,23
2790 PRINT "Kundegr        (max 2 cifre)";BLANK$(1:49)
2800 CURSOR 13,23
2810 INPUT KG$
2820 EXEC NRTEST(KG$)
2830 UNTIL (P>0 AND TEST2=0 AND P<=MKGR) OR (P=-1 AND CÆND=1)
2840 ENDIF 
2850 CURSOR 16,10
2860 IF P>0 AND CÆND<>2 THEN 
2870 DEBKGR$=CHR(P+48)
2880 ENDIF 
2890 PRINT USING "###":INT(ORD(DEBKGR$)-48)
2900 IF CÆND=1 AND TYPE=2 THEN 
2910 EXEC KSØG(DEBNR2,ORD(DEBKGR$)-48)
2920 EXEC KINDSLET(1)
2930 ENDIF 
2940 ENDCASE 
2950 IF CÆND=1 THEN 
2960 DSTYR=9
2970 ENDIF 
2980 UNTIL DSTYR=9
2990 IF CÆND<>1 THEN 
3000 EXEC CALC(0,DSALDO1$,DSALDO2$,DSALDI$)
3010 EXEC CALC(0,DSALDI$,DSALDO3$,DSALDI$)
3020 EXEC CALC(0,DSALDI$,DSALDO4$,DSALDI$)
3030 CURSOR 4,12
3040 PRINT "Saldo      :"
3050 CURSOR 17,12
3060 EXEC TUD(DSALDI$,TAL4$,1,0)
3070 PRINT TAL4$
3080 CURSOR 4,14
3090 PRINT " 0-30 Dage :"
3100 CURSOR 17,14
3110 EXEC TUD(DSALDO1$,TAL4$,1,0)
3120 PRINT TAL4$
3130 CURSOR 4,16
3140 PRINT "30-60 Dage :"
3150 CURSOR 17,16
3160 EXEC TUD(DSALDO2$,TAL4$,1,0)
3170 PRINT TAL4$
3180 CURSOR 4,18
3190 PRINT "60-90 Dage :"
3200 CURSOR 17,18
3210 EXEC TUD(DSALDO3$,TAL4$,1,0)
3220 PRINT TAL4$
3230 CURSOR 4,20
3240 PRINT "Ældre      :"
3250 CURSOR 17,20
3260 EXEC TUD(DSALDO4$,TAL4$,1,0)
3270 PRINT TAL4$
3280 CURSOR 44,12
3290 PRINT "Månedens køb :"
3300 CURSOR 59,12
3310 EXEC TUD(MDNKØB$,TAL4$,1,0)
3320 PRINT TAL4$
3330 CURSOR 44,14
3340 PRINT "Årets køb    :"
3350 CURSOR 59,14
3360 TÅRKØB$=ÅRKØB$
3370 EXEC TUD(TÅRKØB$,TAL4$,1,0)
3380 PRINT TAL4$
3390 ENDIF 
3400 ENDPROC 
3410 PROC TUD(BLB1,UBLB1,TEGN,STØR)
3420 BLB2$=BLB1$;UBLB2$=UBLB1$
3430 EXEC CALC(5,BLB2$,TAH$,UBLB2$)
3440 UBLB1$=UBLB2$
3450 IF TEGN=0 THEN 
3460 UBLB1$=UBLB1$(1:13)
3470 ELSE 
3480 IF TEGN=1 AND UBLB1$(LEN(UBLB1$))="+" THEN 
3490 UBLB1$(LEN(UBLB1$))=" "
3500 ENDIF 
3510 ENDIF 
3520 IF STØR=1 THEN 
3530 UBLB1$=UBLB1$(4:LEN(UBLB1$)-3)
3540 ENDIF 
3550 ENDPROC 
3560 PROC KINDSLET(AR1)
3570 IF FUN+AR1=0 THEN 
3580 IF SPIL1=0 THEN 
3590 KARRAY(ORD(DEBKGR$)-48)=HKUNDE
3600 ELSE 
3610 HKUNDE1=HKUNDE
3620 ENDIF 
3630 ELSE 
3640 IF FUN+AR1=2 THEN 
3650 HKUNDE=SPIL2
3660 IF SPIL1=0 THEN 
3670 KARRAY(ORD(DEBKGR$)-48)=DEBNR
3680 ELSE 
3690 HKUNDE1=DEBNR
3700 ENDIF 
3710 ELSE 
3720 STOP 
3730 ENDIF 
3740 ENDIF 
3750 IF (FUN+AR1=0 OR FUN+AR1=2) AND SPIL1<>0 THEN 
3760 PUT K3$,DTAB(DPIL3,2)+2:DEBGADE1$,DEBTLF1$,HPOST1,HKUNDE1
3770 EXEC FEJL(11,2,K3$)
3780 ENDIF 
3790 ENDPROC 
3800 PROC KSØG(NØGLE,KGR)
3810 FUN=1;SPIL1=0;SPIL2=KARRAY(KGR)
3820 IF SPIL2<NØGLE AND SPIL2>0 THEN 
3830 REPEAT 
3840 SPIL1=SPIL2
3850 EXEC FINDPOST(DTAB,MDANTAL,SPIL1,DPIL3)
3860 IF CEKS=1 THEN STOP 
3870 GET K3$,DTAB(DPIL3,2)+2:DEBGADE1$,DEBTLF1$,HPOST1,HKUNDE1
3880 EXEC FEJL(10,2,K3$)
3890 SPIL2=HKUNDE1
3900 UNTIL SPIL2=>NØGLE OR SPIL2=0
3910 ENDIF 
3920 IF SPIL2=NØGLE THEN FUN=0
3930 ENDPROC 
3940 PROC KPUT
3950 OPEN K4$,W
3960 EXEC FEJL(12,1,K4$)
3970 FOR I=1 TO MKGR DIV 5
3980 J=(I-1)*5+1
3990 PUT K4$,I:KARRAY(J),KARRAY(J+1),KARRAY(J+2),KARRAY(J+3),KARRAY(J+4)
4000 EXEC FEJL(12,2,K4$)
4010 NEXT I
4020 CLOSE K4$
4030 EXEC FEJL(12,3,K4$)
4040 ENDPROC 
4050 PROC NRTEST(NUM1)
4060 P=0;TEST2=0;KTAL=0;L=LEN(NUM1$)
4070 CASE L OF 
4080 FOR I=1 TO L
4090 P1=INT(ORD(NUM1$(I))-48)
4100 IF P1=>0 AND P1<=9 THEN 
4110 P=P*10+P1
4120 ELSE 
4130 TEST2=1
4140 ENDIF 
4150 NEXT I
4160 KTAL=P DIV 10000
4170 WHEN 0
4180 P=-1
4190 WHEN 1
4200 CASE NUM1$ OF 
4210 P=INT(ORD(NUM1$)-48)
4220 WHEN "J","j"
4230 P=-7
4240 WHEN "N","n"
4250 P=-8
4260 ENDCASE 
4270 ENDCASE 
4280 ENDPROC 
4290 PROC OVERSKRIFT
4300 CURSOR 45,1
4310 CASE TYPE OF 
4320 WHEN 1
4330 PRINT "Oprettelse"
4340 WHEN 2
4350 PRINT "Ændring"
4360 WHEN 3
4370 PRINT "Sletning"
4380 WHEN 4
4390 PRINT "Udskrift"
4400 WHEN 5
4410 PRINT "Kundekontoliste"
4420 ENDCASE 
4430 ENDPROC 
4440 K1$="P641220:SYSTEM1"
4450 OPEN K1$,R
4460 EXEC FEJL(9,1,K1$)
4470 GET K1$,1:MFANTAL,MDANTAL
4480 EXEC FEJL(9,2,K1$)
4490 GET K1$,4:MKRMID,MFAK,MVGR,MKGR
4500 EXEC FEJL(9,3,K1$)
4510 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
4520 EXEC FEJL(9,4,K1$)
4530 GET K1$,10:N$
4540 EXEC FEJL(9,5,K1$)
4550 GET K1$,12:K2$
4560 EXEC FEJL(9,6,K1$)
4570 GET K1$,16:K3$
4580 EXEC FEJL(9,7,K1$)
4590 GET K1$,35:K4$
4600 EXEC FEJL(9,8,K1$)
4610 GET K1$,36:K5$
4620 EXEC FEJL(9,9,K1$)
4630 CLOSE K1$
4640 EXEC FEJL(9,10,K1$)
4650 DIM DTAB(MDANTAL,2),KARRAY(MKGR)
4660 K5$=N$+K5$
4670 OPEN K5$,W
4680 EXEC FEJL(9,11,K5$)
4690 GET K5$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),DATO
4700 EXEC FEJL(9,12,K5$)
4710 FOR I=1 TO 3
4720 J=(I-1)*3+1
4730 GET K5$,I+2:LAND$(J),LAND$(J+1),LAND$(J+2)
4740 EXEC FEJL(9,13,K5$)
4750 NEXT I
4760 GET K5$,14:AFIN,ADEB,AKRE,VTAB2(1),VTAB2(2),VTAB2(3),VTAB2(4),VTAB2(5)
4770 EXEC FEJL(9,14,K5$)
4780 GET K5$,17:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
4790 EXEC FEJL(9,15,K5$)
4800 T2(3)=1
4810 PUT K5$,17:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
4820 EXEC FEJL(9,16,K5$)
4830 CLOSE K5$
4840 EXEC FEJL(9,17,K5$)
4850 K3$=N$+K3$
4860 OPEN K3$,W
4870 EXEC FEJL(9,18,K3$)
4880 K2$=N$+K2$
4890 OPEN K2$,W
4900 EXEC FEJL(9,19,K2$)
4910 EXEC INDTAB(DTAB,MDANTAL,K2$)
4920 K4$=N$+K4$
4930 OPEN K4$,R
4940 EXEC FEJL(9,10,K4$)
4950 FOR I=1 TO MKGR DIV 5
4960 J=(I-1)*5+1
4970 GET K4$,I:KARRAY(J),KARRAY(J+1),KARRAY(J+2),KARRAY(J+3),KARRAY(J+4)
4980 EXEC FEJL(9,11,K4$)
4990 NEXT I
5000 CLOSE K4$
5010 EXEC FEJL(9,12,K4$)
5020 BLANK$="                                      ";BLANK$=BLANK$+BLANK$+" "
5030 TAH$="0+";TAL4$="0+"
5040 STREG$="-----------------------------------";STREG$=STREG$+STREG$
5050 REPEAT 
5060 CLEAR 
5070 CURSOR 21,1
5080 PRINT "Kundevedligeholdelse"
5090 CURSOR 2,3
5100 PRINT "0:Færdig"
5110 CURSOR 2,5
5120 PRINT "1:Oprettelse"
5130 CURSOR 2,7
5140 PRINT "2:Ændring"
5150 CURSOR 2,9
5160 PRINT "3:Sletning"
5170 CURSOR 2,11
5180 PRINT "4:Udskrift"
5190 CURSOR 2,13
5200 PRINT "5:Kundekontoliste"
5210 REPEAT 
5220 CURSOR 4,15
5230 PRINT "Vælg type     (0-5)"
5240 CURSOR 14,15
5250 INPUT TY$
5260 EXEC NRTEST(TY$)
5270 UNTIL P>-1 AND P<6
5280 TYPE=P
5290 IF TYPE=0 THEN EXIT 
5300 REPEAT 
5310 EXEC OVERSKRIFT
5320 TEST=0;KONT=1
5330 IF TYPE<5 THEN 
5340 REPEAT 
5350 REPEAT 
5360 CURSOR 3,23
5370 PRINT "Indtast nyt kundenr        (0:for færdig)";BLANK$(1:35)
5380 CURSOR 22,23
5390 INPUT KTN$
5400 EXEC NRTEST(KTN$)
5410 UNTIL (TEST2=0 AND KTAL=DTAL AND DTAL*10000+MKGR<P) OR P=0
5420 KONT=P
5430 IF KONT=0 THEN EXIT 
5440 EXEC FINDPOST(DTAB,MDANTAL,P,DPIL3)
5450 REPEAT 
5460 CURSOR 44,23
5470 IF (CEKS=0 AND TYPE<>1) OR (CEKS=1 AND TYPE=1 AND ADEB<MDANTAL) THEN 
5480 PRINT BLANK$(1:35)
5490 P=-1
5500 ELSE 
5510 IF CEKS=1 AND TYPE=1 AND ADEB=>MDANTAL THEN 
5520 CURSOR 3,23
5530 INPUT "Ikke plads til flere kunder,tast RETURN                      ",A$
5540 ELSE 
5550 IF CEKS=0 THEN 
5560 INPUT "Kunde eksisterer , tast RETURN     ",A$
5570 ELSE 
5580 INPUT "Kunde eksisterer ikke , tast RETURN",A$
5590 ENDIF 
5600 ENDIF 
5610 EXEC NRTEST(A$)
5620 ENDIF 
5630 UNTIL P=-1
5640 UNTIL (CEKS=0 AND TYPE<>1) OR (CEKS=1 AND TYPE=1 AND ADEB<MDANTAL)
5650 IF KONT=0 THEN EXIT 
5660 IF TYPE<>1 THEN 
5670 FNR=KONT
5680 EXEC HENTDPOST
5690 IF TYPE=3 THEN EXEC SALDOTEST
5700 IF TEST<>0 THEN EXIT 
5710 EXEC DINDTAST(2,2,FNR)
5720 ELSE 
5730 DEBNR=KONT
5740 DEBNAVN$=BLANK$(1:25)
5750 DSALDO1$="0+"
5760 DSALDO2$="0+"
5770 DSALDO3$="0+"
5780 DSALDO4$="0+"
5790 MDNKØB$="0+"
5800 ÅRKØB$="0+"
5810 DEBGADE$=BLANK$(1:25)
5820 DEBTLF$=BLANK$(1:9)
5830 HPOST=0
5840 HKUNDE=0
5850 DEBPOSTNR=0
5860 DEBLK$="0"
5870 DEBKGR$="0"
5880 DEBBY$=BLANK$(1:20)
5890 EXEC DINDTAST(2,0,DEBNR)
5900 ENDIF 
5910 ENDIF 
5920 IF KONT=0 THEN EXIT 
5930 IF TEST=0 THEN 
5940 CASE TYPE OF 
5950 STOP 
5960 WHEN 1,2
5970 REPEAT 
5980 REPEAT 
5990 CURSOR 3,23
6000 PRINT "Hvilket felt ønskes ændret       (Indtast feltnr 2-8,";
6010 PRINT "0:for færdig)          "
6020 CURSOR 32,23
6030 INPUT LK$
6040 EXEC NRTEST(LK$)
6050 UNTIL P=0 OR (P>1 AND P<9)
6060 STYR1=P
6070 IF STYR1=0 THEN EXIT 
6080 EXEC DINDTAST(STYR1,1,DEBNR)
6090 UNTIL STYR1=0
6100 IF TYPE=1 THEN 
6110 EXEC KSØG(DEBNR,ORD(DEBKGR$)-48)
6120 EXEC KINDSLET(1)
6130 EXEC FINDPOST(DTAB,MDANTAL,DEBNR,DPIL3)
6140 EXEC INDSÆT(DTAB,ADEB,DEBNR,DPIL3)
6150 EXEC GEMDPOST
6160 ELSE 
6170 EXEC FINDPOST(DTAB,MDANTAL,DEBNR,DPIL3)
6180 EXEC GEMDPOST
6190 ENDIF 
6200 WHEN 3
6210 REPEAT 
6220 CURSOR 3,23
6230 PRINT "Er det rigtigt at denne konto skal slettes";
6240 PRINT "       (J/N)";BLANK$(1:23)
6250 CURSOR 48,23
6260 INPUT A$
6270 EXEC NRTEST(A$)
6280 UNTIL P=-7 OR P=-8
6290 IF P=-7 THEN 
6300 EXEC KSØG(DEBNR,ORD(DEBKGR$)-48)
6310 EXEC KINDSLET(0)
6320 EXEC SLETDPOST(DEBNR)
6330 ENDIF 
6340 WHEN 4
6350 WHEN 5
6360 REPEAT 
6370 REPEAT 
6380 CURSOR 3,23
6390 PRINT "Fra kundenr        (0: Alle)"
6400 CURSOR 15,23
6410 INPUT KTN$
6420 EXEC NRTEST(KTN$)
6430 UNTIL L=5 AND P>9999 AND TEST2=0 OR P=0
6440 IF P=0 THEN 
6450 FRA=1;TIL=ADEB
6460 ELSE 
6470 KONT=P
6480 EXEC FINDPOST(DTAB,MDANTAL,P,DPIL3)
6490 FRA=DPIL3
6500 ENDIF 
6510 UNTIL FRA<=ADEB
6520 IF P>0 THEN 
6530 REPEAT 
6540 CURSOR 3,23
6550 PRINT "Til kundenr                  "
6560 CURSOR 15,23
6570 INPUT KTN$
6580 EXEC NRTEST(KTN$)
6590 UNTIL L=5 AND P>9999 AND TEST2=0 AND P=>KONT
6600 EXEC FINDPOST(DTAB,MDANTAL,P,DPIL3)
6610 IF CEKS=1 THEN DPIL3=DPIL3-1
6620 TIL=DPIL3
6630 ENDIF 
6640 CLEAR 
6650 REPEAT 
6660 CURSOR 8,13
6670 INPUT "Monter papir til udskrift af kundekontoliste og tast RETURN",A$
6680 UNTIL ORD(A$)=255
6690 OUTPUT P
6700 SIDE=1;DA1=DATO;DAT$="        "
6710 FOR J=8 TO 1 STEP -1
6720 IF J MOD 3=0 THEN 
6730 DAT$(J)="."
6740 ELSE 
6750 DAT$(J)=CHR(DA1 MOD 10+48);DA1=DA1 DIV 10
6760 ENDIF 
6770 NEXT J
6780 FOR I=FRA TO TIL STEP 4
6790 PRINT TAB(10);CHR(14);"Kundekontoliste";CHR(15);TAB(38);"Dato : ";DAT$;
6800 PRINT USING "   Side :####":SIDE
6810 PRINT " "
6820 SIDE=SIDE+1
6830 FOR DPIL3=I TO I+3
6840 IF DTAB(DPIL3,1)>0 THEN 
6850 EXEC HENTDPOST
6860 EXEC TUD(MDNKØB$,UD1$,1,0)
6870 TÅRKØB$=ÅRKØB$
6880 EXEC TUD(TÅRKØB$,UD2$,1,0)
6890 PRINT TAB(9);STREG$
6900 PRINT TAB(9);"NAVN OG ADRESSE";TAB(39);"MÅNEDENS KØB      ÅRETS KØB  H";
6910 PRINT "KUNDE HPOST"
6920 PRINT " "
6930 PRINT USING "######  ":DEBNR;
6940 PRINT DEBNAVN$;TAB(38);UD1$;" ";UD2$;
6950 PRINT USING "###### ######":HKUNDE,HPOST
6960 PRINT TAB(9);DEBGADE$;" "
6970 PRINT USING "       ####### ":DEBPOSTNR;
6980 PRINT DEBBY$;TAB(39);
6990 DLK=ORD(DEBLK$)-48;DKGR=ORD(DEBKGR$)-48
7000 PRINT USING "LANDEKODE:###    KUNDEGRUPPE:###":DLK,DKGR
7010 PRINT " "
7020 PRINT TAB(9);"TLF";TAB(23);"0-30 DAGE     30-60 DAGE     60-90 DAGE";
7030 PRINT "        ÆLDRE"
7040 PRINT " "
7050 EXEC TUD(DSALDO1$,UD1$,1,0)
7060 EXEC TUD(DSALDO2$,UD2$,1,0)
7070 EXEC TUD(DSALDO3$,UD3$,1,0)
7080 EXEC TUD(DSALDO4$,UD4$,1,0)
7090 PRINT TAB(9);DEBTLF$;TAB(19);UD1$;" ";UD2$;" ";UD3$;" ";UD4$
7100 PRINT " "
7110 ENDIF 
7120 IF DPIL3=TIL THEN EXIT 
7130 NEXT DPIL3
7140 PRINT CHR(10)
7150 IF DPIL3=TIL THEN EXIT 
7160 NEXT I
7170 FOR J=DPIL3+1 TO I+3
7180 PRINT CHR(10)
7190 PRINT CHR(10)
7200 PRINT CHR(10)
7210 PRINT CHR(10)
7220 PRINT CHR(10)
7230 PRINT " "
7240 NEXT J
7250 OUTPUT T
7260 KONT=0
7270 ENDCASE 
7280 ELSE 
7290 REPEAT 
7300 CURSOR 3,23
7310 PRINT "Denne konto kan ikke slettes, da saldoen ikke er udlignet,";
7320 PRINT " tryk RETURN      "
7330 INPUT A$
7340 EXEC NRTEST(A$)
7350 UNTIL P=-1
7360 ENDIF 
7370 UNTIL KONT=0
7380 UNTIL TYPE=0
7390 EXEC KPUT
7400 EXEC UDTAB(DTAB,MDANTAL,K2$)
7410 CLOSE K2$
7420 EXEC FEJL(9,20,K2$)
7430 CLOSE K3$
7440 EXEC FEJL(9,21,K3$)
7450 T2(3)=0
7460 OPEN K5$,W
7470 EXEC FEJL(9,22,K5$)
7480 PUT K5$,14:AFIN,ADEB,AKRE,VTAB2(1),VTAB2(2),VTAB2(3),VTAB2(4),VTAB2(5)
7490 EXEC FEJL(9,23,K5$)
7500 PUT K5$,17:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
7510 EXEC FEJL(9,24,K5$)
7520 CLOSE K5$
7530 EXEC FEJL(9,25,K5$)
7540 CHAIN "P641210:OPSTART"
7550 PROC SALDOTEST
7560 EXEC CALC(4,DSALDO1$,TAH$,TAH$)
7570 IF SI=0 THEN 
7580 EXEC CALC(4,DSALDO2$,TAH$,TAH$)
7590 IF SI=0 THEN 
7600 EXEC CALC(4,DSALDO3$,TAH$,TAH$)
7610 IF SI=0 THEN 
7620 EXEC CALC(4,DSALDO4$,TAH$,TAH$)
7630 IF SI<>0 THEN TEST=1
7640 ELSE 
7650 TEST=1
7660 ENDIF 
7670 ELSE 
7680 TEST=1
7690 ENDIF 
7700 ELSE 
7710 TEST=1
7720 ENDIF 
7730 ENDPROC