⟦296d2d2e0⟧

Text

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

MIKADOS

⟦296d2d2e0⟧

Derivation

Text
