Função para copiar registro de uma filial para outra

Função para copiar registro de uma filial para outra

Olá pessoal…

Hoje vou mostrar uma função desenvolvida para cópia de registros de uma filial para outra (com opção de mudança de código).

Essa rotina, o ideal é primeiramente utilizar em base de testes, ela faz uma consulta SQL buscando o registro de origem e através desse registro cria um de destino, seja mudando a filial e/ou mudando o código.

Ao abrir a rotina é mostrado a tela de Pergunte.

Tela de parâmetros para cópia de registro
Tela de parâmetros para cópia de registro

Onde os parâmetros são:
Tabela: Alias da tabela (por exemplo, SB1)
Campo Chave: Campo chave da tabela (por exemplo, B1_COD)
Filial Atual: Filial do registro que existe (por exemplo, 01)
Chave Atual: Código do registro do campo chave (por exemplo, 000001)
Filial Nova: Filial do novo registro (por exemplo, 02)
Chave Nova: Novo código do registro (por exemplo, 000099)

Abaixo o código fonte desenvolvido.

//Bibliotecas
#Include "Protheus.ch"
#Include "TopConn.ch"

/*/{Protheus.doc} zCpyReg
Função para copiar registros entre as filiais
@type function
@author Atilio
@since 02/01/2017
@version 1.0
	@example
	u_zCpyReg()
/*/

User Function zCpyReg()
	Local aArea        := GetArea()
	Local cPerg        := "X_zCpyReg"
	Private cTabelaAux := ""
	Private cChaveAux  := ""
	Private cFilAtuAux := ""
	Private cCodAtuAux := ""
	Private cFilNovAux := ""
	Private cCodNovAux := ""
	
	//Cria o grupo de pergunta
	fVldPerg(cPerg)
	
	//Se a pergunta for confirmada
	If Pergunte(cPerg, .T.)
		cTabelaAux := MV_PAR01
		cChaveAux  := MV_PAR02
		cFilAtuAux := MV_PAR03
		cCodAtuAux := MV_PAR04
		cFilNovAux := MV_PAR05
		cCodNovAux := MV_PAR06
		
		//Se tiver algum parâmetro em branco, encerra
		If 	Empty(cTabelaAux) .Or.;
			Empty(cChaveAux) .Or.;
			Empty(cCodAtuAux) .Or.;
			Empty(cCodNovAux)
			MsgAlert("Existe(m) parâmetros em branco!", "Atenção")
		EndIf
		
		Processa({|| fCopia()},'Processando')
	EndIf
	
	RestArea(aArea)
Return

/*---------------------------------------------------------------------*
 | Func:  fCopia                                                       |
 | Autor: Daniel Atilio                                                |
 | Data:  02/01/2017                                                   |
 | Desc:  Função para copiar os dados                                  |
 *---------------------------------------------------------------------*/

Static Function fCopia()
	Local aArea     := GetArea()
	Local aEstru    := {}
	Local aConteu   := {}
	Local nPosFil   := 0
	Local cCampoFil := ""
	Local cQryAux   := ""
	Local nAtual    := 0
	
	DbSelectArea(cTabelaAux)
	
	//Pega a estrutura da tabela
	aEstru := (cTabelaAux)->(DbStruct())
	
	//Encontra o campo filial
	nPosFil   := aScan(aEstru, {|x| "FILIAL" $ AllTrim(Upper(x[1]))})
	cCampoFil := aEstru[nPosFil][1]
	
	//Faz uma consulta sql trazendo o RECNO
	cQryAux := " SELECT "
	cQryAux += " 	R_E_C_N_O_ AS DADREC "
	cQryAux += " FROM "
	cQryAux += " 	"+RetSQLName(cTabelaAux)+" "
	cQryAux += " WHERE "
	cQryAux += " 	"+cCampoFil+" = '"+cFilAtuAux+"' "
	cQryAux += " 	AND "+cChaveAux+" = '"+cCodAtuAux+"' "
	cQryAux += " 	AND D_E_L_E_T_ = ' ' "
	TCQuery cQryAux New Alias "QRY_AUX"
	
	//Caso exista registro
	If ! QRY_AUX->(EoF())
		//Posiciona nesse recno
		(cTabelaAux)->(DbGoTo(QRY_AUX->DADREC))
		
		//Percorre a estrutura
		ProcRegua(Len(aEstru))
		For nAtual := 1 To Len(aEstru)
			IncProc("Adicionando valores ("+cValToChar(nAtual)+" de "+cValToChar(Len(aEstru))+")...")
			
			//Se for campo filial
			If Alltrim(aEstru[nAtual][1]) == Alltrim(cCampoFil)
				aAdd(aConteu, cFilNovAux)
				
			//Se for o campo de código
			ElseIf Alltrim(aEstru[nAtual][1]) == Alltrim(cChaveAux)
				aAdd(aConteu, cCodNovAux)
				
			//Se não, adiciona
			Else
				aAdd(aConteu, &(cTabelaAux+"->"+aEstru[nAtual][1]))
			EndIf
		Next
		
		IncProc("Criando o registro...")
		//Faz um RecLock
		RecLock(cTabelaAux, .T.)
			//Percorre a estrutura
			For nAtual := 1 To Len(aEstru)
				//Grava o novo valor
				&(aEstru[nAtual][1]) := aConteu[nAtual]
			Next
		(cTabelaAux)->(MsUnlock())
		
		MsgInfo("Cópia concluída.", "Atenção")
	EndIf
	QRY_AUX->(DbCloseArea())
	
	RestArea(aArea)
Return

/*---------------------------------------------------------------------*
 | Func:  fVldPerg                                                     |
 | Autor: Daniel Atilio                                                |
 | Data:  02/01/2016                                                   |
 | Desc:  Função para criar o grupo de perguntas                       |
 *---------------------------------------------------------------------*/

Static Function fVldPerg(cPerg)
	//(		cGrupo,	cOrdem,	cPergunt,				cPergSpa,		cPergEng,	cVar,		cTipo,	nTamanho,					nDecimal,	nPreSel,	cGSC,	cValid,	cF3,		cGrpSXG,	cPyme,	cVar01,		cDef01,	cDefSpa1,	cDefEng1,	cCnt01,	cDef02,		cDefSpa2,	cDefEng2,	cDef03,			cDefSpa3,		cDefEng3,	cDef04,	cDefSpa4,	cDefEng4,	cDef05,	cDefSpa5,	cDefEng5,	aHelpPor,	aHelpEng,	aHelpSpa,	cHelp)
	PutSx1(cPerg,		"01",		"Tabela?",				"",				"",			"mv_ch0",	"C",	03,							0,			0,			"G",	"", 		"SX2PAD",	"",			"",		"mv_par01",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"02",		"Campo Chave?",		"",				"",			"mv_ch1",	"C",	10,							0,			0,			"G",	"", 		"",			"",			"",		"mv_par02",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"03",		"Filial Atual?",		"",				"",			"mv_ch2",	"C",	FWSizeFilial(),			0,			0,			"G",	"", 		"SM0",		"",			"",		"mv_par03",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"04",		"Chave Atual?",		"",				"",			"mv_ch3",	"C",	30,							0,			0,			"G",	"", 		"",			"",			"",		"mv_par04",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"05",		"Filial Nova?",		"",				"",			"mv_ch4",	"C",	FWSizeFilial(),			0,			0,			"G",	"", 		"SM0",		"",			"",		"mv_par05",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
	PutSx1(cPerg,		"06",		"Chave Nova?",		"",				"",			"mv_ch5",	"C",	30,							0,			0,			"G",	"", 		"",			"",			"",		"mv_par06",	"",			"",			"",			"",			"",				"",			"",			"",					"",				"",			"",			"",			"",			"",			"",			"",			{},			{},			{},			"")
Return

Esses e outros códigos, estão disponíveis gratuitamente no nosso GitHub, acesse em github.com/dan-atilio/AdvPL.

Bom pessoal, por hoje é só.
Abraços e até a próxima.

About Dan_Atilio

Analista e desenvolvedor de sistemas. Técnico em Informática pelo CTI da Unesp. Graduado em Banco de Dados pela Fatec Bauru. Entusiasta de soluções Open Source e blogueiro nas horas vagas. Autor do projeto Terminal de Informação, onde são postados tutoriais e notícias envolvendo o mundo da tecnologia.

Deixe uma resposta

%d blogueiros gostam disto: