1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
| '******************************************************************************
'*** DIT PROGRAMMA WORDT DOOR <Ru1x1i?> OPGEROEPEN ALS ER IETS GEPRINT OF
'*** VERWERKT MOET WORDEN.
'*** NA HET PRINTEN WORDEN DE PIF BESTANDEN BIJGEWERKT OF WEGGEGOOID.
'*** IEDER RUND WAT GEFACTUREERD IS WORDT INDIVIDUEEL VASTGEHOUDEN.
'******************************************************************************
'*** LINK MEE: 40000 / DATA / HULP / RUIX / ERROR
'*** LIBRARY : ADVBAS20.EXE + BRUN20.EXE
'******************************************************************************
INIT:
rem $include: 'COMALG.V4'
rem $include: 'NETW.INC' : ' ivm Netwerkversie (er wordt geLOCKed)
9 DIM ALG(30),PP(20),DA(30),VA$(40)
DIM ACT(10),ACTIEF(10),ACTIEF$(10),DA$(3),M(12),VOLGT$(30),TS%(6),TG(6)
DIM FBTW%(20),KTBD#(20),CKTBD#(6),BTWPERC(5),KT#(6),FTXT$(6),ATS%(6),ATG(6)
DIM OBBD#(20),PLUS(5),PLUSBD#(5),MIN(5),MINBD#(5),OBP(20),GRBREK#(20),CUM(20)
DIM MI%(10),AT(10),GW(10),TS(8): '@@ Ivm DefaultTellingen
DIM T(18),A#(18),C#(18),PT(18),CP#(18): ' Opmerk Tellers (Zb Vaars etc)
DIM L(10),B#(10),OPM$(18) : ' Klasse Tellers (A0,E4 etc)
rem $include: 'DATABLOK.inc'
TOTPRINT%=0: CTEUR=0: DTEUR=1: ' Verder verschil in Include 'VERWERK3. VER/INK
MAXR=400
if CTEUR=1 then FAX= 8: TBASE%=100: IV$="I": if NETW=1 then TBASE%=1000: MAXR=MAXC
if DTEUR=1 then FAX=23: TBASE%=500: IV$="V": if NETW=1 then TBASE%=5000: MAXR=MAXD
EX1$=JAAR$+IV$
MODULE$="INVRU"+IV$+"X": if TOTPRINT%=1 then MODULE$="TOTRU"+IV$+"X"
gosub PCODES: width lprint 200
PAD2$="\COMPRINT\RUNDER\": if RUND>0 then SOORT$="8."
gosub MINAS: for T=1 to 10: MI%(T)=MI%: next T
gosub LEESF: ' DA() ophalen
TITEL$=" PRINTEN VAN FACTUREN ": TX%=40-int(len(TITEL$)/2)
on timer(1) gosub KLOK: TIMER ON: TYD%=8
for TEL=1 to 22: read LIJST%(TEL): next TEL
data 27, 73, 81, 71, 79, 72, 80, 75, 77
rem esc pup pdn hm end up dn le ri
data 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 9, 32, 23
rem f1 f2 f3 f4 f5 f6 f7 f8 f9 f0 tab a-d a-i
goto 15
10 EXEF$="STARTVHP": goto LEAVE
run
'****************************************************************************
15 KR$=" FACTURERING RUNDEREN ]": K=len(KR$)+len(CBT$): KR$=KR$+string$(67-K,"Í")+"[ PAD: "+CBT$+" "
FACT%=0: if NETW=1 then gosub CHECK
color 7,0: ENPE=0: if VLAG=9 then ENPE=1: VLAG=0
HOOFDPROGRAMMA:
100 call titelscherm(KR$,TITEL$,TX%): call agrond(0,0,0,0,0): call klok
DIR$=CBT$+PAD2$: FILS%=0: FLEN%=320: MODULE$="r100"
'-- Niet LEEG dus DIRECTE FACTUUR --
if DIOP$<>"" then gosub GETDIOPS: VLAG=1: goto EIND
'-- Zoek alle PIF's, zet ze in OPIF (mbv PIF i) --
close #5: call opslag(DIR$,FLEN%,FILS%,"")
'-- Zoek op of Opslag of Direct of Niets --
call getfile(IETS%,FILS%): IETS%=0: if ESC=1 then goto EIND: ' Zoek Opslag of Directe print op.
call agrond(32,0,0,0,0)
gosub LEESF5
if FILS%=1 then FILS%=0: VLAG=1: gosub GETDIOPS
if FILS%=2 then FILS%=0: VLAG=2: gosub OPSLAGPRINTEN: if ESC=1 then goto EIND
if IETS%=0 then
BEEP: call makewindow(17,15,62,17,"",2,3,15,1,0)
call xqprint("GEEN SELECTEERBAAR BESTAND AANWEZIG ! <TOETS>",16,18,31%,0)
if MISWAT%=1 then call helpregel("Ontbrekende gegevens: Importeer de opslag eerst.",0)
call inkey(0,"","",0): call leegregel(0,0)
end if
EIND:
199
color 7: close: QQQ=fre(""): EXEF$="RVIMENU"
if VLAG=1 then EXEF$="Ru1x1": if LG%=2 then VLAG=2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
LEAVE:
ZOEKCODE$="": DIOP$="": call comalg(0,LEVDAT$): run EXEPAD$+EXEF$: run
KLOK: call klok: return
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FACTUURNUMMER:
'** Netw=0 : Inkoop 5 Verkoop 4
'** Netw=1 : Inkoop 6 Verkoop 5
FACNUM$="": call bepfacnr(FACNUM$,FACNR$): FACNUM=val(FACNUM$)
return
'****************************************************************************
'********** DIRECTE PRINT UITVOEREN **********
'****************************************************************************
' COPIE$ wordt FACNR$ indien reeds geprint zodat niet meer geCUMuleerd mag
' worden. Wanneer YY5$ = ! dan is deze factuur NU of EERDER al verwerkt.
GETDIOPS:
2000 '-- Direct printen DIOP$ = gevuld met "PIFxxx" --
COPIE$="": PCOPIE=0: FID$="1 ": IETS%=1: NAME$=DIOP$+"."+JAAR$
gosub LEESF5: gosub FACTUURNUMMER: NR$=mid$(DIOP$,4,3)
2010
gosub PRINTEN: call agrond(32,0,0,0,0)
if PP(19)>0 and PCOPIE < PP(19)-1 then
PCOPIE=PCOPIE+1: IN$="P"
else
PCOPIE=0: call vnp(IN$,SND)
end if
if IN$="P" then COPIE$=FACNR$: goto 2010
call agrond(32,0,0,0,0)
2020 '-- Verwerken NEE --
AKKOORD=0
if IN$="N" then
' Beep : call akkoord(space$(15)+"Gegevens van deze factuur WEGGOOIEN ??",0,AKKOORD)
' if AKKOORD=0 then BEWAAR%=1: gosub ZETINOPIF
' call leegregel(0,0)
call herstfax(FACNUM$)
end if
2030 '-- Verwerken JA --
if IN$="V" then gosub VERWERKEN: AKKOORD=1
2040 '-- Afsluiten --
if AKKOORD=1 then gosub VERWIJDERPIF: AKKOORD=0
call agrond(32,0,0,0,0): FACNR$="": DIOP$="": PCOPIE=0: COPIE$=""
2049 MODULE$="r2049"
return
ZETINOPIF:
2060 '-- Bijwerken in Opif wanneer ( In$="N" + Bewaar%=1 ) --
OK=0
for T= 1 to INDEX5
get #5,T: lset ZZ5$=""
if JN5$="*" and left$(DD5$,6)=DIOP$ then put #5,T: OK=1: T=INDEX5
next T
2065 '-- toevoegen in opif --
if OK=0 then
get #5,INDEX5+1: lset JN5$="*": lset AA5$=LEVDAT$: rset BB5$=CRN$
rset AA5$=str$(TS): lset DD5$=NAME$: rset EE5$="": lset FF5$=SDATUM$
rset GG5$=FACNR$: lset XX5$="": lset YY5$="": lset ZZ5$="": put #5,INDEX5+1
end if
return
'****************************************************************************
'********** OPSLAG PRINTEN UITVOEREN **********
'****************************************************************************
' Wanneer YY5$ = ! dan is deze opgeslagen factuur al verwerkt.
' COPIE$ wordt dan "-1" zodat de CUMulatieven niet vermeerderd worden met de
' gegevens van deze factuur (is reeds gebeurd).
OPSLAGPRINTEN:
2100 '**** OPSLAG PRINTEN ****
call akkoord(space$(20)+"Wilt U zeker de opslag printen??",0,AKKOORD)
if AKKOORD=0 then ESC=1: return
while INDEX5 > 0 and ESC=0
MODULE$="r2100"
FID$="7 ": gosub LEESF5: '** opnieuw inlezen en lengte bepalen
for XX=1 to INDEX5
get #5,XX: HDD$=DD5$: ZOEKEN%=1: COPIE$="": MISWAT%=1
' --- Eerst de te VERWERKEN opslag printen ---
if (ZZ5$="û" or ZZ5$="E") and YY5$="V" then
IETS%=1: NAME$=HDD$: NR$=mid$(NAME$,4,3): SDATUM$=FF5$
gosub ZETFACNR: ' Facnr ophalen uit PIF.I of een nieuwe maken.
2103 gosub PRINTEN
if PP(19)>0 and PCOPIE<PP(19)-1 then PCOPIE=PCOPIE+1: goto 2103
PCOPIE=0: get #5,XX: if ZZ5$="E" then AGRO=1 else AGRO=0
lset ZZ5$="P": H%=5: T=XX: gosub PUTREC
gosub VERWERKEN: lset YY5$="!": H%=5: T=XX: gosub PUTREC
ZOEKEN%=0: gosub ZETFACNR
2105 '*** dit ook in de PIF.I zetten, mag NOOIT meer verwerkt worden.
call agrond(32,0,0,0,0)
end if
next XX
MODULE$="r2110"
2110 for XX=1 to INDEX5
get #5,XX: HDD$=DD5$: ZOEKEN%=1: COPIE$=""
' --- De NIET VERWERKEN opslag printen ---
if (ZZ5$="û" or ZZ5$="E") and (YY5$="N" or YY5$="!") then
IETS%=1: PCOPIE=0: NAME$=HDD$: NR$=mid$(NAME$,4,3): SDATUM$=FF5$
if YY5$="N" then gosub FACTUURNUMMER else gosub ZETFACNR
if YY5$="!" then COPIE$="-1": ' @ Cumulatieven reeds bijgewerkt
2115 gosub PRINTEN
if PP(19)>0 and PCOPIE<PP(19)-1 then PCOPIE=PCOPIE+1: goto 2115
PCOPIE=0: get #5,XX: lset ZZ5$="P": H%=5: T=XX: gosub PUTREC
call agrond(32,0,0,0,0): ZOEKEN%=0: gosub ZETFACNR
if YY5$="N" then call herstfax(FACNUM$) '** ALLEEN DAN en niet anders !!!!!
end if
next XX
2120 '**** Nu kan alles wat net geprint is, nog een keer geprint worden
'**** dus opnieuw een selectie maken en dan weer printen.
FILS%=0: FLEN%=320: MODULE$="r2120"
close #5: call opslag(DIR$,FLEN%,FILS%,"P")
FILS%=3: IETS%=0: call getfile(IETS%,FILS%): if FILS%<>2 then ESC=1
gosub LEESF5: '** opnieuw inlezen en lengte bepalen
wend
2130
MODULE$="r2130"
close #5: FLEN%=320: call opslag(DIR$,FLEN%,FILS%,"")
gosub LEESF5
'-- Let op: Nu wordt de VERWERKTE opslag (YY=!) vrijgemaakt (JN=X) --
'-- Waarom laten we de NIET VERWERKEN opslag nu staan ?? --
2135
for XX=1 to INDEX5
get #5,XX: T=XX: H%=5
if JN5$="*" then
NAME$=DD5$:
if YY5$="!" then
lset JN5$="X": gosub PUTREC: ALLEENKILLEN%=1: gosub VERWIJDERPIF
end if
end if
ALLEENKILLEN%=0
next XX
gosub OPIFX: '-- Opschonen OPIF bestand --
2149 MODULE$="r2149"
return
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Als ZOEKEN% = 1 dan FACNR$ ophalen uit PIFi, niet gevonden dan MAKEN.
' Als ZOEKEN% = 0 dan FACNR$ juist in PIFi wegschrijven.
ZETFACNR:
2150
B$=NAME$: call crunch(B$," ",1)
HEKJE%=6: call openf(DIR$+B$+"i",0,80)
field #6, 1 as JN$, 8 as AA$, 4 as BB$, 4 as CC$, 6 as DD$, 9 as EE$,_
1 as FF$, 5 as GG$, 5 as HH$, 4 as II$, 1 as JJ$, 1 as KK$,_
8 as LL$, 6 as MM$, 2 as NN$, 6 as OO$, 1 as PP$, 8 as ZZ$
get #6,1
if ZOEKEN%=1 then FACNR$=MM$: if val(FACNR$)=0 then gosub FACTUURNUMMER
lset JN$="*": rset MM$=FACNR$: lset JJ$=YY5$: lset KK$=ZZ5$
H%=6: T=1: gosub PUTREC: close #6
return
'****************************************************************************
'********** PRINTEN VOORBEREIDEN **********
'****************************************************************************
' Voorafgaand aan het daadwerkelijk printen de bijzondere factuurgegevens
' ophalen uit PIFi, PIFs, CREDIT.dat etc.
PRINTEN:
2200 MODULE$="r2200"
call PRINTEN(NR$,LG%,LEVDAT$,UP,BYB,REGEL,VERW$,SDATUM$,IKB$,SEUROP%,GWK%,_
CUMAAN%,CORRECTIE$,N$,AD$,PC$,WPL$,BIJZ$,LANDNAAM$,BTW$,_
AGRO$,AGRO,BG$,OBMELD$,UBNNR$,IKBNAAM$,PIF$,ALG())
if DTEUR=1 then AGRO=0: '@V
2210
MODULE$="r2210"
HEKJE%=6: call openf(CBT$+"\DATAHOLD\DATAS.08",0,80)
field #6, 1 as JN$,24 as AA$,1 as BB$,1 as CC$,1 as DD$,8 as EE$,7 as FF$,37 as ZZ$
for T= 1 to 6:
get #6,T: BB(T)=0: GRBREK#(T)=0
if JN$="*" then BB(T)=val(BB$): GRBREK#(T)=val(EE$): 'Eenheid
next T: close #6
2220
PIF$="P"+IV$+"F"+NR$: '@V
HEKJE%=6: call openf(CBT$+PAD2$+PIF$+"."+JAAR$+"s",0,80)
field #6, 1 as JN$,10 as AA$,30 as BB$, 1 as CC$, 1 as DD$,37 as EE$
UPBYB=0
for T=1 to 6
get #6,T: KT#(T)=0: FTXT$(T)="": FBTW%(T)=0: KTBD#(T)=0
if JN$="*" then
KT#(T)=val(AA$): FTXT$(T)=BB$: FBTW%(T)=val(CC$)
KTBD#(T)=KT#(T): ' @ Even VALS gezet ivm BTWLINES%.
if BB(T)=1 and DD$="0" then UPBYB=UPBYB+KT#(T): 'Byb p Kg in PRYS
end if
next T
for T=7 to 10: FBTW%(T)=0: KTBD#(T)=0: next T
get #6, 7: IKBAT% =val(AA$): KOPTEKST$=BB$: TEKSTREGEL%=val(CC$)
get #6, 8: IKBKGKT =val(AA$): SLACHTPLAATS$=BB$: IKGEX%=0: if DD$="1" then IKGEX%=1
get #6, 9: IKBSTKT =val(AA$): TXT$=BB$: ISTEX%=0: if DD$="1" then ISTEX%=1
get #6,10: STBEER =val(AA$): TXT$=TXT$+BB$: BTWUIT%=val(CC$)
get #6,11: VOORSCHOT=val(AA$): TXT$=TXT$+BB$: BETAALCODE$=CC$
get #6,12: BIJEEN =val(AA$): if BIJEEN >0 then BIJEEN$ =BB$: FBTW%( 7)=val(CC$): NODIG%=NODIG%+1
get #6,13: BIJTWEE =val(AA$): if BIJTWEE>0 then BIJTWEE$=BB$: FBTW%( 8)=val(CC$): NODIG%=NODIG%+1
get #6,14: AFEEN =val(AA$): if AFEEN <0 then AFEEN$ =BB$: FBTW%( 9)=val(CC$): NODIG%=NODIG%+1
get #6,15: AFTWEE =val(AA$): if AFTWEE <0 then AFTWEE$ =BB$: FBTW%(10)=val(CC$): NODIG%=NODIG%+1
KTBD#(7)=BIJEEN: KTBD#(8)=BIJTWEE: KTBD#(9)=0-abs(AFEEN): KTBD#(10)=0-abs(AFTWEE): ' InclBtwBedrag
BAF$=str$(FBTW%(7))+str$(FBTW%(8))+str$(FBTW%(9))+str$(FBTW%(10))
call crunch(BAF$," ",1)
if IKGEX%=1 and IKBAT%*IKBKGKT>0 then NODIG%=NODIG%+1
if ISTEX%=1 and IKBAT%*IKBSTKT>0 then NODIG%=NODIG%+1
if TEKSTREGEL%>0 then TREGELS%=TREGELS%+1
if TXT$<>space$(90) then TREGELS%=TREGELS%+1
B$=BETAALCODE$: BETCODE$=""
if B$="B" then BETCODE$="Per Bank" else if B$="K" then BETCODE$="Per Kas"
if B$="C" then BETCODE$="Cheque" else if B$="G" then BETCODE$="Per Giro"
close #6
BTWLINES%=0: ' @ BtwLines ivm Nodig
if ALG(2)=0 or BTWUIT%=1 then goto INITINK
' @ Bepaal welke Btw percentages (+ en -) er in gebruik zijn.
' @ Ktbd#() is VALS = KT#(). Moet zijn: KT#() * (Kg)(St)(Vr)
' @ Plus() + Min() is VALS: 1 = Aan / 0 = Uit. Moet zijn: BtwBedrag
KTBD#(0)=1: FBTW%(0)=1: '- de runderen zelf ook in de BTW -
for T= 0 to 10
for Y= 0 to 5:
if FBTW%(T)=Y then
if KTBD#(T)>0 then PLUS(Y)=1 else if KTBD#(T)<0 then MIN(Y)=1
end if
next Y
next T
Y=0
for T= 0 to 5
if val(BTW$)=1 then
if PLUS(T)=1 then BTWLINES%=BTWLINES%+1: Y=1
if MIN(T) =1 then BTWLINES%=BTWLINES%+1: Y=1
end if
PLUS(T)=0: MIN(T)=0: PLUSBD#(T)=0: MINBD#(T)=0: KTBD#(T+1)=0
next T
KTBD#(0)=0: if val(CORRECTIE$)>0 and Y=1 then BTWLINES%=BTWLINES%+1
MODULE$="initink"
<knip>
....
....
en dat gaat zo nog wel even door... |