FUNCTION get_explicatie
LPARAMETERS tnCodOp

*** ISTORIC OPERATII ***
*!*	*!*	*!*		Modificare                 : codop=1	 *!* *!* *!*
*!*	*!*	*!*		Introducere                : codop=2	 *!* *!* *!*
*!*	*!*	*!*		Preluare                   : codop=3	 *!* *!* *!*
*!*	*!*	*!*		Transformare in mf         : codop=4	 *!* *!* *!*
*!*	*!*	*!*		Iesire din gestiune        : codop=5	 *!* *!* *!*
*!*	*!*	*!*		Intrare in gestiune        : codop=6	 *!* *!* *!*
*!*	*!*	*!*		Stergere                   : codop=7	 *!* *!* *!*
*!*	*!*	*!*		Majorare val inv           : codop=8	 *!* *!* *!*
*!*	*!*	*!*		Reevaluarea val inv        : codop=9	 *!* *!* *!*
*!*	*!*	*!*		Schimbare DNS              : codop=10	 *!* *!* *!*
*!*	*!*	*!*		Recalcularea cota          : codop 11	 *!* *!* *!*
*!*	*!*	*!*		Conservare MF              : codop 12	 *!* *!* *!*
*!*	*!*	*!*		Scoatere din conservare MF : codop 13	 *!* *!* *!*

IF PCOUNT()<1 OR ISNULL(tnCodOp)
	tnCodOp = 0
ENDIF

DO CASE
	CASE tnCodOp = 1
		lcExplic = 'Modificare'
	CASE tnCodOp = 2
		lcExplic = 'Introducere'
	CASE tnCodOp = 3
		lcExplic = 'Preluare din contabilitate'
	CASE tnCodOp = 4
		lcExplic = 'Transformare in MF'
	CASE tnCodOp = 5
		lcExplic = 'Iesire din gestiune'
	CASE tnCodOp = 6
		lcExplic = 'Intrare in gestiune'
	CASE tnCodOp = 7
		lcExplic = 'Stergere'
	CASE tnCodOp = 8
		lcExplic = 'Majorare valoare inventar'
	CASE tnCodOp = 9
		lcExplic = 'Reevaluare MF'
	CASE tnCodOp = 10
		lcExplic = 'Schimbare DNS'
	CASE tnCodOp = 11
		lcExplic = 'Recalculare cota, valoare ramasa'
	CASE tnCodOp = 12
		lcExplic = 'Conservare MF'
	CASE tnCodOp = 13
		lcExplic = 'Scoatere din conservare MF'
	OTHERWISE
		lcExplic = ' '
ENDCASE
lcExplic = SUBSTR(lcExplic,1,50)
RETURN lcExplic


*!*	*!*	*!* *!*	*!*	*!*	*!*	*!*	*!*
*_____________________________________________________________

PROCEDURE a
RETURN
ENDPROC
*_____________________________________________________________
FUNCTION existacamp
PARAM numef,numec
SELE &numef
FOR i=1 TO FCOUNT()
	IF UPPER(ALLT(FIELD(i)))=UPPER(ALLT(numec))
		RETURN .T.
	ENDIF
NEXT
RETURN .F.
*_______________________________________________________

FUNCTION compartabele
PARAMETERS nume

SET EXACT ON
SELECT fistotv
LOCATE FOR numef=UPPER(nume)
IF !FOUND()
	RETURN
ENDIF
SCATTER MEMV
c1=ALLTRIM(m.calealfa)
c2=ALLTRIM(m.cale)
SELECT &nume
nrcol1=FCOUNT()
dat=c1+m.numef

USE &dat IN 0 ALIAS aliasmf
*do deschidf with m.calealfa,m.calealfa,m.numeF,aliasm,m.ordine,m.exc

SELECT aliasmf
nrcol2=FCOUNT()
USE IN aliasmf

IF nrcol1<>nrcol2
	RETURN .F.
ELSE
	RETURN .T.
ENDIF

ENDPROC
*_______________________________________________________
PROCEDURE redeschid
LOCAL lunatrec,antrec,lunacrt,ancrt,dattrec,datcrt
SET SAFETY OFF

lunacrt=m.nl
ancrt=m.an

SELE calendar
LOCATE FOR an=m.an AND nl=m.nl
SKIP -1
IF BOF()
	DO mesajatent WITH 'Luna '+m.nl+' '+m.an,'este prima luna deschisa!'
	RETURN
ENDIF
lunatrec=nl
antrec=an

dattrec=calefirma+'\AN'+antrec+'\DATE'+lunatrec+'\'+'mf.*'
dat=DIRgen+'\imob2003\date\mftemp.*'

CLOSE DATABASE

COPY FILE &dattrec TO &dat
dat=DIRgen+'\imob2003\date\mftemp.dbf'
SELECT 0
USE &dat EXCLUSIVE ALIAS dat
PACK
REPL ALL cod WITH 0
SELE dat
USE


SELE 0
USE &DATE\mf.DBF EXCLUSIVE ALIAS mf
DELETE FROM mf WHERE cod=0
PACK
USE
SELE 0
USE &DATE\mf.DBF ALIAS mf

dat=DIRgen+'\imob2003\date\mftemp.dbf'
SELE mf
APPEND FROM &dat
USE

m.nl=lunacrt
m.an=ancrt
DO totv

&&Actualizare amortizari precedente
SELE 0
dattrec=calefirma+'\AN'+antrec+'\DATE'+lunatrec+'\'+'mf.dbf'
USE &dattrec ALIAS mftrec

SELE mf
SCAN
	SCAT MEMV
	SELE mftrec
*loca for cod=m.cod and allt(denumire)=allt(m.denumire)
	LOCA FOR valoare=m.valoare AND nrinv=m.nrinv AND ALLT(denumire)=ALLT(m.denumire)
	IF FOUND()
*	Scat Memv
		lnAmorttot = amorttot
		SELE mf
		REPL amortprec WITH lnAmorttot
	ENDIF
	SELECT mf
ENDSCAN

SELE mftrec
USE

DO MESAJ WITH 'Lista mijloacelor fixe din luna ',m.nl+' '+m.an+' a fost actualizata!'

m.nl=lunacrt
m.an=ancrt
DO totv

*!*	IF USED('xmf')
*!*	USE IN xmf
*!*	ENDIF
*!*	USE mf AGAIN IN 0 SHARED ALIAS xmf
*!*	SELECT xmf
*!*	SET FILTER TO fel=" "
*!*	INDEX ON NRINV TAG NRINV OF &LOC\&NFSCURT\TEMPO\xMF
*!*	SET ORDER TO TAG NRINV
*!*	ov=create('vizP')
*!*	ov.label10.caption="Lista imobilizarilor "
*!*	SELECT xmf
*!*	SET FILTER TO
*!*	ov.show(1)


RETURN







*_________________________________________________________
PROCEDURE CAUT_norma
PARAMETERS NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
LOCAL MC0,MC1,MC2
SET SAFETY OFF
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
MC2='SET order TO TAG '+NUMECIMP

&MC0
IF EOF()
	APPE BLANK
ENDIF
*&MC2

OCA=CREATEOBJECT("CAUTnorma")
OCA.CAPTION=CAPTEXT
OCA.GRID1.RECORDSOURCE=NUMEBAZA
OCA.GRID1.COLUMN1.CONTROLSOURCE=NUMECIMP
OCA.SHOW(1)

SCATTER MEMVAR
&MC1

ENDPROC



*_________________________________________
PROCEDURE verifmf
LOCAL s
totval=0
s=.T.

SELE actan
SET FILTER TO LEFT(scc,3)='404' AND LEFT(scd,4)#'4426' AND !DELETED()
SCAN
	SCATTER MEMVAR
	SELE mf
	LOCATE FOR cod=m.cod AND !DELETED()
	IF FOUND()
		SUM valoare TO totval FOR cod=m.cod AND !DELETED()
		DO CASE
			CASE totval<m.suma
				DO erver WITH 'Introdus partial!',totval
			CASE totval>m.suma
				DO erver WITH 'Introdus gresit!',totval
		ENDCASE
		s=.F.
	ELSE
		DO erver WITH 'Neintrodus!',0
		s=.F.
	ENDIF
ENDSCAN

IF s
	DO MESAJ WITH 'Toate mijloacele fixe achizitionate','sunt luate in evidenta.'
ENDIF

RETURN



*_________________________________________
PROCEDURE erver
PARAMETERS texter,totval
oer=CREATE('eroareverif')
oer.label5.CAPTION=texter
oer.text5.VALUE=totval
oer.SHOW(1)
RETURN






*_________________________________________________________
PROCEDURE CAUT_ALF_vechi
PARAMETERS NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
LOCAL MC0,MC1,MC2
SET SAFETY OFF
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
MC2='SET order TO TAG '+NUMECIMP

&MC0
IF EOF()
	APPE BLANK
ENDIF
&MC2

OCA=CREATEOBJECT("CAUTALFa")
OCA.GRID1.RECORDSOURCE=NUMEBAZA
OCA.GRID1.COLUMN1.CONTROLSOURCE=NUMECIMP
*OCA.titlufrumos1.caption=PROPER(CAPTEXT)
OCA.CAPT=PROPER(CAPTEXT)
OCA.SHOW(1)

IF buton=2
	&MC0
	SET FILTER TO
	RETURN
ENDIF

&MC0
SCATTER MEMVAR
&MC1

ENDPROC


*_________________________________________________________
PROCEDURE CAUT_ALF
PARAMETERS NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
LOCAL MC0,MC1,MC2
SET SAFETY OFF
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
MC2='SET order TO TAG '+NUMECIMP

&MC0
GO TOP
IF EOF()
	APPE BLANK
ENDIF
&MC2

OCA=CREATEOBJECT("CAUTALFA")
OCA.CAPTION=CAPTEXT
OCA.GRID1.RECORDSOURCE=NUMEBAZA
OCA.GRID1.COLUMN1.CONTROLSOURCE=NUMECIMP
OCA.SHOW(1)

SCATTER MEMVAR
&MC1
&MC0
SET FILTER TO
RETURN


*_________________________________________________________
PROCEDURE CAUT_ALFa
PARAMETERS NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
buton=1
LOCAL MC0,MC1,MC2
SET SAFETY OFF

STORE .T. TO llVizibil

LcVar=VARMEM  && pt variabilele globale(varmem) pt care varmem # numecimp

MC0='SELE '+NUMEBAZA
MC1=[VARMEM=M.]+NUMECIMP
MC2='SET order TO TAG '+NUMECIMP

*!*	&MC0
*!*	GO TOP
*!*	IF EOF()
*!*		APPE BLANK
*!*	ENDIF

*!*	&MC2

LOCAL lcNumeCol2
STORE '' TO lcNumeCol2

LcCol = ALLTRIM(NUMEBAZA) + '.cod_fiscal'
IF TYPE(LcCol) # 'U'
	lcNumeCol2 = 'cod_fiscal'
ENDIF
LcCol = ALLTRIM(NUMEBAZA) + '.gest'
IF TYPE(LcCol) # 'U'
	lcNumeCol2 = 'gest'
ENDIF
LcCol = ALLTRIM(NUMEBAZA) + '.id_sectie'
IF TYPE(LcCol) # 'U'
	lcNumeCol2 = 'id_sectie'
ENDIF
IF EMPTY(lcNumeCol2)
	lcNumeCol2 = 'space(4)'
	llVizibil = .F.
ENDIF

SELECT DISTINCT &NUMECIMP, &lcNumeCol2 FROM (NUMEBAZA) INTO CURSOR tnomenclator READWRITE ORDER BY &NUMECIMP

OCA=CREATEOBJECT("CAUTALFa")
OCA.CAPTION=CAPTEXT
OCA.GRID1.RECORDSOURCE = 'tnomenclator'
OCA.GRID1.COLUMN1.CONTROLSOURCE = NUMECIMP
OCA.GRID1.COLUMN2.CONTROLSOURCE = lcNumeCol2
OCA.GRID1.COLUMN2.VISIBLE = llVizibil
OCA.cmdrenunt1.VISIBLE=.T.
OCA.SHOW(1)

IF buton=2
*!*		&MC0
*!*		SET FILTER TO
	USE IN tnomenclator
	RETURN
ENDIF
*!*	&MC0
*!*	SCATTER MEMVAR

SELECT tnomenclator
SCATTER MEMVAR

&MC1
&LcVar=VARMEM
*!*	&MC0
*!*	SET FILTER TO
USE IN tnomenclator
RETURN



*_________________________________________________________
PROCEDURE caut_alfa_cursor
PARAMETERS NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
LOCAL llVizibil
SET SAFETY OFF
llVizibil = .T.

IF !EMPTY(VARMEM) AND  TYPE('VARMEM') = 'C'
	MC1='VARMEM=M.'+NUMECIMP
ENDIF 

LOCAL lcNumeCol2
STORE '' TO lcNumeCol2

LcCol = ALLTRIM(NUMEBAZA) + '.cod_fiscal'
IF TYPE(LcCol) # 'U'
	lcNumeCol2 = 'cod_fiscal'
ENDIF

LcCol = ALLTRIM(NUMEBAZA) + '.gest'
IF TYPE(LcCol) # 'U'
	lcNumeCol2 = 'gest'
ENDIF

LcCol = ALLTRIM(NUMEBAZA) + '.id_sectie'
IF TYPE(LcCol) # 'U'
	lcNumeCol2 = 'id_sectie'
ENDIF

IF EMPTY(lcNumeCol2)
	lcNumeCol2 = 'space(4)'
	llVizibil = .F.
ENDIF

LcCol = ALLTRIM(NUMEBAZA) + '.id'
IF TYPE(LcCol) # 'U'
	lcNumeCol3 = 'id'
ELSE
	lcNumeCol3 = 'space(4)'
ENDIF

SELECT DISTINCT &NUMECIMP, &lcNumeCol2, &lcNumeCol3 FROM (NUMEBAZA) INTO CURSOR tnomenclator READWRITE ORDER BY &NUMECIMP

OCA=CREATEOBJECT("CAUTALFa")
OCA.CAPTION=CAPTEXT
OCA.GRID1.RECORDSOURCE='tnomenclator'
OCA.GRID1.COLUMN1.CONTROLSOURCE = NUMECIMP
OCA.GRID1.COLUMN2.CONTROLSOURCE = lcNumeCol2
OCA.GRID1.COLUMN2.VISIBLE = llVizibil
OCA.cmdrenunt1.VISIBLE=.T.
OCA.command1.VISIBLE=.F.
OCA.command2.VISIBLE=.F.
OCA.command3.VISIBLE=.F.
OCA.SHOW(1)

IF buton=2
	SELECT tnomenclator
	SCATTER NAME onome BLANK 
	USE IN tnomenclator
	RETURN onome
ENDIF

SELECT tnomenclator
SCATTER MEMVAR
SCATTER NAME onome

IF TYPE('MC1') # 'U'
	&MC1
ENDIF 

USE IN tnomenclator
RETURN onome 

*_________________________________________________________
PROCEDURE GENERARE_ACT
LOCAL i,J,T,T1,T2,T3,T4,T5,T6,T7
SELE varact

OACTGEN=CREATEOBJECT("ACTGEN")
FOR i=5 TO 11
	DO CASE
		CASE i=10
			J="10"
		CASE i=11
			J="11"
		OTHERWISE
			J=CHR(48+i)
	ENDCASE
	GOTO i
	SCATTER MEMVAR
	T=".TEXT"+J+".CONTROLSOURCE=CONTROL"+J
	T1=".LABEL"+J+".CAPTION=M.ETICHETA"
	T2=".LABEL"+J+".VISIBLE=M.VIZIBIL"
	T3=".TEXT"+J+".VISIBLE=M.VIZIBIL"
	T4=".TEXT"+J+".READONLY=M.CAUTARE"
	T5=".CAUT"+J+"=M.CAUTARE"
	T6=".BAZA"+J+"=M.BAZA"
	T7=".CIMP"+J+"=M.CIMP"
	WITH OACTGEN
		&T
		&T1
		&T2
		&T3
		&T4
		&T5
		&T6
		&T7
	ENDWITH
ENDFOR

OACTGEN.SHOW(1)

ENDPROC




*TOTPROC
***********************************************************************************
PROCEDURE CODARE
SELE cod
IF FLOCK()
	GOTO BOTTOM
*SCATTER MEMVAR
	m.cod=cod+1
	APPEND BLANK
*m.COD=RECNO()
	GATHER MEMVAR
ENDIF
UNLOCK
RETURN
*****************



*___________________________________________
PROCEDURE MESAJ
PARAMETERS m1,m2
ot=CREATE('text')
ot.label2.CAPTION=m1
ot.label3.CAPTION=m2
ot.SHOW(1)
RETURN

*___________________________________________
PROCEDURE mesajatent
PARAMETERS m1,m2
ot=CREATE('atentie')
ot.label2.CAPTION=m1
ot.label3.CAPTION=m2
ot.SHOW(1)
RETURN

*___________________________________________
PROCEDURE mesajrosu
PARAMETERS m1,m2
ot=CREATE('atentierosu')
ot.label2.CAPTION=m1
ot.label3.CAPTION=m2
ot.SHOW(1)
RETURN



*___________________________________________
PROCEDURE alfabeta
PARAMETERS clasa,e5,b5,c5,e6,b6,c6,e7,b7,c7,expl
m.explicatia=expl
clasaact='actverif'
oc=CREATE(clasa)
WITH oc
	.eti5=e5
	.eti6=e6
	.eti7=e7
	.baza5=b5
	.baza6=b6
	.baza7=b7
	.cimp5=c5
	.cimp6=c6
	.cimp7=c7
	.num=c5
	.num2=c6
	.expl=c7
ENDWITH
oc.SHOW(1)
RETURN



*_____________________________________-
PROCEDURE IESIRE
*close tables
*close database
*set defa to &dirgen
*erase actactan.*
*erase ?temp.*
QUIT
RETURN


PROCEDURE EXEC_MENIU
RETURN


*________________________________
PROCEDURE danu
PARAMETERS T1,T4,T5
od=CREATE('casdanu')
WITH od
	.text1.VISIBLE=.F.
	.text2.VISIBLE=.F.
	.label1.CAPTION=T1
	.label4.CAPTION=T4
	.label5.CAPTION=T5
ENDWITH
od.SHOW(1)
RETURN

*___________________________________________
PROCEDURE danuquit
PARAMETERS m1
od=CREATE('danu')
od.label1.CAPTION=m1
od.SHOW(1)
IF buton=2
	QUIT
ENDIF
RETURN
*___________________________________________

PROCEDURE DaSauNu
PARAMETERS m1
od=CREATE('danu')
od.label1.CAPTION=m1
od.SHOW(1)
RETURN

*____________________________________
PROC PR
PARAM stare
IF stare>Maxs
*stare=0
	Maxs=2*Maxs
	OP.PRBAR.MAX=Maxs
*return
ENDIF
OP.PRBAR.VALUE=stare
OP.P=ROUND(100*OP.PRBAR.VALUE/OP.PRBAR.MAX,2)
OP.REFRESH
stare=stare+1
RETURN

*________________________________________
PROCEDURE danu_ingest
PARAMETERS cas,txt1,txt2

IF UPPER(ALLTRIM(txt2))='INTRARE'
	lcLb2 = 'Cauza intrarii in gestiune'
	lcLb3 = 'Data intrarii in gestiune'
ENDIF
IF UPPER(ALLTRIM(txt2))='IESIRE'
	lcLb2 = 'Cauza iesirii din gestiune'
	lcLb3 = 'Data iesirii dn gestiune'
ENDIF
m.dataout = ultima_zi_din_luna(m.an,m.nl)
SELECT mf
oi=CREATEOBJECT('ingest')
oi.label1.CAPTION=txt1
oi.label2.CAPTION=lcLb2
oi.label3.CAPTION=lcLb3

*!*		If cas
*!*			oi.label2.Visible=.F.
*!*			oi.text1.Visible=.F.
*!*			oi.label3.Visible=.F.
*!*			oi.text2.Visible=.F.
*!*		Endif
oi.SHOW(1)
RETURN


*_________________________________________________
PROC err
DO MESAJ WITH 'Pentru initializare trebuie lansat','programul CONTAFIN CONT2000'
buton=2
DO WHILE buton=2
	QUIT
ENDDO
RETURN



*________________________________________________
PROCEDURE inchidprog
LOCAL CC,M.NUMESTATIE,UU
IF FILE('c:\contafin\temp\CEPROGRAM.dbf')

	SELE 0
	USE C:\CONTAFIN\temp\ceprogram ALIAS ceprogram
	UU=UTIL
	SELE ceprogram
	USE

	IF !FILE('&LOC\&NFSCURT\TEMPO\OPTIUNI.DBF')
*wait wind 'optiuni'
		RETURN
	ENDIF
	IF !USED('OPTIUNI')
		SELE 0
		USE &loc\&nfscurt\TEMPO\OPTIUNI SHAR ALIAS OPTIUNI
	ENDIF

	SELE OPTIUNI
	LOCA FOR OPTIUNE='RETEA'
	IF !FOUND() OR (FOUND() AND !DA)
		SELE OPTIUNI
		USE
*wait wind LOC
		RETURN
	ENDIF
	SELE OPTIUNI
	USE

	IF !FILE('C:\CONTAFIN\temp\RETEA.DBF')
*wait wind 'start-retea'
		RETURN
	ENDIF
	SELE 0
	USE C:\CONTAFIN\temp\RETEA SHAR ALIAS RETEA
	m.NUMESTATIE=ALLT(NUMESTATIE)
	CC=DIRgen
	USE

	IF FILE('&DIRGEN\Dateretea\istoric.DBF')
		SELE 0
		USE &DIRgen\Dateretea\istoric SHARE ALIAS istoric
	ELSE
		SELE 0
		USE &CC\START2000\DATA\istoric SHARE ALIAS istoric
	ENDIF

	SELE istoric
	SET ORDER TO DATAORAINT
	LOCA FOR EMPTY(dataoraies) AND ALLT(statie)=m.NUMESTATIE AND ALLT(UTILIZATOR)=ALLT(UU)
	IF FOUND()
		IF FLOCK()
			REPL dataoraies WITH DATETIME()
			UNLOCK
		ENDIF
	ENDIF
	SELE istoric
	USE


	IF FILE('&DIRGEN\Dateretea\activ.DBF')
		SELE 0
		USE &DIRgen\Dateretea\ACTIV SHARE ALIAS ACTIV
	ELSE
		SELE 0
		USE &CC\START2000\DATA\ACTIV SHARE ALIAS ACTIV
	ENDIF

	SELE ACTIV
	LOCA FOR ALLT(statie)=m.NUMESTATIE
	IF !FOUND()
		WAIT WIND 'Aceasta statie nu este inregistrata in server!'
	ELSE
		SELE ACTIV
		IF FLOCK()
			REPL mfix2000 WITH .F.
		ENDIF
		UNLOCK
	ENDIF
	SELE ACTIV
	USE
ENDIF
RETURN






*!*	*_____________________________________-
*!*	FUNCTION SERIA_LUNARA_E_CORECTA
*!*	local TIPAR,LOC,L
*!*	L=VAL(M.NL)
*!*	LOC=L+floor((L-1)/2)
*!*	TIPAR='010649161147'

*!*	sele cul
*!*	GO TOP
*!*	&&ESTE CORECTA ULTIMA SERIE?
*!*	IF substr(TIPAR,L,1)=substr(GREEN,LOC,1);
*!*			AND substr(red,1,1)=substr(GREEN,3,1);
*!*			AND substr(red,2,1)=substr(GREEN,6,1);
*!*			AND substr(red,3,1)=substr(GREEN,9,1);
*!*			AND substr(red,4,1)=substr(GREEN,12,1);
*!*			AND substr(red,5,1)=substr(GREEN,15,1)
*!*		RETURN .T.
*!*	ELSE
*!*		RETURN .F.
*!*	ENDIF
*!*	RETURN
*_____________________________________-
FUNCTION SERIA_LUNARA_E_CORECTA
LOCAL loc,L
L=VAL(M.nl)
loc=L+FLOOR((L-1)/2)

SELE cul
GO TOP
&&ESTE CORECTA ULTIMA SERIE?
IF SUBSTR(TIPAR,L,1)=SUBSTR(GREEN,loc,1);
		AND SUBSTR(red,1,1)=SUBSTR(GREEN,3,1);
		AND SUBSTR(red,2,1)=SUBSTR(GREEN,6,1);
		AND SUBSTR(red,3,1)=SUBSTR(GREEN,9,1);
		AND SUBSTR(red,4,1)=SUBSTR(GREEN,12,1);
		AND SUBSTR(red,5,1)=SUBSTR(GREEN,15,1)
	RETURN .T.
ELSE
	RETURN .F.
ENDIF


*!*	*------------------------------------------------
*!*	PROCEDURE seriadebaza
*!*	LOCAL sb,sn
*!*	STORE '' TO sb,sn

*!*	FOR i=1 TO 5
*!*		sb=sb+LITERA()
*!*	NEXT

*!*	SELE cul
*!*	GO TOP
*!*	REPL red WITH sb
*!*	sn=GREEN


*!*	IF SUBSTR(sn,3,1)=SUBSTR(sb,1,1) AND;
*!*			SUBSTR(sn,6,1)=SUBSTR(sb,2,1) AND;
*!*			SUBSTR(sn,9,1)=SUBSTR(sb,3,1) AND;
*!*			SUBSTR(sn,12,1)=SUBSTR(sb,4,1) AND;
*!*			SUBSTR(sn,15,1)=SUBSTR(sb,5,1) AND;
*!*			SUBSTR(sn,VAL(M.nl)+FLOOR((VAL(M.nl)-1)/2),1)=SUBSTR(TIPAR,VAL(M.nl),1)
*!*		RETURN
*!*	ELSE

*!*		FOR i=1 TO 17
*!*			sn=sn+LITERA()
*!*		NEXT

*!*		FOR i=1 TO 5
*!*			sn=STUFF(sn, i*3, 1, SUBSTR(sb,i,1))
*!*		NEXT
*!*		sn=STUFF(sn, VAL(M.nl)+FLOOR((VAL(M.nl)-1)/2), 1, SUBSTR(TIPAR,VAL(M.nl),1))

*!*		SELE cul
*!*		REPL GREEN WITH sn
*!*	ENDIF
*!*	RETURN




*_____________________________________-
FUNCTION e_ultima_luna
SELE calendar
LOCA FOR m.nl=nl AND m.an=an
SKIP
IF EOF()
	ultima_luna=.T.
	RETURN .T.
ELSE
	ultima_luna=.F.
	RETURN .F.
ENDIF
RETURN

PROCEDURE CITESTE_ANALITICE
RETURN

*______________________________________

PROCEDURE alegeprogram
PUBLIC op_imob

IF !USED('verimob')
	USE &DIRgen\IMOB2003\VERIMOB IN 0 ALIAS VERIMOB SHARED
ENDIF

SELECT VERIMOB
DO CASE
	CASE s
		NUMEPROGRAM='CONTAFIN IMOBILIZARI'
		op_imob=CREA('p_imob_i')
		op_imob.pagefrb1.page1.cw1.VISIBLE=.F.
		op_imob.pagefrb1.page1.cw3.VISIBLE=.F.
		op_imob.pagefrb1.page1.shape4.VISIBLE=.F.
		op_imob.pagefrb1.page1.cw4.TOP=17
		op_imob.pagefrb1.page1.cw2.TOP=53
		op_imob.pagefrb1.page1.shape3.TOP=85
	CASE i
		NUMEPROGRAM='CONTAFIN IMOBILIZARI'
		op_imob=CREA('p_imob_i')
	CASE E
		NUMEPROGRAM='CONTAFIN IMOBILIZARI'
		op_imob=CREA('p_imob_e')
ENDCASE



ENDPROC && alegeprogram

*___________________________________________

PROCEDURE verific_cu_balanta
PARAMETERS tcFel
LOCAL ln_fel

IF PCOUNT() > 0
	lcfel = ALLTRIM(UPPER(tcFel))
ELSE
	lcfel = ''
ENDIF

DO CASE
	CASE lcfel =''
		ln_fel=1
	CASE lcfel ='N'
		ln_fel=2
	CASE lcfel ='C'
		ln_fel=3
ENDCASE

CREATE TABLE &loc\&nfscurt\compar_amort (c_imob C(4),c_amort C(4),val_mf N(16),vald_bal N(16),amort_mf N(16),valc_bal N(16))

IF !USED('bal')
	USE &DATE\bal IN 0 AGAIN ALIAS bal SHARED
ENDIF

SELECT contamort
IF TYPE('contamort.fel_imob')#'U'
	SELECT contamort
	GO TOP
	IF EMPTY(fel_imob)
		DO MESAJ WITH 'Dati actualizare de fisier','INITIALIZARE / CONTURI DE AMORTIZARE'
		RETURN
	ENDIF
ELSE
	DO MESAJ WITH 'Reindexati fisierele din DATEAN','<MENU / UTILE / REINDEXARE>'
	RETURN
ENDIF

SELECT contamort
SCAN FOR fel_imob=ln_fel
	SCATTER NAME ocont
	SELECT mf
	SUM valin TO ln_valoare FOR ALLTRIM(scd)=ALLTRIM(ocont.cont_imob) AND !casat AND !inactiv AND ALLTRIM(UPPER(fel))=lcfel
	SUM amorttot TO ln_amort FOR ALLTRIM(scd)=ALLTRIM(ocont.cont_imob) AND !casat AND !inactiv AND ALLTRIM(UPPER(fel))=lcfel
	SELECT bal
	LOCATE FOR ALLTRIM(CONT)=ALLTRIM(ocont.cont_imob)
	IF !FOUND()
		ln_soldD=0
	ELSE
		ln_soldD=solddeb
	ENDIF
	LOCATE FOR CONT=ocont.cont_amort
	IF !FOUND()
		ln_soldC=0
	ELSE
		ln_soldC=soldcred
	ENDIF
	SELECT compar_amort
	APPEND BLANK
	REPLACE c_imob WITH ocont.cont_imob,val_mf WITH ln_valoare,amort_mf WITH ln_amort
	REPLACE c_amort WITH ocont.cont_amort,vald_bal WITH ln_soldD,valc_bal WITH ln_soldC
	SELECT contamort
ENDSCAN

SELECT compar_amort
SCAN
	IF val_mf#vald_bal
		DO MESAJ WITH 'Diferenta intre Imobilizari si Balanta','la contul '+c_imob+' este de '+ALLTRIM(STR(val_mf-vald_bal))+' lei'
	ENDIF

ENDSCAN

SELECT c_amort,SUM(amort_mf) AS tot_amort,valc_bal FROM compar_amort;
	GROUP BY c_amort;
	INTO CURSOR alabala

SELECT alabala
SCAN
	IF tot_amort#valc_bal
		DO MESAJ WITH 'Diferenta intre Imobilizari si Balanta','la contul '+c_amort+' este de '+ALLTRIM(STR(tot_amort-valc_bal))+' lei'
	ENDIF
ENDSCAN

DO MESAJ WITH '','Verificarea s-a incheiat!'
RELEASE ocont

IF USED('bal')
	USE IN bal
ENDIF
IF USED('compar_amort')
	USE IN compar_amort
ENDIF
IF USED('alabala')
	USE IN alabala
ENDIF

ENDPROC && verific_cu_balanta


*ALFANUMERIC ALEATOR__________________________________________
FUNCTION LITERA()
LOCAL Z,N,L,U,R,R1

Z=ROUND(RAND()*10+48,0)
N=IIF(Z=58,'0',CHR(Z))

Z=ROUND(RAND()*26+65,0)
L=IIF(Z=90,'X',CHR(Z))

U=ROUND(RAND(),0)
R=IIF(U=1,N,L)

RETURN R
*RETURN n

*----------------------------------------------------
PROCEDURE intrare

DO FORM start00
ENDPROC && intrare

*----------------------------------------------------
PROCEDURE ACTUALIZARE_FISIER
PARAMETERS TFIS

TFIS=UPPER(ALLTRIM(TFIS))
SELECT fistotv
LOCATE FOR UPPER(ALLTRIM(numef))=TFIS
SCATTER NAME OFIS

SELECT (TFIS)
DELETE ALL

LcFis=ALLTRIM(OFIS.calealfa)+'\'+TFIS+'.DBF'
*WAIT WINDOW LcFis
SELECT (TFIS)
APPEND FROM &LcFis

RELEASE OFIS
ENDPROC

*******
*!*	SET CLASSLIB TO d:\contafin\contab\clase\caut.vcx ADDITIVE
*!*	oo=ret_luna("Luna de inceput")
*** scattered = MYSCATTER() && This is instead of SCATTER NAME...
PROCEDURE myScatter
PARAMETERS tcBlank
LOCAL llBlank, loScatter

llBlank=.F.
IF TYPE('tcBlank')='C'
	IF 'BLANK'$UPPER(tcBlank)
		llBlank=.T.
	ENDIF
ENDIF

myScatterObject = CREATEOBJECT("myScatterObject")
IF !EMPTY(ALIAS())
	IF llBlank
		SCATTER NAME loScatter MEMO BLANK
	ELSE
		SCATTER NAME loScatter MEMO
	ENDIF
	lnFields = FCOUNT(ALIAS())
	FOR N =1 TO lnFields
		lcField=FIELD(N)
		lcvalue=loScatter.&lcField
		myScatterObject.ADDPROPERTY(lcField, lcvalue)
	ENDFOR
	RELEASE loScatter
ENDIF
RETURN myScatterObject && Always return an object, so GATHER command could not choke.
ENDPROC

DEFINE CLASS myScatterObject AS SESSION
* You may use any VFP class directly like myScatterObject = CREATEOBJECT("Session")
* But you may optionally use this DEFINE CLASS
* and declare the native PEMs here as HIDDEN if you want, so they are not exposed
* in case you are using class other than Session or work with VFP version prior to VFP 7.0
ENDDEFINE

*____________________________________________________________________________________________
*** returneaza un obiect cu proprietatile an si nl (de fapt cu toate coloanele din calendar)
FUNCTION ret_luna
PARAMETERS tcTitlu

PRIVATE loLuna

SELECT calendar
USE DBF('calendar') IN 0 AGAIN ALIAS tsel_luna SHARE
SELECT tsel_luna
loLuna=myScatter('blank')

Ol=CREATEOBJECT("frm_sel_luna")
WITH Ol
	.lblTitlu.CAPTION=tcTitlu
	IF EMPTY(.cboLuna.ROWSOURCE)
		.cboLuna.ROWSOURCE="tsel_luna.nl,an"
	ENDIF
	.oLuna=loLuna
	IF EMPTY(.cAlias)
		.cAlias=LEFT(.cboLuna.ROWSOURCE,AT(".",.cboLuna.ROWSOURCE)-1)
	ENDIF
ENDWITH
Ol.SHOW(1)

USE IN tsel_luna

RETURN loLuna
ENDFUNC && ret_oluna
*___________________________________________________________________________________________
*________________________________________
PROCEDURE danu_transfer
PARAMETERS cas,txt1,txt2

SELECT nume_2 FROM respons INTO CURSOR cRespons ORDER BY nume_2

SELECT mf
oi=CREATEOBJECT('ingest_transfer')
oi.label1.CAPTION=txt1
oi.label2.CAPTION=txt2
oi.text2.VALUE = DATE()
IF cas
	oi.label2.VISIBLE=.F.
	oi.text1.VISIBLE=.F.
	oi.label3.VISIBLE=.F.
	oi.text2.VISIBLE=.F.
ENDIF
oi.SHOW(1)
IF USED("cRespons")
	USE IN cRespons
ENDIF
RETURN
*_________________________________________________


FUNCTION TVA
*
ENDFUNC

FUNCTION NRORD
*
ENDFUNC

PROCEDURE ULTIMAZI
*
ENDPROC

PROCEDURE ULTIMAZIL
*
ENDPROC

PROCEDURE IERULAJMAGAZII
*
ENDPROC

PROCEDURE IESTOCURIMAGAZII
*
ENDPROC

PROCEDURE INRULAJMAGAZII
*
ENDPROC

PROCEDURE INSTOCURIMAGAZII
*
ENDPROC

*!*	*!*	*!* *!*	*!*	*!*	*!*	*!*	*!*