Tarifação em Planos de Saúde
Laboratório
Prof. Sérgio Cardoso
www.sergiocardoso.pro.br/saude
BASE DE DADOS
Base de Dados:
Banco: DadosSaudeSergio.mdb
 Tabelas:

◦ Beneficiários
◦ Notas
◦ TipoEvento

Período:
◦ 2005/01 a 2007/11
Laboratório 1
Criar um Banco de Dados Vazio
 Vincular as Tabelas do
DadosSaudeSergio.mdb ao novo banco
 Criar consultas para uma análise
superficial das tabelas Beneficiários e
Notas
 Criar Tabela de Expostos
 Preencher Tabela de Expostos a partir do
VBA com Access.

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 Expostos

Criar Tabela de Expostos com a seguintes
estrutura:
Nome do Campo Tipo de Dados
COMPETENCIA *
Texto
FE *
Número
EXP
Número
(*) Chave primária.
Tamanho
6
Byte
Single
Preencher Tabela de Expostos a partir
do VBA com Access


Criar módulo no VBA
Adicionar ADO nas referências:

Criar Sub PreencheExpostos()
Sub PreencheExpostos()

Acesse a Base de Dados
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset

Defina datas de competência inicial e final
Dim DtCompIni as Date
Dim DtCompFin as Date
DtCompIni = DateSerial(2005, 1, 1) ‘ #1/1/2005#
DtCompFin = DateSerial(2007, 11, 1) ‘ #11/1/2007#

Inclua laço Do-While para a competência
DtComp = DtCompIni
Do While DtComp <= DtCompFin
(*)
DtComp = DateAdd("m", 1, DtComp)
Loop

Teste o código
Sub PreencheExpostos() – (*)

Crie um consula Sql para selecionar os beneficiários dentro da
competência desejada
Comp = 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() – (*) – 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 Date,
DtNasc As Date) As Byte
Dim Idade As Integer
Idade = Round(DateDiff("M", DtNasc, DtComp) / 12, 0)
Select Case (Idade)
Case Is <= 18
FaixaEtaria = 1
Case Is <= 23
FaixaEtaria = 2
Case Is <= 28
FaixaEtaria = 3
Case Is <= 33
FaixaEtaria = 4
Case Is <= 38
FaixaEtaria = 5
Case Is <= 43
FaixaEtaria = 6
Case Is <= 48
FaixaEtaria = 7
Case Is <= 53
FaixaEtaria = 8
Case Is <= 58
FaixaEtaria = 9
Case Else
FaixaEtaria = 10
End Select
Sub PreencheExpostos() – (*) – cont.

Dentro do laço Beneficiários
◦ Some QtdExp para a faixa etária correspondente
do beneficiário
Dim Exp_FE() As Long
QtdExp = 1
If Format(rs("Inclusao"), "yyyymm") = Comp Then
QtdExp = (30 - Day(rs("Inclusao")) + 1) / 30
End If
If Format(rs("Exclusao"), "yyyymm") = Comp Then
QtdExp = (Day(rs("Exclusao")) - 1) / 30
End If
If QtdExp < 0 Then QtdExp = 0
Exp_FE(FE) = Exp_FE(FE) + QtdExp
Sub PreencheExpostos() – (*) – cont.

Após percorrer todo o laço excluir os
resultados na tabela Expostos para a
competência que, eventualmente, possa
ocorrer
cn.Execute "Delete * from Expostos where
Competencia = '" & Comp & "'"
Sub PreencheExpostos() – (*) - 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ários
rs.Close

Feche a conexão e os objetos de Banco
de Dados
cn.Close
Set rs = Nothing
Set cn = Nothing
Teste o código
 Valide os resultados

Laboratório 1I
Criar Tabela de Gastos
 Preencher Tabela de Gastos a partir do
VBA com Access.

Criar Tabela de Gastos

Criar Tabela de Expostos com a seguintes
estrutura:
Nome do Campo Tipo de Dados
COMPETENCIA *
Texto
FE *
Número
Servico *
Texto
INC
Número
GAS
Número
(*) Chave primária.
Tamanho
6
Byte
255
Single
Single
Sub PreencheGastosInc()

Acesse a Base de Dados
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset

Defina datas de competência inicial e final
Dim CompIni As String
Dim CompFin As String
Dim Comp As String
CompIni = Format(DateSerial(2005, 1, 1), "yyyymm") ' #1/1/2005#
CompFin = Format(DateSerial(2007, 11, 1), "yyyymm") ' #11/1/2007#

Excluir registros anteriores
cn.Execute "Delete * from Gastos“

Redimensionar Vetores
Dim Inc_FE() As Single
Dim Gas_FE() As Single
ReDim Gas_FE(1 To 10)
ReDim Inc_FE(1 To 10)
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 Boolean
Calcula = True
Do While Not rs.EOF And Calcula
#
Loop
rs.Close
MsgBox "Fim de processamento!", vbInformation
Sub PreencheGastosInc(#)

Dentro laço Do-While para a Notas
FE = FaixaEtaria(rs("Atendimento"), rs("Nascimento"))
Inc_FE(FE) = Inc_FE(FE) + 1
Gas_FE(FE) = Gas_FE(FE) + rs("Valor")
Servico = rs("servico")
Comp = rs("competencia")
rs.MoveNext
#2
Teste o código
Sub 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
Next
ReDim Gas_FE(1 To 10)
ReDim Inc_FE(1 To 10)
'Servico = rs("servico")
Else
#4
End If
Sub PreencheGastosInc(#4)

Dentro laço Do-While para a Notas (gravar vetores quando
mudar de competência)
If rs.EOF Then
Else
#4
If Servico <> rs("servico") Or Comp <> rs("competencia") 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
Next
ReDim Gas_FE(1 To 10)
ReDim Inc_FE(1 To 10)
End If
End If
Laboratório 1II

Preencher planilha ANS com resultados
obtidos nos laboratórios I e II.
FIM