Ir para conteúdo
  • Cadastre-se

dev botao

Farmácia Popular novo DNS do webservice


Ver Solução Respondido por Amarildo de Matos,
  • Este tópico foi criado há 1856 dias atrás.
  • Talvez seja melhor você criar um NOVO TÓPICO do que postar uma resposta aqui.

Recommended Posts

Agora tenho mensagem de data invalida...

 

estou usando assim

function PegaSolicitacao(cCNPJ, cCPJ, cCRM, cUFCRM, cDataEmissao: PAnsichar): PAnsiChar; cdecl; external 'gbasmsb_library.dll';
 

  Solicitacao.dnaEstacao            := trim(PegaSolicitacao(PAnsiChar(AnsiString(Solicitacao.nuCnpj)), //cnpj//
                                                            PAnsiChar(AnsiString(Solicitacao.nuCpf)),       //cpf//
                                                            PAnsiChar(AnsiString(Solicitacao.nuCrm)),       //crm//
                                                            PAnsiChar(AnsiString(Solicitacao.sgUfCrm)),
                                                            PAnsiChar(AnsiString('04/12/2018'))
//                                                            PAnsiChar(AnsiString('04/12/2018 15:22:00'))
//                                                            PAnsiChar(AnsiString(DateToStr( datahora2)))
                                                           )
                                           );

tentei tanto com data e data+time e nada

poderiam me dizer como fizeram?

 

Link para o comentário
Compartilhar em outros sites

Resumindo:

fiz uma funcao para buscar o resultado pelo gbasmdb.exe, pois se buscar pela dll esta retornando o dna antigo..

  Solicitacao.dnaEstacao := GeraLiberacao(solicitacao.nuCpf,solicitacao.nuCnpj,solicitacao.nuCrm,solicitacao.sgUfCrm,Now);
  Autorizacao := AutorizacaoDTO.Create;
  Autorizacao := wsFarmaciaPopular.executarSolicitacao(Solicitacao, Usuario);

 

function TForm6.GeraLiberacao(cpf,cnpj,crm,ufcrm:string;data:TDate):string;
var
  bat : TextFile;
  cmd : string;
  lStartUpInfo: TStartUpInfo;
  lProcesso: TProcessInformation;
  arquivobat : string;
  diretorio_exe : string;
  resultado : tStringList;

begin
  diretorio_exe   := ExtractFilePath(application.ExeName);
	arquivobat      := diretorio_exe+'\arquivo.bat';
  AssignFile(bat, arquivobat);
  ReWrite(bat);
  writeln(bat, '@echo off');
  writeln(bat, format('"%s" %s %s %s %s %s %s >%s', [diretorio_exe+'\gbasmsb.exe','--solicitacao' , cpf, cnpj,crm,ufcrm,DateToStr(data),diretorio_exe+'\resultado.txt']));
  CloseFile(bat);

  cmd := format('cmd /c "%s"', [arquivobat]);
  lStartUpInfo.cb := 2048;
  lStartUpInfo.lpReserved := NIL;
  lStartUpInfo.lpDesktop := NIL;
  lStartUpInfo.lpTitle := NIL;
  lStartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  lStartUpInfo.wShowWindow := SW_HIDE;

  lStartUpInfo.cbReserved2 := 0;
  lStartUpInfo.lpReserved2 := NIL;

  if not CreateProcess(NIL, pchar(cmd), NIL, NIL, False, 0, NIL, pchar(diretorio_exe), lStartUpInfo, lProcesso) then
  begin
	  ShowMessage('ERRO ');
    DeleteFile(arquivobat);
    result := '';
    exit;
  end
  else
    WaitForSingleObject(lProcesso.hProcess, INFINITE);

  resultado  := TStringList.Create();
  resultado.LoadFromFile(diretorio_exe+'\resultado.txt');
  result := resultado.Text;

  FreeAndNil(resultado);
  DeleteFile(arquivobat);
  DeleteFile(diretorio_exe+'\resultado.txt');



end;

 

Link para o comentário
Compartilhar em outros sites

Também faço a chamada diretamento ao gbasmsb.exe, segue o exemplo:

    PathAplicacao := AcertarPath(ExtractFilePath(Application.ExeName));

    // verifica a existencia do arquivo
    if FileExists(PathAplicacao + 'gbasmsb.exe') then
    begin
        // faz a chamada ao executavel
        Par := ' --identificacao';
        Resultado := Trim(GetDosOutput('gbasmsb.exe' + Par,PathAplicacao));
        if Trim(Resultado)<>'' then
             Observacao(Resultado,'Identificação do terminal.',True)
        else Mensagem  ('Não foi encontrado o método IDENTIFICACAO no executável gbasmsb.exe.','Método não encontrado.',MB_OK,MB_ICONERROR);
    end
    else Mensagem('Não foi encontrado o executável gbasmsb.exe na pasta da aplicação.','Arquivo não encontrado.',MB_OK,MB_ICONERROR);

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

  • Membros Pro
11 minutos atrás, viniciusraduy disse:

opa. legal.. 

wallyson conseguiu resolver seu problema?

felipe, um pouco acima coloquei uma funcao.. veja se lhe serve..

 

Bom dia.

Obrigado!

Com você também vem acontecendo o erro de retorno do WEBSERVICE?
Na semana passada a Popular estava disponibilizando o SERVICOSOLICITACAO sem o HTTPS. 
Verifiquei agora e já adicionaram o "S" do HTTP

ServicoSolicitacaoWS-PROD.xml

Link para o comentário
Compartilhar em outros sites

Felipe. estou postando um teste.pas

 

unit Teste;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Soap.InvokeRegistry, Soap.Rio, Soap.SOAPHTTPClient,
  Soap.xsbuiltins;

type
  TForm6 = class(TForm)
    Button1: TButton;
    HTTPRIO: THTTPRIO;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
		Function GetDosOutput(const CommandLine:string): string;
    function GeraLiberacao(cpf,cnpj,crm,ufcrm:string;data:TDate):string;


  end;

var
  Form6: TForm6;

implementation

uses
  ServicoSolicitacaoWS1quente;


{$R *.dfm}

function PegaSolicitacao(cCNPJ, cCPJ, cCRM, cUFCRM, cDataEmissao: PAnsichar): PAnsiChar; cdecl; external 'gbasmsb_library.dll';
function IdentificaEstacao: PAnsiChar; cdecl; external 'gbasmsb_library.dll';


procedure TForm6.Button1Click(Sender: TObject);
var
  Usuario: UsuarioFarmaciaDTO;
  wsFarmaciaPopular : ServicoSolicitacaoWS;
  Medicamentos : ArrayOfMedicamentoDTO;
  sUrl : string;
  Solicitacao : SolicitacaoDTO;
  Autorizacao : AutorizacaoDTO;
  Item : integer;
  i : integer;
  WFormatoBR: TFormatSettings;
  nuAutorizacao : string;
  datahora : TDateTime;
  datahora2 : TDateTime;
  dna : string;
  dna2: string;
  comando : string;

begin
//		datahora := StrToDateTime( FormatDateTime('DD/MM/YYYY',Now));
		datahora :=  StrToDateTime( FormatDateTime('DD/MM/YYYY HH:MM:SS',Now));
		datahora2 := datahora;//StrToDateTime( '03/12/2018 00:00:00');//'FormatDateTime('DD/MM/YYYY HH:MM:SS',Now));
//		datahora2 := StrToDateTime( '04/12/2018 00:00:00');

//    HTTPRIO.URL          := 'https://farmaciapopular-autorizador-homologacao.saude.gov.br/farmaciapopular-autorizador/services/ServicoSolicitacaoWS';
///    HTTPRIO.WSDLLocation := 'https://farmaciapopular-autorizador-homologacao.saude.gov.br/farmaciapopular-autorizador/services/ServicoSolicitacaoWS?wsdl';
 		sUrl                 := 'https://farmaciapopular-autorizador-homologacao.saude.gov.br/farmaciapopular-autorizador/services/ServicoSolicitacaoWS?wsdl';

//    sUrl                 := 'https://farmaciapopular-autorizador.saude.gov.br/farmaciapopular-autorizador/services/ServicoSolicitacaoWS?wsdl';

//  HTTPRIO.Service      := 'ServicoSolicitacaoWSService';
//  HTTPRIO.Port         := 'ServicoSolicitacaoWS';

//  wsFarmaciaPopular := HTTPRIO as ServicoSolicitacaoWS;

	wsFarmaciaPopular := GetServicoSolicitacaoWS(False, sUrl, nil);

  //Definindo usuário de acesso à farmacia popular//
  Usuario := UsuarioFarmaciaDTO.Create;
//  Usuario.usuarioFarmacia := LerRegistroConfiguracoes('UsuarioEmpresaFarmaciaPopular');// '75948066';
//  Usuario.senhaFarmacia   := LerRegistroConfiguracoes('SenhaEmpresaFarmaciaPopular');//'ec964885';

  Usuario.usuarioFarmacia :=  '3423423'; acertar usuario
  Usuario.senhaFarmacia   := '2342423'; acertar senha


  Usuario.usuarioVendedor := '34234234'; acertar
  Usuario.senhaVendedor   := '12345678'; acertar

  //Passando Items//
  Item := 0;
  SetLength(Medicamentos, 1);

    Medicamentos[Item] := MedicamentoDTO.Create;
    Medicamentos[Item].coCodigoBarra       := '7898372705721';
    Medicamentos[Item].dsUnidApresentacao  := '30';
    Medicamentos[Item].qtPrescrita         := 1;
    Medicamentos[Item].qtSolicitada        := 30;
    Medicamentos[Item].vlPrecoVenda        := 3.6;

    Medicamentos[Item].inAutorizacaoEstorno := '';
    Medicamentos[Item].inAutorizacaoMedicamento := '';
    Medicamentos[Item].qtAutorizada := 0;
    Medicamentos[Item].qtDevolvida := 0;
    Medicamentos[Item].qtEstornada := 0;
    Medicamentos[Item].statusTransacao := '';
    Medicamentos[Item].vlPrecoSubsidiadoMS := 0;
    Medicamentos[Item].vlPrecoSubsidiadoPaciente := 0;
    Medicamentos[Item].vlPrecoSubsidiadoPacientePosEstorno := 0;
    Medicamentos[Item].vlrSubsidiadoMSPosEstorno := 0;
    Medicamentos[Item].vlrTotalVendaPosEstorno := 0;


  //Preparando solicitação//

  Solicitacao := SolicitacaoDTO.Create;
  Solicitacao.arrMedicamentoDTO     := Medicamentos;
  Solicitacao.coSolicitacaoFarmacia := IntToStr( 1 );
  Solicitacao.nuCnpj                := '34523452345234'; acertar cnpj
  Solicitacao.nuCpf                 := '88888888101';
  Solicitacao.nuCrm                 := '23140';
  Solicitacao.sgUfCrm               := 'PR';
  Solicitacao.dtEmissaoReceita      := TXSDateTime.Create;
  Solicitacao.dtEmissaoReceita.AsDateTime :=  datahora;

  Solicitacao.dnaEstacao := GeraLiberacao(solicitacao.nuCpf,solicitacao.nuCnpj,solicitacao.nuCrm,solicitacao.sgUfCrm,Now);

{
  dna := IdentificaEstacao;
  ShowMessage(dna);
}
{
  Solicitacao.dnaEstacao            := trim(PegaSolicitacao(PAnsiChar(AnsiString(Solicitacao.nuCnpj)), //cnpj//
                                                            PAnsiChar(AnsiString(Solicitacao.nuCpf)),       //cpf//
                                                            PAnsiChar(AnsiString(Solicitacao.nuCrm)),       //crm//
                                                            PAnsiChar(AnsiString(Solicitacao.sgUfCrm)),
//                                                            PAnsiChar(AnsiString('04/12/2018'))
//                                                            PAnsiChar(AnsiString('04/12/2018 15:22:00'))
                                                            PAnsiChar(AnsiString(DateToStr( datahora2)))
                                                           )
                                           );
}
  //Preparando Autorizacao//
  Solicitacao.dnaEstacao := GeraLiberacao(solicitacao.nuCpf,solicitacao.nuCnpj,solicitacao.nuCrm,solicitacao.sgUfCrm,Now);
  Autorizacao := AutorizacaoDTO.Create;
  Autorizacao := wsFarmaciaPopular.executarSolicitacao(Solicitacao, Usuario);
  ShowMessage(autorizacao.descMensagemErro);

{
  if Autorizacao.nuAutorizacao <> '' then
  begin
    nuAutorizacao := Autorizacao.nuAutorizacao;

    //Atualizando grid com o retorno//
    for i := 0 to item - 1 do
    begin
      if CD_Items.Locate('codbarras', Autorizacao.arrMedicamentoDTO[i].coCodigoBarra, [loCaseInsensitive]) then
      begin
        //Atualiza Preços//
        if CD_Itemsvalorfpopular.AsFloat <> Autorizacao.arrMedicamentoDTO[i].vlPrecoSubsidiadoMS then
        begin
          if not Assigned(tAreaTrabalho) then tAreaTrabalho := TEdicaoTabela.Create;
           tAreaTrabalho.edit('pruprodutos');
           tAreaTrabalho.setfield('pru_fpopular',Autorizacao.arrMedicamentoDTO[i].vlPrecoVenda);
           tAreaTrabalho.post('emp_codigo = ' +  IntToStr(USUARIOEMPRESA) + ' and pro_codigo='+CD_Itemsproduto.AsString );
          FreeAndNil(tAreaTrabalho);
        end;
        ////////////////////

        CD_Items.Edit;
        CD_Itemsqtdeaprovada.AsFloat  := Autorizacao.arrMedicamentoDTO[i].qtAutorizada;
        CD_Itemsvalorcliente.AsFloat  := Autorizacao.arrMedicamentoDTO[i].vlPrecoSubsidiadoPaciente;
        CD_Itemsvalorfpopular.AsFloat := Autorizacao.arrMedicamentoDTO[i].vlPrecoVenda;
//        CD_Itemsvalorsistema.AsFloat  := Autorizacao.arrMedicamentoDTO[i].vlPrecoVenda * CD_Itemsqtde.AsInteger;
        CD_Itemsstatus.AsString       := Copy(Autorizacao.arrMedicamentoDTO[i].inAutorizacaoMedicamento,1,4);
        if Copy(trim(Autorizacao.arrMedicamentoDTO[i].inAutorizacaoMedicamento),1,4)<> '00SM' then
          CD_Itemssituacao.AsString   := Copy(trim(Autorizacao.arrMedicamentoDTO[i].inAutorizacaoMedicamento),1,100);

        if (CD_Itemsqtdeaprovada.AsFloat <> CD_Itemsqtdesolicitada.AsFloat) then
        begin
          CD_Itemssituacao.AsString   := CD_Itemssituacao.AsString+' Quantidade Aprovada diferente da solicitada...';
          erros := true;
        end;

        CD_Items.Post;

        //atualiza valor//
      end;
    end;

    MessageBoxInformation('Pré-autorização aprovada'+IIf(erros,' parcialmente, corrija antes de exportar',''));

  end else
  begin
    MessageBoxError(Autorizacao.descMensagemErro);
}
end;

function TForm6.GeraLiberacao(cpf,cnpj,crm,ufcrm:string;data:TDate):string;
var
  bat : TextFile;
  cmd : string;
  lStartUpInfo: TStartUpInfo;
  lProcesso: TProcessInformation;
  arquivobat : string;
  diretorio_exe : string;
  resultado : tStringList;

begin
  diretorio_exe   := ExtractFilePath(application.ExeName);
	arquivobat      := diretorio_exe+'\arquivo.bat';
  AssignFile(bat, arquivobat);
  ReWrite(bat);
  writeln(bat, '@echo off');
  writeln(bat, format('"%s" %s %s %s %s %s %s >%s', [diretorio_exe+'\gbasmsb.exe','--solicitacao' , cpf, cnpj,crm,ufcrm,DateToStr(data),diretorio_exe+'\resultado.txt']));
  CloseFile(bat);

  cmd := format('cmd /c "%s"', [arquivobat]);
  lStartUpInfo.cb := 2048;
  lStartUpInfo.lpReserved := NIL;
  lStartUpInfo.lpDesktop := NIL;
  lStartUpInfo.lpTitle := NIL;
  lStartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  lStartUpInfo.wShowWindow := SW_HIDE;

  lStartUpInfo.cbReserved2 := 0;
  lStartUpInfo.lpReserved2 := NIL;

  if not CreateProcess(NIL, pchar(cmd), NIL, NIL, False, 0, NIL, pchar(diretorio_exe), lStartUpInfo, lProcesso) then
  begin
	  ShowMessage('ERRO ');
    DeleteFile(arquivobat);
    result := '';
    exit;
  end
  else
    WaitForSingleObject(lProcesso.hProcess, INFINITE);

  resultado  := TStringList.Create();
  resultado.LoadFromFile(diretorio_exe+'\resultado.txt');
  result := resultado.Text;

  FreeAndNil(resultado);
  DeleteFile(arquivobat);
  DeleteFile(diretorio_exe+'\resultado.txt');



end;

function TForm6.GetDosOutput(const CommandLine: string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir, Line: String;
begin
  Application.ProcessMessages;
  with SA do
  begin
	  nLength := SizeOf(SA);
	  bInheritHandle := True;
	  lpSecurityDescriptor := nil;
  end;
// create pipe for standard output redirection
  CreatePipe(StdOutPipeRead, // read handle
  StdOutPipeWrite, // write handle
  @SA, // security attributes
  0 // number of bytes reserved for pipe - 0 default
  );
  try
	  // Make child process use StdOutPipeWrite as standard out,
	  // and make sure it does not show on screen.
	  with SI do
	  begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect std input
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
	  end; // launch the command line compiler
	  WorkDir := ExtractFilePath(CommandLine);
	  WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil,
	  PChar(WorkDir), SI, PI); // Now that the handle has been inherited, close write to be safe.
	  // We don't want to read or write to it accidentally.
	  CloseHandle(StdOutPipeWrite);
	  // if process could be created then handle its output
	  if not WasOK then
		  raise Exception.Create('Could not execute command line!')
  	else try
	  // get all output until dos app finishes
	  Line := '';
  repeat
  // read block of characters (might contain carriage returns and  line feeds)
	  WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil); // has anything been read?
	  if BytesRead > 0 then
	  begin
		  // finish buffer to PChar
		  Buffer[BytesRead] := #0;
		  // combine the buffer with the rest of the last run
		  Line := Line + Buffer;
	  end;
	  until not WasOK or (BytesRead = 0);
		  // wait for console app to finish (should be already at this point)
		  WaitForSingleObject(PI.hProcess, INFINITE);
	  finally
	  // Close all remaining handles
		  CloseHandle(PI.hThread);
		  CloseHandle(PI.hProcess);
	  end;
  finally
	  result:=Line;
	  CloseHandle(StdOutPipeRead);
  end;
end;
end.

 

Editado por viniciusraduy
Link para o comentário
Compartilhar em outros sites

Também ocorreu comigo ontem, as vezes dava timeout, e outras vezes erro no suporte a canais seguros.

O engraçado é que se eu enviar o teste utilizando o serviço pesquisarAutorizacoes a resposta sempre é retornada informando que não pode mais ser utilizada.

Editado por Marceloal
Link para o comentário
Compartilhar em outros sites

Bom dia...

Também estou enfrentando muitos problemas com o novo DNS, tive que colocar um loop de 5 tentativas, mas está dando muito erro de "EDOMParseError - O documento XML deve ter um elemento de nível superior.". Passa somente depois da 2 a 3 tentativa, enviei uma email para o DATASUS mas não respondem. Está bem complicado e estou bastante preocupado pois dia 10/12 está ai.

  • Curtir 1
  • Triste 1
Link para o comentário
Compartilhar em outros sites

7 minutos atrás, Emersson A Pereira disse:

Bom dia...

Também estou enfrentando muitos problemas com o novo DNS, tive que colocar um loop de 5 tentativas, mas está dando muito erro de "EDOMParseError - O documento XML deve ter um elemento de nível superior.". Passa somente depois da 2 a 3 tentativa, enviei uma email para o DATASUS mas não respondem. Está bem complicado e estou bastante preocupado pois dia 10/12 está ai.

Estou na mesma situação meu amigo, agora é torcer para que normalizem o serviço lá no servidor ou prorroguem essa mudança para 2019.

  • Curtir 1
  • Triste 1
Link para o comentário
Compartilhar em outros sites

Pessoal só pra compartilhar o que tive de fazer.

1º Preparei meu sistema para trabalhar usando o DNS novo e o antigo, e deixei o usuário decidir qual DNS utilizar;

2º Fiz como o amigo Emersson disse, coloquei um loop de 5 tentativas em todas as funções e tratei as exceções que o novo WS vem retornando;

Atualizei o primeiro cliente agora e consegui passar várias vendas utilizando o DNS novo porém está extremamente lento, devido a instabilidade que o novo WS possui. Por padrão meus clientes ainda usarão o DNS antigo até segunda, vamos torcer para que ou prorroguem o prazo ou melhorem esse novo servidor.

Link para o comentário
Compartilhar em outros sites

  • Este tópico foi criado há 1856 dias atrás.
  • Talvez seja melhor você criar um NOVO TÓPICO do que postar uma resposta aqui.
Visitante
Este tópico está agora fechado para novas respostas
×
×
  • Criar Novo...

Informação Importante

Colocamos cookies em seu dispositivo para ajudar a tornar este site melhor. Você pode ajustar suas configurações de cookies, caso contrário, assumiremos que você está bem para continuar.