Private Sub cmdGen834_Click()
Dim oEdiDoc As Fredi.ediDocument
Dim oSchemas As Fredi.ediSchemas
Dim oInterchange As Fredi.ediInterchange
Dim oGroup As Fredi.ediGroup
Dim oTransactionset As Fredi.ediTransactionSet
Dim oSegment As Fredi.ediDataSegment
Dim mSefFile As String
Dim mEdiFile As String
Dim mInvDate As String
Dim mOrderDate As String
Dim mRow, mCol As Integer
Dim mInstance As Integer
Dim sPath As String
Cells(19, 5) = "Please wait gen..."
sPath = Application.ActiveWorkbook.Path & "\"
mSefFile = "834_X095.sef"
mEdiFile = "834_x095.X12"
Set oEdiDoc = New Fredi.ediDocument
oEdiDoc.CursorType = Cursor_ForwardWrite
'disable SRL for better performance. Use SEF files only.
Set oSchemas = oEdiDoc.GetSchemas
oSchemas.EnableStandardReference = False
'define terminators
oEdiDoc.LoadSchema sPath & mSefFile, 0
oEdiDoc.SegmentTerminator = "~" & vbCrLf
oEdiDoc.ElementTerminator = "*"
oEdiDoc.CompositeTerminator = ">"
'Generating the ISA
Set oInterchange = oEdiDoc.CreateInterchange("X", "004010")
'Gets the ISA segment (created above), then the element's values are changed.
Set oSegment = oInterchange.GetDataSegmentHeader
oSegment.DataElementValue(1) = "00"
oSegment.DataElementValue(3) = "00"
oSegment.DataElementValue(5) = "ZZ"
oSegment.DataElementValue(6) = "SENDERISA"
oSegment.DataElementValue(7) = "ZZ"
oSegment.DataElementValue(8) = "RECEIVERISA"
oSegment.DataElementValue(9) = "960807"
oSegment.DataElementValue(10) = "1548"
oSegment.DataElementValue(11) = "U"
oSegment.DataElementValue(12) = "00401"
oSegment.DataElementValue(13) = "000000020"
oSegment.DataElementValue(14) = "0"
oSegment.DataElementValue(15) = "T"
oSegment.DataElementValue(16) = ">"
'Generating the Functional Group
Set oGroup = oInterchange.CreateGroup("004010X095")
Set oSegment = oGroup.GetDataSegmentHeader
oSegment.DataElementValue(1) = "BE"
oSegment.DataElementValue(2) = "SENDERDEPT"
oSegment.DataElementValue(3) = "007326879"
oSegment.DataElementValue(4) = "19960807"
oSegment.DataElementValue(5) = "1548"
oSegment.DataElementValue(6) = "1"
oSegment.DataElementValue(7) = "X"
oSegment.DataElementValue(8) = "004010X095"
'Generating the Transaction Sets
mRow = 2
Set oTransactionset = oGroup.CreateTransactionSet("834")
Set oSegment = oTransactionset.GetDataSegmentHeader
oSegment.DataElementValue(1) = "834"
oSegment.DataElementValue(2) = "00001"
'Beginning Segment
Set oSegment = oTransactionset.CreateDataSegment("BGN")
oSegment.DataElementValue(1) = "00"
oSegment.DataElementValue(2) = "TS12456"
oSegment.DataElementValue(3) = "20050923"
oSegment.DataElementValue(4) = "1230"
oSegment.DataElementValue(8) = "2"
'Plan Sponsor
Set oSegment = oTransactionset.CreateDataSegment("N1\N1")
oSegment.DataElementValue(1) = "P5"
oSegment.DataElementValue(2) = "Sponsor Org"
oSegment.DataElementValue(3) = "FI"
oSegment.DataElementValue(4) = "999888877"
'Payer
Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N1")
oSegment.DataElementValue(1) = "IN"
oSegment.DataElementValue(2) = "Insurance Co"
oSegment.DataElementValue(3) = "FI"
oSegment.DataElementValue(4) = "65445654"
Do While Cells(mRow, 2).Value > 0
'Member Level Detail
Set oSegment = oTransactionset.CreateDataSegment("INS\INS")
oSegment.DataElementValue(1) = "Y"
oSegment.DataElementValue(2) = "18"
oSegment.DataElementValue(3) = "021"
oSegment.DataElementValue(4) = "20"
oSegment.DataElementValue(5) = "A"
oSegment.DataElementValue(8) = "FT"
'Subscriber Number
Set oSegment = oTransactionset.CreateDataSegment("INS\REF")
oSegment.DataElementValue(1) = "0F"
oSegment.DataElementValue(2) = Cells(mRow, "L")
'Member Policy Number
Set oSegment = oTransactionset.CreateDataSegment("INS\REF(2)")
oSegment.DataElementValue(1) = "1L"
oSegment.DataElementValue(2) = Cells(mRow, "M")
'Member Level Dates
Set oSegment = oTransactionset.CreateDataSegment("INS\DTP")
oSegment.DataElementValue(1) = "356"
oSegment.DataElementValue(2) = "D8"
oSegment.DataElementValue(3) = Cells(mRow, "N")
'Member Name
Set oSegment = oTransactionset.CreateDataSegment("INS\NM1\NM1")
oSegment.DataElementValue(1) = "IL"
oSegment.DataElementValue(2) = "1"
oSegment.DataElementValue(3) = Cells(mRow, "B")
oSegment.DataElementValue(4) = Cells(mRow, "A")
oSegment.DataElementValue(8) = "34"
oSegment.DataElementValue(9) = Cells(mRow, "C")
'Member Communications Numbers
Set oSegment = oTransactionset.CreateDataSegment("INS\NM1\PER")
oSegment.DataElementValue(1) = "IP"
oSegment.DataElementValue(3) = "HP"
oSegment.DataElementValue(4) = Cells(mRow, "H")
oSegment.DataElementValue(5) = "WP"
oSegment.DataElementValue(6) = Cells(mRow, "I")
'Member Residence Street Address
Set oSegment = oTransactionset.CreateDataSegment("INS\NM1\N3")
oSegment.DataElementValue(1) = Cells(mRow, "D")
'Member Residence City, State, ZIP Code
Set oSegment = oTransactionset.CreateDataSegment("INS\NM1\N4")
oSegment.DataElementValue(1) = Cells(mRow, "E")
oSegment.DataElementValue(2) = Cells(mRow, "F")
oSegment.DataElementValue(3) = Cells(mRow, "G")
'Member Demographics
Set oSegment = oTransactionset.CreateDataSegment("INS\NM1\DMG")
oSegment.DataElementValue(1) = "D8"
oSegment.DataElementValue(2) = Cells(mRow, "J")
oSegment.DataElementValue(3) = Cells(mRow, "K")
'Health
If Cells(mRow, "O") = "Y" Then
Set oSegment = oTransactionset.CreateDataSegment("INS\HD\HD")
oSegment.DataElementValue(1) = "021"
oSegment.DataElementValue(3) = "HLT"
'Health Coverage Dates
Set oSegment = oTransactionset.CreateDataSegment("INS\HD\DTP")
oSegment.DataElementValue(1) = "348"
oSegment.DataElementValue(2) = "D8"
oSegment.DataElementValue(3) = Cells(mRow, "P")
End If
'Dental
If Cells(mRow, "Q") = "Y" Then
Set oSegment = oTransactionset.CreateDataSegment("INS\HD\HD")
oSegment.DataElementValue(1) = "021"
oSegment.DataElementValue(3) = "DEN"
'Health Coverage Dates
Set oSegment = oTransactionset.CreateDataSegment("INS\HD\DTP")
oSegment.DataElementValue(1) = "348"
oSegment.DataElementValue(2) = "D8"
oSegment.DataElementValue(3) = Cells(mRow, "R")
End If
'Vision
If Cells(mRow, "S") = "Y" Then
Set oSegment = oTransactionset.CreateDataSegment("INS\HD\HD")
oSegment.DataElementValue(1) = "021"
oSegment.DataElementValue(3) = "VIS"
'Health Coverage Dates
Set oSegment = oTransactionset.CreateDataSegment("INS\HD\DTP")
oSegment.DataElementValue(1) = "348"
oSegment.DataElementValue(2) = "D8"
oSegment.DataElementValue(3) = Cells(mRow, "T")
End If
mRow = mRow + 1
Loop
'save Edi file
oEdiDoc.Save sPath & mEdiFile
'display edi string
MsgBox oEdiDoc.GetEdiString
Cells(19, 5) = ""
'destroy objects
Set osegments = Nothing
Set oTransactionset = Nothing
Set oGroup = Nothing
Set oInterchange = Nothing
Set oSchemas = Nothing
Set oEdiDoc = Nothing
MsgBox "Done"
End Sub
