DataMuseum.dk

top - download

    Length: 15201 (0x3b61)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »FAKUD.B«

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

SPC/1 COMAL-BIN

0100 DIM OP1$(12),OP2$(12),RES$(15)
0110 DIM K1$(17),N$(6),K2$(17),K3$(17),DEBNAVN$(25),DSALDO1$(12),DEBKGR$(E)
0120 DIM DSALDO2$(12),DSALDO3$(12),DSALDO4$(12),DEBLK$(E),DEBGADE$(25)
0130 DIM DEBTLF$(W),DEBBY$(20),SALDO$(12),KR$(25),T$(13),D$(8)
0140 DIM ÅRKØB$(12),MDNKØB$(12),TEK$(13),GBELØB$(12),MOMSH$(12),T1(W),T2(W)
0150 DIM MOMS$(12),FTOTAL$(12),KOD1$(E),KOD$(E),TAL1$(12),TAL4$(14)
0160 DIM VARTEKST$(50),VARPRIS$(12),BELØB$(12),TOTAL$(12),T3(W),K4$(17)
0170 DIM SVAR1$(E),FAKKRE$(E),LEVTEKST$(52),ANTAL$(12),BLANK$(50),K5$(17)
0180 DIM FORS$(12),PRO$(12),VARTH$(25),K6$(17),KOD3$(E)
0190 DIM TE$(30),TEKO$(E),F$(E),K7$(17),K8$(17)
0200 DIM K9$(17),LAND$(W,12),BLB2$(12),TAH$(12),D1$(25),D2$(25),D3$(20)
0210 BLANK$="                         ";TAH$="0+";BLANK$=BLANK$+BLANK$
0220 TAL1$="0+";TAL4$="0+";TOTAL$="0+"
0230 PROC NRTEST(NUM1)
0240 P=B;TEST2=B;KTAL=B;L=LEN(NUM1$)
0250 IF L>6 THEN EXIT
0260 CASE L OF
0270 FOR J=E TO L
0280 P1=INT(ORD(NUM1$(J))-48)
0290 IF P1<B OR P1>W THEN
0300 TEST2=E
0310 ELSE
0320 P=P*10+P1
0330 ENDIF
0340 NEXT J
0350 KTAL=P DIV 10000
0360 WHEN B
0370 P=-E
0380 WHEN E
0390 CASE NUM1$ OF
0400 P=INT(ORD(NUM1$)-48)
0410 WHEN "d","D"
0420 P=-G
0430 WHEN "a","A"
0440 P=-V
0450 WHEN "m","M"
0460 P=-4
0470 WHEN "j","J"
0480 P=-7
0490 WHEN "n","N"
0500 P=-8
0510 ENDCASE
0520 ENDCASE
0530 ENDPROC
0540 PROC FEJL(NR1,NR2,NR3)
0550 IF STATUS(NR3$)<>B THEN
0560 PRINT STATUS(NR3$),NR1,NR2,NR3$
0570 STOP
0580 ENDIF
0590 ENDPROC
0600 PROC HENTVPOST
0610 S=VTAB(VPIL3,G)
0620 GET K5$,S:VARENR,VARTEKST$,VARPRIS$,VARKONT,UNDKONT
0630 EXEC FEJL(G,E,K5$)
0640 ENDPROC
0650 PROC CALC(AR3,B1,B2,ES)
0660 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0670 CALL "P641210:REGN"
0680 ES$=RES$
0690 IF AR3<6 THEN
0700 IF FLAG THEN STOP
0710 ENDIF
0720 ENDPROC
0730 PROC HENTDPOST
0740 S=DTAB(DPIL3,G)
0750 GET K4$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
0760 EXEC FEJL(V,E,K4$)
0770 GET K4$,S+E:DSALDO2$,DSALDO3$,DSALDO4$,DPOSTNR,DEBLK$
0780 EXEC FEJL(V,G,K4$)
0790 GET K4$,S+G:DEBGADE$,DEBTLF$,HPOST,HKUNDE
0800 EXEC FEJL(V,V,K4$)
0810 GET K4$,S+V:DEBBY$,ÅRKØB$,MDNKØB$
0820 EXEC FEJL(V,4,K4$)
0830 ENDPROC
0840 PROC TUD(BLB1,UBLB1,TEGN,STØR)
0850 BLB2$=BLB1$
0860 EXEC CALC(5,BLB2$,TAH$,UBLB1$)
0870 IF TEGN=B THEN UBLB1$=UBLB1$(E:13)
0880 IF TEGN=E AND UBLB1$(LEN(UBLB1$))="+" THEN UBLB1$(LEN(UBLB1$))=" "
0890 IF STØR=E THEN UBLB1$=UBLB1$(4:LEN(UBLB1$)-V)
0900 PRINT UBLB1$;
0910 ENDPROC
0920 PROC GEMDPOST
0930 S=DTAB(DPIL3,G)
0940 PUT K4$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
0950 EXEC FEJL(4,E,K4$)
0960 PUT K4$,S+E:DSALDO2$,DSALDO3$,DSALDO4$,DPOSTNR,DEBLK$
0970 EXEC FEJL(4,E,K4$)
0980 PUT K4$,S+G:DEBGADE$,DEBTLF$,HPOST,HKUNDE
0990 EXEC FEJL(4,G,K4$)
1000 PUT K4$,S+V:DEBBY$,ÅRKØB$,MDNKØB$
1010 EXEC FEJL(4,V,K4$)
1020 ENDPROC
1030 PROC INDTAB1(Z,MANT5,L7)
1040 PIL1=MANT5 DIV 32
1050 FOR I=E TO PIL1
1060 H=(I-E)*8+E
1070 GET L7$,I:Z(H),Z(H+E),Z(H+G),Z(H+V),Z(H+4),Z(H+5),Z(H+6),Z(H+7)
1080 EXEC FEJL(G,E,L7$)
1090 NEXT I
1100 ENDPROC
1110 PROC SYSGEM
1120 T1(E)=FAKTNR;T1(G)=KREDNR;T2(4)=APOSTER;T2(5)=AKRED;T2(6)=AFAKT
1130 T2(7)=AVKONTI;T2(8)=FJPOST
1140 OPEN K9$,W
1150 EXEC FEJL(8,E,K9$)
1160 PUT K9$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
1170 EXEC FEJL(8,G,K9$)
1180 PUT K9$,12:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
1190 EXEC FEJL(8,V,K9$)
1200 CLOSE K9$
1210 EXEC FEJL(8,4,K9$)
1220 ENDPROC
1230 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
1240 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=E;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
1250 REPEAT
1260 IF NØGL5=TAB4(PIL6) OR PIL1=E THEN EXIT
1270 PIL1=(PIL1+E) DIV G;PIL6=PIL6+PIL1*(E-G*(NØGL5<TAB4(PIL6)))
1280 IF PIL6<E THEN PIL6=E
1290 IF PIL6>MANT3 THEN PIL6=MANT3
1300 UNTIL PIL1=B
1310 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-E*(PIL6>E)
1320 PIL6=MANT4+PIL6
1330 GET L8$,PIL6:Q(E,E),Q(E,G),Q(G,E),Q(G,G),Q(V,E),Q(V,G),Q(4,E),Q(4,G)
1340 EXEC FEJL(E,E,L8$)
1350 FOR PIL6=E TO 4
1360 IF NØGL5=Q(PIL6,E) THEN EXIT
1370 NEXT PIL6
1380 IF PIL6<>5 THEN CEKS=B
1390 ENDPROC
1400 PROC TABHENT
1410 OPEN K8$,R
1420 EXEC FEJL(G,E,K8$)
1430 FOR I=E TO AVKONTI
1440 GET K8$,I:VJOURARR(I),VBJOUARR$(I),VUJOURARR(I)
1450 EXEC FEJL(G,G,K8$)
1460 NEXT I
1470 CLOSE K8$
1480 EXEC FEJL(G,V,K8$)
1490 ENDPROC
1500 PROC TESTPRIN
1510 KR$="XXXXXXXXXXXXXXXXXXXXXXXXX";T$="XX.XXX.XXX,XX";D$="XX.XX.XX"
1520 OUTPUT P
1530 EXEC TOMLINIE(7)
1540 PRINT TAB(67);KR$(E:6)
1550 PRINT TAB(W);KR$
1560 PRINT TAB(W);KR$;TAB(67);KR$(E:6)
1570 PRINT TAB(W);KR$
1580 PRINT TAB(W);KR$;TAB(65);D$
1590 PRINT TAB(W);KR$
1600 PRINT TAB(W);KR$;TAB(67);KR$(E:6)
1610 PRINT " "
1620 PRINT TAB(65);D$
1630 PRINT " "
1640 PRINT TAB(19);KR$;KR$;"XX"
1650 PRINT " "
1655 PRINT " "
1660 PRINT TAB(8);KR$(E:6);TAB(16);KR$(E:5);TAB(24);KR$;TAB(51);T$;TAB(66);T$
1670 EXEC TOMLINIE(19)
1680 PRINT TAB(8);KR$(E:6);TAB(16);KR$(E:5);TAB(24);KR$;TAB(51);T$;TAB(66);T$
1690 EXEC TOMLINIE(3)
1700 PRINT TAB(16);T$(4:10);TAB(29);T$;TAB(44);T$(W:5);TAB(51);T$;TAB(66);T$
1710 EXEC TOMLINIE(6)
1720 OUTPUT T
1730 ENDPROC
1740 K1$="P641220:SYSTEM1"
1750 OPEN K1$,R
1760 EXEC FEJL(W,E,K1$)
1770 GET K1$,E:MFANTAL,MDANTAL,MKANTAL,MVANTAL
1780 EXEC FEJL(W,G,K1$)
1790 GET K1$,4:KMID,MFAK,MVGR,MKGR
1800 EXEC FEJL(W,V,K1$)
1810 GET K1$,6:KASSENR,GIRONR,BANKNR,UDMOMSNR
1820 EXEC FEJL(W,4,K1$)
1830 GET K1$,7:INDMOMSNR,RENTENR,FRAGTNR,RABATNR
1840 EXEC FEJL(W,5,K1$)
1850 GET K1$,8:DIVNR,DIVDNR
1860 EXEC FEJL(W,6,K1$)
1870 GET K1$,10:N$
1880 EXEC FEJL(W,7,K1$)
1890 GET K1$,12:K2$
1900 EXEC FEJL(W,8,K1$)
1910 GET K1$,14:K3$
1920 EXEC FEJL(W,W,K1$)
1930 GET K1$,16:K4$
1940 EXEC FEJL(W,10,K1$)
1950 GET K1$,18:K5$
1960 EXEC FEJL(W,11,K1$)
1970 GET K1$,29:K6$
1980 EXEC FEJL(W,12,K1$)
1990 GET K1$,30:K7$
2000 EXEC FEJL(W,13,K1$)
2010 GET K1$,31:K8$
2020 EXEC FEJL(W,14,K1$)
2030 GET K1$,36:K9$
2040 EXEC FEJL(W,15,K1$)
2050 GET K1$,43:I,I,I,DUNDKONT
2060 EXEC FEJL(W,155,K1$)
2070 CLOSE K1$
2080 EXEC FEJL(W,16,K1$)
2090 DIM VTAB1(MVANTAL DIV 4),DTAB1(MDANTAL DIV 4),VTAB(4,G),DTAB(4,G)
2100 DIM VJOURARR(MVGR*5),VUJOURARR(MVGR*5),VBJOUARR$(MVGR*5,12)
2110 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$
2120 K5$=N$+K5$;K6$=N$+K6$;K7$=N$+K7$;K8$=N$+K8$;K9$=N$+K9$
2130 OPEN K9$,R
2140 EXEC FEJL(W,17,K9$)
2150 GET K9$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
2160 EXEC FEJL(W,18,K9$)
2170 FOR I=E TO V
2180 H=(I-E)*V+E
2190 GET K9$,I+G:LAND$(H),LAND$(H+E),LAND$(H+G)
2200 EXEC FEJL(W,19,K9$)
2210 NEXT I
2220 GET K9$,12:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W)
2230 EXEC FEJL(W,20,K9$)
2240 GET K9$,13:T3(E),T3(G),T3(V),T3(4),T3(5),T3(6),T3(7),T3(8),T3(W)
2250 EXEC FEJL(W,21,K9$)
2260 CLOSE K9$
2270 EXEC FEJL(W,22,K9$)
2280 FAKTNR=T1(E);KREDNR=T1(G);DATO=T1(7);APOSTER=T2(4);AKRED=T2(5)
2290 AFAKT=T2(6);AVKONTI=T2(7);FJPOST=T2(8)
2300 OPEN K2$,R
2310 EXEC FEJL(W,23,K2$)
2320 OPEN K3$,R
2330 EXEC FEJL(W,24,K3$)
2340 OPEN K4$,W
2350 EXEC FEJL(W,25,K4$)
2360 OPEN K5$,R
2370 EXEC FEJL(W,26,K5$)
2380 EXEC INDTAB1(DTAB1,MDANTAL,K2$)
2390 EXEC INDTAB1(VTAB1,MVANTAL,K3$)
2400 EXEC TABHENT
2410 CLEAR
2420 CURSOR 20,W
2430 PRINT "Udskrivning af fakturaer."
2440 CURSOR 20,11
2450 PRINT "0: Færdig."
2460 CURSOR 20,13
2470 PRINT "1: Udskrift af sidst indtastede faktura."
2480 CURSOR 20,15
2490 PRINT "2: Udskrift af alle indtastede fakturaer."
2500 REPEAT
2510 CURSOR 20,17
2520 INPUT "Vælg 0-2:",SVAR1$
2530 UNTIL SVAR1$="1" OR SVAR1$="2" OR SVAR1$="0"
2540 IF SVAR1$<>"0" THEN
2550 IF SVAR1$="2" THEN
2560 LYNFAK=B;STPOST=E
2570 ELSE
2580 LYNFAK=E
2590 OPEN K6$,R
2600 EXEC FEJL(V,E,K6$)
2610 FOR I=APOSTER-V TO E STEP -E
2620 GET K6$,I:ORDRENR,FDATO,ANPOST
2630 EXEC FEJL(V,G,K6$)
2640 IF ANPOST=APOSTER+G-I THEN EXIT
2650 NEXT I
2660 STPOST=I-E
2670 CLOSE K6$
2680 EXEC FEJL(V,V,K6$)
2690 ENDIF
2700 GEN=B
2710 REPEAT
2720 CLEAR
2730 CURSOR 20,W
2740 PRINT "Udskrivning af fakturaer."
2750 CURSOR 20,11
2760 PRINT "Monter papir til udskrift af testprint."
2770 CURSOR 20,13
2780 INPUT "Tast RETURN.",SVAR1$
2790 EXEC TESTPRIN
2800 REPEAT
2810 REPEAT
2820 CURSOR 20,13
2830 INPUT "Ønskes flere testprint (J/N):",SVAR1$
2840 UNTIL SVAR1$="J" OR SVAR1$="N" OR SVAR1$="j" OR SVAR1$="n"
2850 IF SVAR1$="J" OR SVAR1$="j" THEN EXEC TESTPRIN
2860 UNTIL SVAR1$="N" OR SVAR1$="n"
2870 TE$="Der udskrives fakturaer."
2880 EXEC BIL
2890 OUTPUT P
2900 IF APOSTER=B THEN EXIT
2910 OPEN K6$,R
2920 EXEC FEJL(V,4,K6$)
2930 I=STPOST
2940 REPEAT
2950 TOTAL$="0+"
2960 GET K6$,I:KUNDENR,ORDRED,FAKKRE$,DIVD
2970 EXEC FEJL(V,5,K6$)
2980 I=I+E
2990 GET K6$,I:ORDRENR,FDATO,ANPOST,KOD$
3000 EXEC FEJL(V,6,K6$)
3010 I=I+E
3020 EXEC FINDPOST1(DTAB1,DTAB,MDANTAL,KUNDENR,DPIL3,K2$)
3030 IF CEKS=B THEN EXEC HENTDPOST
3040 IF DIVD=E THEN
3050 D1$=DEBNAVN$;D2$=DEBGADE$;D3$=DEBBY$;D4=DPOSTNR
3060 DEBNAVN$=BLANK$;DEBGADE$=BLANK$;DEBBY$=BLANK$
3070 GET K6$,I:DEBNAVN$(E:13)
3080 EXEC FEJL(V,7,K6$)
3090 GET K6$,I+E:DEBNAVN$(14:12)
3100 EXEC FEJL(V,8,K6$)
3110 GET K6$,I+G:DEBGADE$(E:13)
3120 EXEC FEJL(V,W,K6$)
3130 GET K6$,I+V:DEBGADE$(14:12)
3140 EXEC FEJL(V,10,K6$)
3150 GET K6$,I+4:DPOSTNR,DEBBY$(E:W)
3160 EXEC FEJL(V,11,K6$)
3170 GET K6$,I+5:DEBBY$(10:11)
3180 EXEC FEJL(V,12,K6$)
3190 I=I+6;ANPOST=ANPOST-6
3200 ENDIF
3210 SIDE=E;LINIE=E;POSTER=B
3220 REPEAT
3230 EXEC TOMLINIE(6)
3240 IF FAKKRE$="F" THEN
3250 PRINT " "
3260 ELSE
3270 PRINT TAB(49);"Kreditnota"
3280 ENDIF
3290 PRINT TAB(66);
3300 IF FAKKRE$="F" THEN
3310 PRINT USING "#######":FAKTNR
3320 ELSE
3330 PRINT USING "#######":KREDNR
3340 ENDIF
3350 PRINT TAB(W);DEBNAVN$
3360 PRINT TAB(W);DEBGADE$;TAB(66);
3370 PRINT USING "#######":KUNDENR
3380 PRINT TAB(6);
3390 PRINT USING "#######":DPOSTNR;
3400 PRINT TAB(14);DEBBY$
3410 EXEC DATOUD(ORDRED)
3420 PRINT " "
3430 PRINT TAB(66);
3440 PRINT USING "#######":ORDRENR
3450 PRINT " "
3460 EXEC DATOUD(FDATO)
3470 PRINT " "
3480 IF KOD$>"H" AND SIDE=E THEN
3490 KOD$=CHR(ORD(KOD$)-11)
3500 PRINT " "
3510 ELSE
3520 IF SIDE=E THEN
3530 LEVTEKST$=BLANK$+BLANK$+"  "
3540 FOR J=I TO I+V
3550 GET K6$,J:LEVTEKST$((J-I)*13+E:13)
3560 EXEC FEJL(V,13,K6$)
3570 NEXT J
3580 ANPOST=ANPOST-4;I=I+4
3590 ENDIF
3600 PRINT TAB(W);LEVTEKST$
3610 ENDIF
3620 EXEC TOMLINIE(2)
3630 IF SIDE=G THEN
3640 PRINT TAB(24);"Subtotal";TAB(66);
3650 EXEC TUD(TOTAL$,TAL4$,E,B)
3660 LINIE=G
3670 ENDIF
3680 REPEAT
3690 CASE KOD$ OF
3700 STOP
3710 WHEN "A"
3720 EXEC VPOST
3730 EXEC FINDPOST1(VTAB1,VTAB,MVANTAL,VARENR,VPIL3,K3$)
3740 IF CEKS=E THEN STOP
3750 EXEC HENTVPOST
3760 EXEC VUD
3770 WHEN "B"
3780 EXEC BPOST(1)
3790 PRO$="     0,"+VARPRIS$(7:G)+VARPRIS$(10:G)+"-"
3800 IF VARPRIS$(7)=" " THEN PRO$(8)="0"
3810 EXEC CALC(G,PRO$,GBELØB$,BELØB$)
3820 EXEC CALC(B,TOTAL$,BELØB$,TOTAL$)
3830 PRINT TAB(24);VARPRIS$(E:11);" %";TAB(66);
3840 EXEC TUD(BELØB$,TAL4$,E,B)
3850 VARKONT=RABATNR;ENTNR=(ORDRENR DIV 100)*100+DUNDKONT
3860 IF GEN=B THEN EXEC VJOURNAL
3870 WHEN "C"
3880 EXEC BPOST(0)
3890 PRINT TAB(24);"Subtotal";TAB(66);
3900 EXEC TUD(BELØB$,TAL4$,E,B)
3910 GBELØB$=BELØB$
3920 WHEN "D"
3930 EXEC TPOST
3940 PRINT TAB(16);VARTEKST$
3950 WHEN "E"
3960 EXEC TPOST
3970 EXEC BPOST(0)
3980 PRINT TAB(24);VARTEKST$;TAB(66);
3990 EXEC TUD(BELØB$,TAL4$,E,B)
4000 EXEC CALC(B,TOTAL$,BELØB$,TOTAL$)
4010 GBELØB$=BELØB$;VARKONT=DIVNR;ENTNR=(ORDRENR DIV 100)*100+DUNDKONT
4020 IF GEN=B THEN EXEC VJOURNAL
4030 WHEN "F"
4040 EXEC VPOST
4050 EXEC FINDPOST1(VTAB1,VTAB,MVANTAL,VARENR,VPIL3,K3$)
4060 IF CEKS=E THEN STOP
4070 EXEC HENTVPOST
4080 EXEC BPOST(1)
4090 EXEC VUD
4100 WHEN "G"
4110 EXEC TPOST
4120 VARTH$=VARTEKST$
4130 EXEC VPOST
4140 EXEC FINDPOST1(VTAB1,VTAB,MVANTAL,VARENR,VPIL3,K3$)
4150 IF CEKS=E THEN STOP
4160 EXEC HENTVPOST
4170 VARTEKST$=VARTH$
4180 EXEC VUD
4190 WHEN "H"
4200 EXEC TPOST
4210 VARTH$=VARTEKST$
4220 EXEC VPOST
4230 EXEC FINDPOST1(VTAB1,VTAB,MVANTAL,VARENR,VPIL3,K3$)
4240 IF CEKS=E THEN STOP
4250 EXEC HENTVPOST
4260 VARTEKST$=VARTH$
4270 EXEC BPOST(1)
4280 EXEC VUD
4290 ENDCASE
4300 LINIE=LINIE+E
4310 UNTIL POSTER=>ANPOST-5 OR LINIE=22
4320 IF LINIE=22 AND POSTER<ANPOST-5 THEN
4330 SIDE=G;ANPOST=ANPOST-POSTER;POSTER=B;LINIE=E
4340 PRINT TAB(24);"Subtotal";TAB(66);
4350 EXEC TUD(TOTAL$,TAL4$,E,B)
4360 EXEC TOMLINIE(9)
4370 ENDIF
4380 UNTIL POSTER=>ANPOST-5
4390 EXEC BPOST(0)
4400 FORS$=BELØB$;VARKONT=FRAGTNR;ENTNR=1000000
4410 EXEC VJOURNAL
4420 EXEC BPOST(0)
4430 MOMSH$=BELØB$
4440 EXEC BPOST(0)
4450 FTOTAL$=BELØB$
4460 EXEC TOMLINIE(25-LINIE)
4470 EXEC CALC(B,FORS$,TOTAL$,TOTAL$)
4480 EXEC CALC(5,FORS$,FORS$,TAL4$)
4490 PRINT TAB(16);TAL4$(4:10);TAB(29);
4500 EXEC TUD(TOTAL$,TAL4$,E,B)
4510 PRINT TAB(44);MOMSH$(7:5);TAB(51);
4520 EXEC CALC(E,FTOTAL$,TOTAL$,BELØB$)
4530 EXEC TUD(BELØB$,TAL4$,E,B)
4540 VARKONT=UDMOMSNR;ENTNR=1000000
4550 EXEC VJOURNAL
4560 PRINT TAB(66);
4570 EXEC TUD(FTOTAL$,TAL4$,E,B)
4580 PRINT " "
4590 EXEC TOMLINIE(5)
4600 IF GEN=B THEN
4610 OPEN K7$,W
4620 EXEC FEJL(4,E,K7$)
4630 FJPOST=FJPOST+E
4640 IF FAKKRE$="K" THEN
4650 FTOTAL$(12)="-";VARENR=KREDNR;AKRED=AKRED-E
4660 ELSE
4670 VARENR=FAKTNR;AFAKT=AFAKT-E
4680 ENDIF
4690 PUT K7$,FJPOST:KUNDENR,FTOTAL$,VARENR,FDATO,ORDRENR
4700 EXEC FEJL(4,G,K7$)
4710 BELØB$=ÅRKØB$
4720 CLOSE K7$
4730 EXEC FEJL(4,V,K7$)
4740 EXEC CALC(E,TOTAL$,FORS$,TOTAL$)
4750 IF FAKKRE$="K" THEN TOTAL$(12)="-"
4760 EXEC CALC(B,MDNKØB$,TOTAL$,MDNKØB$)
4770 EXEC CALC(B,BELØB$,TOTAL$,BELØB$)
4780 ÅRKØB$=BELØB$
4790 IF DIVD=E THEN DEBNAVN$=D1$;DEBGADE$=D2$;DEBBY$=D3$;DPOSTNR=D4
4800 EXEC GEMDPOST
4810 ENDIF
4820 IF FAKKRE$="K" THEN
4830 KREDNR=KREDNR+E
4840 ELSE
4850 FAKTNR=FAKTNR+E
4860 ENDIF
4870 UNTIL I=>APOSTER
4880 OUTPUT T
4890 CLOSE K6$
4900 REPEAT
4910 CLEAR
4920 CURSOR 20,10
4930 INPUT "Ønskes ny udskrift (J/N):",SVAR1$
4940 UNTIL SVAR1$="J" OR SVAR1$="N" OR SVAR1$="j" OR SVAR1$="n"
4950 IF SVAR1$="J" OR SVAR1$="j" THEN
4960 OPEN K9$,R
4970 EXEC FEJL(6,E,K9$)
4980 GET K9$,G:FAKTNR,KREDNR
4990 EXEC FEJL(6,G,K9$)
5000 CLOSE K9$
5010 EXEC FEJL(6,V,K9$)
5020 GEN=E
5030 ENDIF
5040 UNTIL SVAR1$="N" OR SVAR1$="n"
5050 APOSTER=STPOST-E
5060 ENDIF
5070 PROC DATOUD(DA)
5080 PRINT TAB(67);
5090 PRINT USING "###.##":(DA MOD 10000)/100;
5100 PRINT TAB(64);
5110 PRINT USING "###.#":(DA DIV 1000)/10
5120 ENDPROC
5130 PROC VPOST
5140 ANTAL$="           +"
5150 GET K6$,I:VARENR,ANTAL$(5:7),KOD$
5160 EXEC FEJL(5,E,K6$)
5170 POSTER=POSTER+E;I=I+E
5180 ENDPROC
5190 PROC BPOST(SL)
5200 GET K6$,I:TEK$
5210 EXEC FEJL(6,E,K6$)
5220 POSTER=POSTER+E;I=I+E
5230 IF SL=B THEN
5240 BELØB$=TEK$
5250 ELSE
5260 VARPRIS$=TEK$
5270 ENDIF
5280 KOD$=TEK$(13)
5290 ENDPROC
5300 PROC TPOST
5305 KOD3$=KOD$
5310 VARTEKST$=BLANK$
5320 GET K6$,I:VARTEKST$(E:13)
5340 EXEC FEJL(7,E,K6$)
5350 I=I+E
5360 GET K6$,I:TEK$
5380 EXEC FEJL(7,G,K6$)
5390 LE=LEN(TEK$)
5400 IF LE>E THEN
5410 VARTEKST$(14:LE-E)=TEK$
5420 ENDIF
5430 KOD$=TEK$(LE);I=I+E;POSTER=POSTER+G
5440 IF KOD3$="D" AND LE=13 THEN
5450 GET K6$,I:VARTEKST$(26:13)
5460 EXEC FEJL(99,V,K6$)
5470 I=I+G;POSTER=POSTER+G
5480 GET K6$,I-E:VARTEKST$(39:12)
5490 EXEC FEJL(99,4,K6$)
5500 ENDIF
5510 ENDPROC
5520 PROC VUD
5530 PRINT TAB(7);
5540 PRINT USING "#######":VARENR;
5550 PRINT TAB(16);ANTAL$(5:4+V*(ANTAL$(10:G)<>"00"));TAB(24);
5560 PRINT VARTEKST$(E:25);TAB(51);
5570 EXEC TUD(VARPRIS$,TAL4$,E,B)
5580 PRINT TAB(66);
5590 EXEC CALC(G,VARPRIS$,ANTAL$,BELØB$)
5600 EXEC TUD(BELØB$,TAL4$,E,B)
5610 GBELØB$=BELØB$;ENTNR=(ORDRENR DIV 100)*100+DUNDKONT
5620 EXEC CALC(B,TOTAL$,BELØB$,TOTAL$)
5630 IF GEN=B THEN EXEC VJOURNAL
5640 ENDPROC
5650 PROC VJOURNAL
5660 IF GEN=B THEN
5670 EJFUNDET=B
5680 FOR M=E TO AVKONTI
5690 IF VJOURARR(M)=VARKONT AND VUJOURARR(M)=ENTNR THEN
5700 IF FAKKRE$="F" THEN
5710 EXEC CALC(E,VBJOUARR$(M),BELØB$,VBJOUARR$(M))
5720 ELSE
5730 EXEC CALC(B,VBJOUARR$(M),BELØB$,VBJOUARR$(M))
5740 ENDIF
5750 M=AVKONTI;EJFUNDET=E
5760 ENDIF
5770 NEXT M
5780 IF EJFUNDET=B THEN
5790 IF AVKONTI<MVGR*5 THEN
5800 AVKONTI=AVKONTI+E;VJOURARR(AVKONTI)=VARKONT;VBJOUARR$(AVKONTI)=BELØB$
5810 VUJOURARR(AVKONTI)=ENTNR
5820 IF FAKKRE$="F" THEN
5830 IF BELØB$(12)="+" THEN
5840 VBJOUARR$(AVKONTI,12)="-"
5850 ELSE
5860 VBJOUARR$(AVKONTI,12)="+"
5870 ENDIF
5880 ENDIF
5890 ELSE
5900 STOP
5910 ENDIF
5920 ENDIF
5930 ENDIF
5940 ENDPROC
5950 PROC TOMLINIE(ANTLIN)
5960 FOR ANLI=E TO ANTLIN
5970 PRINT " "
5980 NEXT ANLI
5990 ENDPROC
6000 OPEN K8$,W
6010 EXEC FEJL(8,E,K8$)
6020 FOR I=E TO AVKONTI
6030 PUT K8$,I:VJOURARR(I),VBJOUARR$(I),VUJOURARR(I)
6040 EXEC FEJL(8,G,K8$)
6050 NEXT I
6060 CLOSE K8$
6070 EXEC FEJL(8,V,K8$)
6080 OUTPUT T
6090 TE$="      Programvalg           "
6100 EXEC BIL
6110 EXEC SYSGEM
6120 CHAIN "P641210:OPSTART"
6130 END
6140 PROC BIL
6150 CLEAR
6160 CURSOR 20,W
6170 PRINT "*****************************************"
6180 CURSOR 20,10
6190 PRINT "*";TAB(41);"*"
6200 PRINT TAB(20);"*";TAB(30);TE$;TAB(60);"*"
6210 PRINT TAB(20);"*";TAB(60);"*"
6220 PRINT TAB(20);"*****************************************"
6230 ENDPROC