Ir para o conteúdo
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

Kc_Nirvana

PHC 2010 - Criar Dossiers Internos

Mensagens Recomendadas

Kc_Nirvana

Bom dia.

Eu tenho uma tecla que me cria um tipo de dossier interno.

Ao carregar a primeira vez tudo fino. Mas ao carregar a 2ª ele começa a dar erros de buffer.

Alguem me consegue ajudar?

local Horas, strSQL, intProxAutoNo, strAdjBoStamp, strBiStamp,strProcesso,strItem,strRef,intNo,intEstab,strEmissao,intEDebito, intPerc, strAdjBiStamp
local strDGeral, dtmDataFinal, intEPCusto, intArmazem

Select TTA
Horas = TTA.Hreal + TTA.U_HORASC
If not empty(Horas)
	Text to strSQL noshow textmerge
      		SELECT BO.BOSTAMP,BO2.PROCESSO,BI.LITEM,BI.REF,BO.NO,BO.ESTAB,BO.MEMISSAO,BI.EDEBITO,BI.QTT,BI.BISTAMP,
      			BI.DGERAL,BO.DATAFINAL,BI.EPCUSTO,BI.ARMAZEM
      		FROM BO(NOLOCK) 
			INNER JOIN BO2(NOLOCK) ON BO.BOSTAMP = BO2.BO2STAMP
			INNER JOIN BI(NOLOCK) ON BI.BOSTAMP = BO.BOSTAMP
			INNER JOIN TTA(NOLOCK) ON TTA.TTASTAMP = BI.U_TTASTAMP
		WHERE BO2.ADJUDICADO = 1 AND TTA.TTASTAMP ='<< TTA.TTASTAMP >>'
	EndText

	If u_sqlexec(strSQL,'tmpC') AND not empty(tmpC.BOSTAMP)
		Select tmpC				
			strAdjBoStamp= tmpC.BOSTAMP
			strProcesso = tmpC.PROCESSO
			strItem = tmpC.LITEM
			strRef = tmpC.REF
			intNo = tmpC.NO
			intEstab = tmpC.ESTAB
			strEmissao = tmpC.MEMISSAO
			intEDebito = tmpC.EDEBITO
			intPerc = (TTA.HREAL * 100) / tmpC.QTT
			strAdjBiStamp = tmpC.BISTAMP
			strDGeral = tmpC.DGERAL
			dtmDataFinal = tmpC.DATAFINAL
			intEPCusto = tmpC.EPCUSTO
			intArmazem = tmpC.ARMAZEM
		Fecha("tmpC")

		Text to strSQL noshow textmerge
			SELECT MAX(ISNULL(BO2.AUTONO,0))+1 AS PROXNO FROM BO2 (NOLOCK) 
				INNER JOIN BO (NOLOCK) ON BO.BOSTAMP=BO2.BO2STAMP 
			WHERE BO2.ADJBOSTAMP='<< strAdjBoStamp >>' AND BO.NDOS=22
		Endtext

		If u_sqlexec(strSQL,'tmpD')
			Select tmpD
				intProxAutoNo = tmpD.PROXNO
			Fecha("tmpD")
		Endif

		fecha("mbocursor")
		fecha("mbo2cursor")
		fecha("mbicursor")
		fecha("mbicursor2")

		* usar tabelas de dossiers
		do dbfusebo
		do dbfusebo2
		do dbfusebi


		* Utilizar a configuração do tipo de dossier nº22
		do tsread with "",22

		* criar os cursores mbocursor, mbo2cursor, mbicursor e mbicursor2 vazios
		create cursor mbocursor (no n(10), estab n(3), memissao c(10),fref c(20))
		u_sqlexec([select * from bo2 (nolock) where 1=0],[mbo2cursor])
		u_sqlexec([select * from bi (nolock) where 1=0],[mbicursor])
		u_sqlexec([select * from bi2 (nolock) where 1=0],[mbicursor2])

		* limpar os cursores
		select mbocursor
		delete for .t.
		append blank
		select mbicursor
		delete for .t.
		select mbo2cursor
		delete for .t.
		select mbicursor2
		delete for .t.

		* preencher alguns campos do cabeçalho (mbocursor)
		select mbocursor
		replace mbocursor.no with intNo
		replace mbocursor.estab with intEstab
		replace mbocursor.memissao with strEmissao


		select mbo2cursor
		append blank
		replace mbo2cursor.processo with strProcesso
		replace mbo2cursor.autono with intProxAutoNo
		replace mbo2cursor.autos with .t.
		replace mbo2cursor.adjudicado with .t.
		replace mbo2cursor.adjbostamp with strAdjBoStamp

		select mbicursor
		append blank
		replace mbicursor.datafinal with dtmDataFinal
		replace mbicursor.armazem with intArmazem
		replace mbicursor.litem with strItem
		replace mbicursor.dgeral With strDGeral
		replace mbicursor.adjudicada With .t.
		replace mbicursor.ref with strRef

		Do BOACTREF with '',.t.,'OKPRECOS','mbicursor'

		* preenche o campo preço de venda (bi.edebito) da linha do artigo:
		replace mbicursor.edebito with intEDebito
		replace mbicursor.epcusto With intEPCusto
		* preenche quantidade do artigo (bi.qtt):
		replace mbicursor.qtt with TTA.HREAL

		* preenche o campo Nº subtipo (bi.stipo) da linha do dossier:
		replace mbicursor.stipo with 4

		select mbicursor2
		append blank
		replace mbicursor2.qttnew with TTA.HREAL
		replace mbicursor2.percnew with intPerc
		replace mbicursor2.qttnew2 with TTA.HREAL

		* totaliza a linha do artigo:
		do u_bottdeb with 'mbicursor'			
		do bobiact				

		if not criabobi(22,'mbicursor','mbocursor','mbo2cursor',.t.,.f.,DATE(),.t.,'mbicursor2')
			mensagem('Erro a gravar dossier','DIRECTA')
			return			
		endif

		Text to strSQL noshow textmerge
		      select bistamp from bi(NOLOCK) inner join bo(NOLOCK) on bi.bostamp = bo.bostamp inner join bo2(NOLOCK) on bo.bostamp = bo2.bo2stamp where autono =<< intProxAutoNo >>
		EndText
		if u_sqlexec(strSQL,'cursor')
			Select cursor
				strBiStamp= cursor.bistamp
			Text to strSQL noshow textmerge
		      	UPDATE BI SET OOBOSTAMP ='<< STRADJBOSTAMP >>',OBISTAMP ='<< STRADJBISTAMP >>',OOBISTAMP='<< STRADJBISTAMP >>' WHERE BI.BISTAMP='<< STRBISTAMP >>'
			EndText
			u_sqlexec(strSQL)				
		Endif			
	Endif
Endif

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
Kc_Nirvana

Aqui fica o codigo da questão resolvido para quem quiser aproveitar

local Horas, strSQL, intProxAutoNo, strAdjBoStamp, strBiStamp,strProcesso,strItem,strRef,intNo,intEstab,strEmissao,intEDebito, intPerc, strAdjBiStamp
local strDGeral, dtmDataFinal, intEPCusto, intArmazem,Horas2
WAIT WINDOW "A verificar tarefa " TIMEOUT 1
Select TTA
Horas = TTA.u_horasr + TTA.U_HORASC
Text to strSQL noshow textmerge
  		SELECT BO.BOSTAMP,BO2.PROCESSO,BI.LITEM,BI.REF,BO.NO,BO.ESTAB,BO.MEMISSAO,BI.EDEBITO,BI.QTT,BI.BISTAMP,
  			BI.DGERAL,BO.DATAFINAL,BI.EPCUSTO,BI.ARMAZEM
  		FROM BO 
		INNER JOIN BO2 ON BO.BOSTAMP = BO2.BO2STAMP
		INNER JOIN BI ON BI.BOSTAMP = BO.BOSTAMP
		INNER JOIN TTA ON TTA.TTASTAMP = BI.U_TTASTAMP
	WHERE BO2.ADJUDICADO = 1 AND TTA.TTASTAMP ='<< TTA.TTASTAMP >>'
EndText

If u_sqlexec(strSQL,'tmpC') AND not empty(tmpC.BOSTAMP)
	WAIT WINDOW "A medir a tarefa " TIMEOUT 1
	Select tmpC				
		strAdjBoStamp= tmpC.BOSTAMP
		strProcesso = tmpC.PROCESSO
		strItem = tmpC.LITEM
		strRef = tmpC.REF
		intNo = tmpC.NO
		intEstab = tmpC.ESTAB
		strEmissao = tmpC.MEMISSAO
		intEDebito = tmpC.EDEBITO
		intPerc = ((TTA.u_horasr/8) * 100) / tmpC.QTT
		strAdjBiStamp = tmpC.BISTAMP
		strDGeral = tmpC.DGERAL
		dtmDataFinal = tmpC.DATAFINAL
		intEPCusto = tmpC.EPCUSTO
		intArmazem = tmpC.ARMAZEM
	Fecha("tmpC")

	Text to strSQL noshow textmerge
		SELECT ISNULL(MAX(BO2.AUTONO),0)+1 AS PROXNO FROM BO2  
			INNER JOIN BO  ON BO.BOSTAMP=BO2.BO2STAMP 
		WHERE BO2.ADJBOSTAMP='<< strAdjBoStamp >>' AND BO.NDOS=22
	Endtext

	If u_sqlexec(strSQL,'tmpD')
		Select tmpD
			intProxAutoNo = tmpD.PROXNO
		Fecha("tmpD")
	Endif

	fecha("mbocursor")
	fecha("mbo2cursor")
	fecha("mbicursor")
	fecha("mbicursor2")

	If wexist("SBO")
   			SBO.doactualizar
		SBO.release()
	EndIf

	do dbfusebo
	do dbfusebo2
	do dbfusebi
	do dbfusebi2

	doread('BO')

	do tsread with "",22

	create cursor mbocursor (no n(10), estab n(3), memissao c(10),fref c(20),datafinal T)
	u_sqlexec([select * from bo2 (nolock) where 1=0],[mbo2cursor])
	u_sqlexec([select * from bi (nolock) where 1=0],[mbicursor])
	u_sqlexec([select * from bi2 (nolock) where 1=0],[mbicursor2])

	select mbocursor
	delete for .t.
	append blank
	select mbicursor
	delete for .t.
	select mbo2cursor
	delete for .t.
	select mbicursor2
	delete for .t.

	select mbocursor
	replace mbocursor.no with intNo
	replace mbocursor.estab with intEstab
	replace mbocursor.memissao with strEmissao
	replace mbocursor.datafinal with dtmdatafinal

	select mbo2cursor
	append blank
	replace mbo2cursor.processo with strProcesso
	replace mbo2cursor.autono with intProxAutoNo
	replace mbo2cursor.autos with .t.
	replace mbo2cursor.adjudicado with .t.
	replace mbo2cursor.adjbostamp with strAdjBoStamp

	select mbicursor
	append blank
	replace mbicursor.datafinal with dtmDataFinal
	replace mbicursor.armazem with intArmazem
	replace mbicursor.litem with strItem
	replace mbicursor.dgeral With strDGeral
	replace mbicursor.adjudicada With .t.
	replace mbicursor.ref with strRef

	Do BOACTREF with '',.t.,'OKPRECOS','mbicursor'		
	If not u_tabupdate(.t.,.t.,'BI')
		mensagem('Erro a gravar dossier','DIRECTA')
		return
	endif

	replace mbicursor.edebito with intEDebito
	replace mbicursor.epcusto With intEPCusto
	replace mbicursor.qtt with (TTA.u_horasr/8)
	replace mbicursor.stipo with 4

	select mbicursor2
	append blank
	replace mbicursor2.qttnew with (TTA.u_horasr/8)
	replace mbicursor2.percnew with intPerc
	replace mbicursor2.qttnew2 with (TTA.u_horasr/8)

	do u_bottdeb with 'mbicursor'			
	do bobiact
	If not u_tabupdate(.t.,.t.,'BI')
		mensagem('Erro a gravar dossier','DIRECTA')
		return
	endif			

	if criabobi(22,'mbicursor','mbocursor','mbo2cursor',.f.,.f.,DATE(),.f.,'mbicursor2')
		Select BO
		v_bibostamp= bo.bostamp
		u_requery('bi')
		Select bi
			Locate For bi.bostamp = bo.bostamp
			If Found()
				replace bi.oobostamp With STRADJBOSTAMP
				replace bi.obistamp With STRADJBISTAMP
				replace bi.oobistamp With STRADJBISTAMP
				If not u_tabupdate(.t.,.t.,'BI')
					mensagem('Erro a gravar dossier','DIRECTA')
					return
				Endif
			endif	
	else
		mensagem('Erro a gravar dossier','DIRECTA')
		return
	endif

	For each form in _screen.forms			
		If form.name='SBO'
			SBO.doactualizar
			SBO.release()
		endif
	next

Endif
WAIT WINDOW "A actualizar tarefa " TIMEOUT 1
Select TTA
Horas = tta.u_horasc + tta.u_horasr
intPerc =(TTA.u_horasr * 100) / TTA.HPREV
If horas > tta.hprev
	mensagem('Ultrapassou as horas previstas.','DIRECTA')
Endif

replace tta.pctreal with (tta.pctreal + Round(intPerc,2))
replace tta.u_horasc With horas
replace tta.u_horasr with 0
If not u_tabupdate(.t.,.t.,'TTA')
	mensagem('Erro a gravar tarefa','DIRECTA')
	return
endif													

For each form in _screen.forms			
	If form.name='STTA'
		STTA.doactualizar
	endif
next

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
ghst

Desculpem a minha ignorância.. Que tipo de código/linguagem é esse?

Há alguma documentação que eu possa obter para aprender PHC mais avançado (mais à frente  :()?

Obrigado.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
Kc_Nirvana

Visual FoxPro

É a linguagem do ERP da PHC.

Tens a enciclopedia da PHC que te traz alguns métodos para usares e programas já feitos para usares e perceberes como funciona o código

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
paulo capelo

Visual FoxPro

É a linguagem do ERP da PHC.

Tens a enciclopedia da PHC que te traz alguns métodos para usares e programas já feitos para usares e perceberes como funciona o código

onde posso arranjar essa enciclopédia ?

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora

×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade. Este site usa cookies para disponibilizar funcionalidades personalizadas. Para mais informações visite esta página.