DataMuseum.dk

top - download

    Length: 16371 (0x3ff3)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »DEBVEDL.B«

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

SPC/1 COMAL-BIN

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