-
Notifications
You must be signed in to change notification settings - Fork 0
/
CADBAX.PRG
244 lines (243 loc) · 8.43 KB
/
CADBAX.PRG
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
*****************************************************************************
* Funcao : CADbax *
* Objetivo : Manuten‡Æo do Cadastro de Baixas *
* Autor : Joacir Gon‡alves dos Santos *
*****************************************************************************
FUNCTION CADbax()
Local tipo, cliente, ndoc, valorpp
local ndupl, npp, valorp, datap
Local Tela, linha1, linha2
Private Getlist := {}
ABREabt() && Abre arquivo de lancamentos
abrecli() && Abre arquivo de clientes fornecedores
abrehis() && Abre arquivo de historicos
abrepag() && Abre arquivo de baixas
abreban() && Abre arquivo de contas
linha1 := savescreen(00,00,03,79)
linha2 := savescreen(21,00,24,79)
Setcolor ("bg+ /n,bg+ /n")
borda (03,00,21,79)
restscreen (00,00,03,79,linha1)
restscreen (21,00,24,79,linha2)
@ 02,41 say padc ("Baixas Diversos",38) color("w+/n")
Setcolor ("bg+ /n")
@ 05,08 clear to 18,71
@ 05,08 to 18,71
@ 06,10 say "N§ da duplicata....: "
@ 07,10 say "Cliente/Fornecedor.: -"
@ 08,10 say "N§ do Documento....: "
@ 09,10 say "N§ de Parcelas.....: "
@ 10,10 say "C¢digo Hist¢rico...: "
@ 11,10 say "Data de EmissÆo....: "
@ 12,10 say "Data de Vencimento.: "
@ 13,10 say "Valor Total........: "
@ 14,10 say "Valor por Parcela..: "
@ 15,10 say "Parcelas pagas.....: "
@ 16,10 say "Valor pago.........: "
@ 17,10 say "Data do pagamento..: "
@ 22,01 clear to 22,78
@ 24,00 say padc("Esc-Sair Enter-Confirma F2-Consulta F5-Altera F6-Exclui "+chr(024)+chr(025)+chr(027)+chr(026)+" -Movimenta",78) color ("w+ /b")
Tela := Savescreen(00,00,24,79)
Do while .t.
Restscreen(00,00,24,79,Tela)
set cursor on
Set Confirm off
ndupl := 0
valorpp:= 0.00
pag->(dbgobottom())
set key -1 to l_bax()
ndupl := pag->ndupli + 1
@ 06,31 get ndupl pict "99999999" valid ndupl > 0 && Entra com nduplicata
read
set key -1 to
if lastkey() = 27
exit
endif
ban->(dbseek(" 1")) && busca conta caixa
if ban->(!found())
mens("Conta do Caixa ainda nÆo foi criada !!",.t.,.t.)
exit
endif
pag->(dbseek(str(ndupl,8,0)))
if pag->(found())
set cursor off
@ 07,31 say substr(pag->clifor,7,1) + "-" + substr(pag->clifor,1,6)
cli->(dbseek(pag->clifor))
if cli->(found())
@ 07,40 say cli->nome
else
@ 07,40 say "NÆo encontrado !"
endif
@ 08,31 say pag->nrodoc
@ 09,31 say pag->npapag
@ 10,31 say pag->codhis
his->(dbseek(str(pag->codhis,4,0)))
if his->(found())
@ 10,40 say his->descri
else
@ 10,40 say "Hist¢rico nÆo encontrado !"
endif
@ 11,31 say pag->dtaabt
@ 12,31 say pag->dtavcm
@ 13,31 say transform(pag->valorap,"@e 999,999,999.99")
valorpp := pag->valorap / pag->npapag
@ 14,31 say transform(valorpp,"@e 999,999,999.99")
@ 15,31 say pag->nppaga
@ 16,31 say transform(pag->valorpg,"@e 999,999,999.99")
@ 17,31 say pag->dtapag
do while .t.
Inkey(0)
@ 22,01 clear to 22,78
If lastkey() # 27 .and. lastkey() # 13 .and. Lastkey() # -4 .and. Lastkey() # -5
Mens("Tecla Inv lida!!!",.t.,.t.)
Loop
Endif
exit
enddo
if lastkey() = 27 .or. lastkey() = 13
loop
endif
Do Case
case Lastkey() = -5 && ExclusÆo
set cursor on
If Confirma("ExclusÆo")
if his->tipo = "D"
ban->salatu := ban->salatu + pag->valorpg
else && atualiza saldo
ban->salatu := ban->salatu - pag->valorpg
endif
abt->(dbseek(pag->clifor + pag->nrodoc)) && busca lancamento
if abt->(found())
abt->nparce := abt->nparce + pag->nppaga
abt->valorap:= abt->valorap + pag->valorpg
else
abt->(dbappend()) && reinclui lancamento
abt->codcli := pag->clifor
abt->nrodoc := pag->nrodoc
abt->nparce := pag->nppaga
abt->dtaabt := pag->dtaabt
abt->valorap := pag->valorpg
abt->dtavcm := pag->dtavcm
abt->codhis := pag->codhis
endif
pag->(Dbdelete()) && remove baixa
Endif
Loop
case Lastkey() = -4 && Altera‡Æo
set cursor on
npp := 1
datap := date()
@ 15,31 get npp pict "99" valid npp > 0 .and. npp <= pag->npapag
read
if lastkey() = 27
loop
endif
valorp := valorpp * npp
@ 16,31 get valorp pict "@E 999,999,999.99"
@ 17,31 get datap valid datap >= abt->dtaabt
read
if lastkey() = 27
loop
endif
If Confirma("Altera‡Æo")
abt->(dbseek(pag->clifor + pag->nrodoc)) && busca lancamento
if his->tipo = "D"
ban->salatu := ban->salatu + pag->valorpg
ban->salatu := ban->salatu - valorp
abt->valorap:= abt->valorap + pag->valorpg
abt->valorap:= abt->valorap - valorp
else
ban->salatu := ban->salatu - pag->valorpg
ban->salatu := ban->salatu + valorp
abt->valorap:= abt->valorap - pag->valorpg
abt->valorap:= abt->valorap + valorp
endif
abt->nparce := abt->nparce + pag->nppaga
abt->nparce := abt->nparce - npp
if abt->nparce = 0
abt->(dbdelete())
endif
pag->nppaga := npp
pag->dtapag := datap
pag->valorpg := valorp
Endif
Endcase
else
cliente:= 0
ndoc := 0
tipo := space(1)
l_lan() && Mostra lanc/tos
if lastkey() = 27
loop
endif
@ 07,31 get tipo pict "!" && Entra com tipo
read
set key -1 to
set confirm on
@ 07,33 get cliente pict "999999" valid cliente > 0 && entra com cli/for
@ 08,31 get ndoc pict "99999999" valid ndoc > 0 && entra com n§ docto
read
cli->(dbseek(str(cliente,6,0)+tipo))
@ 07,40 say cli->nome
abt->(dBSeek(str(cliente,6,0)+tipo+str(ndoc,8,0)))
if abt->(!Found())
loop
endif
@ 09,31 say abt->nparce
@ 10,31 say abt->codhis
his->(dbseek(str(abt->codhis,4,0)))
if his->(found())
@ 10,40 say his->descri
else
@ 10,40 say "Hist¢rico nÆo encontrado !"
endif
@ 11,31 say abt->dtaabt
@ 12,31 say abt->dtavcm
@ 13,31 say transform(abt->valorap,"@e 999,999,999.99")
valorpp := abt->valorap / abt->nparce
@ 14,31 say transform(valorpp,"@e 999,999,999.99")
set cursor on
npp := 1
datap := date()
@ 15,31 get npp pict "99" valid npp > 0 .and. npp <= abt->nparce
read
if lastkey() = 27
loop
endif
valorp := valorpp * npp
@ 16,31 get valorp pict "@E 999,999,999.99"
@ 17,31 get datap valid datap >= abt->dtaabt
read
if lastkey() = 27
loop
endif
If Confirma("InclusÆo")
pag->(dbappend())
pag->ndupli := ndupl
pag->nrodoc := str(ndoc,8,0)
pag->clifor := str(cliente,6,0) + tipo
pag->nppaga := npp
pag->npapag := abt->nparce
pag->dtapag := datap
pag->valorpg := valorp
pag->valorap := abt->valorap
pag->dtaabt := abt->dtaabt
pag->dtavcm := abt->dtavcm
pag->codhis := abt->codhis
if his->tipo = "D"
ban->salatu := ban->salatu - valorp && decrementa saldo
else
ban->salatu := ban->salatu + valorp && incrementa saldo
endif
if abt->nparce - npp = 0
abt->(dbdelete()) && apaga lancamento
else
abt->nparce := abt->nparce - npp && decrementa parcela
abt->valorap := abt->valorap - valorp && decrementa valor
endif
Endif
endif
Enddo
Dbcloseall()
set cursor off
Return Nil