romfast/roaimob
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
7364ca2abd1d54667b50f58652ec49168d39f1c3
roaimob/Programe/Vechi/proceduri.prg

1210 lines
23 KiB
Plaintext
Raw Blame History

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
*!* *!* *!* *!* *!* *!* *!* *!* *!*
Reference in New Issue View Git Blame Copy Permalink