Private Sub Command0_Click()
'This is just an example program to show how to translate an EDI X12 130 file
'in VB Script with the Framework EDI component
Dim oEdiDoc As Fredi.ediDocument
Dim oSegment As Fredi.ediDataSegment
Dim oSchemas As Fredi.ediSchemas
Dim oConn As ADODB.Connection
Dim oRsInterchange As ADODB.Recordset
Dim oRsGroup As ADODB.Recordset
Dim oRs130Header As ADODB.Recordset
Dim oRs130TestScores As ADODB.Recordset
Dim oRs130IndividualInfo As ADODB.Recordset
Dim oRs130Immunization As ADODB.Recordset
Dim oRs130AcademicSession As ADODB.Recordset
Dim oRs130Awards As ADODB.Recordset
Dim oRs130CourseRecord As ADODB.Recordset
Dim sConn As String
Dim sInterchangeControlNo As String
Dim sGroupControlNo As String
Dim sTSNo As String
Dim sTSControlNo As String
Dim sPath As String
Dim nInterchangeKey As Long
Dim nGroupKey As Long
Dim nTsKey As Long
Dim i As Integer
Dim sEntity As String
Dim sSefFile As String
Dim sEdiFile As String
Dim sSegmentID As String
Dim sLoopSection As String
Dim nArea As Integer
Dim iIndex As Integer
Dim sQlfr As String
sPath = CurrentProject.Path & "\"
sConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sPath & "tran130.mdb"
Set oConn = New ADODB.Connection
oConn.Open sConn
'The InterchangeIndex table stores information for each Interchange received.
Set oRsInterchange = New ADODB.Recordset
oRsInterchange.Open "InterchangeIndex", oConn, adOpenDynamic, adLockOptimistic
'The GroupIndex table stores information for each Group received.
Set oRsGroup = New ADODB.Recordset
oRsGroup.Open "GroupIndex", oConn, adOpenDynamic, adLockOptimistic
'The 130Header table stores information of the Transaction Sets
Set oRs130Header = New ADODB.Recordset
oRs130Header.Open "130Header", oConn, adOpenDynamic, adLockOptimistic
'The 130TestScores table
Set oRs130TestScores = New ADODB.Recordset
oRs130TestScores.Open "130TestScores", oConn, adOpenDynamic, adLockOptimistic
'The 130IndividualInfo table
Set oRs130IndividualInfo = New ADODB.Recordset
oRs130IndividualInfo.Open "130IndividualInfo", oConn, adOpenDynamic, adLockOptimistic
'The 130Immunization table
Set oRs130Immunization = New ADODB.Recordset
oRs130Immunization.Open "130Immunization", oConn, adOpenDynamic, adLockOptimistic
'The 130AcademicSession table
Set oRs130AcademicSession = New ADODB.Recordset
oRs130AcademicSession.Open "130AcademicSession", oConn, adOpenDynamic, adLockOptimistic
'The 130Awards table
Set oRs130Awards = New ADODB.Recordset
oRs130Awards.Open "130Awards", oConn, adOpenDynamic, adLockOptimistic
'The 130CourseRecord table
Set oRs130CourseRecord = New ADODB.Recordset
oRs130CourseRecord.Open "130CourseRecord", oConn, adOpenDynamic, adLockOptimistic
sSefFile = sPath & "130_4010.SEF"
sEdiFile = sPath & "130.x12"
Set oEdiDoc = New Fredi.ediDocument
'Makes certain that the internal Standard Reference Library is not used, but only
'the SEF file provided.
Set oSchemas = oEdiDoc.GetSchemas
oSchemas.EnableStandardReference = False
'Loads the SEF file and EDI file.
oEdiDoc.LoadSchema sSefFile, 0
oEdiDoc.LoadEdi sEdiFile
'Gets the first data segment of the EDI file
Set oSegment = oEdiDoc.FirstDataSegment
'Traverse thru the EDI file. A data segment is identified by its segment ID, its loop
'section, and Area (or table) number.
'The values of the data elements of the segments are then stored into a database
Do While Not oSegment Is Nothing
sSegmentID = oSegment.ID
sLoopSection = oSegment.LoopSection
nArea = oSegment.Area
If nArea = 0 Then
If sSegmentID = "ISA" Then
oRsInterchange.AddNew
oRsInterchange("InterchangeControlNo").Value = oSegment.DataElementValue(13)
oRsInterchange("SenderID_Qlfr").Value = oSegment.DataElementValue(5)
oRsInterchange("SenderID").Value = oSegment.DataElementValue(6)
oRsInterchange("ReceiverID_Qlfr").Value = oSegment.DataElementValue(7)
oRsInterchange("ReceiverID").Value = oSegment.DataElementValue(8)
oRsInterchange("Version").Value = oSegment.DataElementValue(12)
ElseIf sSegmentID = "GS" Then
oRsGroup.AddNew
oRsGroup("InterchangeKey").Value = oRsInterchange("InterchangeKey").Value
oRsGroup("GroupNo").Value = oSegment.DataElementValue(6)
oRsGroup("Version").Value = oSegment.DataElementValue(8)
oRsGroup("FunctionalIdCode").Value = oSegment.DataElementValue(1)
oRsGroup("SenderDept").Value = oSegment.DataElementValue(2)
oRsGroup("ReceiverDept").Value = oSegment.DataElementValue(3)
ElseIf sSegmentID = "IEA" Then
oRsInterchange.Update
ElseIf sSegmentID = "GE" Then
oRsGroup.Update
End If
ElseIf nArea = 1 Then
If sLoopSection = "" Then
If sSegmentID = "ST" Then
oRs130Header.AddNew
oRs130Header("GroupKey").Value = oRsGroup("GroupKey").Value
oRs130Header("TransactionSetControlNo").Value = oSegment.DataElementValue(2)
oRs130Header("TransactionSetNo").Value = oSegment.DataElementValue(1)
ElseIf sSegmentID = "BGN" Then
oRs130Header("PurposeCode").Value = oSegment.DataElementValue(1) 'Transaction Set Purpose Code
oRs130Header("ReferenceId").Value = oSegment.DataElementValue(2) 'Reference Identification
oRs130Header("Date").Value = oSegment.DataElementValue(3) 'Date
ElseIf sSegmentID = "ERP" Then
oRs130Header("TranscriptType").Value = oSegment.DataElementValue(1) 'Transaction Type Code
oRs130Header("ReasonCode").Value = oSegment.DataElementValue(2) 'Status Reason Code
ElseIf sSegmentID = "REF" Then
If oSegment.DataElementValue(1) = "SY" Then 'Reference Identification Qualifier
oRs130Header("SSN").Value = oSegment.DataElementValue(2) 'Reference Identification
End If
End If
ElseIf sLoopSection = "N1" Then
'Obtains the qulaifier for the loop to determine the kind of information the
'segments in the loop holds
If sSegmentID = "N1" Then
sEntity = oSegment.DataElementValue(1)
End If
If sEntity = "AS" Then 'Postsecondary Education Sender
If sSegmentID = "N1" Then
oRs130Header("SenderName").Value = oSegment.DataElementValue(2)
ElseIf sSegmentID = "N3" Then
oRs130Header("SenderAddress").Value = oSegment.DataElementValue(1)
ElseIf sSegmentID = "N4" Then
oRs130Header("SenderCity").Value = oSegment.DataElementValue(1)
End If
ElseIf sEntity = "AT" Then 'Postsecondary Education Recipient
If sSegmentID = "N1" Then
oRs130Header("ReceiverName").Value = oSegment.DataElementValue(2)
ElseIf sSegmentID = "N3" Then
oRs130Header("ReceiverAddress").Value = oSegment.DataElementValue(1)
ElseIf sSegmentID = "N4" Then
oRs130Header("ReceiverCity").Value = oSegment.DataElementValue(1)
End If
End If 'sEntity
ElseIf sLoopSection = "IN1" Then
If sSegmentID = "IN1" Then
If Not oRs130IndividualInfo.BOF Then
oRs130IndividualInfo.Update
End If
oRs130IndividualInfo.AddNew
oRs130IndividualInfo("TsKey").Value = oRs130Header("TsKey").Value
ElseIf sSegmentID = "IN2" Then
sQlfr = oSegment.DataElementValue(1)
If sQlfr = "05" Then
oRs130IndividualInfo("Lastname").Value = oSegment.DataElementValue(2) 'Last Name
ElseIf sQlfr = "02" Then
oRs130IndividualInfo("Firstname").Value = oSegment.DataElementValue(2) 'First Name
ElseIf sQlfr = "07" Then
oRs130IndividualInfo("MiddleInitial").Value = oSegment.DataElementValue(2) 'Middle Initial
End If
End If 'Segment ID
ElseIf sLoopSection = "IN1;N3" Then
If sSegmentID = "N3" Then
oRs130IndividualInfo("Address").Value = oSegment.DataElementValue(1)
ElseIf sSegmentID = "N4" Then
oRs130IndividualInfo("City").Value = oSegment.DataElementValue(1)
oRs130IndividualInfo("State").Value = oSegment.DataElementValue(2)
oRs130IndividualInfo("Zip").Value = oSegment.DataElementValue(3)
End If 'Segment ID
ElseIf sLoopSection = "SST" Then
If sSegmentID = "SST" Then
oRs130IndividualInfo("HSGraduationType").Value = oSegment.DataElementValue(1)
oRs130IndividualInfo("HSGraduationDate").Value = oSegment.DataElementValue(3)
ElseIf sSegmentID = "N1" Then
oRs130IndividualInfo("InstitutionType").Value = oSegment.DataElementValue(1) 'Entity Identifier Code
oRs130IndividualInfo("InstitutionName").Value = oSegment.DataElementValue(2) 'Name
ElseIf sSegmentID = "N4" Then
oRs130IndividualInfo("InstitutionCity").Value = oSegment.DataElementValue(1)
oRs130IndividualInfo("InstitutionState").Value = oSegment.DataElementValue(2)
End If 'Segment ID
ElseIf sLoopSection = "ATV" Then
If sSegmentID = "ATV" Then
If Not oRs130Awards.BOF Then
oRs130Awards.Update
End If
oRs130Awards.AddNew
oRs130Awards("TsKey").Value = oRs130Header("TsKey").Value
oRs130Awards("Title").Value = oSegment.DataElementValue(3)
ElseIf sSegmentID = "DTP" Then
oRs130Awards("Date").Value = oSegment.DataElementValue(3)
End If 'Segment ID
ElseIf sLoopSection = "TST" Then
If sSegmentID = "TST" Then
If Not oRs130TestScores.BOF Then
oRs130TestScores.Update
End If
oRs130TestScores.AddNew
oRs130TestScores("TsKey").Value = oRs130Header("TsKey").Value
oRs130TestScores("TestName").Value = oSegment.DataElementValue(2) 'Name
oRs130TestScores("TestDate").Value = oSegment.DataElementValue(4) 'Date Time Period
oRs130TestScores("StudentGradeLevel").Value = oSegment.DataElementValue(7) 'Level of Individual, Test, or Course Code
End If 'SegmentID
ElseIf sLoopSection = "TST;SBT" Then
If sSegmentID = "SBT" Then
oRs130TestScores("TestCode").Value = oSegment.DataElementValue(1)
ElseIf sSegmentID = "SRE" Then
oRs130TestScores("StandardScore").Value = oSegment.DataElementValue(2)
End If 'sSegmentID
End If 'sLoopSection
ElseIf nArea = 2 Then
If sLoopSection = "" Then
If sSegmentID = "SE" Then
oRs130Header.Update
End If
ElseIf sLoopSection = "LX" Then
If sSegmentID = "LX" Then
sValue = oSegment.DataElementValue(1) 'Assigned Number
ElseIf sSegmentID = "IMM" Then
If Not oRs130Immunization.BOF Then
oRs130Immunization.Update
End If
oRs130Immunization.AddNew
oRs130Immunization("TsKey").Value = oRs130Header("TsKey").Value
oRs130Immunization("ImmunCode").Value = oSegment.DataElementValue(1) 'Immunization Type Code
oRs130Immunization("ImmunDate").Value = oSegment.DataElementValue(3) 'Date Time Period
End If 'Segment ID
ElseIf sLoopSection = "LX;SES" Then
If sSegmentID = "SES" Then
If Not oRs130AcademicSession.BOF Then
oRs130AcademicSession.Update
End If
oRs130AcademicSession.AddNew
oRs130AcademicSession("TsKey").Value = oRs130Header("TsKey").Value
oRs130AcademicSession("SessionDate").Value = oSegment.DataElementValue(1) 'Date Time Period
oRs130AcademicSession("SessionCode").Value = oSegment.DataElementValue(4) 'Session Code
oRs130AcademicSession("SessionName").Value = oSegment.DataElementValue(5) 'Name
oRs130AcademicSession("SessionStartDate").Value = oSegment.DataElementValue(7) 'Date Time Period
oRs130AcademicSession("SessionEndDate").Value = oSegment.DataElementValue(9) 'Date Time Period
oRs130AcademicSession("SessionGradeCode").Value = oSegment.DataElementValue(10) 'Level of Individual, Test, or Course Code
oRs130AcademicSession("StatusCode").Value = oSegment.DataElementValue(14) 'Status Reason Code
End If 'Segment ID
ElseIf sLoopSection = "LX;SES;CRS" Then
If sSegmentID = "CRS" Then
If Not oRs130CourseRecord.BOF Then
oRs130CourseRecord.Update
End If
oRs130CourseRecord.AddNew
oRs130CourseRecord("SessionKey").Value = oRs130AcademicSession("SessionKey").Value
oRs130CourseRecord("CreditCode").Value = oSegment.DataElementValue(1) 'Basis for Academic Credit Code
oRs130CourseRecord("CreditTypeCode").Value = oSegment.DataElementValue(2) 'Academic Credit Type Code
oRs130CourseRecord("CourseGrade").Value = oSegment.DataElementValue(6) 'Academic Grade
oRs130CourseRecord("GradeLevel").Value = oSegment.DataElementValue(8) 'Academic Grade or Course Level Code
oRs130CourseRecord("Points").Value = oSegment.DataElementValue(12) 'Academic Credit Type Code
oRs130CourseRecord("CourseSubject").Value = oSegment.DataElementValue(14) 'Academic Credit Type Code
oRs130CourseRecord("CourseNumber").Value = oSegment.DataElementValue(15) 'Academic Grade
oRs130CourseRecord("CourseTitle").Value = oSegment.DataElementValue(16) 'Academic Grade or Course Level Code
End If 'Segment ID
End If 'sLoopSection
End If 'nArea
Set oSegment = oSegment.Next
Loop
oRs130CourseRecord.Update
oRs130AcademicSession.Update
oRs130Immunization.Update
oRs130TestScores.Update
oRs130Awards.Update
oRs130IndividualInfo.Update
Set oSegment = Nothing
MsgBox "Done"
End Sub
