Continuare Cap. 10 p. 2
Program:
C:\CURS\PROGT\MENUS.PRG
System:
Evidenta situatiilor financiar-contabile Author: Emil
Pfeiffer Copyn'ght(c) 1998, Emil Pfeiffer Lasîmodified:
08/14/98 9:59
Called
by: FIN.PRG
Calls:
INTMENU.PRG
IESMENU.PRG
CORMENU.PRG
LINMENU.PRG
LOUMENU.PRG
INMENU.PRG
LISMENU.PRG
ACTMENU.PRG
CINTMENU.PRG
COUTMENU.PRG
Documented
08/14/98 at 10:19 FoxDoc
DEFINING
THE MAIN MENU AND POP-UP'S
********************************
28 set
talk off
29
clea
30 set color
set to co1
31 define
menu mainmenu
32 define pad
intrari of mainmenu prompt 'INTRARI' at 0,0
33 define pad
iesiri of mainmenu prompt 'IESIRI'
at 0,8
34 define pad
corectii of mainmenu prompt 'CORECTII'
at 0,15
35
define pad list_jn of mainmenu prompt 'LIST INTR' at 0,25
36 define pad
list_out of mainmenu prompt 'LIST ies' at 0,35
37
define pad init of mainmenu prompt 'INITIALIZARE' at 0,44
38 define pad
list_stoc of mainmenu prompt 'LIST STOC' at 0,58
39
define pad actual of mainmenu prompt 'ACTUALIZARE' at 0,68
40
41
on pad intrari of mainmenu activate popup intpop
42
on pad iesiri of mainmenu activate popup iespop
43
on pad corectii of mainmenu activate popup corpop
44
on pad listjn of mainmenu activate popup linpop
45
on pad list_out of mainmenu activate popup loupop
46
on pad init of mainmenu activate popup inpop
47
on pad list_stoc of mainmenu activate popup lispop
48
on pad actual of mainmenu activate popup actpop
49
50
define popup intpop from 2,1 shadow
51
define bar 1 ofintpop prompt '\<Note de Predare' message;
52
Aceasta functie este invalida!!! Selectati alta'
53
define bar 2 ofintpop prompt 'h \<lnventar' message;
54
Aceasta functie este invalida!" Selectati alta'
55
define bar 3 of intpop prompt 'Nota de \<Receptie' message;
56
Aceasta functie este invalida!!! Selectati alta'
57
on selection popup intpop do intmenu
58
59
define popup iespop from 2,8 shadow
60
define bar 1 of iespop prompt '\<Proces Verbal de Casare' message;
61
Aceasta functie este invalida!!! Selectati alta'
62
define bar 2 of iespop prompt '\<Facturi' message;
63
Aceasta functie este invalida!!! Selectati alta'
64
define bar 3 of iespop prompt '\<Note de Transfer' message;
65
Aceasta functie este invalida!!! Setectati alta'
66
define bar 4 of iespop prompt 'Note de \<Restituire' message;
67
Aceasta functie este invalida!!! Selectati alta'
68
define bar 5 of iespop prompt '\<Scoatere din custodie' message;
69
' Aceasta functie este invalida!!! Selectati alta'
70
define bar 6 of iespop prompt '\<Bon de consum' message;
71
' Realizeaza inregistrarea bonurilor de consum'
72
on selection popup iespop do iesmenu
73
74
define popup corpop from 2,15 shadow
75
define bar 1 of corpop prompt '\<Intrari' message;
76
Aceasta functie este invalida!!! Selectati alta'
77 define
bar 2 of corpop prompt 'i\<Esiri' message;
78 ' Realizeaza
corectarea unor documente care au fost introduse anterior'
79 define bar 3 of
corpop prompt' \<Fisademagazielmessage;
80
' Realizeaza vizualizarea fisei de magazie'
81
on seiection popup corpop do cormenu
82
83
define popup linpop from 2,24 shadow
84
define bar 1 of linpop prompt 'Centralizare pe \<Conturi' message;
85
' Aceasta functie este invalida!!! Selectati alta'
86
define bar 2 of linpop prompt 'Centralizare pe tip \<Document';
87
message ' Aceasta functie este invalida!!! Selectati alta'
88
define bar 3 of linpop prompt '\<Lista documentelor' message;
89
' Aceasta functie este invalida!!! Selectati alta'
90
on selection popup linpop do linmenu "
91
92
define popup loupop from 2,31 stiadow
93
define bar 1 of loupop prompt 'Centralizare pe \<Beneficiari';
94
message' Aceasta functie este invalida!!'Selectati aita'
95
define bar 2 of loupop prompt 'Centralizare pe \<Conturi' message;
96
' Aceasta functie este invalida!!! Selectati alta'
97
define bar 3 of loupop prompt 'Centralizare pe tip \<Document';
98
message ' Aceasta functie este invalida!!! Selectati alta'
98
define bar 4 of loupop prompt 'Situatia \<Vinzarilor' message;
00 '
Aceasta functie este invalida!" Setectati a'ta'
101
define bar 5 of loupop prompt '\<Lista documentelor' message;
102
' Aceasta functie este invalida!!! Selectati alta'
103
on selection popup loupop do loumenu
104
105
define popup inpop from 2,40 shadow
106
define bar 1 of inpop prompt '\<0perare in stocuri' message;
107
' Aceasta functie este invalida!!! Selectati alta'
108
define bar 2 of inpop prompt '\<Penalizari Facturi' message ;
110
define bar 3 of inpop prompt '\<Verificare stoc = O' message;
111
' Aceasta functie este invalida!." Seiectati alta'
112
on selection popup inpop do inmenu
113
114 define bar 1 of lisnop
prompt '\<Ecran balanta verificare' message'
115
' Vizualizarea balantei de verificare'
117
define bar 2 of lispop prompt 'Balanta \<Analitica' message;
118
' Aceasta functie este invalida!!! Selectati alta'
119
define bar 3 of lispop prompt 'Situatia \<7' message;
120
' Aceasta functie este invalida!!! Selectati alta'
121
define bar 4 of lispop prompt '\<Balanta sintetica' message;
122
' Aceasta functie este invalida!!! Selectati alta'
123
define bar 5 of lispop prompt 'Balanta de \<Verificare' message;
124
' Aceasta functie este invalida!!! Selectati alta'
125
define bar 6 of lispop prompt 'Balanta sintetica pe \<Mag.';
126
message ' Aceasta functie este invalida!!! Selectati alta'
127
define bar 7 of lispop prompt 'Stocuri cu miscare \<Lenta';
128
message ' Aceasta functie este invalida!!! Selectati alta'
129
define bar 8 of lispop prompt 'Stocuri \<Fara miscare' message;
130
' Aceasta functie este invalida!!! Selectati alta'
131
define bar 9 of lispop prompt 'ColectareNote\<Predare' message;
132
' Aceasta functie este invalida!!! Selectati alta'
133
define bar 10 of lispop prompt '\<Salvare (dbf.zip)' message;
134'
Realizeaza salvarea bazelor de date pe luna. Se executa inainte de
inchidere!!'
135
on selection popup lispop do lismenu
136
137
define popup actpop from 2,61 shadow
138
define bar 1 of actpop prompt '\<Adaugare' message;
139
' Aceasta functie este invalida!!! Setectati alta'
140
define bar 2 of actpop prompt '\<Modificare' message;
141
' Aceasta functie este invalida!!! Selectati a!ta'
142
define bar 3 of actpop prompt '\<Stergere' message;
143
' Aceasta functie este invalida!!! Selectati alta'
144
define bar 4 of actpop prompt'\<Listare'message;
145
' Aceasta functie este invalida!!! Selectati alta'
146
define bar 5 of actpop prompt '\<Vizualizare' message;
147
' Aceasta functie este invalida!!! Selectati alta'
148
definebar6ofactpopprompt'\<CalculCC'message;
149
' Realizeaza calculul cifrei de control'
150
define bar 7 of actpop prompt '\<Beneficiari adaugare' message;
151
' Aceasta functie este invalida!!! Selectati alta'
152
define bar 8 of actpop prompt '\<Editare benef message;
153
' Aceasta functie este invalida!!! Selectati alta'
154
define bar 9 of actpop prompt 'Ster\<gere beneficiari'message;
155
' Aceasta functie este invalida!!! Selectati alta'
156
define bar 10 of actpop prompt "\/i\zualizare bânef
messaae;
157
' Aceasta functie este invalida!!! Selectati alta'
158 define bar 11
of actpop prompt '\<Terminare program' message;
159 'lesirea
din lucrare'
160
on selection popup actpop do actmenu
161
162
define popup int1 pop from 8,20 shadow
163
define bar 1 of int'i pop prompt "\<Note de Predare'
message;
164
' Aceasta functie este invalida!!! Selectati alta'
155
define bar 2 of int1 pop prompt 'h \<!nventar' message;
156
' Aceasta functie este invalida!!! Selectati alta'
157
define bar 3 of int1 pop prompt 'Nota de \<Receptie' message;
158
' Aceasta functie este invalida!!! Selectati alta'
169
on selection popup intlpop do cintmenu
170
171
define popup ies1pop from 8,20 shadow
172
define bar 1 of ies1pop prompt '\<Proces Verbal de Casare';
173
message ' Aceasta functie este invalida!!! Selectati alta'
174
define bar 2 of ies1 pop prompt '\<Facturi' message;
175
' Aceasta functie este invalida!!! Selectati alta'
176
define bar 3 of iest pop prompt '\<Note de Transfer' message;
177
' Aceasta functie este invalida!!! Seiectati alta'
178
define bar 4 of ies1 pop prompt 'Note de \<Restituire' message;
179 '
Aceasta functie este invalida!!! Selectati alta'
180
define bar 5 of ieslpop prompt '\<Scoatere din custodie' message;
181
' Aceasta functie este invalida!!! Selectati alta'
182 define bar 6 of ies1
pop prompt '\<Bonu"; de consum' message;
183 'Corectie
la bonurile de consum introduse'
184
on selection popup ies1 pop do coutmenu
185: EOF:
MENUS.ACT
Programul
MENUS.PRG este programul care vizualizează şi serveşte la
selectarea şi
lansarea programelor componente ale lucrării de evidenţă contabilă
a produselor finite şi a materialelor. O mare parte din
opţiunile acestei lucrări sunt invalide, oarece sunt multe programe
şi pentru a evita o lucrare extrem de voluminoasă nu prezentăm
toate programele, Programete care nu sunt valide sunt semnalate
(mesaj în subsolul ecranului) la selectarea opţiunii
respective, pentru a evita încercarea de lansare a
acestei opţiuni (eroare).
1
****************************************
2
*
3
* Program: C:\CURS\PROGT\IESMENU.PRG
4
*
5 * System: Evidenta
situatiilor financiar-contabile
6
* Author: Emil Pfeiffer
7
* Copyright (c) 1998, Emil Pfeiffer
8
* Last modified: 03/29/97 10:47
9
*
10
* Called by: MENUS.PRG
11
*
12
* Calls: BAR() (function in ?)
13 :
PVC.PRG
14 :
AE.PRG
15 :
NT.PRG
16 :
NP.PRG
17 :
OCUST.PRG
18 :
BC.PRG
19
*
20
* Documented 08/14/98 at 10.19
21
*************************************
22 choice
= bar()
23 hide
menu mainmenu
24 hide
popup iespop
25 flmstoc
= .f.
26 do
case
27 case
choice = 1
28 do
pvc
29 case
choice = 2
30 do
ae
31 case
choice = 3
32 do
nt
33 case
choice = 4
34 do
np with 33
35 case
choice = 5
36 do
ocust
37 case
choice = 6
38 do
bc with 11
39 endcase
40 deactivate
window all
41 show
menu mainmenu
42 show
popup intpop
43 clear
44 return
45
*
46
*EOF: IESMENU.ACT
Este meniul de
lansare a documenfelor de ieşire din lucrarea de evidenta a
produselor finite şi materialelor.
1
**********************************
2
*
3
* Procedure file: C:\CURS\PROGtBC.PRG\
4
*
5
* System: Evidenta situatiilor financiar-contabile
6
* Author: Emil Pfeiffer
7 * Copyright (c) 1998,
Emil Pfeiffer
8
* Last modified: 03/29/97 10:47
9
*
10
* Procs & Fncts: DESIGN
11
* GET_ANTET
12
* GET_TEMS
13
* GET_LINE
14
* MOVE_UP
15
* MOVE_DOWN
16
* NO_DOC
17
* DEL REC
18
*
19
* Set by:IESMENU.PRG
20
*
21
* Calls DESIGN (procedure in BC.PRG)
22
* DATE() (function in ?)
23
* GET_ANTET (procedure in BC.PRG)
24
* GET_ITEMS (procedure in BC.PRG)
25
*
26
* Uses: MISC.DBF :
27
* TMP.DBF :
28
* NOM.DBF
29
*
30
* Indexes: INDMISC.IDX
31 ISMISC.IDX
32 INDNOM.IDX
33 *
34
* Documented 08/14/98 at 10:20 FoxDoc
35
**********************************************
36
*
37
* NP.PRG culegere BC-uri, FL-uri şi FD-uri
38
*********************************
39
parameter document
40
close databases
41
activate screen
42
clear
43
define window errwind from 1,40 to 3,79 double color scheme 1
44
define window itemwind from 15,6 to 23,74 none
45
select a
46
use misc index indmisc, fismisc
47
select b
48
use tmp
49
*—————————!!!
50
select d
51
use nom index indnom
52
*----------------------------!!!
53
select b
54
do design
55
nir = .t.
56
vdata = date()
57
do while nir
58
select tmp
59
zap
60
store 0 to vnrdoc, vsec, vform, vmag
61
store ' ' to vum
62
do get_antet
63
if nir
64
do get_items
65
endif
66
enddo
67
close databases
68
activate screen
69
clear
70
retum
71
80
*,****************************
81
*!
82
*! Procedure: DESIGN
83
*.'
84
*! Called by: BC.PRG
85
*! : CORBC.PRG
86
*
87
*********************************
80
procedure design
81
82
*ANTET
83
@ 2,5,8,75 box
84
@ 4, 5 to 4, 75
85
@ 6,5 to 6,75
86
i = 0
87
for i=19 to 61 step 14
88
@ 5, i say '|' && semnul este bara verticală 'l'
89
@ 7, i say '|'
90
@ 4, i say ' ┴ ' && semnuf este continuare cu leg.
sus.
91
@ 6, i say '┼' && semnul este continuare în
cruce.
92
@ 8,i say '┬' && semnul este continuare cu leg. jos.
93
endfor
94
for i=4 to 6 step 2
95
@ i,5 say'├' && semnul ester contin. limitat stânga.
96
@ i,75 say '┤' &&semnuleste 'contin.limitat
dreapta.
97
endfor
&&
semnele se găsesc în meniul FOX SPECIAL CHARACTER
98
@ 2,13 say '|'
99
@ 4,13 say ' ┴ '
100
@ 3,13 say '├'
101
do case
102
case document = 11
103
@ 0, 30 say 'OPERARE BONURf DE CONSUM'
104
case document = 12
105
@ 0,30 say 'OPERARE FISE LIMITA'
106
case document = 13
107
@ 0,30 say 'OPERARE FiSE DE DEROGARE'
108
endcase
109
@ 3, 7 say'ANTET' color r/w+
110
@ 5, 7 say 'NR.DOCUMEN'
111
@ 5,24 say'DATA'
112
@ 5,37 say'SECTIA'
113
@ 5. 51 say 'FORMATIA'
114
@ 5. 65 say 'MAGAZIA'
115
*
116
*POZITII
117
@ 10,5,25,75 box
118
@ 12,5 to 12,75
119
@14, 5 to14,75
120
for i=11 to 59 step 16
121
@ 12,i say "│"
122
@13,i say "│"
123
@14,i say "┼"
124
@ 24, i say "┴"
125
endfor
126
for i=12 to 14 step 2
127
@ i,5 say '├'
128
@ i, 75 say "┤"
129
endfor
130
activate window itemwind
131
for i = 0 to 8
132
for j=5 to 53 step16
133
@ i,j say "│"
134
endfor
135
endfor
136
activate screen
137
@11,7 say 'POZITII 'color r/w+
138
@10,15 say "│"
139
@11,15 say '|'
140
@12,15 "┴"
141
@11,16 say 'MATERIAL:'
142
@13,7 say 'NR.'
143
@13,13 say 'CODMATERIAL'
144
@ 13,34 say 'CONT'
145
@ 13,47 say 'CANTITATE'
146
@13,64 say 'VALOARE'
147
@ 9,5 say 'CANTITATE' color gr+/b
148
@ 9,40 say 'VALOARE:' color gr+/b
149
retum
150
*
163
*********************
164
*
165
Procedure: GET_ANTET
166
*
167
Called by: BC.PRG
168
: CORBC.PRG
169
*
170
Calls: SYS() (function in ?)
171
NO_DOC (procedure in BC.PRG)
172
READKEY (function in ?)
173
*
174
**********************************
163
procedure get_antet
164
= sys(2002,1) && set cureor on
165
set intensity on
166
set confirm on
167
antet_ok = .f.
168
do while .not. antet_ok
169
@ 7,10 get vnrdoc picture [999999] valid no_doc(vnrdoc)
170
@ 7,22 get vdata when vnrdoc # 0
171
@ 7,39 get vsec picture [99] when vnrdoc # 0
172
@ 7,54 get vform picture [99] when vnrdoc # 0
173
@ 7,68 get vmag picture [99] when vnrdoc # 0
174
read
175
exit_code = readkey()
176
antet_ok = (exit_code = 15) .or. (exit_code = 271) .or.;
177
(exit_code = 7) .or. (exit_code = 263)
178
if vnrdoc > 0
179
nir = .t.
180
else
181
nir = .f.
182
endif
183
enddo
184
return
185
*
212
******************************************
213
*
214
* Procedure: GET_ITEMS
215
*
216
* Called by: BC.PRG
217
* : CORBC.PRG
218
*
219
* Calls: REPLICATE() (function in ?)
220
* : STR() (function in ?)
221
: INKEYQ function in ?)
222 :
MOVE_UP (procedure in BC.PRG)
223 :
MOVE.DOWN (procedure in BC.PRG)
224 :
DEL_REC (procedure in BC.PRG)
225 :
CHR() function in ?)
226
: GET_LINE (procedure in BC.PRG)
227
EOF() (function in?)
228
ADDSTOC.PRG
229 RECNO()
(function in ?)
230 SUBSTOC.PRG
231 REC1()
(function in ?)
232 RECCOUNT()
(function in ?)
233 MIN()
( function in ?)
234
235 Uses:
TMP.DBF
236*
237
*************************************
212
procedure get_tems
213
set intensity off
214
modifying = .f.
215
select tmp
216
activate window itemwind
217
nr=1
218
records=0
219
row_nr=0
220
store 0 to vcod, vpret, vcant, wal
221
vum=' '
222
vcont=replicate( ,12)
223
iteming = .t.
224
store 0 to totcant, totval
225
do white iteming
226 @ row_nr, 1 say
str(nr, 2) +'.'
227
if modifying
228
@ row_nr, 09 say vcod picture [9999999999]
229
@ row_nr, 23 say vcont
230 @ row_nr, 40 say
vcant picture [9999999.999]
231
@ row_nr, 57 say vcant * vpret picture [99999999,99]
232
endif
233
@ row_nr, 09 say"
234
ch=inkey(0)
235 do case
236
case ch=5
237
do move_up
238
case ch=24
239
do move_down
240
case ch = 7
241
= del_rec(nr)
242
activate screen
243 stc=str(totcant,11,3)
244
stv=str(totval ,12,2)
245 @ 9,17 get stc colorgr+/b
246
@ 9,50 get stv color gr+/b
247 clear gets
248
activate window itemwind
249 case (ch > 47 .and. ch < 58)
.or. ch = 13
250
keyboard chr(ch)
251
do get_line
252
activate screen
253
stc = str(totcant, 11,3)
254
stv = str(totval ,12,2)
255
@ 9,17 get stc color gr+/b
256
@ 9,50 get stv colorgr+/b
257
clear gets
258
activate window itemwind
259
endcase
260
enddo
261
select misc
262 select tmp
263
go top
264
if.not.eof0
265 scan
all
266
select misc
267 append
blank
268
replace type with document, sec with vsec, form with vform
269
replace nrdoc with vnrdoc, data with vdata;
270
mag with vmag
271
replace cont with tmp.cont,cod with tmp.cod, pret with tmp.pret;
272
cant with tmp->cant, valoare with tmp->valoare
273
select tmp
274
endscan
275
*---——————
276
do addstoc with document,vmag
277 *-—-.——————!!!
278
endif
279
clear
280
for i = 0 to 8
281
for j = 5 to 53 step 16
282 @ i,j say
283;
Endfor;
284;
Endfor
285;
activate screen
286;
totcant = 0
287;
totval = 0
288;
stc = str(totcant, 11,3)
289;
stv = str(totval ,12,2)
290;
@ 9,17 get stc color gr+/b
291;
@ 9,50 get stv color gr+/b
292; clear gets
293;
set intensity on
294;
return
295
309;
***********************
310;
*i
311;
*! Procedure: GET_LINE
312;
*.
313;
*.' Called by: GET_ITEMS; (procedure in BC.PRG)
314
315; *' Calls: ISMAT();
(function in ACTMENU.PRG)
315; *! : STR() (function
in?)
317; *! : VAL() ;
(function in ?)
318;
*! : READKEY(); (function in?)
319;
*! :CCONTROL; (procedure in FIN.PRG)
320;
*l
321 ;
******************************;
309;
procedure get_line
310;
lineok = .f.
311;
do while .not. lineok
312; @ rownr, 09 get
vcod picture; [9999999999] valid:
313;
is_mat(vcod)
314;
read
315;
sele nom
316;
Seek str(vcod,10)
317;
vcont=nom.cont
318;
vv=val(cont)
319;
If vv>=300
320;
vv=vv+300
321;
else
322; vv=vv+300
323
endif
324
vcont='600'
325
sele tmp
326 @
row_nr, 23 get vcont pict '!!!!!!!!!!' when vcod > 0
327 @ row_nr, 40
get vcant picture [9999999.999] when vcod > 0
328
read
329
@ row_nr, 57 say vcant * vpret picture [99999999.99]
330
exit_code = readkey()
331
if exit_cod = 15 .or. exit_code = 271
332
line_ok =.t.
333
endif
334
enddo
335
select tmp
336
if vcod = 0
337
iteming = .f.
338
else
339
totcant = totcant + vcant
340
totval =totval +vcant*vpret
341
if modifying
342
totcant=totcant-cant
343
totval =totval-cant*pret
344
endif
345
row_nr=row_nr+1
346
if row_nr=9
347
row_nr=8
348
scroll 10,0,8,68,1
349 for i = 5
to 53 step16
350
@ 8, i say '|'
351
endfor
352
endif
353
if .not.modifying
354
records = records + 1
355
append blank
356
endif
357
replace cant with vcant
358
replace cod with vcod
359
replace pret with vpret
360
replace valoare wit vcant*vpret
351
replace cont with vcont
362
skip
363
nr=nr+1
364 if nr > records
365
modifying = .f.
366 else
367 vcod =cod
368 vcant = cant
369 vcont = cont
370 vpret = pret
371 endif
372 endif
373 return
374
382 *****************************
383 *.
384 *! Procedure: MOVE_UP
385 *!
386*!
Called by: GET_ITEMS (procedure in BC.PRG)
387
*!
382
procedure move_up
383
if nr>1
384
modifying = .t.
385
nr=nr-1
386
if nr = records
387
@ row_nr, 1 say' '
388
endif
389
if row_nr>0
390
row_nr = row_nr - 1
391
else
392
scroll 0,0,8,68, -1
393
for i=5 to 53 step 16
394
@ row_nr, i say 'l'
395
endfor
396
endif
397
select tmp
398
skip -1
399
vcod =cod
400
vcant = cant
401
vcont = cont
402
vpret = pret
403
endif
404
return
405
*
413
************************************
414
*
415
* PROCEDURE MOVE_DOWN
416
*
417
* Called by GET_ITEMS (procedure in BC.PRG)
418
*
419
************************************
413
procedure move_down
414
sele tmp
415
if nr=records
415
skip
416
nr = nr + 1
417
if row_nr>8
row_nr
= row_nr + 1
419
else
421
scroll 0,0,8,68,1
422
for i = 5 to 53 step 16
423
@ row_nr,i say '|'
424
endfor
425
endif
426
endif
427
if nr > records
428
modifying = .F.
429
else
430
vcod = cod
431
vcant = cant
432
vcont = cont
433
vpret = pret
434
endif
435
return
436
451
**********************************
452
*
453
* Function IS_MAT()
454
*
455
* Called by ACTMENU.PRG
456
* : FIS.PRG
457
* : GET_LINE (procedure in BC.PRG)
458
*
459
* Calls: STR() (function in ?)
460
* FOUND() (function in ?)
461 *!:SUBSTR()
(function in?)
462
* : CHR() (function in?)
463
*
464
****************************************
451
function is_mat
452
parameter xcod
453
if xcod>0
454
*************************
455
scod = str(xcod,8)
456
select nom
457
********************
458
find '&scod'
459
if found()
460
vpret = pretunitar
461
vum=unitmas
462
deactivate window errwind
463
activate screen
464
@ 11,27 say substr(denumire, 1,45)
465
@11,71 say unitmas
466
activate window itemwind
467
return .t.
468
else
469
activate window errwind
470
@ 0,1 say 'Material inexistent in nomenclator!'
471
return .f.
472
endif
473
else
474
return .t.
475
endif
476
489
*
|
Procedure:
NO_DOC
|
|
490
*
|
||
491
*
|
Called
by: GET_ANTET
|
ANTET
(proced in BC
|
492
*
|
||
493
*
|
Calls:
STR()
|
(function
in?)
|
494
*
|
:FOUND()
|
(function
in?)
|
495
*
|
function
no_doc
parameter
coddoc
if
coddoc > 0
select
misc
sdoc
= str(document, 2) + str(coddoc, 6)
find
'&sdoc'
if
found()
activate
window enwind
@
0,1 say 'Document deja existent!'
return .f.
else
deactivate
window errwind
return .t.
endif
else
retum
.t.
endif
***************************
*
Procedure: DEL_REC
* Called
by:GET_ITEMS (procedure in BC.PRG)
*
Calls: MIN() : (function in?)
*
STR() (function in?)
******'****************************,*****
515 function del_rec
516 parameter recnr &&
rec to delete
517 select tmp
518 if records >= recnr
519
totcant=toitcant-cant
520
totval=totval-cant*pret
521 delete
522 skip
523 records=records-1
524 if records < recnr
525 if records > 0
526 go bott
527 vcod=cod
528 vcont=cont
529
vpret = pret
530
vcant = cant
531
skip
532
endif
533
@ row_nr,0 clear to row_nr,68
534
for i=5 to 53 step 16
535
@ row_nr, i say 'l' .
536
endfor
537
modifying=.f.
538
else
539
vcod = cod
540
vcont = cont
541
vpret = pret
542
vcant = cant
543
scroll row_nr, 0,8,68,1
544
dif=recnr-row_nr
545
for i = row_nr to min(8,row_nr+records-recnr)
546 @ i,1 say str(i+dif,2)+'.'
547 endfor
548 if records>=dif+8
549 skip 8 - row_nr
550 @ 8, 1say str(i,2)+'.'
551 @ 8,09 say cod picture
[9999999999]
552 @ 8, 23 say cont
553 @ 8,40 say cant picture
[9999999.999]
554 @ 8,57 say cant * pret picture
[99999999.99]
555 skip row_nr - 8
556 endif
557 for i=5 to 53 step 16
558 @ 8, i say''
559 endfor
560 endif
561 endif
562 retum 7
563
565 *: EOF: BC.ACT
Este
programul de introducere pentru bonurile de consum (singurul
program
prezentat pentru introducerea de documente). Celelalte
programe de introducere a
documentelor: note de
intrare-recepţie, proces verbal de custodie, facturi, note de
transfer, etc) suntprograme asemănătoare având evident şi
unele deosebiri faţă de acestea. Va fi prezentat in extenso (ca şi
celelalte programe) după ce vor fi listate toate programele.
*******************************
*
Program: C:\CURS\PROGT\ADDSTOC.PRG
- System: Evidenta situatiilor financiar-contabile
*
Author: Emil Pfeiffer
*
Copyright (c) 1998, Emil Pfeiffer
*
Last modified: 05/21/97 9:37
*
Called by: GET_ITEMS (procedure in BC.PRG)
*
Calls: USED() (function in?)
*
:STR() (function in?)
*
:FOUND() (function in?)
*
:RECNO(): (function in?)
*
DATE() (function in?)
*
Uses: MTOT.DBF
*
: MISC3.DBF
*
: STOC.DBF
*
Indexes: MTOT.IDX
*
: MISC3.IDX
*
: INDSTOC.IDX
*
Documented 08/14/98 at 10:20 FoxDoc
**************************************
28
parameter doc.pmag
29
priv lmag, lcod, xx
30
if flmped
31
select 8
32
use mtot index mtot
33
endif
34
select 5
35
use misc3 inde misc3
36
select 7
37
openned = used()
38
if .not.opened
39
use stoc inde indstoc
40
endif
41
select tmp
42
if vcont='351'.and.doc=16
43
repl all cont with vcont
44
go top
45
endif
46
scan all
47
if doc=9.and.cont='351'
48
lmag=pmag
49
lcod=cod
50
else
51
if cod=0
52
lmag=0
53
else
54
lmag=pmag
55
endif
56
lcod=cod
57
endif
58 if
doc=9.and.tmp.cont=l351'.and.tmp.codies#0.and;
.tmp.codies#tmp.cod
59
vind = str(lmag,2)+str(cod, 10)
60
vind1=str(codies,10)
61
else
62
vind = str(lmag,2)+str(lcod,10)
63
vind1=str(lcod,10)
64 endif
65
select stoc
66
seek vind
67
if.not.found()
68
append blank
69
repl codmater with lcod, codmag with Imag, cantitate with 0,
70
i with 0, pi with 0, o with 0, po with 0
71
endif
72
if doc=33
73 rep! o with o -
tmp->cant, po with po - tmp->valooare
74
else
75
if doc>10.and.doo#33
76
if doc = 16 .and. tmp->cont='351'
77
reccr=recno()
78
seek '0'+vind1
79
if not.found()
80
append blank
81 repl codmater
with lcod, codmag with 0, o with 0, po with 0
82
endif
83
repl i with i+tmp->cant, pi with pi+tmp->valoare
84
go reccr
85
endif
86
if doc=15
87
repl o with o-tmp.cant, po with po-tmp.valoare
88
endif
89
if doc#15.and.doc#33
90
repl o with o + tmp->cant, po with po + tmp->valoare
91
endif
92
else
93
if doc <> 9.and.doc<>7
94
replace i with i + tmp->cant
95
replace pi with pi + tmp->valoare
96
else
97
if tmp.cont<>'351'
98
replace i with i -tmp.cant
99
replace pi with pi-tmp.valoare
100
endif
101 if
tmp->cont='351'
102
reccr=recno()
103
seek vind
104
replace pi with pi+tmp->valoare
105
replace i with i+tmp->cant
106
seek '0'+vindl
107
replace po with po+tmp->valoare,o with o+tmp->cant
108
go reccr
109
else
110
seek vind
111
replace i with i+tmp->cant
112
sele nom
113
seek str(tmp.cod,10)
114
sele stoc
115
replace pi with pi + tmp->cant*nom->pretunitar
116
endif
117
endif
118
endif
118
endif
120
if doc>10.and.lmag#0
121
select misc3
122
seek str(tmp->mag,2)+str(tmp->cod,10)
123
if .not. found()
124
appe blank
125
repl cod with tmp->cod, mag with Imag, data with date()
126
endif
127
if doc=33
128
repl etcr with etcr-tmp->cant,mag with Imag
129
endif
130
if doc<14
131
repl eccr with eccr+tmp->cant.mag with Imag
132
endif
133
if doc=11 .or.doc=12
134
if data<tmp->data
135
repl data with tmp->data
136
endif
137
endif
138
select tmp
139
endif
140
if doc<10.and.lmag#0
141
se!ect misc3
142
seek str(tmp->mag,2)+str(tmp->cod,10)
143
if.not.found()
144
appe blank
145
repl cod with tmp->cod, mag with Imag, data with date()
146
endif
147
repl etcr with etcr+tmp->cant,mag with Imag
148
endif
149
if flpmed
150
select tmp
151 if (type= 1
.and. (cont='401' .or. cont='498')) .or.;
152
(type= 16 .and. cont='400') .or.;
153
(type= 9 .and. cont='401') .or. type=33
154
select mtot
155
seek str(tmp->cod, 10)
156
if.not.found()
157
append blank
158
repl codmater with tmp->cod, cantitate with 0, i with 0, ;
159
pi with 0, o with 0, po with 0
160
endif
161
do case
162
case tmp->type = 1
163
valo = tmp->valoare
164
cantit = tmp->cant
165
case tmp->type=16
166
valo = -tmp->valoare
167
cantit = -tmp->cant
168
case tmp->type = 9
169
cantit = tmp->cant
170
select nom
171
seek str(tmp->cod,10)
172
select mtot
173
valo = cantit*nom->pretunitar
174
endcase
175
repl cantitate with cantitate+cantit
176
repl valoare with valoare+valo
177
select nom
178
seek str(tmp.cod,10)
179
if(mtot,cantitate + mtot.i + mtot.o + mtot.pi;
180
+mtot.po) # 0.and. mtot.cantitate + mtot.i - mtot.o > 0
181
replace pretmediu with (mtot.cantitate * pretunitar ;
182 +
'ntot.pi - mtot.po) / (mtot.cantitate + mtot.i - mtot.o)
183
else
184
replace pretmediu with pretunitar
185
endif
186
endif
187
endif
188
select tmp
189
endscan
190
if flpmed
191
sele 8
192
use
193
endif
194
if .not.opened
195
sele 7
196
use
197
endif
198
return
199
* EOF: ADDSTOC.ACT
Acest program
(ADDSTOC.PRG) realizează adăugarea poziţiilor de materiale
(produse finite) în fişierul de stocuri în momentul
operării meterialului (produsului) În acest fel toate
materialele existente în fişierul de mişcări vor fi prezente
şi în fişierul de stoc. Când se va consulta
fişierul de stoc (în orice moment) vor fi obţinute situaţii
la zi având toate documentele operate prezente. Există
un program asemănător(SUBSTOC.PRG) care realizează operarea
ştergerilor din STOC .adică operarea documentelor de corecţie
(care pot avea şi ştergeri) în fişierul de stoc.
1
|
*******************************
|
2
|
|
3
|
Procedure
file: C:\CURS\PROGT\CORMENU.PRG
|
4
|
|
5
|
System:
Evidenta situatiilor financiar-contabile
|
6
|
Author:
Emil Pfeiffer
|
7
|
Copyright
(c) 1998, Emil Pfeiffer
|
8
|
Last
modified: 08/19/91 15:47
|
9
|
|
10
|
Procs
& Fncts: CORIMENU
|
11
|
:COROMENU
|
12
|
|
13
|
Set
by:MENUS.PRG
|
14
|
|
15
|
Calls:
BAR() (function in ?)
|
16
|
CORIMENU
(procedure in CORMENU.PRG)
|
17
|
COROMENU
(procedure in CORMENU.PRG)
|
18
|
FIS.PRG
|
19
|
|
Documented
08/14/98 at 10:19 FoxDoc
|
|
21
|
********************************************
|
22 choice
= bar()
23 do
case
24 case
choice = 1
25 do
corimenu
26 case
choice = 2
27 do
coromenu
28 case
choice = 3
29 do
fls
30 endcase
31 clear
32 retum
33
*
41
**********************************
42
* procedure: CORIMENU
43
* Called by: CORMENU.PRG
44
*
45
*********^************************
46 *
|
41
procedure corimenu 42 42 activate popup indpop
43
return
44*
|
52
*******************************************
53
*
54
*! Procedure: COROMENU
55
*!
56
* Called by: CORMENU.PRG
57*!
|
58
*********************'***********
|
52
procedure coromenu
53
activate popup ieslpop
54
return
55
*: EOF: CORMENU.ACT
CORMENU.PRG este un
program meniu construit pentru a se putea selecta şi lansa
programele de corecţie. Programele de corecţie (singurul ce va fi
discutat aici este CORBC..PRG) au fost concepute pentru a putea
corecta eventualele erori de introdusere din documente. Având
în vedere că funcţionarea lor este asemănătoare cu a
prograrnelor de introducere cu diferenţa că se vizualizează
documentul introdus şi se pot aduce corecţii corecţii la acest
document. Corecţiile se fac de asemenea şi în fişieruf de
stoc care este adus la zi.
1
******************************************
2
*
3
* Procedure file: C:\CURS\PROGT\F!S.PRG
4
*
5
* System: Evidenta situatiilor financiar-contabile
6
* Author: Emil Pfeiffer
7
* Last modified: 08/21/98 10:41
8
*
9
* Procs & Fncts: SCROLLING
10
*
11
* Setby:CORMENU.PRG
12
*
13
* Calls: STR() (function in ?)
14
* CCONTROL (procedure in FIN.PRG)
15 * IS_MAT()
(function in actmenu.prg)
16
* LEFT() (function in?)
17
* RECCOUNT() (function in?)
18
* FOUND() (function in?)
19
* DTOC() (function in?)
20
* SCROLLING (procedure in FIS.PRG)
21
*
22
* Uses: STOC.DBF
23
* TYPE.DBF
24
* MISC.DBF
25
* NOM.DBF
26
* FISTMP.DBF
27
* FTMP.DBF
28
*
29
* Indexes: INDSTOC.IDX
30
* TYPE.IDX
31
* FISMISC.IDX
33
* INDNOM.IDX
34
* IFISTMP.IDX
35
*
36
* Documented 08/21/98 at 10:48 FoxDoc
37
***********************************************
38
set intensity on
39
set talk off
40
set status off
41
set bell off
42
set notify off
43
set near on
44
set confirm on
45
hide popup all
46
hide menu all
47
deactivate window all
48
activate screen
49
clear
50
close data
51
select e
52
use stoc index indstoc
53
select d
54
use type index type
55
select c
56
use misc inde fismisc
57 set filter to
.not. (type=9 .and. cont='206')
58
dime win(2)
59
win(1) = 'inwin'
60
win(2) = 'outwin'
61
define window titwin from 0,0 to 3, 79 title ;
'FISAdeMAGAZIE'double
62
defîne window inwin from 8,1 to 22,38
63
define window outwin from 8,40 to 22, 78
64 define
windoweirwin from 15,15 to 20,65 double
65 define window
scrollwin from 3,15 to 5,65 double
66
@ 4,0 to 24,79 double
67
@ 6,1 to 6,78
68
@ 5,39 to 23, 39
69
@ 4,39 say 'l'
70
@ 6,39say '+'
71
@ 24,39 say '┘'
72
@ 5,15 say 'INTRARI'
73
@ 5,55 say 'IESIRI'
74 @ 7,1 say 'Tip
Nr.Doc Data Cantitate'
75 @ 7,40 say 'Tip
Nr.Doc Data Cantitate'
76
@ 7,1 fill to 7,78
77
select b
78
use nom index indnom
79
sele a
80
use fistmp
81
zap
82
set relation to str(type,2) into type
83
activate window titwin
84
vag = o
85
@ 0,0 say 'Mag:' get vmag picture '99'
86
read
87
vcod = 0
88
do while vmag#0
89
@ 0,9 say 'Cod:' get vcod picture '99999999' valid vcod = 0;
90
.or. (ccontroi(vcod) .and. is_mat(vmag, vcod))
91
read
92
do while vcod#0
93
scod = str(vcod,8)
94
select b
95
seek str(vcod,8)
96
select e
97
seek str(vmag,2)+str(vcod,8)
98
select a
99
@ 0,25 say 'UM : '+b->unitmas
100
@ 0,34 say 'Pret: '+str(b->pretunitar, 10,3)
101
@ 1, 0 say 'Denumire: '+left(b->denumire, 30)
102
@ 1,42 say 'STOC: '+str(e->cantitate, 10,3)+' ->'
103
stocin = e->cantitate
104
activate window errwin
105
clear
106
@ 0,22 say 'Asteptati un moment...'
107
select misc
108
if reccount()>0
109
scod = str(vcod,8)
110
store 0 to totin, totout, nrin, nrout
111
seek str(vcod,8)
112
if found()
113
copy to ftmp rest for cod = vcod .and. cant<>.and. mag =
vmag
114
select tistmp
115
zap
116
append from ftmp
117
index on str(type, 2)+dtoc(data, 1) to ifistmp
118
count for type < 10 to nrin
119
sum cant totout for type<10
120
sum cant to totout for type > 10
121
nrout = reccount() - nrin
122
deactivate window errwin
123
activate window titwin
124
@ 1, 65 say stocin + totin - totout picture '9999999.999'
125
if nrout>0
126
find '11'
127
activate window outwin
128
clear
129
if nrout>13
130
activate screen
131
@ 5,75 say '+'
132
activate window outwin
133
for i=1 to13
134
? type->short, nrdoc,' '.data, cant
135
skip
136
endfor
137
else
138
activate screen
139
@ 5,75 say " "
140
activate window outwin
141
for i=1 to nrout
142
? type->short, nrdoc,' ',data, cant
143
skip endfor endif endif ]fnrin>0
144
find '1'
145
activate window inwin
146
clear
147
if nrin>13 -
148
activate screen
148
@ 5,35 say '+'
149
activate window inwin
150
clear
151
if nrin<13
152
activate screeen
153
@ 5,35 say '+'
154
activate windows inwin
155
for i=1 to 13
156
?type->short, nrdoc,' ',data, cant
157
skip
158
endfor
159
else
160
activate screen
161
@ 5,35 say ' '
162
activate window inwin
163
for i=1 to nrin
164
? type->short, nrdoc, ' '.data, cant
165
Skip
166
endfor
167
endif
168
endif
169
endif
170
else
171
store 0 to totin, totout, nrin, nrout
172
endif
173
deativate window errwin
Niciun comentariu:
Trimiteți un comentariu