romfast/roaregistratura
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
56bcbb20a20f459f4bf00bf368cdfa55acccd1e6
roaregistratura/Programe/Vechi/pmenu.prg

4579 lines
99 KiB
Plaintext
Raw Blame History

*--------------------------------------------
Function deschide_menu
Parameters tabela, cc1,cc2,mnrtata,stinga,sus,ONT
Public nt,no,m
nt=Alltrim(tabela)+'_'+Alltrim(Str(mnrtata))
If Upper(Left(tabela,6))='_MENU1'
no='o'+nt
zz='SELECT '+cc1+' AS C1, '+cc2+' AS C2,nrnod,PROCEDURA,TATAFIU,ID_SET,LISTA_NOTE FROM '+;
tabela+' WHERE NRTATA='+Alltrim(Str(mnrtata))+' INTO CURSOR '+nt
Else
no='o_'+nt
zz='SELECT '+cc1+' AS C1, '+cc2+' AS C2,nrnod,PROCEDURA,TATAFIU,ID_SET FROM '+;
tabela+' WHERE NRTATA='+Alltrim(Str(mnrtata))+' INTO CURSOR '+nt
Endif
&zz
m=0
Select &nt
Scan
mm=Len(Alltrim(c1))
m=Iif(m>mm,m,mm)
Endscan
ta=_Tally
If ta=0
Return '0'
Endif
If Type("&no")!='O'
Public &no
zz=no+'=crea("menuclasic")'
&zz
With &no
wm=m*7
.NUME=no
.ONUMETATA=ONT
.Left=stinga
.Top=sus
.tabela=tabela
.camp1=cc1
.camp2=cc2
.sursa=nt
.Width=wm+2*.margine
.NRFII=ta
.rh=.container1.cwm1.Height
.Height=(.rh+1)*.NRFII+2*.margine+2
*.show()
Endwith
Endif
Release nt,m
Return no
*------------------------------------------------------------------------------------------
Procedure deschide_menuuri
*!* If !Used('menu1')
*!* Use &DIRGEN\CONTAB\Date\menu1 In 0 Alias menu1 Order Tag 'nrnod'
*!* Endif
*!* If !Used('menu2')
*!* Use &DIRGEN\CONTAB\Date\menu2 In 0 Alias menu2 Order Tag 'nrnod'
*!* Endif
*!* If !Used('menu3')
*!* Use &DIRGEN\CONTAB\Date\menu3 In 0 Alias menu3 Order Tag 'nrnod'
*!* Endif
*!* If !Used('menu4')
*!* Use &DIRGEN\CONTAB\Date\menu4 In 0 Alias menu4 Order Tag 'nrnod'
*!* Endif
*!* If PRIMADATA
*!* Do CE_WINDOWS
*!* omenuvertical=Crea('menuvertical')
*!* omenuvertical.Show()
*!* Endif
*deschide_menu(tabela, cc1,cc2,mnrtata,stinga,sus,ONT
Return
*--------------------------------------
Procedure CE_WINDOWS
Local vermajor,verminor
Public TIP_MENU,COL_MENU,cewin
Store '' To cewin
Store 0 To vermajor,verminor,TIP_MENU
vermajor=Val(Os(3))
verminor=Val(Os(4))
Do Case
Case vermajor<4
cewin='95'
Case vermajor=4
cewin='98'
Case vermajor>=5
Do Case
Case verminor=0
cewin='2000'
Case verminor=1
cewin='XP'
Otherwise
cewin='MAINOU'
Endcase
Endcase
*IF INLIST(CEWIN,'95','98','2000')
TIP_MENU=0&&'RAISED'
*ELSE
*TIP_MENU=2&&'FLAT'
*ENDIF
*!* Do Case
*!* Case Inlist(cewin,'95','98')
*!* COL_MENU=Rgb(192,192,192)&&GRI
*!* Case cewin='2000'
*!* COL_MENU=Rgb(212,208,200)&&NISIP GRI
*!* Case cewin='XP'
*!* COL_MENU=Rgb(236,233,216)&&NISIP BEJ
*!* Otherwise
COL_MENU=Rgb(255,255,255)&&ALB
*!* Endcase
Return
*--------------------------------------
Function SCRIE_IN_FISIERE
Parameters INFORMGEST
*!* DEBUG
*!* SUSPEND
Local M.DEB,M.CRED,COND
Store 0 To M.DEB, M.CRED
Public OZ
COND='(Empty(SUMA) AND INLIST(XSETS.ID_SET,70))'&&INREGISTRARI CU SUMA 0
*!* SELECT actactan
*!* SCAN
*!* SCATTER NAME loCont
*!* IF EMPTY(loCont.ascd)
*!* SELECT plcontana
*!* LOCATE FOR cont=locont.scd
*!* IF FOUND()
*!* loCont.ascd='0000'
*!* ENDIF
*!* ENDIF
*!* IF EMPTY(loCont.ascc)
*!* SELECT plcontana
*!* LOCATE FOR cont=locont.scc
*!* IF FOUND()
*!* loCont.ascc='0000'
*!* ENDIF
*!* ENDIF
*!* SELECT actactan
*!* GATHER NAME loCont
*!* ENDSCAN
*!* RELEASE loCont
DD=Datetime()
Do CODARE
Select ACTACTAN
Replace All COD With M.COD
Replace All UTIL With UTILIZATOR, DATAORA With DD
Go Top
Scatter Name OZ
Select ACTACTAN
Scan For !Empty(SUMA) OR &COND
Scatter Memv
Select ACT
If Flock()
Append Blank
Gather Memv
Endif
Unlock
Select ACTAN
If Flock()
Append Blank
Gather Memv
Endif
Unlock
Select ACTACTAN
Endscan
Do Case
Case Left(Upper(INFORMGEST),3)='NIR'
Do SCRIE_NIR
Case Left(Upper(INFORMGEST),3)='BON'
Select IESIRI
Replace All COD With M.COD
IF !INLIST(M.ID_SET,70)
Do IERULAJMAGAZII
Do IESTOCURIMAGAZII
ENDIF
If Inlist(M.ID_SET,74,75,76)&&TRANSFER
Select INTRARI
Replace All COD With M.COD
Do INRULAJMAGAZII
Do INSTOCURIMAGAZII
Endif
Case Upper(INFORMGEST)='SCHIMBPRET'
Select INTRARI
Replace All COD With M.COD
Select IESIRI
Replace All COD With M.COD
Do IERULAJMAGAZII
Do IESTOCURIMAGAZII
Do INRULAJMAGAZII
Do INSTOCURIMAGAZII
Endcase
&& TABELA DE CONTURI
*!* IF USED('conturi')
*!* USE IN conturi
*!* ENDIF
*!* IF USED('cc')
*!* USE IN cc
*!* ENDIF
IF _program='cont'
Select Distinct SCD As Cont,ascd as acont,99999999999999 As DEB,;
99999999999999 As CRED,99999999999999.99 As DEBVAL,99999999999999.99 As CREDVAL;
FROM ACTACTAN Into Table &LOC\&NFSCURT\TEMPO\CONTURI
ELSE
Select Distinct SCD As Cont,ascd as acont,99999999999999 As DEB,;
99999999999999 As CRED,99999999999999.99 As DEBVAL,99999999999999.99 As CREDVAL;
FROM ACTACTAN Into Table &LOC\&NFSCURT\TEMPO\CONTURI_g
USE IN conturi_g
USE &LOC\&NFSCURT\TEMPO\CONTURI_g IN 0 ALIAS conturi
ENDIF
Select CONTURI
Replace All DEB With 0, CRED With 0,DEBVAL With 0, CREDVAL With 0
Select Distinct SCC As Cont,ascc as acont From ACTACTAN;
WHERE SCC+ASCC Not In (Sele Distinct Cont+ACONT From CONTURI);
INTO Cursor CC
Select CONTURI
Append From Dbf('CC')
Select CONTURI
Scan
Scatter Memv
Select ACTACTAN
Sum SUMA To M.DEB For SCD=M.CONT AND ascd=m.acont
Sum SUMA To M.CRED For SCC=M.CONT AND ascc=m.acont
Sum SUMA_2 To M.DEBVAL For SCD=M.CONT AND ascd=m.acont
Sum SUMA_2 To M.CREDVAL For SCC=M.CONT AND ascc=m.acont
Select CONTURI
Gather Fields DEB, CRED,DEBVAL,CREDVAL Memv
Endscan
&& SCRIE IN BALANTA
Select CONTURI
Scan
Scatter Memv
Select BAL
If Flock()
LOCATE FOR cont=M.CONT
If !Found()
Sele PLCONT
Locate For Left(CIMP1,4)=Left(M.CONT,4)
If Found()
Do MESAJ With 'Se introduce in balanta contul',M.CONT
Scatter Memvar
m.CONT=M.CIMP1
m.denumire=m.cimp2
Sele BAL
If Flock()
Append Blank
Gather Memvar
Endif
Unlock
Else
Do MESAJ With 'Contul '+M.CONT+' nu este introdus','nici in planul de conturi si nici in balanta!'
Do Form contnou
Endif
Endif
Select BAL
Replace RULDEB With RULDEB+M.DEB, TOTDEB With TOTDEB+M.DEB,;
RULCRED With RULCRED+M.CRED, TOTCRED With TOTCRED+M.CRED
SOLD=TOTDEB-TOTCRED
Replace SOLDDEB With Iif(SOLD>0,SOLD,0), SOLDCRED With Iif(SOLD<0,-SOLD,0)
Endif
Unlock
Select CONTURI
Endscan
&&scrie in balanta analitica
Select ascd,ascc From ACTACTAN Where !Empty(ascd) Or !Empty(ascc) Into Cursor aacont
If _Tally<>0
Select balana
If Flock()
Select ACTACTAN
Scan
Scatter Memv
&&deb
IF !EMPTY(m.ascd)
Select balana
Seek m.SCD+m.ascd
If !Found()
Seek m.SCD+'0000'
If !Found()
Append Blank
Replace Cont With m.SCD
Replace acont With '0000'
Endif
Endif
Replace RULDEB With RULDEB+M.suma, TOTDEB With TOTDEB+M.suma
SOLD=TOTDEB-TOTCRED
Replace SOLDDEB With Iif(SOLD>0,SOLD,0)
endif
&&cred
IF !EMPTY(m.ascc)
Select balana
Seek m.SCc+m.ascc
If !Found()
Seek m.SCc+'0000'
If !Found()
Append Blank
Replace Cont With m.SCc
Replace acont With '0000'
Endif
Endif
Replace RULcred With RULcred+M.suma, TOTcred With TOTcred+M.suma
SOLD=TOTDEB-TOTCRED
Replace SOLDcred With Iif(SOLD<0,-SOLD,0)
endif
Select ACTACTAN
Endscan
Endif
Unlock In balana
Endif
&& SCRIE IN FISIERE
Select Distinct A.Cont,b.acont,A.FPROC,B.DEB,B.CRED,B.DEBVAL,B.CREDVAL From INFISIERE A, CONTURI B ;
WHERE A.Cont=B.Cont ;
INTO Cursor COM
*!* SELECT com
*!* BROWSE
Select COM
Scan
Scatter Memv
zz='Do '+Alltrim(FPROC)+' with m.deb,m.cred,M.DEBVAL,M.CREDVAL'
&zz
SELECT COM
Endscan
SELECT com
LOCATE FOR INLIST(cont,'4426','4427')
IF !FOUND()
DO caut_neimpozab WITH 'actactan'
ENDIF
m.NNIR=OZ.NNIR
If Type('OXSET')='O'
If !Empty(OXSET.LISTARE)
zz=Alltrim(OXSET.LISTARE)
zz='DO '+zz
If !Empty(OXSET.PARAM2)
zz=zz+' WITH '+OXSET.PARAM2
Endif
&zz
Endif
Endif
DO inchid_actcv
Do STERGE
Release OZ
Return 0
*-----------------------------------------------
Procedure _401
Parameters debit,credit,VALDEBIT,VALCREDIT
&&&&&&&&&&& FURNIZOR
Select FURNIZOR
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit
Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit
Endif
Unlock
Local di,din,div
SELECT actactan
Sum SUMA To di For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount
Sum neimpozab To din For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount
Sum SUMA_2 To div For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount valuta
&&&&&&&&&&&CUMPLUN
Local nui
Select cumplun
Set Order To nract
&&creditul=factura
If credit!=0 OR din!=0 && discount neimpozabil
nui=.F.
Select ACTACTAN
Locate For SCC=m.CONT AND ascc=m.acont
Scatter NAME o401
Select cumplun
Seek o401.nract
If Found()
Locate For nract=o401.nract And dataact=o401.dataact And NUME=o401.NUME AND acont=o401.ascc
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Memv
Replace totctva With 0,SUMAVAL WITH 0
Endif
Replace totctva With totctva+credit-di
Replace SUMAVAL With SUMAVAL+VALcredit-div
REPLACE cursschimb WITH o401.suma_3
REPLACE ACONT WITH o401.ascc
Endif
Unlock
Endif
RELEASE o401
&&debitul=plata
If debit!=0 OR (credit=0 AND debit=0) && atunci cand sunt sume cu + si -, cu total 0
nui=.F.
Select ACTACTAN
Locate For SCD=m.CONT AND ascd=m.acont
Scatter Memv
Select cumplun
DO CASE
CASE !(COD=M.COD) AND !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_plati With 'cumplun','ascd','nume'
OTHERWISE
Select cumplun
If Flock()
Replace achitat With achitat+debit-di
Replace achitatVAL With achitatVAL+VALdebit-div
Endif
Unlock
ENDCASE
Endif
Select cumplun
Set Order To Tag dataireg
&&&&&&&&&&&CUMP
*!* If credit!=0 OR din!=0 && discount neimpozabil
*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai
*!* Select ACTACTAN
*!* Locate For SCC=m.CONT
*!* Scatter Memv
*!* Sum neimpozab To m.neimpozab For SCC=m.CONT AND ascc=m.acont
*!* m.neimpozab=m.neimpozab-din
*!* * Sum SUMA To di For Left(SCC,1)='7' And SCD=m.CONT &&discount
*!* m.totctva=credit-di
*!*
*!* * Sum suma To m.tvam For Left(scd,3)='442' AND SCC=m.CONT AND ascc=m.acont
*!* Select CONTURI
*!* Locate For Left(Cont,3)='442'
*!* If Found()
*!* m.tvam=DEB-CRED
*!* Endif
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!* ** m.totctva=m.totftvam+m.neimpozab+m.tvam
*!* Select cump
*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME
*!* IF !FOUND()
*!* If Flock()
*!* Append Blank
*!* Gather Memv
*!* Endif
*!* UNLOCK
*!* ELSE
*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab
*!* ENDIF
*!* Endif
Return
*-----------------------------------------------
Procedure _404
Parameters debit,credit,VALDEBIT,VALCREDIT
Select FURNIZ404
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit
Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit
Endif
UNLOCK
Local di,din,div
SELECT actactan
Sum SUMA To di For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount
Sum neimpozab To din For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount
Sum SUMA_2 To div For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount valuta
&&&&&&&&&&&CUMPLUN
Local nui
Select cumplun404
Set Order To nract
&&creditul=factura
If credit!=0 OR din!=0 && discount neimpozabil
nui=.F.
Select ACTACTAN
Locate For SCC=m.CONT AND ascc=m.acont
*Scatter Memv
SCATTER NAME o404
Select cumplun404
Seek o404.nract
If Found()
Locate For nract=o404.nract And dataact=o404.dataact And NUME=o404.NUME AND acont=o404.ascc
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Memv
GATHER NAME o404
Replace totctva With 0,SUMAVAL WITH 0
Endif
Replace totctva With totctva+credit-di
Replace SUMAVAL With SUMAVAL+VALcredit-div
REPLACE cursschimb WITH o404.suma_3
REPLACE ACONT WITH o404.ascc
Endif
Unlock
Endif
&&debitul=plata
If debit!=0 OR (credit=0 AND debit=0)
nui=.F.
Select ACTACTAN
Locate For SCD=m.CONT AND ascd=m.acont
Scatter Memv
Select cumplun404
DO CASE
CASE !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_plati With 'cumplun404','ascd','nume'
OTHERWISE
Select cumplun404
If Flock()
Replace achitat With achitat+debit-di
Replace achitatVAL With achitatVAL+VALdebit-div
Endif
Unlock
ENDCASE
Endif
Select cumplun404
Set Order To Tag dataireg
&&&&&&&&&&&CUMP
*!* If credit!=0 OR din!=0 && discount neimpozabil
*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai
*!* Select ACTACTAN
*!* Locate For SCC=m.CONT
*!* Scatter Memv
*!* Sum neimpozab To m.neimpozab For SCC=m.CONT
*!* m.neimpozab=m.neimpozab-din
*!* * Sum SUMA To di For Left(SCC,1)='7' And SCD=m.CONT &&discount
*!* m.totctva=credit-di
*!* Select CONTURI
*!* Locate For Left(Cont,3)='442'
*!* If Found()
*!* m.tvam=DEB-CRED
*!* Endif
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!* **m.totctva=m.totftvam+m.neimpozab+m.tvam
*!* Select cump
*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME
*!* IF !FOUND()
*!* If Flock()
*!* Append Blank
*!* Gather Memv
*!* Endif
*!* UNLOCK
*!* ELSE
*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab
*!* ENDIF
*!* Endif
RETURN
*-----------------------------------------------
PROCEDURE _4426
Parameters debit,credit,VALDEBIT,VALCREDIT
Store 0 To m.totctvam,m.totftvam,m.tvam,neimpozab,totftvai,tvai
SELECT infisiere
LOCATE FOR cont='4426'
SCATTER NAME ofis
lcCoresp_d=ALLTRIM(ofis.coresp_d)
lcCoresp_c=ALLTRIM(ofis.coresp_c)
SELECT actactan
SUM suma TO tvam_deb FOR scd='4426' AND proc_tva=m.ctvam AND INLIST(ALLTRIM(scc),&lcCoresp_d)
SUM suma TO tvam_cred FOR scc='4426' AND proc_tva=m.ctvam AND INLIST(ALLTRIM(scd),&lcCoresp_c)
m.tvam=tvam_deb-tvam_cred
SUM suma TO tvai_deb FOR scd='4426' AND proc_tva=m.ctvai AND INLIST(ALLTRIM(scc),&lcCoresp_d)
SUM suma TO tvai_cred FOR scc='4426' AND proc_tva=m.ctvai AND INLIST(ALLTRIM(scd),&lcCoresp_c)
m.tvai=tvai_deb-tvai_cred
IF debit#0 OR (credit=0 AND debit=0)
*m.tvam=debit-credit
SELECT SUM(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),neimpozab,IIF(ALLTRIM(scc)='767' AND INLIST(ALLTRIM(scd),&lcCoresp_d),-neimpozab,0))) as neimpozab;
FROM actactan INTO CURSOR tcn
SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),suma,IIF(ALLTRIM(scc)='767' AND INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0))) as totctvam;
FROM actactan WHERE proc_tva=m.ctvam ;
INTO CURSOR tvam
SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),suma,IIF(ALLTRIM(scc)='767' AND INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0))) as totctvai;
FROM actactan WHERE proc_tva=m.ctvai ;
INTO CURSOR tvai
SELECT tvam
SCATTER MEMVAR
SELECT tcn
SCATTER MEMVAR
SELECT tvai
SCATTER MEMVAR
USE IN tvam
USE IN tcn
USE IN tvai
m.totftvam=m.totctvam-m.tvam
m.totftvai=m.totctvai-m.tvai
m.totctva=m.totctvam+m.totctvai+m.neimpozab
IF EMPTY(m.totctva)
RELEASE ofis
RELEASE o4426
RETURN
ENDIF
SELECT actactan
LOCATE FOR scd='4426'
IF !FOUND() OR scc='4428'
GO top
ENDIF
SCATTER NAME o4426
o4426.scd=o4426.scc
Select cump
Locate For nract=o4426.nract AND cod=o4426.cod &&And dataact=m.dataact And NUME=m.NUME
IF !FOUND()
If Flock()
Append Blank
Gather NAME o4426
GATHER MEMVAR
Endif
UNLOCK
ELSE
REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
tvam WITH tvam+m.tvam,totftvai WITH totftvai+m.totftvai, ;
tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab
ENDIF
ENDIF
IF credit#0
*m.tvam=debit-credit
SELECT SUM(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),-neimpozab,0)) as neimpozab ;
FROM actactan INTO CURSOR tcn
SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),-suma,0)) as totctvam ;
FROM actactan WHERE proc_tva=m.ctvam;
INTO CURSOR tvam
SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),-suma,0)) as totctvai ;
FROM actactan WHERE proc_tva=m.ctvai ;
INTO CURSOR tvai
SELECT tvam
SCATTER MEMVAR
SELECT tcn
SCATTER MEMVAR
SELECT tvai
SCATTER MEMVAR
USE IN tvam
USE IN tcn
USE IN tvai
m.totftvam=m.totctvam-m.tvam
m.totftvai=m.totctvai-m.tvai
m.totctva=m.totctvam+m.totctvai+m.neimpozab
IF EMPTY(m.totctva)
RELEASE ofis
RELEASE o4426
RETURN
ENDIF
SELECT actactan
LOCATE FOR scc='4426'
SCATTER NAME o4426
Select cump
Locate For nract=o4426.nract AND cod=o4426.cod &&And dataact=m.dataact And NUME=m.NUME
IF !FOUND()
If Flock()
Append Blank
Gather NAME o4426
GATHER MEMVAR
Endif
UNLOCK
ELSE
REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
tvam WITH tvam+m.tvam,totftvai WITH totftvai+m.totftvai, ;
tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab
ENDIF
ENDIF
RELEASE ofis
RELEASE o4426
RETURN
*-----------------------------------------------
Procedure _408
Parameters debit,credit,VALDEBIT,VALCREDIT
Select ana408
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit
Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit
Endif
Unlock
SELECT DISTINCT scd as cont,ascd as acont,proc_tva,sum(suma) as suma408,sum(suma_2) as suma408_2,"D" as tip ;
from actactan WHERE scd='408 ' AND ascd=m.acont GROUP BY ascd,proc_tva INTO CURSOR t408 ;
UNION ;
SELECT DISTINCT scc as cont,ascc as acont,proc_tva,sum(suma) as suma408,sum(suma_2) as suma408_2,"C" as tip ;
from actactan WHERE scc='408 ' AND ascc=m.acont GROUP BY ascc,proc_tva;
order BY tip
SELECT t408
SCAN FOR tip='C'
SCATTER MEMVAR
&&&&&&&&&&& FACT408
Local nui
Select fact408
Set Order To nract
Select fact408
&&creditul=factura
*If credit!=0
nui=.F.
Select ACTACTAN
Locate For SCC=m.CONT AND ascc=m.acont AND proc_tva=m.proc_tva
Scatter Memv
Select fact408
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont AND proc_tva=m.proc_tva
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Memv
Replace totctva With 0
Replace SUMAVAL With 0
Endif
Select fact408
Replace totctva With totctva+m.suma408 &&credit
Replace SUMAVAL With SUMAVAL+m.suma408_2 &&VALcredit
REPLACE cursschimb WITH m.suma_3
REPLACE ACONT WITH m.ascc
ENDIF
Unlock
*Endif
ENDSCAN
&&debitul=plata
If debit!=0 OR (credit=0 AND debit=0)
nui=.F.
Select ACTACTAN
Locate For SCD=m.CONT AND ascd=m.acont
Scatter Memv
Select fact408
If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_plati With 'fact408','ascd','nume'
Else
Select fact408
If Flock()
Replace achitat With achitat+debit
Replace achitatVAL With achitatVAL+VALdebit
Endif
Unlock
Endif
Endif
Select fact408
Set Order To Tag dataireg
&&&&&&&&&&&CUMP
*!* LOCAL di
*!* If credit!=0
*!*
*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai
*!* Select ACTACTAN
*!* Locate For SCC=m.CONT
*!* Scatter Memv
*!* Sum neimpozab To m.neimpozab For SCC=m.CONT
*!* SUM suma TO di FOR LEFT(scc,1)='7' AND SCd=m.CONT&&discount
*!* m.totctva=credit-di
*!* Select CONTURI
*!* Locate For LEFT(Cont,3)='442'
*!* If Found()
*!* m.tvam=DEB-cred
*!* Endif
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!* Select cump
*!* If Flock()
*!* Append Blank
*!* Gather Memv
*!* Endif
*!* Unlock
*!* Endif
Return
*-------------------------------------------------------------
Procedure _409
Parameters debit,credit,VALDEBIT,VALCREDIT
Select AVANS409
If debit#0
If Flock()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME
If !Found()
Append Blank
Gather Fields Except achitat,facturat,achitatval,factval Memv
Endif
Replace achitat With achitat+debit &&, facturat With facturat+credit
Replace achitatVAL With achitatVAL+VALdebit
REPLACE cursschimb WITH m.suma_3
REPLACE ACONT WITH m.ascd
Endif
Unlock
ENDIF
If credit#0
*!* If Used('actcv1')
*!* Select actcv1
*!* Scan For ALES
*!* Scatter Name av
*!* Select AVANS409
*!* Locate For nract=av.nract And dataact=av.dataact And NUME=av.NUME
*!* If Flock()
*!* Replace facturat With facturat+av.sumaachi
*!* Replace factVAL With factVAL+av.sumaachi2
*!* Endif
*!* Unlock
*!* Select actcv1
*!* ENDSCAN
*!* Release av
*!* ELSE &&la modificare
SELECT actactan
LOCATE FOR LEFT(scc,3)='409'
SCATTER NAME omodif
*!* lcDat=Right(Allt(omodif.NRORD),10)
*!* ldDAT=Ctod(lcDat)
*!* lcNr=Strtran(Strtran(omodif.NRORD,lcDat,''),'/','')
*!* lnNr=Val(lcNr)
Select AVANS409
Locate For nract=omodif.pereche2 And NUME=omodif.NUME
IF FOUND()
If Flock()
Replace facturat With facturat+CREDIT
Replace factVAL With factVAL+valCREDIT
Endif
UNLOCK
ENDIF
Release omodif
*!* ENDIF
*!*
Endif
Select FURNIZOR
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace avans With avans+debit-credit
Replace avansVAL With avansVAL+VALdebit-VALcredit
Endif
Unlock
IF USED('actcv1')
USE IN actcv1
ENDIF
Return
*-----------------------------------------------
Procedure _411
Parameters debit,credit,VALDEBIT,VALCREDIT
Select clienti
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace productie With productie +debit, incasat With incasat+credit
Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit
Endif
UNLOCK
IF id_set=10421
DO regularizare_clienti
IF USED('actcv')
USE IN actcv
ENDIF
RETURN
ENDIF
Local di,din,div
SELECT actactan
Sum SUMA To di For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount
Sum neimpozab To din For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount
Sum SUMA_2 To div For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount valuta
&&&&&&&&&&&vanzLUN
Local nui
Select vanzlun
Set Order To nract
&&debitul=factura
If (debit!=0 OR din!=0) &&AND xsets.id_set!=10421 && discount neimpozabil + regularizari avans-facturi(e uraaaaaaaaaaaaaaaaaat)
nui=.F.
Select ACTACTAN
Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont
Scatter Memv
*!* IF m.ctvam#m.ctvai
*!* SUM suma TO m.totftvam FOR Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont AND proc_tva=m.ctvam
*!* SUM suma TO m.tvam FOR SCc='4427' AND ascd=m.acont AND proc_tva=m.ctvam
*!* SUM suma TO m.totftvai FOR Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont AND proc_tva=m.ctvai
*!* SUM suma TO m.tvai FOR SCc='4427' AND ascd=m.acont AND proc_tva=m.ctvai
*!* SUM suma TO m.neimpozab FOR Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont AND neimpozab#0
*!* ENDIF
Select vanzlun
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont
If !Found()
nui=.T.
Endif
Else
nui=.T.
ENDIF
If Flock()
If nui
Append Blank
Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv
ENDIF
Replace totctva With totctva+debit-di
Replace SUMAVAL With SUMAVAL+VALdebit-div
*!* REPLACE totftvam WITH totftvam+m.totftvam-di,totftvai WITH totftvai+m.totftvai-di,tvam WITH tvam+m.tvam,tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab
REPLACE cursschimb WITH m.suma_3
REPLACE ACONT WITH m.ascd
Endif
Unlock
Endif
&&creditul=plata
If credit!=0 OR (credit=0 AND debit=0)
nui=.F.
Select ACTACTAN
Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont
Scatter Memv
Select vanzlun
DO CASE
CASE !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_incasari With 'vanzlun','ascc','nume'
OTHERWISE
Select vanzlun
If Flock()
Replace achitat With achitat+credit-di
Replace achitatVAL With achitatVAL+VALcredit-div
Endif
Unlock
ENDCASE
Endif
Select vanzlun
Set Order To Tag dataireg
&&&&&&&&&&&vanz
*!* If debit!=0 OR din!=0 && discount neimpozabil
*!* m.totctva=debit-di
*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai
*!* Select ACTACTAN
*!* Locate For SCD=m.CONT
*!* Scatter Memv
*!* Sum neimpozab To m.neimpozab For Left(SCD,3)=Left(m.CONT,3)
*!* m.neimpozab=m.neimpozab-din
*!* Select CONTURI
*!* Locate For Cont='4427'
*!* If Found()
*!* m.tvam=CRED
*!* Endif
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!* Select vanz
*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME
*!* IF !FOUND()
*!* If Flock()
*!* Append Blank
*!* Gather Memv
*!* Endif
*!* UNLOCK
*!* ELSE
*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab
*!* ENDIF
*!* Endif
Return
*-----------------------------------------------
PROCEDURE _4427
Parameters debit,credit,VALDEBIT,VALCREDIT
Store 0 To m.totctvam,m.totftvam,m.tvam,m.neimpozab,m.totftvai,m.tvai
SELECT infisiere
LOCATE FOR cont='4427'
SCATTER NAME ofis
lcCoresp_c=ALLTRIM(ofis.coresp_c)
lcCoresp_d=ALLTRIM(ofis.coresp_d)
SELECT actactan
SUM suma TO tvam_deb FOR scd='4427' AND proc_tva=m.ctvam AND INLIST(ALLTRIM(scc),&lcCoresp_d)
SUM suma TO tvam_cred FOR scc='4427' AND proc_tva=m.ctvam AND INLIST(ALLTRIM(scd),&lcCoresp_c)
m.tvam=tvam_cred-tvam_deb
SUM suma TO tvai_deb FOR scd='4427' AND proc_tva=m.ctvai AND INLIST(ALLTRIM(scc),&lcCoresp_d)
SUM suma TO tvai_cred FOR scc='4427' AND proc_tva=m.ctvai AND INLIST(ALLTRIM(scd),&lcCoresp_c)
m.tvai=tvai_cred-tvai_deb
IF credit#0 OR (credit=0 AND debit=0)
SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),neimpozab,IIF(ALLTRIM(scd)='667' AND INLIST(ALLTRIM(scc),&lcCoresp_c),-neimpozab,0))) as neimpozab ;
FROM ACTACTAN INTO CURSOR tcn
SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),suma,IIF(ALLTRIM(scd)='667' AND INLIST(ALLTRIM(scc),&lcCoresp_c),-suma,0))) as totctvam;
FROM actactan WHERE proc_tva=m.ctvam ;
INTO CURSOR tvam
SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),suma,IIF(ALLTRIM(scd)='667' AND INLIST(ALLTRIM(scc),&lcCoresp_c),-suma,0))) as totctvai;
FROM actactan WHERE proc_tva=m.ctvai ;
INTO CURSOR tvai
SELECT tvam
SCATTER MEMVAR
SELECT tcn
SCATTER MEMVAR
SELECT tvai
SCATTER MEMVAR
USE IN tvam
USE IN tcn
USE IN tvai
m.totftvam=m.totctvam-m.tvam
m.totftvai=m.totctvai-m.tvai
m.totctva=m.totctvam+m.totctvai+m.neimpozab
IF EMPTY(m.totctva)
RELEASE ofis
RETURN
ENDIF
SELECT actactan
LOCATE FOR scc='4427'
IF !FOUND() OR scd='4428'
GO top
ENDIF
SCATTER FIELDS EXCEPT neimpozab MEMVAR
Select vanz
Locate For nract=m.nract AND cod=m.cod &&And dataact=m.dataact And NUME=m.NUME
IF !FOUND()
If Flock()
Append Blank
Gather Memv
Endif
UNLOCK
ELSE
REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
tvam WITH tvam+m.tvam,totftvai WITH totftvai+m.totftvai, ;
tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab
ENDIF
ENDIF
IF debit#0
*!* SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0)) as totctva,;
*!* sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-neimpozab,0)) as neimpozab ;
*!* FROM actactan ;
*!* INTO CURSOR tva
*!*
*!* SELECT tva
*!* SCATTER MEMVAR
*!* m.tvam=credit-debit
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-neimpozab,0)) as neimpozab ;
FROM actactan INTO CURSOR tcn
SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0)) as totctvam ;
FROM actactan WHERE proc_tva=m.ctvam ;
INTO CURSOR tvam
SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0)) as totctvai ;
FROM actactan WHERE proc_tva=m.ctvai ;
INTO CURSOR tvai
SELECT tvam
SCATTER MEMVAR
SELECT tcn
SCATTER MEMVAR
SELECT tvai
SCATTER MEMVAR
USE IN tvam
USE IN tcn
USE IN tvai
m.totftvam=m.totctvam-m.tvam
m.totftvai=m.totctvai-m.tvai
m.totctva=m.totctvam+m.totctvai+m.neimpozab
IF EMPTY(m.totctva)
RELEASE ofis
RETURN
ENDIF
SELECT actactan
LOCATE FOR scd='4427'
SCATTER FIELDS EXCEPT neimpozab MEMVAR
m.scd=m.scc
Select vanz
Locate For nract=m.nract AND cod=m.cod &&And dataact=m.dataact And NUME=m.NUME
IF !FOUND()
If Flock()
Append Blank
Gather Memv
Endif
UNLOCK
ELSE
REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
tvam WITH tvam+m.tvam,totftvai WITH totftvai+m.totftvai, ;
tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab
ENDIF
ENDIF
RELEASE ofis
RETURN
*----------------------------------------------------------------
Procedure _4118
Parameters debit,credit,VALDEBIT,VALCREDIT
Select client4118
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace productie With productie +debit, incasat With incasat+credit
Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit
Endif
Unlock
&&&&&&&&&&&vanzLU4118
Local nui
Select vanzlu4118
Set Order To nract
&&debitul=factura
If debit!=0
nui=.F.
Select ACTACTAN
Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont
Scatter Memv
Select vanzlu4118
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv
Endif
Replace totctva With totctva+debit
Replace SUMAVAL With SUMAVAL+VALdebit
REPLACE cursschimb WITH m.suma_3
REPLACE ACONT WITH m.ascd
Endif
Unlock
Endif
&&creditul=plata
If credit!=0 OR (credit=0 AND debit=0)
nui=.F.
Select ACTACTAN
Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont
Scatter Memv
Select vanzlu4118
If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_incasari With 'vanzlu4118','ascc','nume'
Else
Select vanzlu4118
If Flock()
Replace achitat With achitat+credit
Replace achitatVAL With achitatVAL+VALcredit
Endif
Unlock
Endif
Endif
Select vanzlu4118
Set Order To Tag dataireg
&&&&&&&&&&&vanz
*!* if debit!=0
*!* SELECT vanz
*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME
*!* If Found()
*!* IF FLOCK()
*!* REPLACE scd WITH m.cont
*!* ENDIF
*!* ENDIF
*!* *!* m.totctva=debit
*!* *!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai
*!* *!* Select ACTACTAN
*!* *!* Locate For SCD=m.CONT
*!* *!* Scatter Memv
*!* *!* Sum neimpozab To m.neimpozab For Left(SCC,3)=Left(m.CONT,3)
*!* *!* Select CONTURI
*!* *!* Locate For Cont='4427'
*!* *!* If Found()
*!* *!* m.tvam=CRED
*!* *!* Endif
*!* *!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!* *!* Select vanz
*!* *!* If Flock()
*!* *!* Append Blank
*!* *!* Gather Memv
*!* *!* Endif
*!* *!* Unlock
*!* Endif
RETURN
*-----------------------------------------------
Procedure _418
Parameters debit,credit,VALDEBIT,VALCREDIT
Select ana418
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace productie With productie +debit, incasat With incasat+credit
Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit
Endif
Unlock
*!* &&&&&&&&&&&vanzLUN
*!* Local nui
*!* Select fact418
*!* Set Order To nract
*!* &&debitul=factura
*!* If debit!=0
*!* nui=.F.
*!* Select ACTACTAN
*!* Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont
*!* Scatter Memv
*!* Select fact418
*!* Seek m.nract
*!* If Found()
*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont
*!* If !Found()
*!* nui=.T.
*!* Endif
*!* Else
*!* nui=.T.
*!* Endif
*!* If Flock()
*!* If nui
*!* Append Blank
*!* Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv
*!* Endif
*!* Replace totctva With totctva+debit
*!* Replace SUMAVAL With SUMAVAL+VALdebit
*!* REPLACE cursschimb WITH m.suma_3
*!* REPLACE ACONT WITH m.ascd
*!* Endif
*!* Unlock
*!* Endif
SELECT DISTINCT scd as cont,ascd as acont,proc_tva,sum(suma) as suma418,sum(suma_2) as suma418_2,"D" as tip ;
from actactan WHERE scd='418 ' AND ascd=m.acont GROUP BY ascd,proc_tva INTO CURSOR t418 ;
UNION ;
SELECT DISTINCT scc as cont,ascc as acont,proc_tva,sum(suma) as suma418,sum(suma_2) as suma418_2,"C" as tip ;
from actactan WHERE scc='418 ' AND ascc=m.acont GROUP BY ascc,proc_tva;
order BY tip
&&&&&&&&&&& FACT418
SELECT t418
SCAN FOR tip='D'
SCATTER MEMVAR
Local nui
Select fact418
Set Order To nract
Select fact418
nui=.F.
Select ACTACTAN
Locate For SCD=m.CONT AND ascd=m.acont AND proc_tva=m.proc_tva
Scatter Memv
Select fact418
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont AND proc_tva=m.proc_tva
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Memv
Replace totctva With 0
Replace SUMAVAL With 0
Endif
Select fact418
Replace totctva With totctva+m.suma418 &&credit
Replace SUMAVAL With SUMAVAL+m.suma418_2 &&VALcredit
REPLACE cursschimb WITH m.suma_3
REPLACE ACONT WITH m.ascd
ENDIF
UNLOCK
ENDSCAN
&&creditul=plata
If credit!=0 OR (credit=0 AND debit=0)
nui=.F.
Select ACTACTAN
Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont
Scatter Memv
Select fact418
If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_incasari With 'fact418','ascc','nume'
Else
Select fact418
If Flock()
Replace achitat With achitat+credit
Replace achitatVAL With achitatVAL+VALcredit
Endif
Unlock
Endif
Endif
Select fact418
Set Order To Tag dataireg
Return
*-----------------------------------------------
Procedure _461
Parameters Tndebit,Tncredit,TnVALDEBIT,TnVALCREDIT
Select debitor
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace DEBIT With DEBIT+tndebit, CREDIT With CREDIT+tncredit
Replace VALDEBIT With VALDEBIT +tnVALdebit, VALCREDIT With VALCREDIT+tnVALcredit
Endif
UNLOCK
LOCAL di,din
SELECT actactan
Sum SUMA To di For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount
Sum neimpozab To din For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount
Sum SUMA_2 To div For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount valuta
&&&&&&&&&&&vanzLUN
Local nui
Select deblun
Set Order To nract
&&debitul=factura
If tndebit!=0
nui=.F.
Select ACTACTAN
Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont
Scatter Memv
Select deblun
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv
ENDIF
Replace totctva With totctva+TnDebit-di
Replace SUMAVAL With SUMAVAL+TnVALdebit-div
REPLACE cursschimb WITH m.suma_3
REPLACE ACONT WITH m.ascd
Endif
Unlock
Endif
&&creditul=plata
If tnCredit!=0 OR (tnCredit=0 AND tnDebit=0)
nui=.F.
Select ACTACTAN
Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont
Scatter Memv
Select deblun
DO CASE
CASE !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_incasari With 'deblun','ascc','nume'
OTHERWISE
Select deblun
If Flock()
Replace achitat With achitat+tnCredit-di
Replace achitatVAL With achitatVAL+TnVALcredit-div
Endif
Unlock
ENDCASE
Endif
Select deblun
Set Order To Tag dataireg
&&&&&&&&&&&vanz
*!* If tnDebit!=0 OR din!=0 && discount neimpozabil
*!* m.totctva=tndebit-di
*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai
*!* Select ACTACTAN
*!* Locate For SCD=m.CONT
*!* Scatter Memv
*!* Sum neimpozab To m.neimpozab For Left(SCD,3)=Left(m.CONT,3)
*!* m.neimpozab=m.neimpozab-din
*!* Select CONTURI
*!* Locate For Cont='4427'
*!* If Found()
*!* m.tvam=CRED
*!* Endif
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!* Select vanz
*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME
*!* IF !FOUND()
*!* If Flock()
*!* Append Blank
*!* Gather Memv
*!* Endif
*!* UNLOCK
*!* ELSE
*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab
*!* ENDIF
*!* Endif
Return
*-----------------------------------------------
Procedure _462
Parameters Tndebit,Tncredit,TnVALDEBIT,TnVALCREDIT
Select CREDITOR
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace DEBIT With DEBIT+tndebit, CREDIT With CREDIT+tncredit
Replace VALDEBIT With VALDEBIT +tnVALdebit, VALCREDIT With VALCREDIT+tnVALcredit
Endif
UNLOCK
&&&&&&&&&&&CREDLUN
Local nui
Select CREDlun
Set Order To nract
&&creditul=factura
If TNcredit!=0
nui=.F.
Select ACTACTAN
Locate For SCC=m.CONT AND ascc=m.acont
Scatter Memv
Select CREDlun
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Fields Except totctva Memv
Endif
Replace totctva With totctva+TNcredit
Replace SUMAVAL With SUMAVAL+TnVALcredit
REPLACE cursschimb WITH m.suma_3
REPLACE ACONT WITH m.ascc
Endif
Unlock
Endif
&&debitul=plata
If TNdebit!=0 OR (TNcredit=0 AND TNdebit=0)
nui=.F.
Select ACTACTAN
Locate For SCD=m.CONT AND ascd=m.acont
Scatter Memv
Select CREDlun
DO CASE
CASE !(COD=M.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_plati With 'CREDlun','ascd','nume'
OTHERWISE
Select CREDlun
If Flock()
Replace achitat With achitat+TNdebit
Replace achitatVAL With achitatVAL+TnVALdebit
Endif
Unlock
ENDCASE
Endif
Select CREDlun
Set Order To Tag dataireg
&&&&&&&&&&& CUMP NU STIU ????????????????
*!* Local di
*!* If credit!=0
*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai
*!* Select ACTACTAN
*!* Locate For SCC=m.CONT
*!* Scatter Memv
*!* Sum neimpozab To m.neimpozab For SCC=m.CONT
*!* Sum SUMA To di For Left(SCC,1)='7' And SCD=m.CONT&&discount
*!* m.totctva=credit-di
*!* Select CONTURI
*!* Locate For Left(Cont,3)='442'
*!* If Found()
*!* m.tvam=DEB-CRED
*!* Endif
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!* *m.totctva=m.totftvam+m.neimpozab+m.tvam
*!* Select cump
*!* If Flock()
*!* Append Blank
*!* Gather Memv
*!* Endif
*!* Unlock
*!* Endif
Return
*-----------------------------------------------
Procedure _419
Parameters debit,credit,VALDEBIT,VALCREDIT
Select AVANS419
If credit#0
If Flock()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME
If !Found()
Append Blank
Gather Fields Except achitat,facturat,achitatval,factval Memv
Endif
Replace achitat With achitat+credit &&, facturat With facturat+credit
Replace achitatVAL With achitatVAL+VALcredit
REPLACE cursschimb WITH m.suma_3
REPLACE ACONT WITH m.ascc
Endif
Unlock
Endif
If debit#0
*!* If Used('actcv1')
*!* Select actcv1
*!* Scan For ALES
*!* Scatter Name av
*!* Select AVANS419
*!* Locate For nract=av.nract And dataact=av.dataact And NUME=av.NUME
*!* If Flock()
*!* Replace facturat With facturat+av.sumaachi
*!* Replace factVAL With factVAL+av.sumaachi2
*!* Endif
*!* Unlock
*!* Select actcv1
*!* Endscan
*!* Release av
*!* ELSE &&la modificare
SELECT actactan
LOCATE FOR LEFT(scd,3)='419'
SCATTER NAME omodif
*!* lcDat=Right(Allt(omodif.NRORD),10)
*!* ldDAT=Ctod(lcDat)
*!* lcNr=Strtran(Strtran(omodif.NRORD,lcDat,''),'/','')
*!* lnNr=Val(lcNr)
Select AVANS419
Locate For nract=omodif.pereche And NUME=omodif.NUME
IF FOUND()
If Flock()
Replace facturat With facturat+debit
Replace factVAL With factVAL+valdebit
Endif
UNLOCK
ENDIF
Release omodif
*!* Endif
Endif
Select clienti
If Flock()
If Alltrim(NUME)!=Alltrim(M.NUME)
Seek Alltrim(M.NUME)
If !Found()
Append Blank
Gather Fields NUME,COD_FISCAL Memv
Endif
Endif
Replace avans With avans-debit+credit
Replace avansVAL With avansVAL-VALdebit+VALcredit
Endif
Unlock
DO inchid_actcv
Return
*-----------------------------------------------
Procedure _5311
Parameters debit,credit,VALDEBIT,VALCREDIT
STORE 0 TO m.plati,m.incasari
&&credit=casa plateste
IF CREDIT#0
Select ACTACTAN
Locate For SCC=m.CONT
Scatter Memv
*m.casa=m.CASACRED
m.casa=ALLTRIM(m.nume_3)
Select casa
If Flock()
Append Blank
Gather Memv
Replace plati With credit
Endif
Unlock
Select casanume
*Locate For casa=m.casaCRED
Locate For ALLTRIM(casa)=m.casa
If Flock()
If !Found()
Append Blank
*Gather Fields casa Memv
REPLACE CASA WITH M.CASA
Endif
Replace plati With plati+credit
Endif
Unlock
ENDIF
&&debit=casa incas
IF DEBIT#0
Select ACTACTAN
Locate For SCD=m.CONT
Scatter Memv
*m.casa=m.CASADEB
m.casa=ALLTRIM(m.nume_3)
Select casa
If Flock()
Append Blank
Gather Memv
Replace incasari With debit
Endif
Unlock
Select casanume
Locate For ALLTRIM(casa)=m.casa
If Flock()
If !Found()
Append Blank
*Gather Fields casa Memv
REPLACE CASA WITH M.CASA
Endif
Replace incasari With incasari+debit
Endif
Unlock
ENDIF
Return
*-----------------------------------------------
Procedure _5314
Parameters debit,credit,VALDEBIT,VALCREDIT
STORE 0 TO m.plati,m.incasari,m.platival,m.incasval
&&credit=casa plateste
IF CREDIT#0
IF EMPTY(M.CASAVALCRE) && pt modificare
Select ACTACTAN
Locate For SCC=m.CONT
M.CASAVALCRE=nume_5
ENDIF
Select casVnume
Locate For NUME_5=M.CASAVALCRE
If Flock()
If !Found()
Append Blank
REPLACE NUME_5 WITH M.CASAVALCRE
*Gather Fields NUME_5 Memv
Endif
Replace plati With plati+credit
Replace platiVAL With platiVAL+VALcredit
REPLACE numeval WITH m.nume_4
Endif
UNLOCK
Select ACTACTAN
SCAN For SCC=m.CONT && din cauza diferentelor de curs valutar
Scatter Memv
*m.casa=m.nume_5
M.CASA=M.CASAVALCRE
Select casaVAL
If Flock()
Append Blank
Gather Memv
Replace plati With m.suma,cursschimb WITH m.suma_3,numeval WITH m.nume_4
Replace platiVAL With m.suma_2
Endif
UNLOCK
SELECT actactan
ENDSCAN
ENDIF
&&debit=casa incas
IF DEBIT#0
IF EMPTY(M.CASAVALDEB) && pt modificare
Select ACTACTAN
Locate For SCD=m.CONT
M.CASAVALDEB=nume_5
ENDIF
Select casVnume
Locate For NUME_5=m.CASAVALDEB
SELECT casvnume
If Flock()
If !Found()
Append Blank
*Gather Fields NUME_5 Memv
REPLACE NUME_5 WITH m.CASAVALDEB
Endif
Replace incasari With incasari+debit
Replace incasVAL With incasVAL+VALdebit
REPLACE numeval WITH m.nume_4
Endif
UNLOCK
Select ACTACTAN
SCAN For SCD=m.CONT && din cauza diferentelor de curs valutar
Scatter Memv
*m.casa=m.nume_5
M.CASA=m.CASAVALDEB
Select casaVAL
If Flock()
Append Blank
Gather Memv
Replace incasari With m.suma,cursschimb WITH m.suma_3,numeval WITH m.nume_4
Replace incasVAL With m.suma_2
Endif
UNLOCK
SELECT actactan
ENDSCAN
ENDIF
Return
*-----------------------------------------------
Procedure _5121
Parameters debit,credit,VALDEBIT,VALCREDIT
STORE 0 TO m.plati,m.incasari
&&credit=banca plateste
IF CREDIT#0
Select ACTACTAN
Locate For SCC=m.CONT
Scatter Memv
m.BANCACRED=ALLTRIM(m.nume_2)
m.banca=m.BANCACRED
Select banca
If Flock()
Append Blank
Gather Memv
Replace plati With credit
Endif
Unlock
Select bannume
Locate For ALLTRIM(nume_2)=m.bancaCRED
If Flock()
If !Found()
Append Blank
*Gather Fields nume_2 Memv
REPLACE NUME_2 WITH M.BANCACRED
Endif
Replace plati With plati+credit
Endif
Unlock
ENDIF
&&debit=banca incas
IF DEBIT#0
Select ACTACTAN
Locate For SCD=m.CONT
Scatter Memv
m.bancadeb=ALLTRIM(m.nume_2)
m.banca=m.BANCADEB
Select banca
If Flock()
Append Blank
Gather Memv
Replace incasari With debit
Endif
Unlock
Select bannume
Locate For ALLTRIM(nume_2)=m.bancaDEB
If Flock()
If !Found()
Append Blank
*Gather Fields nume_2 Memv
REPLACE NUME_2 WITH m.bancaDEB
Endif
Replace incasari With incasari+debit
Endif
Unlock
ENDIF
Return
*-----------------------------------------------
Procedure _5124
Parameters debit,credit,VALDEBIT,VALCREDIT
STORE 0 TO m.plati,m.incasari,m.platival,m.incasval
&&credit=banca plateste
IF CREDIT#0
IF EMPTY(m.banvalcred) && pt modificare
Select ACTACTAN
Locate For SCC=m.CONT
m.BANVALCRED=nume_3
ENDIF
Select banVnume
Locate For nume_3=m.BANVALCRED
If Flock()
If !Found()
Append Blank
*Gather Fields nume_3 Memv
REPLACE NUME_3 WITH m.BANVALCRED
Endif
Replace plati With plati+credit
Replace platiVAL With platiVAL+VALcredit
REPLACE numeval WITH m.nume_4
Endif
UNLOCK
Select ACTACTAN
SCAN For SCC=m.CONT && din cauza diferentelor de curs valutar
Scatter Memv
m.banca=m.BANVALCRED
Select bancaVAL
If Flock()
Append Blank
Gather Memv
Replace plati With m.suma,cursschimb WITH m.suma_3,numeval WITH m.nume_4
Replace platiVAL With m.suma_2
Endif
UNLOCK
Select ACTACTAN
ENDSCAN
ENDIF
&&debit=banca incas
IF DEBIT#0
IF EMPTY(m.banvaldeb) && pt modificare
Select ACTACTAN
Locate For SCD=m.CONT
m.BANVALDEB=nume_3
ENDIF
Select banVnume
Locate For nume_3=m.BANVALDEB
If Flock()
If !Found()
Append Blank
*Gather Fields nume_3 Memv
REPLACE NUME_3 WITH m.BANVALDEB
Endif
Replace incasari With incasari+debit
Replace incasVAL With incasVAL+VALdebit
REPLACE numeval WITH m.nume_4
Endif
UNLOCK
Select ACTACTAN
SCAN For SCD=m.CONT && din cauza diferentelor de curs valutar
Scatter Memv
m.banca=m.BANVALDEB
Select bancaVAL
If Flock()
Append Blank
Gather Memv
Replace incasari With m.suma,cursschimb WITH m.suma_3,numeval WITH m.nume_4
Replace incasVAL With m.suma_2
Endif
UNLOCK
Select ACTACTAN
ENDSCAN
ENDIF
Return
*-----------------------------------------------
Procedure _542
Parameters Tndebit,Tncredit,TnVALDEBIT,TnVALCREDIT
Select achit542
If Flock()
If Alltrim(NUME_2)!=Alltrim(M.NUME_2)
Seek Alltrim(M.NUME_2)
If !Found()
Append Blank
Gather Fields NUME_2,COD_FISCAL Memv
Endif
Endif
Replace DEBIT With DEBIT+tndebit, CREDIT With CREDIT+tncredit
Replace VALDEBIT With VALDEBIT +tnVALdebit, VALCREDIT With VALCREDIT+tnVALcredit
Endif
UNLOCK
&&&&&&&&&&& achiLUN
Local nui
Select achilun
Set Order To nract
&&debitul=factura
If tndebit!=0
nui=.F.
Select ACTACTAN
Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont
Scatter Memv
Select achilun
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME_2 AND acont=m.acont
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv
ENDIF
Replace totctva With totctva+TnDebit
Replace SUMAVAL With SUMAVAL+TnVALdebit
REPLACE cursschimb WITH m.suma_3
REPLACE nume WITH m.nume_2
REPLACE ACONT WITH m.ascd
Endif
Unlock
Endif
&&creditul=plata
If tnCredit!=0 OR (tnCredit=0 AND tnDebit=0)
nui=.F.
Select ACTACTAN
Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont
Scatter Memv
Select achilun
*!* DO CASE
*!* CASE !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_incasari With 'achilun','ascc','nume_2'
*!* OTHERWISE
*!* Select achilun
*!* If Flock()
*!* Replace achitat With achitat+tnCredit
*!* Replace achitatVAL With achitatVAL+TnVALcredit
*!* Endif
*!* Unlock
*!* ENDCASE
Endif
Select achilun
Set Order To Tag dataireg
*!* Parameters debit,credit,VALDEBIT,VALCREDIT
*!* &&&&&&&&&&& achit542
*!* Select ACTACTAN
*!* Locate For SCC=m.CONT Or SCD=m.CONT
*!* Scatter Fields nume_2 Memv
*!* Select achit542
*!* If Flock()
*!* If Upper(Alltrim(nume_2))!=Upper(Alltrim(M.nume_2))
*!* Seek Upper(Alltrim(M.nume_2))
*!* If !Found()
*!* Append Blank
*!* Gather Fields nume_2 Memv
*!* Endif
*!* Endif
*!* Replace dat With dat+credit, luat With luat+debit
*!* Endif
*!* Unlock
Endproc
*-----------------------------------------------
Procedure _455
Parameters debit,credit,VALDEBIT,VALCREDIT
Select actionar
If Flock()
If Upper(Alltrim(nume_2))!=Upper(Alltrim(M.nume_2))
Seek Upper(Alltrim(M.nume_2))
If !Found()
Append Blank
Gather Fields nume_2 Memv
Endif
Endif
Replace dat With dat+debit, luat With luat+credit
Endif
Unlock
Endproc
*--------------------------------------------------------
Procedure _471
Parameters debit,credit,VALDEBIT,VALCREDIT
Local nui
Select chavans
Set Order To nract
Select chavans
If debit!=0
nui=.F.
Select ACTACTAN
Locate For SCD=m.CONT AND ascd=m.acont
Scatter Memv
Select chavans
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Memv
Replace totctva With 0
Endif
Select chavans
Replace totctva With totctva+debit
Endif
Unlock
Endif
&&debitul=plata
If credit!=0 OR (credit=0 AND debit=0)
nui=.F.
Select ACTACTAN
Locate For SCC=m.CONT AND ascc=m.acont
Scatter Memv
Select chavans
If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_incasari With 'chavans','ascc','nume'
ELSE
Select chavans
* LOCATE FOR ALLTRIM(nume)=ALLTRIM(m.nume) AND ALLTRIM(dst_chlt)=ALLTRIM(m.dst_chlt)
* IF FOUND()
If Flock()
Replace achitat With achitat+credit
Endif
UNLOCK
* ENDIF
Endif
Endif
Select chavans
Set Order To Tag dataireg
Endproc
*--------------------------------------------------------
Procedure _472
Parameters debit,credit,VALDEBIT,VALCREDIT
Local nui
Select vnavans
Set Order To nract
Select vnavans
If credit!=0
nui=.F.
Select ACTACTAN
Locate For SCc=m.CONT AND ascc=m.acont
Scatter Memv
Select vnavans
Seek m.nract
If Found()
Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont
If !Found()
nui=.T.
Endif
Else
nui=.T.
Endif
If Flock()
If nui
Append Blank
Gather Memv
Replace totctva With 0
Endif
Select vnavans
Replace totctva With totctva+credit
Endif
Unlock
Endif
&&debitul=plata
If debit!=0 OR (credit=0 AND debit=0)
nui=.F.
Select ACTACTAN
Locate For SCC=m.CONT AND ascd=m.acont
Scatter Memv
Select vnavans
If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura
Do trezorerie_plati With 'vnavans','ascd','nume'
ELSE
Select vnavans
* LOCATE FOR ALLTRIM(nume)=ALLTRIM(m.nume) AND ALLTRIM(dst_chlt)=ALLTRIM(m.dst_chlt)
* IF FOUND()
If Flock()
Replace achitat With achitat+credit
Endif
UNLOCK
* ENDIF
Endif
Endif
Select vnavans
Set Order To Tag dataireg
ENDPROC
*-----------------------------------------------------------------
Procedure _5112
Parameters debit,credit,VALDEBIT,VALCREDIT
Select ACTACTAN
Locate For SCD=m.CONT Or SCC=m.CONT
Scatter Memv
Select cecnume
If Flock()
If Upper(Alltrim(cec))!=Upper(Alltrim(M.explicatia))
Seek Upper(Alltrim(M.explicatia))
If !Found()
Append Blank
Replace cec With m.explicatia
Endif
Endif
Replace incarcat With incarcat+debit,plati With plati+credit
Endif
Unlock
Sele cec
If Flock()
Go Bottom
Appe Blank
m.plati=credit
m.incarcat=debit
Gather Memvar
Endif
Unlock
Endproc
*--------------------------------------------------------
*!* PROCEDURE _667
*!* PARAMETERS debit,credit,valdebit,valcredit
*!* SELECT actactan
*!* LOCATE FOR scd=m.cont
*!* lcScc=scc
*!* SELECT infisiere
*!* LOCATE FOR cont=lcScc
*!* SCATTER NAME ofis
*!* SELECT (ofis.fisier)
*!* ENDPROC
Procedure SCRIE_NIR
DD=Datetime()
Select INTRARI
Replace All COD With M.COD
Replace All UTIL With UTILIZATOR
Replace All DATAORA With DD
Do INRULAJMAGAZII
Do INSTOCURIMAGAZII
Return
*--------------------------------------------------------
Function LANS
Parameters IDS
*DO STERGE
m.ID_SET=IDS
Select XSETS
Seek IDS
Scatter Name OXSET
oitem=Crea('actbaza')
oitem.ID_SET=IDS
oitem.Show(1)
If OXSET.nu_sterg=.F. And buton!=2
Do danu With 'Doriti sa continuati cu operatii de acest fel?'
If buton=1
LANS(IDS)
Endif
Endif
Release OXSET
Return
*----------------------------------------------
Procedure afis_operatii
PARAMETERS tcFis,tlVisible
SELECT (tcFis)
Scatter Fields COD,SCD,SCC,nume_2 Memvar
Select * From &tcFis Where &tcFis..COD=m.COD Into Cursor AAA NOFILTER
Select AAA
N=Reccount()
Public camp
Scatter Name camp
Do Form vizpage
*ov=CREATEOBJECT('vizpage') && NU MERGE SI NU INTELEG DE CE :(
*ov.bandablOC1.visible=tlVisible
*ov.banda21.visible=!tlVisible
*ov.blocbuton1.visible=!tlVisible
*ov.show()
Release camp
Select rull
Set Filter To
Select &tcfis
Endproc
*!* *-------------------------------------------
*!* Function BLOCHEZ_NIR
*!* Select NRNIR
*!* Flock()
*!* DO case
*!* case nr_bonuri=0
*!* Calculate Max(NR) To m For NRGEST=NR_GEST And GEST=M.GEST
*!* m=m+1
*!* m.NNIR='1'+Str(NR_GEST,1,0)+Str(m.GEST,3,0)+Str(m,5,0)
*!* m.NNIR=Strtran(M.NNIR,' ','0')
*!* case nr_bonuri=1
*!* Calculate Max(NR) To m
*!* m=m+1
*!* m.NNIR=Alltrim(Str(m))
*!* case nr_bonuri=2
*!* Calculate Max(NR) To m For NRGEST=idutil
*!* m=m+1
*!* m.NNIR=Alltrim(Str(m))
*!* Endcase
*!* Append Blank
*!* Gather Fields NNIR Memv
*!* Replace NRGEST With idutil,NR With m
*!* *Replace NRGEST With m.nr_gest,NR With m
*!* Unlock
*!* Return M.NNIR
*-------------------------------------------
Function BLOCHEZ_NIR
LOCAL G,M
STORE 0 TO M,G
Select NRNIR
Flock()
DO case
case nr_bonuri=0
Calculate Max(NR) To m For NRGEST=NR_GEST And GEST=M.GEST
m=m+1
m.NNIR='1'+Str(NR_GEST,1,0)+Str(m.GEST,3,0)+Str(m,5,0)
m.NNIR=Strtran(M.NNIR,' ','0')
G= m.nr_gest
case nr_bonuri=1
Calculate Max(NR) To m
m=m+1
m.NNIR=Alltrim(Str(m))
case nr_bonuri=2
Calculate Max(NR) To m For NRGEST=idutil
m=m+1
m.NNIR=Alltrim(Str(m))
G= idutil
ENDCASE
Select NRNIR
Append Blank
Gather Fields NNIR,GEST Memv
*Replace NRGEST With idutil,NR With m
*Replace NRGEST With m.nr_gest,NR With m
REPLACE NR WITH M,NRGEST WITH G
Unlock
Return M.NNIR
*----------------------------------
Function ELIB_NIR
Parameters N
Select NRNIR
Seek N
If Found()
If Flock()
Delete
Endif
Unlock
Endif
Return
*!* *-------------------------------------------
*!* Function BLOCHEZ_BON
*!* Select nrbon
*!* Flock()
*!* DO case
*!* case nr_bonuri=0
*!* Calculate Max(NR) To m For NRGEST=NR_GEST And GEST=M.GEST
*!* m=m+1
*!* m.NNIR='2'+Str(NR_GEST,1,0)+Str(M.GEST,3,0)+Str(m,5,0)
*!* m.NNIR=Strtran(M.NNIR,' ','0')
*!* case nr_bonuri=1
*!* Calculate Max(NR) To m
*!* m=m+1
*!* m.NNIR=Alltrim(Str(m))
*!* case nr_bonuri=2
*!* Calculate Max(NR) To m For NRGEST=idutil
*!* m=m+1
*!* m.NNIR=Alltrim(Str(m))
*!* Endcase
*!* Append Blank
*!* Gather Fields NNIR Memv
*!* Replace NRGEST With idutil,NR With m
*!* *!* Gather Fields NNIR,gest Memv
*!* *!* Replace NRGEST With m.nr_gest,NR With m
*!* Unlock
*!* Return M.NNIR
*-------------------------------------------
Function BLOCHEZ_BON
LOCAL G,M
STORE 0 TO G,M
Select nrbon
Flock()
DO case
case nr_bonuri=0
Calculate Max(NR) To m For NRGEST=NR_GEST And GEST=M.GEST
m=m+1
m.NNIR='2'+Str(NR_GEST,1,0)+Str(M.GEST,3,0)+Str(m,5,0)
m.NNIR=Strtran(M.NNIR,' ','0')
G= m.nr_gest
case nr_bonuri=1
Calculate Max(NR) To m
m=m+1
m.NNIR=Alltrim(Str(m))
case nr_bonuri=2
Calculate Max(NR) To m For NRGEST=idutil
m=m+1
m.NNIR=Alltrim(Str(m))
G= idutil
ENDCASE
SELECT NRBON
Append Blank
Gather Fields NNIR,GEST Memv
*Replace NRGEST With idutil,NR With m
*!* Gather Fields NNIR,gest Memv
*!* Replace NRGEST With m.nr_gest,NR With m
REPLACE NR WITH M,NRGEST WITH G
Unlock
Return M.NNIR
*----------------------------------
Function ELIB_BON
Parameters N
Select nrbon
Seek N
If Found()
If Flock()
Delete
Endif
Unlock
Endif
Return
*______________________________________________________________________________
Procedure aleg_doc_plata
Parameters tcfis,tcNume,tlval,tcFelCont
If Used('actcv')
Use In actcv
Endif
tcNume=Upper(Alltrim(tcNume))
tcfis=Alltrim(tcfis)
IF tlval
lccond=[ABS(&tcfis..sumaval-&tcfis..achitatval)>0]
ELSE
IF existacamp('&tcfis','sumaval')
lccond=[&tcfis..sumaval-&tcfis..achitatval=0]
ELSE
lccond='.t.'
ENDIF
ENDIF
Sele distinct &tcfis..* ;
FROM &tcfis ;
WHERE Upper(Alltrim(&tcfis..NUME))==Upper(Allt(tcNume)) And ;
!(Abs(&tcfis..totctva-&tcfis..achitat)=0 Or (&tcfis..totctva<&tcfis..achitat And &tcfis..totctva>0)) and ;
&lccond ;
into TABLE &LOC\&NFSCURT\TEMPO\actcv order by &tcfis..dataact
*!* SELECT DISTINCT actan.cod,actan.nrord FROM actan,&tcfis WHERE actan.cod=&tcfis..cod AND actan.NRACT=&tcfis..NRACT ;
*!* INTO CURSOR actfis
*!* SELECT &tcfis..*,actfis.nrord ;
*!* FROM (&tcfis left join actfis on &tcfis..cod=actfis.cod) ;
*!* WHERE Upper(Alltrim(&tcfis..NUME))==Upper(Allt(tcNume)) And ;
*!* !(Abs(&tcfis..totctva-&tcfis..achitat)=0 Or (&tcfis..totctva<&tcfis..achitat And &tcfis..totctva>0)) and ;
*!* &lccond ;
*!* into TABLE &LOC\&NFSCURT\TEMPO\actcv order by &tcfis..dataact
*!* USE IN actfis
DO CASE
CASE ALLTRIM(UPPER(tcFelCont))='A'
ALTER TABLE actcv rename COLUMN ACONT to ascc
CASE ALLTRIM(UPPER(tcFelCont))='P'
ALTER TABLE actcv rename COLUMN ACONT to ascd
ENDCASE
Alter Table actcv Add Column ALES L Add Column sumaachi N(14) Add Column SUMAACHI2 N(14,2) Add Column achilei N(14)
IF tlval
Alter Table actcv ADD COLUMN difplus n(14) ADD COLUMN difminus n(14) Add Column cursval n(7) Add Column cursdif n(7)
ENDIF
Sele actcv
Go Top
Endproc && aleg_doc_plata
*______________________________________________________________________________
Procedure trezorerie_plati
Parameters tcfis,tcAcont,tcCol
tcAcont=ALLTRIM(tcAcont)
lcAcont='trez.'+tcAcont
lcCol='trez.'+ALLTRIM(tcCol)
*!* IF USED('actcv')
*!* Select actcv
*!* Scan For ALES
*!* Scatter Name trez
*!*
*!* IF existacamp('actcv',tcAcont)
*!* Select (tcfis)
*!* IF TYPE('actcv.proc_tva')#'U'
*!* Locate For nract=trez.nract And dataact=trez.dataact And NUME=trez.NUME AND acont=&lcAcont AND proc_tva=trez.proc_tva
*!* ELSE
*!* Locate For nract=trez.nract And dataact=trez.dataact And NUME=trez.NUME AND acont=&lcAcont
*!* ENDIF
*!* ELSE
*!* Select (tcfis)
*!* Locate For nract=trez.nract And dataact=trez.dataact And NUME=trez.NUME
*!* ENDIF
*!* If Flock()
*!* Replace achitat With achitat+trez.sumaachi
*!* IF existacamp('&tcfis','achitatval')
*!* Replace achitatval With achitatval+trez.sumaachi2
*!* ENDIF
*!* Endif
*!* UNLOCK
*!* Select actcv
*!* ENDSCAN
*!* ELSE && pt modificare sau analitice diferite
SELECT actactan
Scan For pereche#0 AND &tcAcont=m.acont
Scatter Name trez
IF TYPE(tcfis+'.acont')#'U'
Select (tcfis)
IF TYPE(tcfis+'.proc_tva')#'U'
Locate For nract=trez.pereche And NUME=&lcCol AND acont=&lcAcont AND proc_tva=trez.proc_tva
ELSE
Locate For nract=trez.pereche And NUME=&lcCol AND acont=&lcAcont
ENDIF
ELSE
Select (tcfis)
Locate For nract=trez.pereche And NUME=&lcCol
ENDIF
IF FOUND()
If Flock()
Replace achitat With achitat+trez.suma
IF TYPE(tcfis+'.achitatval')#'U'
Replace achitatval With achitatval+trez.suma_2
ENDIF
ENDIF
UNLOCK
ENDIF
Select actactan
ENDSCAN
*!* ENDIF
Release trez
IF USED('actcv')
USE IN actcv
ENDIF
Endproc && trezorerie_incasari_plati
*______________________________________________________________________________
Procedure trezorerie_incasari
Parameters tcfis,tcAcont,tcCol
tcAcont=ALLTRIM(tcAcont)
lcAcont='trez.'+tcAcont
lcCol='trez.'+ALLTRIM(tcCol)
SELECT actactan
Scan For pereche2#0 AND &tcAcont=m.acont
Scatter Name trez
IF TYPE(tcfis+'.acont')#'U'
Select (tcfis)
IF TYPE(tcfis+'.proc_tva')#'U'
Locate For nract=trez.pereche2 And NUME=&lcCol AND acont=&lcAcont AND proc_tva=trez.proc_tva
ELSE
Locate For nract=trez.pereche2 And NUME=&lcCol AND acont=&lcAcont
ENDIF
ELSE
Select (tcfis)
Locate For nract=trez.pereche2 And NUME=&lcCol
ENDIF
IF FOUND()
If Flock()
Replace achitat With achitat+trez.suma
IF TYPE(tcfis+'.achitatval')#'U'
Replace achitatval With achitatval+trez.suma_2
ENDIF
ENDIF
UNLOCK
ENDIF
Select actactan
ENDSCAN
Release trez
IF USED('actcv')
USE IN actcv
ENDIF
Endproc && trezorerie_incasari
*------------------------------------------------------------------------------
PROCEDURE test_facturi
Parameters tcfis,tccont,tcNume,tcfel
tcNume=Upper(Alltrim(tcNume))
tcfis=Alltrim(tcfis)
LcCond=upper(allt(ofis.camp_verif))+[=']+tcnume+[' AND ]+tcfel+[=']+Tccont+['] && ofis.camp_verif---> vezi procedura viz_fact
SELE 0
USE &DATE/ACT.DBF AGAIN ALIAS ACn1
SELECT ACN1
SET FILTER TO &Lccond
select &tcfis..nume,&tcfis..dataact,&tcfis..nract,&tcfis..dataireg,&tcfis..totctva as suma,;
&tcfis..achitat,&tcfis..achitat as pereche,&tcfis..fdoc,&tcfis..fdoc as scc,&tcfis..fdoc as scd,&tcfis..fdoc as nume_2,&tcfis..fdoc as explicatia;
FROM &tcfis;
WHERE Upper(Alltrim(&tcfis..NUME))==Upper(Allt(tcNume)) ;
into cursor acn2 order by dataireg
RETURN LcCond
ENDPROC
*________________________________________________________________________________
PROCEDURE imperechere_fact_avans
PARAMETERS tcfis,tcNume,TnSuma,tlval,tcPereche
PRIVATE PlStrict
STORE .f. to PlStrict
tcfis=UPPER(ALLTRIM(tcfis))
tcNume=Upper(Alltrim(tcNume))
lcPereche='m.'+ALLTRIM(tcPereche)
IF tlval
lccond=[&tcfis..achitatval-&tcfis..factval>0]
ELSE
lccond=[&tcfis..achitatval-&tcfis..factval=0]
ENDIF
IF USED('actcv1')
USE IN actcv1
ENDIF
SELECT * ;
from &tcfis;
where Upper(Alltrim(&tcfis..NUME))==tcNume AND &tcfis..achitat-&tcfis..facturat#0 AND &lccond;
into Table &loc\&nfscurt\tempo\actcv1 order by dataact
ALTER TABLE actcv1 ADD COLUMN ales l ADD COLUMN sumaachi n(14) ADD COLUMN sumaachi2 n(14,2) ;
ADD COLUMN difplus n(14) ADD COLUMN difminus n(14)
IF _tally=0
DO mesaj with 'Nu exista avansuri inregistrate','la acest partener !'
DO STERGE
DO inchid_actcv
DO deschid_actc
RETURN
ENDIF
IF xsets.id_set=10421 && regularizari clienti creditori
SELECT actcv
REPLACE ALL sumaachi WITH sumaachi/m.ctva FOR neimpozab=0 AND ales
REPLACE ALL neimpozab WITH sumaachi FOR neimpozab#0 AND ales
SUM sumaachi TO tnsuma FOR ales
ENDIF
*m.suma=tnsuma
SELECT actcv1
IF !tlval
oavans=CREATEOBJECT('avansales')
oavans.suma=tnSuma
ELSE
oavans=CREATEOBJECT('avansval')
oavans.suma_2=m.suma_2
ENDIF
oavans.pcfis='AVANS'
oavans.show(1)
IF buton=2
DO sterge
DO inchid_actcv
DO deschid_actc
RETURN
ENDIF
SELECT ACTCV1
LOCATE FOR ALES
SCATTER NAME av
IF av.proc_tva=0
m.proc_tva=m.ctvam
ELSE
m.proc_tva=av.proc_tva
ENDIF
lnSumaAchi=av.sumaachi
lnSumaAchiVal=av.sumaachi2
NRAVANS=NRACT
DATAAVANS=DATAACT
LcNRORD=ALLT(STR(NRAVANS))+' / '+ALLT(DTOC(DATAAVANS))
*!* IF USED('actactan')
*!* USE IN actactan
*!* ENDIF
*!* IF USED('actc')
*!* USE IN actc
*!* ENDIF
*!* USE &LOC\&NFSCURT\TEMPO\ACTc IN 0 again ALIAS ACTACTAN exclusive ORDER TAG nr_nota
*!* SET DELETED ON
SELECT actactan
PACK
IF lnSumaAchi<PnSuma OR tlval &&(tlval AND lnSumaAchiVal<pnSumaVal)- asta nu mai stiu de ce imi trebiua
SELECT actcv
LOCAL lni
lni=0
SCAN FOR ales
* lnNeimpozab=neimpozab
lni=lni+1
STORE MIN(sumaachi2,lnSumaAchiVal) TO LnMinVal
IF !tlval
STORE MIN(sumaachi,lnSumaAchi) TO LnMin
LnMinAct=LnMin
ELSE
LnMin=LnMinVal*cursschimb
LnMinAct=LnMinVal*MIN(cursschimb,av.cursschimb)
ENDIF
IF sumaachi-Lnmin>0 OR sumaachi2-LnminVal>0
REPLACE sumaachi WITH LnMin
REPLACE sumaachi2 WITH LnMinVal
ENDIF
LnSumaAchi=LnSumaAchi-LnMin
LnSumaAchiVal=LnSumaAchiVal-LnMinVal
SELECT actactan
GOTO lni
SELECT actactan
REPLACE suma WITH LnMinAct
REPLACE suma_2 WITH LnMinVal
REPLACE &tcPereche WITH av.nract
* REPLACE neimpozab WITH lnNeimpozab
SELECT actactan
IF tlval
IF suma_3>av.cursschimb
SCATTER NAME oaa
APPEND BLANK
GATHER NAME oaa
IF tcfis='AVANS419'
REPLACE scd WITH '665 ',suma WITH (oaa.suma_3-av.cursschimb)*LnMinVal,;
explicatia WITH 'DIFERENTE NEFAVORABILE',suma_2 WITH 0,suma_3 WITH av.cursschimb
ELSE
REPLACE scc WITH '765 ',suma WITH (oaa.suma_3-av.cursschimb)*LnMinVal,;
explicatia WITH 'DIFERENTE FAVORABILE',suma_2 WITH 0,suma_3 WITH av.cursschimb
ENDIF
ENDIF
IF suma_3<av.cursschimb
SCATTER NAME oaa
APPEND BLANK
GATHER NAME oaa
IF tcfis='AVANS419'
REPLACE scc WITH '765 ',suma WITH (-oaa.suma_3+av.cursschimb)*LnMinVal,;
explicatia WITH 'DIFERENTE FAVORABILE',suma_2 WITH 0,suma_3 WITH av.cursschimb
ELSE
REPLACE scd WITH '665 ',suma WITH (-oaa.suma_3+av.cursschimb)*LnMinVal,;
explicatia WITH 'DIFERENTE NEFAVORABILE',suma_2 WITH 0,suma_3 WITH av.cursschimb
ENDIF
ENDIF
ENDIF
SELECT actcv
ENDSCAN
RELEASE av
RELEASE oaa
ENDIF
IF !tlval
IF tcfis='AVANS419'
SELECT ACTACTAN
SCAN FOR LEFT(scd,3)='419' AND neimpozab=0
i=RECNO()
SCATTER NAME OAV
APPEND BLANK
IF FLOCK()
GATHER NAME OAV
REPLACE SCD WITH '411 ',ascd WITH oav.ascc,SCC WITH '4427',ascc WITH '',SUMA WITH ROUND((1-m.proc_tva)*oav.SUMA,0),proc_tva WITH m.proc_tva
ENDIF
UNLOCK
SELECT ACTACTAN
GOTO i
ENDSCAN
RELEASE OAV
ENDIF
ENDIF
SELECT ACTACTAN
REPLACE ALL NRORD WITH LcNRORD
*REPLACE ALL &tcPereche WITH nravans
SCRIE_IN_FISIERE(' ')
DO inchid_actcv
DO deschid_actc
ENDPROC && imperechere_fact_avans
*________________________________________________________
Procedure verif_balana
Local aprecdeb,apreccred,aruldeb,arulcred,acontvid
acontvid='0000'
STORE 0 TO aprecdeb,apreccred,aruldeb,arulcred
SELECT balana
IF FLOCK()
Select Distinct Cont From BALANA Into Cursor cc
Select cc
Scan
Scatter Memv
Select BAL
Seek m.cont
Scatter Memv
Select BALANA
Sum precdeb,preccred,RULDEB,RULCRED To aprecdeb,apreccred,aruldeb,arulcred For Cont=m.cont
If aprecdeb<>m.precdeb Or apreccred<>m.preccred Or aruldeb<>m.RULDEB Or arulcred<>m.RULCRED
Select BALANA
Seek m.cont+acontvid
If !Found()
Append Blank
Gather Memv
REPLACE acont WITH acontvid
Endif
Replace precdeb With m.precdeb-aprecdeb
Replace preccred With m.preccred-apreccred
Replace RULDEB With m.RULDEB-aruldeb
Replace RULCRED With m.RULCRED-arulcred
Endif
Select cc
ENDSCAN
ENDIF
UNLOCK IN balana
SELECT balana
SET FILTER TO
return
*_______________________________________
Procedure CALCULEAZABALANTA_ANA
Select BALANA
If Flock()
Replace All TOTDEB With RULDEB+precdeb;
totcred With RULCRED+preccred
Endif
Unlock
Scan
If Flock()
If TOTDEB-totcred>0
Replace SOLDDEB With TOTDEB-totcred;
SOLDCRED With 0
Else
Replace SOLDCRED With totcred-TOTDEB;
SOLDDEB With 0
Endif
Endif
Unlock
Endscan
Return
********************************************
PROCEDURE introducere_compacta
PARAMETERS tcfis,tcscd,tcscc,tl_calcTVA,tl_plata,tctitlu,tctva,tn_idset
*!* tcfis=fisierul din calefirma (achi_mat.dbf)
*!* tcscd=simbol cont debitor
*!* tcscc=simbol cont creditor
*!* tl_calctva=daca se calculeaza TVA-ul per total
*!* tl_plata=daca se achita factura respectiva
*!* tctitlu=titlul formularului frm_introd_compact
*!* tctva=contul de TVA (daca tl_calctva=.t.)
*!* tn_idset=parametrul functiei lans()
IF USED('introdc')
USE IN introdc
ENDIF
SELECT (tcfis)
COPY STRUCTURE TO &loc\&nfscurt\tempo\introdc WITH CDX
USE &loc\&nfscurt\tempo\introdc IN 0 SHARED
SELECT introdc
APPEND FROM &CALEFIRMA\DATEAN\&tcfis FOR id_set=tn_idset
SET ORDER TO tag ordine
SELECT introdc
IF FLOCK()
IF INLIST(tn_idset,10467,10468) && PLATI IMPOZITE
REPLACE ALL nrcrt WITH 0
ELSE
REPLACE ALL NRCRT WITH ordine
ENDIF
IF !EMPTY(tcscd)
REPLACE ALL scd WITH tcscd FOR EMPTY(scd) OR UPPER(scd)='X'
ENDIF
IF !EMPTY(tcscc)
REPLACE ALL scc WITH tcscc FOR EMPTY(scc) OR UPPER(scc)='X'
ENDIF
IF m.ctva-1=0
REPLACE ALL bifa WITH .t.
REPLACE ALL ptva WITH 0
ENDIF
ENDIF
UNLOCK
SELECT actactan
ZAP
SELECT introdc
GO TOP
obj=CREATEOBJECT('FRM_INTROD_COMPACT')
obj.gridb1.column3.backcolor=RGB(255,255,255)
obj.gridb1.column4.backcolor=RGB(255,255,255)
IF !tl_plata
obj.container2.visible=.f.
obj.container2.optiongroup1.value=0
OBJ.HEIGHT=obj.container2.TOP
ELSE
obj.container2.optiongroup1.value=1
ENDIF
IF !tl_calcTVA
obj.container1.visible=.f.
OBJ.HEIGHT=obj.container1.TOP+10
ENDIF
obj.titlufrumos1.caption=tctitlu
obj.show(1)
IF BUTON=2
DO deschid_actc
RETURN
ENDIF
*!* IF tn_idset=10455 && rate leasing
*!* lans(10411)
*!* ENDIF
SELECT actactan
REPLACE ALL id_set WITH tn_idset
SELECT actactan
SCRIE_IN_FISIERE(' ')
DO deschid_actc
ENDPROC &&introducere_compacta
*___________________________________________________
PROCEDURE deschid_actc
IF USED('actactan')
USE IN actactan
ENDIF
IF !USED('ACTc')
DO DES WITH 'ACTc'
ENDIF
ENDPROC && deschid_actc
*____________________________________________________
PROCEDURE inchid_actcv
IF USED('actcv')
USE IN actcv
ENDIF
IF USED('ACTcv1')
USE IN 'ACTcv1'
ENDIF
ENDPROC && inchid_actcv
*_____________________________________________________________________________________________________________________
PROCEDURE viz_facturi
PARAMETERS tcFis1,tcFis2,tnCont,tlCuTest,tlVisible,tcTitlu,TcColDeb,TcColCred
SELECT infisiere
LOCATE FOR VAL(cont)=tnCont
SCATTER NAME ofis
*!* SELECT(tcfis1)
*!* If EXISTACIMP(tcfis1,'TOTDEB')
*!* If Flock()
*!* DO CASE
*!* CASE UPPER(ofis.fel)='A'
*!* Replace All totdeb With precdeb+productie,totcred With preccred+incasat
*!* CASE UPPER(ofis.fel)='P'
*!* Replace All totdeb With precdeb+platit,totcred With preccred+achizit
*!* ENDCASE
*!* Endif
*!* UNLOCK
*!* ENDIF
SELECT(tcfis1)
If EXISTACIMP(tcfis1,'TOTDEB')
Replace All totdeb With precdeb+&TcColDeb,totcred With preccred+&TcColCred
ENDIF
Local C
C="nume+ALLTRIM(STR(YEAR(dataact)))+RIGHT('0'+ALLTRIM(STR(MONTH(dataact))),2)+RIGHT('0'+ALLTRIM(STR(DAY(dataact))),2)"
buton=1
IF tlCuTest
SELECT (tcfis2)
Set Filter To
lcProc='inainte_'+ALLTRIM(tcfis2)
Do &lcProc In inaintede.prg
If buton=2
Return
ENDIF
ENDIF
If Used('ACTCV')
Use In actcv
ENDIF
lcCale='&Date\'+ALLTRIM(tcfis2)
Use &lcCale In 0 Again Alias actcv SHARED order dataireg
Sele actcv
*!* Index On &C Tag nd Of &loc\&nfscurt\tempo\actcv
*!* Index On DATAireg Tag DATAireg Of &loc\&nfscurt\tempo\actcv additive
*!* Set Order To Tag DATAireg
PRIVATE pcAnalitic
STORE '' TO pcAnalitic
Oreg=Createobject("AFCUMPVANZanp")
With Oreg
.LABEL10.Caption=PROPER(tcTitlu)
.grid1.column12.Visible=.T.
.cont=tnCont
.fisier=ALLTRIM(tcFis2)
.CHECK2.Visible=tlVisible
.CHECK6.Visible=tlVisible
.CHECK7.Visible=tlVisible
.CHECK9.Visible=tlVisible
*.command1.Visible=tlVisible
*.command3.Visible=tlVisible
.grid1.column2.Visible=tlVisible
.grid1.column11.Visible=tlVisible
.grid1.column13.Visible=tlVisible
.grid1.column14.Visible=tlVisible
.grid1.column7.Visible=tlVisible
.grid1.column8.Visible=tlVisible
.grid1.column10.Visible=tlVisible
IF !tlVisible
.CHECK3.Caption='Regularizate'
.CHECK4.Caption='Neregularizate'
.check10.Caption='Regularizat'
.grid1.column12.header1.Caption='Regularizat'
.grid1.column2.Width=0
ENDIF
Endwith
*OREG.cmdlist1.VISIBLE=.f.
Oreg.Show(1)
IF USED('actcv')
Use In actcv
ENDIF
RELEASE ofis
RELEASE oreg
*?????? Do totv
ENDPROC && viz_facturi
*--------------------------------------
Function STERGE_DIN_FISIERE
Parameters PlConfirmare,pnCod
Local M.DEB,M.CRED,COND
Store 0 To M.DEB, M.CRED
CREATE TABLE &loc\&nfscurt\tempo\conturi.dbf FREE (cont c(4),ana c(4),deb n(14),cred n(14),debval n(14.2),credval n(14.2))
SELECT conturi
APPEND BLANK
APPEND BLANK
DD=Datetime()
IF PlConfirmare
IF USED('actactan')
USE IN actactan
ENDIF
SELECT * from actjur WHERE cod=pnCod INTO CURSOR actactan
overif=CREATEOBJECT('verificare')
overif.show(1)
IF buton=2
USE IN conturi
Release Overif
RETURN
ENDIF
ENDIF
&& sterg efectele neimpozab,TVA si baza din cump si vanz pt toate inregistrarile din nota
&& in loc sa fac o procedura sterg_4426 si sterg_4427
DO sterg_TVA WITH "actactan"
Select ACTJUR
SET FILTER TO
SCAN FOR cod=pnCod
SCATTER NAME osterg
Replace UTILS With UTILIZATOR, DATAORAS With DD
DELETE
Select ACTAN
SET DELETED ON
If Flock()
LOCATE FOR cod=osterg.cod AND scd=osterg.scd AND scc=osterg.scc AND suma=osterg.suma
IF FOUND()
DELETE
ENDIF
Endif
UNLOCK
SELECT conturi
GOTO 1
REPLACE cont WITH osterg.scd,ana WITH osterg.ascd,deb WITH -osterg.suma,debval WITH -osterg.suma_2
GOTO 2
REPLACE cont WITH osterg.scc,ana WITH osterg.ascc,cred WITH -osterg.suma,credval WITH -osterg.suma_2
&& sterge din balanta si balanta analitica
Select conturi
SCAN
Scatter Memv
Select BAL
If Flock()
Seek ALLTRIM(M.CONT)
If !Found()
Do MESAJ With 'Contul '+M.CONT+' nu se regaseste in balanta!',''
ELSE
Select BAL
Replace RULDEB With RULDEB+M.DEB, TOTDEB With TOTDEB+M.DEB,;
RULCRED With RULCRED+M.CRED, TOTCRED With TOTCRED+M.CRED
SOLD=TOTDEB-TOTCRED
Replace SOLDDEB With Iif(SOLD>0,SOLD,0), SOLDCRED With Iif(SOLD<0,-SOLD,0)
Endif
Endif
UNLOCK
SELECT balana
IF FLOCK()
IF !EMPTY(m.ana)
Seek m.cont+m.ana
IF FOUND()
Replace RULDEB With RULDEB+M.deb, TOTDEB With TOTDEB+M.deb, ;
RULcred With RULcred+M.cred, TOTcred With TOTcred+M.cred
SOLD=TOTDEB-TOTCRED
Replace SOLDDEB With Iif(SOLD>0,SOLD,0),SOLDcred With Iif(SOLD<0,-SOLD,0)
ENDIF
ENDIF
ENDIF
UNLOCK
Select conturi
ENDSCAN
Select Distinct A.Cont,b.ana as acont,A.FPROC,B.DEB,B.CRED,B.DEBVAL,B.CREDVAL From INFISIERE A, conturi B ;
WHERE A.Cont=B.Cont ;
INTO Cursor COM
Select COM
SCAN
Scatter Memv
zz='Do '+'sterg'+Alltrim(FPROC)+' with m.deb,m.cred,M.DEBVAL,M.CREDVAL'
&zz
SELECT com
ENDSCAN
Select ACTJUR
ENDSCAN
&&in gestiuni ????
sele RUL
set filter to
if flock()
DELETE for cod=osterg.cod
endif
unlock in rul
sele RULL
set filter to
if flock()
SCAN FOR cod=osterg.cod
IF PlConfirmare
scat memv
sele stoc
if flock()
loca for allt(denumire)=allt(m.denumire) and allt(codmat)=allt(m.codmat) and pret=m.pret and gest=m.gest and scd=m.scd
if found()
if m.cant#0
repl cant with cant-m.cant
else
repl cante with cante-m.cante
endif
endif
ENDIF
UNLOCK
ENDIF
sele rull
delete
endscan
endif
unlock in rull
USE IN conturi
Do STERGE
Release Osterg
Return 0
*-----------------------------------------------
Procedure sterg_401
Parameters debit,credit,VALDEBIT,VALCREDIT
&&&&&&&&&&& FURNIZOR
Select FURNIZOR
If Flock()
Seek Alltrim(osterg.NUME)
Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit
Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit
Endif
Unlock
Local di,din,div
IF Left(osterg.SCC,3)='767' And osterg.SCD=m.CONT AND osterg.ascd=m.acont &&discount
di=osterg.suma
din=osterg.neimpozab
div=osterg.SUMA_2
ELSE
STORE 0 TO di,din,div
ENDIF
&&&&&&&&&&& CUMPLUN
Select cumplun
IF credit#0 OR di#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont
ELSE
Locate For nract=osterg.pereche And NUME=osterg.NUME AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+credit+di
Replace SUMAVAL With SUMAVAL+VALcredit+div
Replace achitat With achitat+debit+di
Replace achitatVAL With achitatVAL+VALdebit+div
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
Endif
UNLOCK
ENDIF
&&&&&&&&&&&CUMP
*!* If credit!=0 OR di#0
*!* m.neimpozab=-osterg.neimpozab+din
*!* m.totctva=credit+di
*!* IF Left(osterg.scd,3)='442'
*!* m.tvam=credit
*!* ELSE
*!* m.tvam=0
*!* ENDIF
*!*
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!*
*!* Select cump
*!* If Flock()
*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME
*!* IF FOUND()
*!* IF FLOCK()
*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab
*!* ENDIF
*!* ENDIF
*!*
*!* SELECT cump
*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0
*!* DELETE
*!* ENDIF
*!* ENDIF
*!* Unlock
*!* Endif
Return
*-----------------------------------------------
Procedure sterg_404
Parameters debit,credit,VALDEBIT,VALCREDIT
&&&&&&&&&&& FURNIZOR
Select FURNIZ404
If Flock()
Seek Alltrim(osterg.NUME)
Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit
Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit
Endif
Unlock
Local di,din,div
IF Left(osterg.SCC,3)='767' And osterg.SCD=m.CONT AND osterg.ascd=m.acont &&discount
di=osterg.suma
din=osterg.neimpozab
div=osterg.SUMA_2
ELSE
STORE 0 TO di,din,div
ENDIF
Select cumplun404
IF credit#0 OR di#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont
ELSE
Locate For nract=osterg.pereche And NUME=osterg.NUME AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+credit+di
Replace SUMAVAL With SUMAVAL+VALcredit+div
Replace achitat With achitat+debit+di
Replace achitatVAL With achitatVAL+VALdebit+div
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
Endif
UNLOCK
ENDIF
&&&&&&&&&&&CUMP
*!* If (credit!=0 OR di#0) AND osterg.neimpozab#0
*!* m.neimpozab=-osterg.neimpozab+din
*!* m.totctva=credit+di
*!* IF Left(osterg.scd,3)='442'
*!* m.tvam=credit
*!* ELSE
*!* m.tvam=0
*!* ENDIF
*!*
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!*
*!* Select cump
*!* If Flock()
*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME
*!* IF FOUND()
*!* IF FLOCK()
*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab
*!* ENDIF
*!* ENDIF
*!*
*!* SELECT cump
*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0
*!* DELETE
*!* ENDIF
*!* ENDIF
*!* Unlock
*!* Endif
Return
*----------------------------------------------
Procedure sterg_408
Parameters debit,credit,VALDEBIT,VALCREDIT
Select ana408
If Flock()
Seek Alltrim(osterg.NUME)
Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit
Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit
Endif
Unlock
Select fact408
IF credit#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont AND proc_tva=osterg.proc_tva
ELSE
Locate For nract=osterg.pereche And NUME=osterg.NUME AND acont=m.acont AND proc_tva=osterg.proc_tva
ENDIF
If Found()
If Flock()
Replace totctva With totctva+credit
Replace SUMAVAL With SUMAVAL+VALcredit
Replace achitat With achitat+debit
Replace achitatVAL With achitatVAL+VALdebit
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
Endif
UNLOCK
ENDIF
*!* IF debit#0 && pt regularizari 408-401,4426-4428
*!* LOCAL lnSUma
*!* lnSuma=0
*!* SELECT cump
*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME
*!* IF FOUND()
*!* lnSuma=ROUND(debit*(m.ctva-1)/m.ctva,0)
*!* REPLACE tvam WITH tvam+lnSuma
*!* REPLACE totftvam WITH totftvam-lnSuma
*!* ENDIF
*!* SELECT cump
*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0
*!* DELETE
*!* ENDIF
*!* ENDIF
RETURN
*-----------------------------------------------
PROCEDURE sterg_4426
Parameters debit,credit,VALDEBIT,VALCREDIT
*** vezi sterg_TVA
RETURN
*-----------------------------------------------
PROCEDURE sterg_4427
Parameters debit,credit,VALDEBIT,VALCREDIT
*** vezi sterg_TVA
RETURN
*-----------------------------------------------
Procedure sterg_409
Parameters debit,credit,VALDEBIT,VALCREDIT
Select AVANS409
If debit#0
If Flock()
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME
If Found()
Replace achitat With achitat+debit &&, facturat With facturat+credit
Replace achitatVAL With achitatVAL+VALdebit
Endif
Endif
Unlock
Endif
If credit#0
*!* lcDat=Right(Allt(osterg.NRORD),10)
*!* ldDAT=Ctod(lcDat)
*!* lcNr=Strtran(Strtran(osterg.NRORD,lcDat,''),'/','')
*!* lnNr=Val(lcNr)
Select AVANS409
Locate For nract=osterg.pereche2 And NUME=osterg.NUME
IF FOUND()
If Flock()
Replace facturat With facturat+credit
Replace factVAL With factVAL+valcredit
Endif
UNLOCK
ENDIF
ENDIF
SELECT avans409
IF achitat=0 AND facturat=0 AND achitatval=0 AND factval=0
DELETE
ENDIF
Select FURNIZOR
If Flock()
Seek Alltrim(osterg.NUME)
If Found()
Replace avans With avans+debit-credit
Replace avansVAL With avansVAL+VALdebit-VALcredit
Endif
Endif
UNLOCK
Return
*-------------------------------------------------------------
Procedure sterg_419
Parameters debit,credit,VALDEBIT,VALCREDIT
Select AVANS419
If credit#0
If Flock()
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME
If Found()
Replace achitat With achitat+credit &&, facturat With facturat+credit
Replace achitatVAL With achitatVAL+VALcredit
Endif
Endif
Unlock
ENDIF
If debit#0
*!* lcDat=Right(Allt(osterg.NRORD),10)
*!* ldDAT=Ctod(lcDat)
*!* lcNr=Strtran(Strtran(osterg.NRORD,lcDat,''),'/','')
*!* lnNr=Val(lcNr)
Select AVANS419
Locate For nract=osterg.pereche And NUME=osterg.NUME
IF FOUND()
If Flock()
Replace facturat With facturat+debit
Replace factVAL With factVAL+valdebit
Endif
UNLOCK
ENDIF
Endif
SELECT avans419
IF achitat=0 AND facturat=0 AND achitatval=0 AND factval=0
DELETE
ENDIF
Select clienti
If Flock()
Seek Alltrim(osterg.NUME)
If Found()
Replace avans With avans-debit+credit
Replace avansVAL With avansVAL-VALdebit+VALcredit
Endif
Endif
UNLOCK
*---------------------------------------------------------------------
Procedure sterg_462
Parameters tndebit,tncredit,tnVALDEBIT,tnVALCREDIT
&&&&&&&&&&& CREDITORI
Select CREDITOR
If Flock()
Seek Alltrim(osterg.NUME)
Replace debit With debit +TnDebit, credit With Credit+TnCredit
Replace VALdebit With VALdebit +tnVALdebit, VALcredit With VALcredit+tnVALcredit
Endif
Unlock
Local di,din,div
IF Left(osterg.SCC,3)='767' And osterg.SCD=m.CONT AND ascd=m.acont &&discount
di=osterg.suma
din=osterg.neimpozab
div=osterg.SUMA_2
ELSE
STORE 0 TO di,din,div
ENDIF
&&&&&&&&&&& CREDLUN
Select credlun
IF TNcredit#0 OR di#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont
ELSE
Locate For nract=osterg.pereche And NUME=osterg.NUME AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+TNcredit+di
Replace SUMAVAL With SUMAVAL+TnVALcredit+div
Replace achitat With achitat+TNdebit+di
Replace achitatVAL With achitatVAL+TnVALdebit+div
Endif
UNLOCK
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
ENDIF
*----------------------------------------------
Procedure sterg_411
Parameters debit,credit,VALDEBIT,VALCREDIT
&&&&&&&&&&& CLIENTI
Select clienti
If Flock()
Seek Alltrim(osterg.NUME)
Replace productie With productie +debit, incasat With incasat+credit
Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit
Endif
Unlock
Local di,din,div,reg
STORE 0 TO di,din,div,reg
DO CASE
CASE Left(osterg.SCd,3)='667' And osterg.SCc=m.CONT AND osterg.ascc=m.acont &&discount
di=osterg.suma
din=osterg.neimpozab
div=osterg.SUMA_2
CASE osterg.id_set=10421 AND osterg.scc='4427' &&regularizare facturi-avans
reg=osterg.suma
ENDCASE
&&&&&&&&&&& VANZLUN
Select vanzlun
IF (debit#0 OR di#0) AND osterg.id_set#10421 &&discount + regularizare avans-factura
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont
ELSE
LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+debit+di+reg
Replace SUMAVAL With SUMAVAL+VALdebit+div
Replace achitat With achitat+credit+di+reg
Replace achitatVAL With achitatVAL+VALcredit+div
Endif
UNLOCK
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
ENDIF
&&&&&&&&&&&VANZ
*!* If debit!=0 OR di#0
*!* m.neimpozab=-osterg.neimpozab+din
*!* m.totctva=debit+di
*!* IF Left(osterg.scc,3)='442'
*!* m.tvam=debit
*!* ELSE
*!* m.tvam=0
*!* ENDIF
*!*
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!*
*!* Select vanz
*!* If Flock()
*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME
*!* IF FOUND()
*!* IF FLOCK()
*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab
*!* ENDIF
*!* ENDIF
*!*
*!* SELECT vanz
*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0
*!* DELETE
*!* ENDIF
*!* ENDIF
*!* Unlock
*!* Endif
RETURN
*----------------------------------------------
Procedure sterg_461
Parameters tndebit,tncredit,tnVALDEBIT,tnVALCREDIT
&&&&&&&&&&& DEBITORI
Select debitor
If Flock()
Seek Alltrim(osterg.NUME)
Replace debit With debit +TnDebit, credit With Credit+TnCredit
Replace VALdebit With VALdebit +tnVALdebit, VALcredit With VALcredit+tnVALcredit
Endif
Unlock
Local di,din,div
IF Left(osterg.SCd,3)='667' And osterg.SCc=m.CONT AND osterg.ascc=m.ascc &&discount
di=osterg.suma
din=osterg.neimpozab
div=osterg.SUMA_2
ELSE
STORE 0 TO di,din,div
ENDIF
&&&&&&&&&&& DEBLUN
SELECT deblun
IF tnDebit#0 OR di#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont
ELSE
LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+tndebit+di
Replace SUMAVAL With SUMAVAL+tnVALdebit+div
Replace achitat With achitat+tncredit+di
Replace achitatVAL With achitatVAL+tnVALcredit+div
Endif
UNLOCK
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
ENDIF
&&&&&&&&&&&VANZ
*!* If tnDebit!=0 OR di#0
*!* m.neimpozab=-osterg.neimpozab+din
*!* m.totctva=tnDebit+di
*!* IF Left(osterg.scc,3)='442'
*!* m.tvam=tnCredit
*!* ELSE
*!* m.tvam=0
*!* ENDIF
*!*
*!* m.totftvam=m.totctva-m.neimpozab-m.tvam
*!*
*!* Select vanz
*!* If Flock()
*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME
*!* IF FOUND()
*!* IF FLOCK()
*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ;
*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab
*!* ENDIF
*!* ENDIF
*!*
*!* SELECT vanz
*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0
*!* DELETE
*!* ENDIF
*!* ENDIF
*!* Unlock
*!* Endif
Return
*---------------------------------------------------------------------------
Procedure sterg_4118
Parameters debit,credit,VALDEBIT,VALCREDIT
&&&&&&&&&&& CLIENT4118
Select client4118
If Flock()
Seek Alltrim(osterg.NUME)
Replace productie With productie +debit, incasat With incasat+credit
Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit
Endif
Unlock
Local di,din,div
IF Left(osterg.SCd,3)='667' And osterg.SCc=m.CONT AND osterg.ascc=m.acont &&discount
di=osterg.suma
din=osterg.neimpozab
div=osterg.SUMA_2
ELSE
STORE 0 TO di,din,div
ENDIF
&&&&&&&&&&& VANZLU4118
Select vanzlu4118
IF debit#0 OR di#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont
ELSE
LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+debit+di
Replace SUMAVAL With SUMAVAL+VALdebit+div
Replace achitat With achitat+credit+di
Replace achitatVAL With achitatVAL+VALcredit+div
Endif
UNLOCK
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
ENDIF
RETURN
*---------------------------------------------------------------------------
Procedure sterg_418
Parameters debit,credit,VALDEBIT,VALCREDIT
&&&&&&&&&&& ANA418
Select ana418
If Flock()
Seek Alltrim(osterg.NUME)
Replace productie With productie +debit, incasat With incasat+credit
Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit
Endif
UNLOCK
&&&&&&&&&&& FACT418
Select Fact418
IF debit#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont AND proc_tva=osterg.proc_tva
ELSE
LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont AND proc_tva=osterg.proc_tva
ENDIF
If Found()
If Flock()
Replace totctva With totctva+debit
Replace SUMAVAL With SUMAVAL+VALdebit
Replace achitat With achitat+credit
Replace achitatVAL With achitatVAL+VALcredit
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
ENDIF
UNLOCK
ENDIF
*-----------------------------------------------------------------------------------
Procedure sterg_471
Parameters debit,credit,VALDEBIT,VALCREDIT
Select chavans
Set Order To nract
Select chavans
IF debit#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont
ELSE
LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+debit
* Replace SUMAVAL With SUMAVAL+VALdebit
Replace achitat With achitat+credit
* Replace achitatVAL With achitatVAL+VALcredit
Endif
UNLOCK
IF totctva=0 AND achitat=0
DELETE
ENDIF
ENDIF
Select chavans
Set Order To Tag dataireg
ENDPROC
*----------------------------------------------------------------------------------
Procedure sterg_472
Parameters debit,credit,VALDEBIT,VALCREDIT
Select vnavans
Set Order To nract
Select vnavans
IF credit#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont
ELSE
LOCATE FOR nract=osterg.pereche AND NUME=osterg.NUME AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+credit
* Replace SUMAVAL With SUMAVAL+VALcredit
Replace achitat With achitat+debit
* Replace achitatVAL With achitatVAL+VALdebit
Endif
UNLOCK
IF totctva=0 AND achitat=0
DELETE
ENDIF
ENDIF
Select vnavans
Set Order To Tag dataireg
ENDPROC
*----------------------------------------------------------------------------------
Procedure sterg_455
Parameters debit,credit,VALDEBIT,VALCREDIT
Select actionar
If Flock()
Seek Upper(Alltrim(osterg.nume_2))
If Found()
Replace dat With dat+debit, luat With luat+credit
Endif
Endif
UNLOCK
ENDPROC
*--------------------------------------------------------
Procedure sterg_5311
Parameters debit,credit,VALDEBIT,VALCREDIT
SELECT casa
LOCATE FOR cod=osterg.cod
IF FOUND()
DELETE
ENDIF
Select casanume
Locate For ALLTRIM(casa)=osterg.nume_3
If Flock()
If Found()
Replace incasari With incasari+debit
Replace plati With plati+credit
Endif
Endif
Unlock
Return
*-----------------------------------------------
Procedure sterg_5314
Parameters debit,credit,VALDEBIT,VALCREDIT
STORE 0 TO m.plati,m.incasari,m.platival,m.incasval
SELECT casaval
LOCATE FOR cod=osterg.cod
IF FOUND()
DELETE
ENDIF
Select casvnume
Locate For ALLTRIM(nume_5)=osterg.nume_5
If Flock()
If Found()
Replace incasari With incasari+debit
Replace incasVAL With incasVAL+VALdebit
Replace plati With plati+credit
Replace platiVAL With platiVAL+VALcredit
Endif
Endif
Unlock
Return
*-----------------------------------------------
Procedure sterg_5121
Parameters debit,credit,VALDEBIT,VALCREDIT
SELECT banca
LOCATE FOR cod=osterg.cod
IF FOUND()
DELETE
ENDIF
Select bannume
Locate For ALLTRIM(nume_2)=osterg.nume_2
If Flock()
If Found()
Replace incasari With incasari+debit
Replace plati With plati+credit
Endif
Endif
Unlock
Return
*-----------------------------------------------
Procedure sterg_5124
Parameters debit,credit,VALDEBIT,VALCREDIT
SELECT bancaval
LOCATE FOR cod=osterg.cod
IF FOUND()
DELETE
ENDIF
Select banvnume
Locate For ALLTRIM(nume_3)=osterg.nume_3
If Flock()
If Found()
Replace incasari With incasari+debit
Replace incasVAL With incasVAL+VALdebit
Replace plati With plati+credit
Replace platiVAL With platiVAL+VALcredit
Endif
Endif
Unlock
*--------------------------------------------------------
Procedure sterg_5112
Parameters debit,credit,VALDEBIT,VALCREDIT
Sele cec
If Flock()
LOCATE FOR cod=osterg.cod
IF FOUND()
DELETE
ENDIF
Endif
UNLOCK
Select cecnume
If Flock()
LOCATE FOR UPPER(ALLTRIM(cec))=Upper(Alltrim(osterg.explicatia))
If Found()
Replace incarcat With incarcat+debit,plati With plati+credit
Endif
Endif
UNLOCK
ENDPROC
*--------------------------------------------------------
Procedure sterg_542
Parameters tndebit,tncredit,tnVALDEBIT,tnVALCREDIT
&&&&&&&&&&& DEBITORI
Select achit542
If Flock()
Seek Alltrim(osterg.NUME_2)
Replace debit With debit +TnDebit, credit With Credit+TnCredit
Replace VALdebit With VALdebit +tnVALdebit, VALcredit With VALcredit+tnVALcredit
Endif
Unlock
&&&&&&&&&&& achiLUN
SELECT achilun
IF tnDebit#0
Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME_2 AND acont=m.acont
ELSE
LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME_2 AND acont=m.acont
ENDIF
If Found()
If Flock()
Replace totctva With totctva+tndebit
Replace SUMAVAL With SUMAVAL+tnVALdebit
Replace achitat With achitat+tncredit
Replace achitatVAL With achitatVAL+tnVALcredit
Endif
UNLOCK
IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0
DELETE
ENDIF
ENDIF
*!* Parameters debit,credit,VALDEBIT,VALCREDIT
*!* &&&&&&&&&&& achit542
*!* Select achit542
*!* If Flock()
*!* Seek Upper(Alltrim(osterg.nume_2))
*!* If Found()
*!* Replace dat With dat+credit, luat With luat+debit
*!* Endif
*!* Endif
*!* Unlock
ENDPROC
*-----------------------------------------------------------------------
*** INCEPUT PROCEDURA INTRODUC_TVA
PROCEDURE caut_neimpozab
PARAMETERS tcAlias
LOCAL lcAlias, lcTVAD,lcTVAC,llvanz,llcump
lcAlias = ALLTRIM(tcAlias)
lcTVAD = "4426"
lcTVAC = "4427"
SELECT infisiere
LOCATE FOR cont=lcTVAD
lclstcDD=coresp_d && lista corespondentelor 4426 pe debit
lclstcDC=coresp_c && lista corespondentelor 4426 pe credit
LOCATE FOR cont=lcTVAC
lclstcCD=coresp_d && lista corespondentelor 4427 pe debit
lclstcCC=coresp_c && lista corespondentelor 4427 pe credit
STORE .F. to llvanz, llcump
IF !USED(lcAlias)
RETURN
ENDIF
*** caut daca exista inregistrari care afecteaza tva-ul
SELECT (lcAlias)
LOCATE FOR neimpozab!=0
IF !FOUND()
RETURN
ENDIF
SELECT (lcAlias)
LOCATE FOR neimpozab != 0
IF FOUND()
IF INLIST(ALLTRIM(scd),&lclstcCC) OR INLIST(ALLTRIM(scc),&lclstcCD)
llvanz = .T.
ENDIF
IF INLIST(ALLTRIM(scd),&lclstcDC) OR INLIST(ALLTRIM(scc),&lclstcDD)
llcump = .T.
ENDIF
ENDIF
IF llcump
DO _4426 WITH 0,0,0,0
ENDIF
IF llvanz
DO _4427 WITH 0,0,0,0
ENDIF
RETURN
*-----------------------------------------------------------------------
*** INCEPUT PROCEDURA STERG_TVA
PROCEDURE sterg_TVA
PARAMETERS tcAlias
LOCAL lcAlias, lcTVAD,lcTVAC,llvanz,llcump
lcAlias = ALLTRIM(tcAlias)
lcTVAD = "4426"
lcTVAC = "4427"
lclstcCD = [411;4111;4112;4113;4114;4115;4116;4117;4118;4119;4428] && lista corespondentelor 4427 pe debit
lclstcCC = [411;4111;4112;4113;4114;4115;4116;4117;4118;4119;461;5121;5124;5311;5314;428;635] && lista corespondentelor 4427 pe credit
lclstcDD = [401;404;5121;5124;542] && lista corespondentelor 4426 pe debit
lclstcDC = [4427;4424;635] && lista corespondentelor 4426 pe credit
STORE .F. to llvanz, llcump
IF !USED(lcAlias)
RETURN
ENDIF
*** caut daca exista inregistrari care afecteaza tva-ul
SELECT (lcAlias)
LOCATE FOR neimpozab!=0 OR INLIST(scd,lcTVAD,lcTVAC) OR INLIST(scc,lcTVAD,lcTVAC)
IF !FOUND()
RETURN
ENDIF
SELECT (lcAlias)
GO top
SCATTER NAME losterg
*** verific daca trebuie sa sterg din vanz sau din cump
SELECT (lcAlias)
LOCATE FOR INLIST(lcTVAD,scd,scc)
IF FOUND()
llcump = .T.
ELSE
LOCATE FOR INLIST(lcTVAC,scd,scc)
IF FOUND()
llvanz = .T.
ENDIF
ENDIF
IF !(llcump OR llvanz) && daca nu am gasit inreg cu TVA caut neimpozab
SELECT (lcAlias)
LOCATE FOR neimpozab != 0
IF FOUND()
IF ALLTRIM(scd)$lclstcCD OR ALLTRIM(scc)$lclstcCD OR ALLTRIM(scc)$lclstcCC OR ALLTRIM(scd)$lclstcCC
llvanz = .T.
ENDIF
IF ALLTRIM(scc)$lclstcDC OR ALLTRIM(scd)$lclstcDC OR ALLTRIM(scd)$lclstcDD OR ALLTRIM(scc)$lclstcDD
llcump = .T.
ENDIF
ENDIF
ENDIF
IF llvanz
SELECT vanz
LOCATE FOR cod=losterg.cod AND nract=losterg.nract
IF FOUND()
IF FLOCK()
DELETE
UNLOCK
ENDIF
ENDIF
ENDIF
IF llcump
SELECT cump
LOCATE FOR cod=losterg.cod AND nract=losterg.nract
IF FOUND()
IF FLOCK()
DELETE
UNLOCK
ENDIF
ENDIF
ENDIF
ENDPROC && sterg_TVA
*-----------------------------------------------
PROCEDURE regularizare_clienti
&&&&&&&&&vanzlun
SELECT actactan
SCAN FOR INLIST(m.acont,ascc,ascd)
SCATTER NAME oreg
SELECT vanzlun
IF FLOCK()
DO CASE
CASE LEFT(OREG.scc,3)='411'
LOCATE FOR nract=oreg.pereche2 AND NUME=oreg.NUME AND acont=oreg.ascc
IF FOUND()
REPLACE achitat WITH achitat+oreg.suma
ENDIF
CASE LEFT(OREG.scd,3)='411'
LOCATE FOR nract=oreg.pereche2 AND NUME=oreg.NUME AND acont=oreg.ascd
IF FOUND()
REPLACE achitat WITH achitat-oreg.suma
ENDIF
ENDCASE
ENDIF
UNLOCK
SELECT actactan
ENDSCAN
RELEASE oreg
ENDPROC
*----------------------------------------------------------------------------------------------
PROCEDURE afis_sold_casabanca
PARAMETERS tcTip,tcFis,tcTitlu,TcCont,TcNumeCol1,TcNumeCol2,tlVisibil
Private m.sum1,m.sum2,m.sum3,m.sumA2,m.sumA3,m.sumA4,m.sumA5,m.sumA6,m.sumA7,m.sumA8,m.sumA9,m.sumA10,m.sumA11,m.sumA12,m.sumA13,pcnumele,M.NUMEVAL,;
m.tincasari,m.tplati,sold
STORE 0 TO m.sum1,m.sum2,m.sum3,m.sumA2,m.sumA3,m.sumA4,m.sumA5,m.sumA6,m.sumA7,m.sumA8,m.sumA9,m.sumA10,m.sumA11,m.sumA12,m.sumA13,;
m.tincasari,m.tplati,sold
STORE '' TO pcnumele,M.NUMEVAL
Sele &tcFis
m.SOLDDEB=0
m.SOLDCRED=0
Sum &TcNumeCol2,PLATI To m.sum1,M.sum2
m.sum3=M.sum1-M.sum2
Sele Bal
Seek TcCont
If Found()
Scatter Memvar
If M.SOLDDEB-M.SOLDCRED # M.sum3
Do mesajval With 'Diferenta este:',M.SOLDDEB-M.SOLDCRED-M.sum3
Endif
*!* Else
*!* Do mesajval With '',M.SOLDDEB
Endif
Sele &tcFis
Obancana=Createobject("afbancanav")
WITH Obancana
.tip=tcTip
.grid1.column1.ControlSource=TcNumeCol1
.grid1.column3.ControlSource=TcNumeCol2
.grid1.column3.DynamicForeColor='IIF('+TcNumeCol2+'>=0, RGB(0,0,0), RGB(255,0,0))'
.grid1.column9.ControlSource=TcNumeCol2+'-PLATI'
.grid1.column9.DynamicForeColor='IIF('+TcNumeCol2+'-plati>=0, RGB(0,0,0), RGB(255,0,0))'
.grid1.column3.header3.caption=PROPER(TcNumeCol2)
.TitluFrumos1.Caption=TcTitlu
.check1.visible=TlVisibil
.check3.visible=TlVisibil
.check5.visible=TlVisibil
.check7.visible=TlVisibil
.TEXT14.VISIBLE=TlVisibil
.TEXT15.VISIBLE=TlVisibil
.TEXT16.VISIBLE=TlVisibil
.LABEL2.VISIBLE=TlVisibil
.GRID1.column5.visible=TlVisibil
.GRID1.column6.visible=TlVisibil
.GRID1.column7.visible=TlVisibil
.GRID1.column8.visible=TlVisibil
ENDWITH
Obancana.Show()
ENDPROC
*--------------------------------------------------------------------
procedure umple_log
PARAMETERS textul,textmare
LOCAL datatext
datatext=""
*----------------FACE INREGISTRARI IN LOG_TEXT.
datatext=calefirma+"\logs\contab\log_"+ALLTRIM(STR(DAY(DATE())))+"_"+ALLTRIM(STR(MONTH(DATE())))+"_"+ALLTRIM(STR(YEAR(DATE())))+".txt"
CD &CALEFIRMA
If !Directory("LOGS")
md logs
ENDIF
CD &calefirma\logs
If !Directory("contab")
Md contab
ENDIF
Set Textmerge On
Set Textmerge Noshow
Set Textmerge To &datatext ADDITIVE
\\<<DATETIME()>>,<<ALLTRIM(utilizator)>>,<<textul>>,<<textmare>>
\
Set Textmerge To
CD &dirgen
RETURN &&-------umple_log
Reference in New Issue View Git Blame Copy Permalink