Tarifação em Planos de Tarifação em Planos de SaúdeSaúdeLaboratório

Prof. Sérgio Cardosowww.sergiocardoso.pro.br/saude

BASE DE DADOSBASE DE DADOS

Base de Dados: Base de Dados: Banco: DadosSaudeSergio.mdbTabelas:

◦Beneficiários◦Notas◦TipoEvento

Período:◦2005/01 a 2007/11

Laboratório 1Laboratório 1Criar um Banco de Dados VazioVincular as Tabelas do

DadosSaudeSergio.mdb ao novo banco

Criar consultas para uma análise superficial das tabelas Beneficiários e Notas

Criar Tabela de ExpostosPreencher Tabela de Expostos a

partir do VBA com Access.

Criar consultas (exemplos)Criar consultas (exemplos)Beneficiários (Datas mín. e máx. de

inclusão e exclusão:◦ SELECT Min(Format([Inclusao],"yyyy/mm"))

AS CompInclusãoMin, Min(Format([Inclusao],"yyyy/mm")) AS CompExclusãoMin, Max(Format([Inclusao],"yyyy/mm")) AS CompInclusãoMax, Max(Format([Inclusao],"yyyy/mm")) AS CompExclusãoMax FROM Beneficiarios;

Notas (Quantidade de notas por competência)◦ SELECT Format([Atendimento],"yyyy/mm")

AS [Comp], Count(Notas.Matricula) AS ContarDeMatricula FROM Notas GROUP BY Format([Atendimento],"yyyy/mm");

Criar Tabela de ExpostosCriar Tabela de ExpostosCriar Tabela de Expostos com a

seguintes estrutura:

(*) Chave primária.

Preencher Tabela de Expostos a Preencher Tabela de Expostos a partir do VBA com Accesspartir do VBA com AccessCriar módulo no VBAAdicionar ADO nas referências:

Criar Sub PreencheExpostos()

Sub PreencheExpostos()Sub PreencheExpostos() Acesse a Base de Dados

Dim cn As ADODB.ConnectionDim rs As ADODB.RecordsetSet cn = CurrentProject.ConnectionSet rs = New ADODB.Recordset

Defina datas de competência inicial e finalDim DtCompIni as DateDim DtCompFin as DateDtCompIni = DateSerial(2005, 1, 1) ‘ #1/1/2005#DtCompFin = DateSerial(2007, 11, 1) ‘ #11/1/2007#

Inclua laço Do-While para a competênciaDtComp = DtCompIniDo While DtComp <= DtCompFin

(*)DtComp = DateAdd("m", 1, DtComp)

Loop Teste o código

Sub PreencheExpostos() – Sub PreencheExpostos() – (*)(*) Crie um consula Sql para selecionar os beneficiários dentro da

competência desejadaComp = Year(DtComp) & Format(Month(DtComp), "00")SQL = "SELECT Nascimento, Inclusao, Exclusao " & _

" FROM Beneficiarios WHERE " & _ "((Inclusao<#" & _ Format(DateAdd("m", 1, DtComp), "mm/dd/yyyy") & _ "# AND Exclusao Is Null) OR (Inclusao<#" & _ Format(DateAdd("m", 1, DtComp), "mm/dd/yyyy") & "# AND Exclusao>#" &

_ Format(DtComp, "mm/dd/yyyy") & "#))" Abra a consulta

rs.Open sql, cn, adOpenKeyset Redimencione o Vetor para receber os expostos por faixa etária

Dim Exp_FE() As Long

Inclua laço Do-While para a consulta beneficiários e percorra por todos os beneficiários da consulta

ReDim Exp_FE(1 To 10) ‘Apaga o vetor Do While Not rs.EOF

(*)rs.MoveNext

loop

Sub PreencheExpostos() – (*) – Sub PreencheExpostos() – (*) – cont.cont.Dentro do laço Beneficiários

◦Determine a Faixa Etária do Participante Crie uma função que, recebendo a data

de nascimento e a data do cálculo, retorne o número da faixa etária do participante

FE = FaixaEtaria(DtComp, rs("Nascimento"))

Function FaixaEtaria(DtComp As Function FaixaEtaria(DtComp As Date, DtNasc As Date) As ByteDate, DtNasc As Date) As Byte

Dim Idade As IntegerIdade = Round(DateDiff("M", DtNasc, DtComp) / 12, 0)Select Case (Idade)

Case Is <= 18FaixaEtaria = 1

Case Is <= 23FaixaEtaria = 2

Case Is <= 28FaixaEtaria = 3

Case Is <= 33FaixaEtaria = 4

Case Is <= 38FaixaEtaria = 5

Case Is <= 43FaixaEtaria = 6

Case Is <= 48FaixaEtaria = 7

Case Is <= 53FaixaEtaria = 8

Case Is <= 58FaixaEtaria = 9

Case ElseFaixaEtaria = 10

End Select

Sub PreencheExpostos() – (*) – Sub PreencheExpostos() – (*) – cont.cont.Dentro do laço Beneficiários

◦Some QtdExp para a faixa etária correspondente do beneficiárioDim Exp_FE() As LongQtdExp = 1If Format(rs("Inclusao"), "yyyymm") = Comp Then

QtdExp = (30 - Day(rs("Inclusao")) + 1) / 30

End IfIf Format(rs("Exclusao"), "yyyymm") = Comp Then

QtdExp = (Day(rs("Exclusao")) - 1) / 30End IfIf QtdExp < 0 Then QtdExp = 0Exp_FE(FE) = Exp_FE(FE) + QtdExp

Sub PreencheExpostos() – (*) – Sub PreencheExpostos() – (*) – cont.cont.Após percorrer todo o laço excluir

os resultados na tabela Expostos para a competência que, eventualmente, possa ocorrercn.Execute "Delete * from Expostos

where Competencia = '" & Comp & "'"

Sub PreencheExpostos() – (*) - Sub PreencheExpostos() – (*) - cont.cont. Incluir os resultados na tabela Expostos Criar a Consulta For FE = 1 To 10

SQL = "INSERT INTO EXPOSTOS ([COMP], FE, EXP ) SELECT " & _

Comp & " AS A, " & FE & " AS B, " & Str(Exp_FE(FE)) & " AS C"

cn.Execute SQL

Next

Fechar a Consulta Beneficiáriosrs.Close

Feche a conexão e os objetos de Banco de Dadoscn.CloseSet rs = NothingSet cn = Nothing

Teste o códigoValide os resultados

Laboratório 1ILaboratório 1ICriar Tabela de GastosPreencher Tabela de Gastos a

partir do VBA com Access.

Criar Tabela de GastosCriar Tabela de GastosCriar Tabela de Expostos com a

seguintes estrutura:

(*) Chave primária.

Sub PreencheGastosInc()Sub PreencheGastosInc() Acesse a Base de Dados

Dim cn As ADODB.ConnectionDim rs As ADODB.RecordsetSet cn = CurrentProject.ConnectionSet rs = New ADODB.Recordset

Defina datas de competência inicial e finalDim CompIni As StringDim CompFin As StringDim Comp As StringCompIni = Format(DateSerial(2005, 1, 1), "yyyymm") ' #1/1/2005#CompFin = Format(DateSerial(2007, 11, 1), "yyyymm") ' #11/1/2007#

Excluir registros anteriorescn.Execute "Delete * from Gastos“

Redimensionar Vetores Dim Inc_FE() As Single Dim Gas_FE() As SingleReDim Gas_FE(1 To 10)ReDim Inc_FE(1 To 10)

Sub PreencheGastosInc()Sub PreencheGastosInc() Abrir Consulta Notas / Beneficiarios

SQL = "SELECT Format([Atendimento],'yyyymm') AS competencia, Notas.Atendimento, " & _

"Notas.Servico, Beneficiarios.Nascimento, Notas.Alta, Notas.Valor " & _

"FROM Notas INNER JOIN Beneficiarios ON Notas.Matricula = Beneficiarios.Matricula " & _

"WHERE (((Format([Atendimento], 'yyyymm')) >= '" & CompIni & "' And (Format([Atendimento], 'yyyymm')) <= '" & _

CompFin & "')) ORDER BY Format([Atendimento],'yyyymm'), Notas.Servico;"

rs.Open SQL, cn, adOpenKeyset Inclua laço Do-While para a consulta

Dim Calcula As BooleanCalcula = TrueDo While Not rs.EOF And Calcula#Looprs.CloseMsgBox "Fim de processamento!", vbInformation

Sub Sub PreencheGastosInc(#)PreencheGastosInc(#) Dentro laço Do-While para a Notas

FE = FaixaEtaria(rs("Atendimento"), rs("Nascimento"))Inc_FE(FE) = Inc_FE(FE) + 1Gas_FE(FE) = Gas_FE(FE) + rs("Valor")Servico = rs("servico")Comp = rs("competencia")rs.MoveNext#2

Teste o código

Sub Sub PreencheGastosInc(#3)PreencheGastosInc(#3) Dentro laço Do-While para a Notas (gravar

vetores quando fim de arquivo) If rs.EOF Then For FE = 1 To 10 SQL = "INSERT INTO GASTOS ([COMP], FE, SERVICO, INC, GAS )

SELECT " & _ Comp & " AS A, " & FE & " AS B, '" & Servico & "' as C, " &

Str(Inc_FE(FE)) & " AS D, " & _Str(Gas_FE(FE)) & " AS E"cn.Execute SQL

NextReDim Gas_FE(1 To 10)ReDim Inc_FE(1 To 10)'Servico = rs("servico")

Else#4End If

Sub Sub PreencheGastosInc(#4)PreencheGastosInc(#4) Dentro laço Do-While para a Notas (gravar

vetores quando mudar de competência) If rs.EOF ThenElse#4 If Servico <> rs("servico") Or Comp <> rs("competencia") Then

For FE = 1 To 10SQL = "INSERT INTO GASTOS ([COMP], FE,

SERVICO, INC, GAS ) SELECT " & _Comp & " AS A, " & FE & " AS B, '" & Servico & "'

as C, " & Str(Inc_FE(FE)) & " AS D, " & _

Str(Gas_FE(FE)) & " AS E"cn.Execute SQL

NextReDim Gas_FE(1 To 10)ReDim Inc_FE(1 To 10)

End IfEnd If

Laboratório 1IILaboratório 1IIPreencher planilha ANS com

resultados obtidos nos laboratórios I e II.

FIMFIM