Exportar dados usando 2 ou mais dbf´s

por **Jorge** » 28 Nov 2009 11:51

Olá pessoal, estou com esse problema e preciso de uma luz nesse primeiro post. Fiz 2 programas separados para poder depois juntá-los num só. Em âmbos bancos de dados, existe um campo com igual código que identifica a igualdade da disposição dos dados diferentes à serem exportados num arquivo texto. O problema é bem esse: usando o primeiro banco de dados, deverá ser gravado numa primeira linha do arquivo txt, os dados que se fazem necessários (até aí tudo bem); na sequencia, preciso selecionar o segundo banco de dados e filtrar pelo campo código para que a exportação siga a sua continuidade na mesma linha. Caso se repitam 10 campos, deverá repetir os dados do primeiro banco de dados e assim continuar a sequencia de onde parou. Será que alguém tem uma sugestão de como ordenar a idéia (laços lógico)? Desde já agradeço à quem puder me ajudar. Abraços.

por **alxsts** » 28 Nov 2009 12:28

Olá!

Boa tarde Jorge. Seja bem-vindo ao Fórum!

Jorge escreveu:Exportar dados usando 2 ou mais dbf´s

Ficou um pouco vaga a tua explicação. Quantas tabelas são? Duas ou mais?

Jorge escreveu:Caso se repitam 10 campos, deverá repetir os dados do primeiro banco de dados e assim continuar a sequencia de onde parou.

Pelo que entendi, você tem uma tabela principal e uma com detalhes e precisa gerar, num arquivo texto, uma composição das duas, fazendo um join por um identificador comum às duas tabelas. Alem disso, cada linha do arquivo texto comporta até 10 registros-detalhe. Havendo mais de 10, é necessário gerar um novo registro no arquivo texto, repetindo-se os dados da tabela principal (como em uma quebra de página de relatório, por exemplo). Seria isso? Se for, parece fácil de ser feito. Se você postar os layouts ficará bem mais fácil.

por **leandromiler** » 28 Nov 2009 15:32

Não entendi muito bem, mas pelo que entendi eu resolveria da seguinte forma.

vamos imaginar as 2 tabelas

tabela pai.dbf
codigo n 10
NOME C 20
tabela filho.dbf
codigo n 10

vamos ao codigo - Talvez este código abaixo te da uma luz.

 use filho alias filho new
 index on codigo to xfilho

 use pai alias pai new 
 index on codigo to xpai
 do top

 SET PRINT ON
 SET DEVICE TO PRINT
 SET PRINT TO ARQUIVO.TXT
 do while !eof()
    mCODIGO:=PAI->CODIGO
    mNOME:=PAI->NOME
    @ PROW()+1,0 SAY mCODIGO+mNOME
    SELE FILHO
    SET FILTER TO CODIGO=mCODIGO
    GO TOP
    XCONTA=0
    DO WHILE !EOF()  .and. XCONTA<=10
        @ PROW()+1,0 SAY FILHO->CODIGO
        XCONTA++
        SKIP
    ENDDO
    IF FILHO->CODIGO=mCODIGO
       LOOP
    ELSE
       SELE PAI     
       SKIP
    ENDIF
 enddo
 SET PRINT OFF
 SET DEVICE TO SCREEN
 return .t.

abraços.

---
Nota da Moderação (Maligno):
A presente mensagem teve de ser editada para a inserção das tags de indentação, a fim de tornar a leitura do código mais fácil e assim, incentivar os colegas a analisá-lo e tentar resolver o problema.

por **gvc** » 28 Nov 2009 18:34

Desculpe. Não deu para entender. Vc poderia exemplificar?
E vc fez 2 programas e agora quer juntar 2 Dbf's?

por **Jorge** » 29 Nov 2009 12:03

Obrigado pelas boas vindas e pela disposição em ajudar.
Segue o Layout de no momento serem 2 bancos de dados;
aih.dbf

estrutura:={ {"num_aih"      ,"C"    ,13     ,0},;
                {"prontuario"   ,"N"    ,07     ,0},;
                {"cart_sus"     ,"C"    ,15     ,0},;
                {"raca_pac"     ,"C"    ,02     ,0},;
                {"cep_ende"     ,"C"    ,08     ,0},;
                {"nome_pac"     ,"C"    ,70     ,0},;
                {"tipo_logr"    ,"C"    ,03     ,0},;
                {"nome_tipo"    ,"C"    ,20     ,0},;
                {"ende_pac"     ,"C"    ,50     ,0},;
                {"num_ende"     ,"N"    ,07     ,0},;
                {"comp_ende"    ,"C"    ,15     ,0},;
                {"bairro_ende"  ,"C"    ,30     ,0},;
                {"cidade_ende"  ,"C"    ,25     ,0},;
                {"cod_ibge"     ,"C"    ,06     ,0},;
                {"uf_ende"      ,"C"    ,02     ,0},;
                {"data_nasc"    ,"C"    ,10     ,0},;
                {"idade_pac"    ,"N"    ,03     ,0},;
                {"sexo_pac"     ,"C"    ,01     ,0},;
                {"enfer_pac"    ,"C"    ,04     ,0},;
                {"leito_pac"    ,"N"    ,04     ,0},;
                {"nome_mae"     ,"C"    ,70     ,0},;
                {"nome_resp"    ,"C"    ,70     ,0},;
                {"tpo_doc_pac"  ,"C"    ,01     ,0},;
                {"doc_pac"      ,"C"    ,11     ,0},;
                {"cpf_med_sol"  ,"C"    ,11     ,0},;
                {"proc_sol"     ,"C"    ,10     ,0},;
                {"car_inter"    ,"C"    ,01     ,0},;
                {"data_inter"   ,"C"    ,10     ,0},;
                {"data_alta"    ,"C"    ,10     ,0},;
                {"qtde_dias"    ,"N"    ,03     ,0},;
                {"especiali"    ,"C"    ,01     ,0},;
                {"motivo"       ,"C"    ,02     ,0},;
                {"acompa"       ,"N"    ,02     ,0},;
                {"pre_natal"    ,"C"    ,11     ,0},;
                {"cid_pri"      ,"C"    ,04     ,0},;
                {"cid_sec"      ,"C"    ,04     ,0},;
                {"nasc_vivos"   ,"C"    ,05     ,0},;

linhas.dbf

estrutura:={ {"num_linha"    ,"C"    ,03     ,0},;
             {"aih_num"      ,"C"    ,13     ,0},;
             {"procedto"     ,"C"    ,10     ,0},;
             {"ato_prof"     ,"C"    ,02     ,0},;
             {"proc_qtde"    ,"C"    ,03     ,0},;
             {"num_cpf"      ,"C"    ,11     ,0},;
             {"num_cbo"      ,"C"    ,06     ,0},;
             {"num_cnes"     ,"C"    ,07     ,0},;
             {"num_cnpj"     ,"C"    ,14     ,0},;
             {"cnes_valor"   ,"C"    ,07     ,0},;
             {"ordem_proc"   ,"C"    ,01     ,0} }

Explicação: os dados do banco de dados aih estarão numa sequencia lado à lado na primeira linha do arquivo txt e o campo em destaque é o campo "num_aih". seguindo a sequencia dos dados, deverá pegar o banco de dados 2 linhas.dbf e o campo que deve identificar é o "aih_num" numa repetição de no máximo 10 vêzes lado à lado. Caso ultrapasse a quantidade de 10 linhas, deverá iniciaruma nova linha no arquivo repetindo os dados do naco de dados aih.dbf e a sequencia será a linha 11 e assim por diante. Será que consegui expôr o problema? Obrigado imensamente pelo interesse em ajudar.

Este é o programa que grava os dados das linhas:

select 1
use linhas
index on aih_num to aihnum
index on ordem_proc to ordemproc
index on ato_prof to atoprof
set index to aihnum,ordemproc,atoprof

pRecno      :=0
pRecCount   :=Lastrec()
C=0
go top
termoh(pRecno)
HandleDCIH  :=FCreate(z_num_dcih+".txt",FC_NORMAL)
z_aih_num = space(13)
w_aih_num = space(13)
w_qtde_reg = 1
w_qtde_aih = 1
w_linha = 1
do while .not. eof()
      select 1
      pRecno=(++C)*100/pRecCount
      Termoh(pRecno)
      wLine:=""
      w_aih_num = aih_num
      w_ident_cpf = 5
      w_ind_equipe = "0"
      w_ident_cnes = "0"
      w_procedto = procedto
      w_ato_prof = ato_prof
      w_proc_qtde = proc_qtde
      w_num_cpf = num_cpf
      w_num_cbo = num_cbo
      w_num_cnes = num_cnes
      w_num_cnpj = num_cnpj
      w_cnes_valor = cnes_valor
      if w_qtde_reg > 10
         wLine+=chr(13)+chr(10)
         w_qtde_reg = 1
         w_linha = w_linha + 1
      endif
      if w_aih_num <> z_aih_num .and. recno() <> 1
         if w_qtde_reg <> 1
            w_tot_reg = (10 - w_qtde_reg)
            w_um_reg = 73
            w_tot_zero = 73 + (w_tot_reg * w_um_reg)
            wLine+=PadR(replicate("0",w_tot_zero),w_tot_zero,0)
            wLine+=chr(13)+chr(10)
            w_qtde_reg = 1
            w_linha = w_linha + 1
         endif
      endif
      if val(w_ato_prof) >= 1 .and. val(w_ato_prof) <= 6
         w_ind_equipe = subs(w_ato_prof,02,1)
      endif
      if w_num_cnes <> "       "
         w_ident_cnes = "5"
      endif
      if w_num_cpf <> "           "
         w_ident_cpf = 1
         w_ident_cnes = "0"
      endif
      @ 12,47 say z_num_dcih +".Txt"
      @ 15,51 say w_qtde_aih pict "999"
      @ 18,45 say ((w_linha * 732) + 1) pict "999,999,999"
      @ 20,51 say w_aih_num
      wLine+=PadR(w_ident_cpf,1,0)             // indicador documento    664 - 664 (01)
      wLine+=PadR(replicate(" ",03),03,0)      // zeros cpf medico       665 - 667 (03)
      wLine+=PadR(w_num_cpf,11,0)          // cpf medico       668 - 678 (11)
      wLine+=PadR(" ",01,0)                // ????          679 - 679 (01)
      wLine+=PadR(w_num_cbo,06,0)          // numero cbo do cpf      680 - 685 (06)
      wLine+=PadR(w_ind_equipe,01,0)          // indicador equipe       686 - 686 (01)
      wLine+=PadR(w_ident_cnes,01,0)          // indicador cnes    687 - 687 (01)
      wLine+=PadR(w_num_cnes,07,0)          // numero cnes       688 - 694 (07)
      wLine+=PadR(replicate(" ",07),07,0)      // espacos cnes           695 - 701 (07)
      wLine+=PadR("5",01,0)             // indicador executor    702 - 702 (01)
      wLine+=PadR(w_cnes_valor,07,0)          // cnes valor       703 - 709 (07)
      wLine+=PadR(replicate(" ",08),08,0)      // espacos executor       710 - 717 (08)
      wLine+=PadR(w_procedto,10,0)             // procedimento           718 - 727 (10)
      wLine+=PadR(" ",01,0)               // zero procedimento      728 - 728 (01)
      wLine+=PadR(w_proc_qtde,02,0)            // qtde procedimento      729 - 730 (03)
      wLine+=PadR(replicate("0",04),04,0)      // ano competencia        731 - 734 (04)
      wLine+=PadR(replicate("0",02),02,0)      // mes competencia        735 - 736 (02)
      w_qtde_reg = w_qtde_reg + 1
      w_qtde_aih = w_qtde_aih + 1
      z_aih_num = w_aih_num
      File_Save(HandleDCIH,wLine)
      DbSkip()
enddo
w_tot_reg = (10 - w_qtde_reg)
w_um_reg = 73
w_tot_zero = (w_tot_reg * w_um_reg)
wLine+=PadR(replicate("0",w_tot_zero),w_tot_zero,0)
wLine+=chr(13)+chr(10)
File_Save(HandleDCIH,wLine)
File_Save(HandleDCIH,chr(26))
FClose(HandleDCIH)
restscreen(00,00,maxrow(),maxcol(),telasave)
close all

Este é o programa que grava os dados de início do arquivo

select 2
use aih
index on especiali to espec
index on num_aih to numaih
set index to espec,numaih
LINHA = 1
z_modali = "02"
z_muda_proc = "2"
z_ident_doc = "1"
z_nacionali = "010"

pRecno      :=0
pRecCount   :=Lastrec()
C=0
go top
termoh(pRecno)
HandleDCIH  :=FCreate(z_num_dcih+".txt",FC_NORMAL)
do while .not. eof()
      inkey(0.05)
      pRecno=(++C)*100/pRecCount
      Termoh(pRecno)
      @ 12,47 say z_num_dcih+".Txt" color"w+/n+"
      @ 15,51 say qtde_aih pict "999" color "w+/n+"
      @ 20,51 say num_aih color "w+/n+"
      z_identifi = "01"
      z_num_aih = num_aih
      z_prontua = prontuario
      z_cart_sus = cart_sus
      z_raca_pac = raca_pac
      z_cep_ende = cep_ende
      z_nome_pac = nome_pac
      z_ende_pac = ende_pac
      z_num_ende = num_ende
      z_tipo_logr = tipo_logr
      z_nome_tipo = nome_tipo
      z_comp_ende = comp_ende
      z_bairro_ende = bairro_ende
      z_cidade_ende = cidade_ende
      z_cod_ibge = cod_ibge
      z_uf_ende = uf_ende
      z_data_nasc = data_nasc
      z_sexo_pac = sexo_pac
      z_enfer_pac = enfer_pac
      z_leito_pac = leito_pac
      z_nome_mae = nome_mae
      z_nome_resp = nome_resp
      z_tpo_doc_pac = tpo_doc_pac
      z_doc_pac = doc_pac
      z_cpf_med_sol = cpf_med_sol
      z_proc_sol = proc_sol
      z_car_inter = car_inter
      z_data_inter = data_inter
      z_data_alta = data_alta
      z_especiali = especiali
      z_motivo = motivo
      z_acompa = acompa
      z_pre_natal = pre_natal
      z_cid_pri = cid_pri
      z_cid_sec = cid_sec
      z_cid_obi = space(04)
      z_nasc_vivos = nasc_vivos
      if z_motivo = "41"
         z_cid_obi = z_cid_pri
      endif
      if z_sexo_pac = "1"
         z_sexo_pac = "M"
      endif
      if z_sexo_pac = "3"
         z_sexo_pac = "F"
      endif
      wLine:=""
      wLine+=PadR(z_num_dcih,08,0)          // numero do lote     01 -  08 (08)
      wLine+=PadR(replicate("0",03),03,0)      // qtde de aihs       09 -  11 (03)
      wLine+=PadR(z_apres,06,0)            // apresentacao       12 -  17 (06)
      wLine+=PadR(replicate("0",03),03,0)      // sequencial         18 -  20 (03)
      wLine+=PadR(z_org_emisso,10,0)         // orgao emissor      21 -  30 (10)
      wLine+=PadR(z_cnes,07,0)              // cnes hospital      31 -  37 (07)
      wLine+=PadR(z_ibge_hosp,06,0)         // ibge hospital      38 -  43 (06)
      wLine+=PadR(z_num_aih,13,0)         // numero aih         44 -  56 (13)
      wLine+=PadR(z_identifi,02,0)         // identificacao      57 -  58 (02)
      wLine+=PadR("0",01,0)            // especialidade      59 -  59 (01)
      wLine+=PadR(z_especiali,01,0)         // especialidade      60 -  60 (01)
      wLine+=PadR(replicate("0",45),45,0)      // filler (zeros)     61 - 105 (45)
      wLine+=PadR(z_modali,02,0)         // modalidade aih    106 - 107 (02)
      wLine+=PadR(replicate("0",03),03,0)       // sequencial aih5   108 - 110 (03)
      wLine+=PadR(replicate("0",13),13,0)       // aih posterior     111 - 123 (13)
      wLine+=PadR(replicate("0",13),13,0)      // aih anterior      124 - 136 (13)
      wLine+=PadR(Subs(z_data_inter,7,4),4,0)      // ano emiss/inter   137 - 140 (04)
      wLine+=PadR(Subs(z_data_inter,4,2),2,0)      // mes emiss/inter   141 - 142 (02)
      wLine+=PadR(Subs(z_data_inter,1,2),2,0)      // dia emiss/inter   143 - 144 (02)
      wLine+=PadR(Subs(z_data_inter,7,4),4,0)      // ano internacao    145 - 148 (04)
      wLine+=PadR(Subs(z_data_inter,4,2),2,0)      // mes internacao    149 - 150 (02)
      wLine+=PadR(Subs(z_data_inter,1,2),2,0)      // dia internacao    151 - 152 (02)
      wLine+=PadR(Subs(z_data_alta,7,4),4,0)      // ano alta           153 - 156 (04)
      wLine+=PadR(Subs(z_data_alta,4,2),2,0)      // mes alta            157 - 158 (02)
      wLine+=PadR(Subs(z_data_alta,1,2),2,0)      // dia alta           159 - 160 (02)
      wLine+=PadR(z_proc_sol,10,0)         // proc solicitado   161 - 170 (10)
      wLine+=PadR(z_muda_proc,01,0)         // mudanca proc      171 - 171 (01)
      wLine+=PadR(z_proc_sol,10,0)         // proc realizado    172 - 181 (10)
      wLine+=PadR("0",01,0)            // carat inter       182 - 182 (01)
      wLine+=PadR(z_car_inter,01,0)         // carat inter       183 - 183 (01)
      wLine+=PadR(z_motivo,02,0)         // motivo alta       184 - 185 (02)
      wLine+=PadR(z_ident_doc,01,0)           // ident doc med sol 186 - 186 (01)
      wLine+=PadR(replicate("0",04),04,0)      // zeros cpf med sol 187 - 190 (04)
      wLine+=PadR(z_cpf_med_sol,11,0)         // cpf med sol       191 - 201 (11)
      wLine+=PadR(z_ident_doc,01,0)         // ident doc med res 202 - 202 (01)
      wLine+=PadR(replicate("0",04),04,0)      // zeros cpf med res 203 - 206 (04)
      wLine+=PadR(z_cpf_med_sol,11,0)         // cpf med res       207 - 217 (11)
      wLine+=PadR(z_ident_doc,01,0)         // ident doc dir cli 218 - 218 (01)
      wLine+=PadR(replicate("0",04),04,0)      // zeros cpf dir cli 219 - 222 (04)
      wLine+=PadR(z_dir_cli,11,0)            // cpf dir cli   223 - 233 (11)
      wLine+=PadR(z_ident_doc,01,0)         // ident doc med aut 234 - 234 (01)
      wLine+=PadR(replicate("0",04),04,0)      // zeros cpf med aut 235 - 238 (04)
      wLine+=PadR(z_cpf_aud,11,0)         // cpf med aut       239 - 249 (11)
      wLine+=PadR(z_cid_pri,04,0)         // cid principal     250 - 253 (04)
      wLine+=PadR(z_cid_sec,04,0)         // cid secundario    254 - 257 (04)
      wLine+=PadR(replicate(" ",04),04,0)      // cid causas comple 258 - 261 (04)
      wLine+=PadR(z_cid_obi,04,0)         // cid obito           262 - 265 (04)
      wLine+=PadR(replicate("0",03),03,0)      // cod solic liber   266 - 268 (03)
      wLine+=PadR(z_nome_pac,70,0)         // nome paciente     269 - 338 (70)
      wLine+=PadR(Subs(z_data_nasc,7,4),4,0)      // ano data nasc     339 - 342 (04)
      wLine+=PadR(Subs(z_data_nasc,4,2),2,0)      // mes data nasc     343 - 344 (02)
      wLine+=PadR(Subs(z_data_nasc,1,2),2,0)      // dia data nasc     345 - 346 (02)
      wLine+=PadR(z_sexo_pac,01,0)         // sexo paciente     347 - 347 (01)
      wLine+=PadR(z_raca_pac,02,0)         // raca paciente     348 - 349 (02)
      wLine+=PadR(z_nome_mae,70,0)         // nome mae pac   350 - 419 (70)
      wLine+=PadR(z_nome_resp,70,0)         // nome responsavel  420 - 489 (70)
      wLine+=PadR(z_tpo_doc_pac,01,0)         // tipo doc pac      490 - 490 (01)
      wLine+=PadR(z_doc_pac,11,0)         // doc paciente      491 - 501 (11)
      wLine+=PadR(z_cart_sus,15,0)         // cartao sus    502 - 516 (15)
      wLine+=PadR(z_nacionali,03,0)         // nacionalidade     517 - 519 (03)
      wLine+=PadR(z_tipo_logr,03,0)         // tipo logradouro   520 - 522 (03)
      wLine+=PadR(z_ende_pac,50,0)         // endereco paciente 523 - 572 (50)
      wLine+=PadR(z_num_ende,07,0)         // numero endereco   573 - 579 (07)
      wLine+=PadR(z_comp_ende,15,0)         // complemento ende  580 - 594 (15)
      wLine+=PadR(z_bairro_ende,30,0)          // bairro endereco   595 - 624 (30)
      wLine+=PadR(z_cod_ibge,06,0)         // codigo ibge pac   625 - 630 (06)
      wLine+=PadR(z_uf_ende,02,0)         // uf endereco pac   631 - 632 (02)
      wLine+=PadR(z_cep_ende,08,0)         // cep endereco pac  633 - 640 (08)
      wLine+=PadR(replicate(" ",08),08,0)      // espacos prontua   641 - 648 (08)
      wLine+=PadL(z_prontua,07,0)         // prontuario   649 - 655 (07)
      wLine+=PadR(z_enfer_pac,04,0)         // enfermaria        656 - 659 (04)
      wLine+=PadL(z_leito_pac,04,0)         // leito      660 - 663 (04)
      wLine+=chr(13)+chr(10)   
      File_Save(HandleDCIH,wLine)
      DbSkip()
enddo
File_Save(HandleDCIH,chr(26))
FClose(HandleDCIH)
restscreen(00,00,maxrow(),maxcol(),telasave)
close all

---
Nota da Moderação (Maligno):
A presente mensagem foi editada para a inserção das tags de indentação de código. Se ler o código alheio já é uma coisa extremamente aborrecida e difícil, sem a indentação fica muito pior. Indentando, pode-se notar agora, melhora muito. Portanto, por favor, futuramente, quando for postar código e/ou estruturas e/ou scripts, mesmo que em menor tamanho, use essas tags de identação. Aliás, isso já incentiva um pouco mais pessoas a ler o código e, assim, crescem suas chances de ter seu problema resolvido. Ou seja, você também ganha.

por **Jorge** » 29 Nov 2009 15:02

Olá Alexandre Santos (AlxSts). Seria isso mesmo e como estou há mais de 10 anos sem mexer em programação, me perdi um pouco nessa parte. Os fontes anexos estão funcionais e só preciso interagir dessa maneira como você entendeu. Fácil pra quem é craque e pode ajudar os menos experientes. Obrigado e fico no aguardo para uma possível solução. Abraços e felicidades.

por **Jorge** » 01 Dez 2009 09:16

Olá Leandro Miler, primeiramente quero agradecer a sua sugestão no tópico. Eu não quis optar por direcionar esse arquivo para um arquivo de impressão. Será que você olhando os 2 fontes teria como dar uma sugestão sobre como interagir. desde já agradeço a sua ajuda. Valeu e abraços a todos que puderem ajudar.

por **alxsts** » 02 Dez 2009 22:11

Olá!

Jorge:
nos últimos dias, não consegui tempo para tentar resolver esse caso mas, amanhã, creio que poderei me dedicar um pouco ao mesmo.

A propósito:
- os registros-detalhe do arquivo de saída tem largura fixa? Por exemplo: se eu tiver um registro mestre e apenas um detalhe para o mesmo, devo completar o registro com brancos à direita? (talvez a resposta esteja no código postado por você... Confesso que não analisei a fundo).
- como proceder se não houver correspondência entre os arquivos (pelo menos um registro-detalhe para cada registro-mestre)?

por **Jorge** » 02 Dez 2009 23:22

Olá Alexandre. Agradeço imensamente a sua ajuda e interesse.
Os registros detalhe como se refere (linhas.dbf), tem largura fixa sim. Cada linha tem 73 bytes numa repetição de até 10 vezes lado à lado. Caso tenha menos que 10, o sistema deve completar com zeros à direita até dar as 10 linhas lado à lado. Se tiver mais que 10, deve repetir os dados do registro mestre (aih.dbf) e continuar a linha de onde parou e até 10 linhas novamente e assim por diante.
praticamente seria assim a sequencia de 1 linha no arquivo gerado:
dados do registro mestre (aih): 664 bytes
dados do registro detalhe até 10 repetições de 73 bytes = 730 bytes
então o tamanho de cada linha seria de 1394 bytes.
Fico no aguardo. Obrigado.

por **alxsts** » 06 Dez 2009 22:09

Olá!

Jorge, conforme prometido, segue uma proposta de solução para o problema.

Pesquisei e encontrei o layout da AIH na Internet. Notei que existem algumas discrepâncias entre o ele e o posicionamento dos campos no arquivo, que você codificou. A parte fixa do registro vai até a posição 663. Na 664 começam os dados variáveis. Precisas conferir isto. Para testar, gerei apenas alguns campos em cada registro e completei o resto com zeros.

Procurei comentar o código mas, caso tenha dúvidas, é só postar.

Espero que lhe sirva.

Boa semana para todos.

//------------------------------------------------------------------------------
//
//  AIH.Prg - Geração do arquivo texto AIH
//  Alexandre Santos - Dez/2009
//
//  Compilar: Clipper AIH /N/W
//------------------------------------------------------------------------------

#include    "FileIO.Ch"

// modos para abertura de arquivos
#define     DB_SHARED       .F.
#define     DB_EXLUSIVE     .T.

// Marcadores
#define     LN_EOL          Chr(13) + Chr(10)
#define     LN_EOF          Chr(26)

// Qtde maxima de itens por linha
#define     LN_MAXCOUNT     10

// largura de cada linha
#define     LN_MAXLEN       1393

// nome do arquivo de saida, para efeito de testes        ##### VERIFICAR o NOME ####
#define     NUM_DCIH        "TestDCIH"
//------------------------------------------------------------------------------

PROCEDURE AIH()

   FIELD aih_num, ordem_proc, ato_prof IN LINHAS
   FIELD especiali, num_aih IN AIH

   LOCAL cNum_aih, nItens, cParteFixa, cLinha, nHandle
   LOCAL nTotalAIH := 0, nTotalItens := 0

   BEGIN SEQUENCE

      CLS

      // abrir arquivos. Optei pelo modo exclusivo...
      IF ! NetUse( "LINHAS", DB_EXLUSIVE, 3 )
         Alert( "Falha ao abrir arquivo LINHAS.DBF." )
         Break
      ENDIF

      // O ideal é ter uma rotina separada no sistema para criação de indices...

      // No teu codigo, foram criados 3 indices para a tabela LINHAS mas voce
      // usa apenas o primeiro (aih_num)

      //index on aih_num to aihnum
      //index on ordem_proc to ordemproc
      //index on ato_prof to atoprof

      // Minha duvida: sera que voce quer ordenar por aih_num, dentro do
      // aih_num por ordem_proc e dentro disso tudo por ato_prof?
      // Entendi que sim...

      DbCreateIndex( "LINHAS", "aih_num + ordem_proc + ato_prof", ;
                     { || aih_num + ordem_proc + ato_prof } ;
                   )

      IF ! NetUse( "AIH", DB_EXLUSIVE, 3 )
         Alert( "Falha ao abrir arquivo AIH.DBF." )
         Break
      ENDIF

      // No teu codigo, foram criados 2 indices para a tabela AIH mas voce
      // usa apenas o primeiro (espec)

      //index on especiali to espec
      //index on num_aih to numaih
      //set index to espec,numaih

      // Criei um apenas com as duas colunas

      DbCreateIndex( "AIH", "especiali + num_aih", { || especiali + num_aih } )

      IF AIH->( LastRec() ) == 0
         Alert( "Arquivo AIH.DBF vazio." )
         Break
      ENDIF

      // Cria o arquivo de saida  ===> COLOQUEI UMA CONSTANTE (NUM_DCIH) - ALTERAR PARA O NUMERO DO LOTE
      IF (nHandle := FCreate( NUM_DCIH + ".TXT", FC_NORMAL)) == -1
         Alert( "Falha ao abrir arquivo texto de saida." )
         Break
      ENDIF

      @ 12,20 Say "Gerando arquivo " + NUM_DCIH  + ".TXT" Color"w+/n+"

      AIH->( DbGoTop( ) )

      // Loop percorrendo o arquivo principal
      WHILE AIH->( ! Eof() )

         // (Suponho que AIH->num_aih seja unico no arquivo)

         @ 15,25 Say "Gerando AIH: " + AIH->num_aih Color "w+/n+"

         // Se existirem linhas de procedimento para o AIH
         IF LINHAS->( DbSeek( AIH->num_aih ) )

            // Gera a parte fixa da linha para o AIH corrente
            cParteFixa := GeraParteFixa()

            // percorre os itens do AIH atualmente em processamento
            WHILE ( LINHAS->aih_num == AIH->num_aih ) .AND. ( LINHAS->( ! Eof() ) )

               // inicializa uma nova linha
               cLinha := cParteFixa

               // inicializa contador de itens por linha
               nItens := 0

               // percorre um máximo de 10 itens do AIH atualmente em processamento
               WHILE ( LINHAS->aih_num == AIH->num_aih ) .AND. ( nItens < LN_MAXCOUNT ) .AND. ( LINHAS->( ! Eof() ) )

                  // Acrescenta os dados da linha na string a ser gravada
                  cLinha += GeraParteVariavel()

                  nItens++

                  LINHAS->( DbSkip() )
               ENDDO

               // Quebrou o aih_num ou foi atingido o nr máximo de itens...

               // Ajusta tamanho da linha, se necessario
               IF Len( cLinha ) < LN_MAXLEN
                  cLinha += Replicate( "0", LN_MAXLEN - Len( cLinha ) )
               ENDIF

               // Acrescenta marcador de fim de linha
               cLinha += LN_EOL

               // Grava a linha no arquivo texto
               IF FWrite( nHandle, cLinha, LN_MAXLEN  + Len( LN_EOL ) ) != LN_MAXLEN + Len( LN_EOL )
                  Alert( "Falha ao gravar arquivo texto de saida." )
                  Break
               ENDIF

               nTotalItens += nItens

            ENDDO
         ELSE
            // AIH sem linhas... ignorar?
         ENDIF

         nTotalAIH++

         @ 20,25 Say "AIH's gerados: " + PadR( Ltrim( Str( nTotalAIH ) ) + "/" + ;
                                               Ltrim( Str( AIH->( LastRec() ) ) ), 30 ) Color "w+/n+"

         AIH->( DbSkip() )

      ENDDO

      // Grava marcador de fim de arquivo
      IF FWrite( nHandle, LN_EOF, Len( LN_EOF ) ) != Len( LN_EOF )
         Break
      ENDIF

      @ 22,25 Say "Processamento concluido com exito." Color "w+/n+"

   END SEQUENCE

   FClose( nHandle )

   DbCloseAll()

   RETURN
//------------------------------------------------------------------------------
STATIC FUNCTION GeraParteFixa()

   LOCAL cString

   // Gera parte fixa do registro de saida

   cString := NUM_DCIH                         // numero do lote 01 - 08 (08)

   cString += PadR(replicate("0",03),03,0)     // qtde de aihs 09 - 11 (03)

   // * ==> Coloquei AAAAMM da data atual... cString += PadR(z_apres,06,0) // apresentacao 12 - 17 (06)
   cString += Left( DtoS( Date() ), 6 )        // apresentacao 12 - 17 (06)
   // * ==>

   cString += PadR(replicate("0",03),03,0)     // sequencial 18 - 20 (03)

   // * ==>NÃO SEI DE ONDE VEM cString += PadR(z_org_emisso,10,0) // orgao emissor 21 - 30 (10)
   cString += Space(10 )                       // orgao emissor 21 - 30 (10)
   // * ==>

   // * ==> NÃO SEI DE ONDE VEM cString cString += PadR(z_cnes,07,0) // cnes hospital 31 - 37 (07)
   cString += Space( 7 ) // cnes hospital 31 - 37 (07)
   // * ==> NÃO SEI DE ONDE VEM cString += PadR(z_ibge_hosp,06,0) // ibge hospital 38 - 43 (06)
   cString += Space( 6 ) // ibge hospital 38 - 43 (06)
   cString += AIH->num_aih // numero aih 44 - 56 (13)

   // ... demais campos

   cString += Replicate( "0", 607 ) // completa a linha só para testar...

   RETURN cString
//------------------------------------------------------------------------------
STATIC FUNCTION GeraParteVariavel()

   LOCAL cString

   /*

   Não é necessário jogar os campos para a memória...
   Voce pode manipular estes campos diretamente da área de leitura,
   economizando memória e tempo.

   w_aih_num = aih_num
   w_ident_cpf = 5
   w_ind_equipe = "0"
   w_ident_cnes = "0"
   w_procedto = procedto
   w_ato_prof = ato_prof
   w_proc_qtde = proc_qtde
   w_num_cpf = num_cpf
   w_num_cbo = num_cbo
   w_num_cnes = num_cnes
   w_num_cnpj = num_cnpj
   w_cnes_valor = cnes_valor

   if w_num_cnes <> " "
      w_ident_cnes = "5"
   endif
   */

   /* *** V E R I F I Q U E ***

   Encontrei este layout na Net... tem diferenças entre este e o teu

   59 IN_PROF            001 Indicador Documento Profissional
      0-Não Aplicavel
      1-CPF
      2-CNS

   60 IDENT_PROF         015 Identificação do Profissional CPF/ CNS

   61 CBO_PROF           006 Código do CBO 2002

   62 IN_EQUIPE 001 Indicador da Equipe
      0-Não Aplicavel
      1-Primeiro Cirurgião
      2-Primeiro Auxiliar
      3-Segundo Auxiliar
      4-Terceiro Auxiliar
      5-Quarto Auxiliar
      6-Anestesista

   63 IN_SERVICO         001 Indicador do Prestador do Serviço
      0- Não Aplicavel
      3- CNPJ
      5- CNES
   64 IDENT_SERVICO      014 Identificação do Prestador do Serviço CNPJ/CNES

   65 IN_EXECUTOR        001 Indicador Documento do Executor

   66 IDENT_EXECUTOR     015 Documento que identifica o executor
                             do Serviço (quem efetivamente recebe o credito)

   67 COD_PROCED         010 Codigo do Procedimento

   68 QTD_PROCED         003 Quantidade de Procedimentos

   69 CMPT               006 Competência (UTI/Acompanhante) AAAAMM
   */

   cString := If( ! Empty( LINHAS->num_cpf ), "1", "0" )   // indicador documento 664 - 664 (01)
   cString += "000"                                        // zeros cpf medico 665 - 667 (03)

   cString += StrZero( Val( LINHAS->num_cpf ), 15 )        // cpf medico 668 - 678 (11) ############### NO LAYOUT CONSTAM 15 BYTES   #######

   cString += StrZero( Val( LINHAS->num_cbo ), 06 )        // numero cbo do cpf 680 - 685 (06)

   // indicador equipe 686 - 686 (01)
   /* E SE NÃO ESTIVER ENTRE 1 E 6 ???

   if val(w_ato_prof) >= 1 .and. val(w_ato_prof) <= 6
      w_ind_equipe = subs(w_ato_prof,02,1)
   endif

   */

   cString += If( LINHAS->ato_prof > "0" .And. LINHAS->ato_prof < "7", Right( LINHAS->ato_prof, 1 ), "0" ) // indicador equipe 686 - 686 (01)

   /* indicador cnes 687 - 687 (01)
      SE CPF PREENCHIDO, "0" SENÃO  ?????

   if w_num_cpf <> " "
      w_ident_cpf = 1
      w_ident_cnes = "0"
   endif
   */

   cString += If( ! Empty( LINHAS->num_cpf ), "1", "0" )   // indicador cnes 687 - 687 (01)

   // ... demais campos

   // TESTE: a linha abaixo é so para completar o registro. Favor completar o registro com os demais campos
   cString += Replicate( "0", 73 - Len( cString ) )
   //

   RETURN cString
//------------------------------------------------------------------------------

//#define     DB_SHARED     .F.
//#define     DB_EXLUSIVE   .T.
//---

FUNCTION NetUse( cDatabase, lOpenMode, nSeconds, cAlias )

   LOCAL lForever , nPos, wsqual

   If Empty( cDatabase )
      Return .F.
   Endif

   lOpenMode := If( Empty( lOpenMode ), DB_SHARED, lOpenMode )
   nSeconds  := If( nSeconds == Nil, 0, nSeconds )
   cAlias    := If( Empty( cAlias ), FileBase( cDataBase ), cAlias )
   //---
   lForever = (nSeconds = 0)

   DO WHILE .T.          // (lForever .OR. nSeconds > 0)
     IF lOpenMode
         USE (cDatabase) EXCLUSIVE NEW Alias (cAlias)
     ELSE
         USE (cDatabase) SHARED NEW Alias (cAlias) // Shared
     ENDIF
     IF .NOT. NETERR()          // USE succeeds
        RETURN (.T.)
     ENDIF
     INKEY(1)                 // Wait 1 second
     nSeconds = nSeconds - 1
     if nSeconds < 0

       If Alert( "Nao foi possivel abrir o arquivo " + cDataBase + ".DBF.;" + ;
                     " (Arquivo em manutencaoo por outro usuario).;; " + ;
                     "Deseja tentar novamente?", {" Sim "," Nao " } ) == 2
          Exit
       Endif

       nSeconds := 5

     endif
   ENDDO
   RETURN (.F.)                // USE fails
//------------------------------------------------------------------------------
/***
*
*  FileBase( <cFile> ) --> cFileBase
*
*  Extract the eight letter base name from a filename
*
*/
FUNCTION FileBase( cFile )

   LOCAL nPos           // Marks the position of the last "\", if any
   LOCAL cFileBase      // Return value containing the filename

   DO CASE
   CASE ( nPos := RAT( "\", cFile )) != 0

      // Strip out full path name leaving only the filename (with
      // extension)
      cFileBase := SUBSTR( cFile, nPos + 1 )

   CASE ( nPos := AT( ":", cFile )) != 0

      // Strip drive letter if cFile contains only drive letter
      // no subdirectories
      cFileBase := SUBSTR( cFile, nPos + 1 )

   OTHERWISE

      // Assume it's already taken care of
      cFileBase := cFile

   ENDCASE

   // Strip out the file extension, if any
   IF ( nPos := AT( ".", cFileBase )) != 0
      cFileBase := SUBSTR( cFileBase, 1, nPos - 1 )
   ENDIF

   RETURN ( cFileBase )
//------------------------------------------------------------------------------

por **Jorge** » 08 Dez 2009 00:11

Olá Alexandre. Primeiramente quero te agradecer pelo empenho em ajudar-me nesse problema. Realmente esse layout que encontrou é o mesmo do qual estou utilizando para importar os dados dos pacientes e, PARABÉNS pois nem citei que era usado para importar os dados, o que comprova sua integridade e dinamismo profissional. Também houve esse erro onde coloquei essa diferença de tamanho em bytes e por você foi observado. Testei a sua rotina e não foi uma surpresa que ela funcionou exatamente como o problema se demonstrava. Agora vou apenas completar com os campos todos e as sugestões que colocou. O nível da sua programação não é o mesmo que o meu. Como é de sua autoria, vou preservar os direitos autorais constantes no programa. É um mínimo que eu posso fazer em reconhecimento ao seu profissionalismo e em especial à pessoa que é, apesar de não conhecê-lo. Dignidade, caráter e respeito são valores que se conquistam com o tempo. Obrigado amigo e espero que sejas muito feliz.

por **alxsts** » 08 Dez 2009 10:28

Olá!

Disponha dos amigos deste Fórum. Se precisar, é só postar.

Felicidades e sucesso para você também!

Exportar dados usando 2 ou mais dbf´s

Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Re: Exportar dados usando 2 ou mais dbf´s

Quem está online