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.

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.

4 Responses

  1. CLEBERSON DA SILVA disse:

    Bom dia, Danilo

    Será que nesta função seria possível copiar todos os registros de determinado produto, pelo que entendi ele a função vai copiando por campo

  2. CLEBERSON DA SILVA disse:

    DANIEL

    Qual o nome da função estou tentando colocar ela no menu mas não esta dando certo

    • Dan_Atilio disse:

      Bom dia Cleberson.
      A função é a zCpyReg, porém como ela é de 2017, a função PutSX1 para criar grupo de perguntas já foi descontinuada, então você terá que criar um grupo de perguntas conforme a função fVldPerg.
      Um grande abraço.

Deixe uma resposta