DataMuseum.dk

top - download

    Length: 20224 (0x4f00)
    Types: TextFile
    Notes: Mikados_K
    Names: »DEBVEDL.K«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »DEBVEDL.K« 

Mikados K File

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