Private Sub Command0_Click()
'This is just an example program to demonstrate how to generate an EDI X12 130 Transaction Set
'in Access VB script with the Framework EDI component
Dim oEdiDoc As Fredi.ediDocument
Dim oSchema As Fredi.ediSchema
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 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 sPath As String
Dim i As Integer
Dim sSefFile As String
Dim sEdiFile As String
sPath = CurrentProject.Path & "\"
sSefFile = "130_4010.SEF"
sEdiFile = "130Outbound.x12"
'CREATES OEDIDOC OBJECT
Set oEdiDoc = New Fredi.ediDocument
'THIS MAKES CERTAIN THAT FREDI ONLY USES THE SEF FILE PROVIDED, AND THAT IT DOES
'NOT USE ITS BUILT-IN STANDARD REFERENCE TABLE TO GENERATE THE EDI FILE.
Set oSchemas = oEdiDoc.GetSchemas
oSchemas.EnableStandardReference = False
'ENABLES FORWARD WRITE, AND INCREASES BUFFER I/O TO IMPROVE PERFORMANCE
oEdiDoc.CursorType = Cursor_ForwardWrite
oEdiDoc.Property(Property_DocumentBufferIO) = 200
'SET TERMINATORS
oEdiDoc.SegmentTerminator = "~{13:10}"
oEdiDoc.ElementTerminator = "*"
oEdiDoc.CompositeTerminator = ":"
'LOADS THE SEF FILE
Set oSchema = oEdiDoc.ImportSchema(sPath & sSefFile, 0)
sConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sPath & "Gen130.mdb"
Set oConn = New ADODB.Connection
oConn.Open sConn
'CREATE TABLE OBJECTS
'The InterchangeIndex table stores information for each Interchange received.
Set oRsInterchange = New ADODB.Recordset
Set oRsGroup = New ADODB.Recordset
Set oRs130Header = New ADODB.Recordset
Set oRs130TestScores = New ADODB.Recordset
Set oRs130IndividualInfo = New ADODB.Recordset
Set oRs130Immunization = New ADODB.Recordset
Set oRs130AcademicSession = New ADODB.Recordset
Set oRs130Awards = New ADODB.Recordset
Set oRs130CourseRecord = New ADODB.Recordset
'INTERCHANGE INFO
oRsInterchange.Open "select * from InterchangeIndex", oConn
Do While Not oRsInterchange.EOF
'CREATES THE ISA SEGMENT
Set oInterchange = oEdiDoc.CreateInterchange("X", "004010")
Set oSegment = oInterchange.GetDataSegmentHeader
oSegment.DataElementValue(1) = "00" 'Authorization Information Qualifier
oSegment.DataElementValue(2) = " " 'Authorization Information
oSegment.DataElementValue(3) = "00" 'Security Information Qualifier
oSegment.DataElementValue(4) = " " 'Security Information
oSegment.DataElementValue(5) = oRsInterchange("SenderID_Qlfr").Value 'Interchange ID Qualifier
oSegment.DataElementValue(6) = oRsInterchange("SenderID").Value 'Interchange Sender ID
oSegment.DataElementValue(7) = oRsInterchange("ReceiverID_Qlfr").Value 'Interchange ID Qualifier
oSegment.DataElementValue(8) = oRsInterchange("ReceiverID").Value 'Interchange Receiver ID
oSegment.DataElementValue(9) = Format(Now(), "YYMMDD") 'Interchange Date
oSegment.DataElementValue(10) = "0101" 'Interchange Time
oSegment.DataElementValue(11) = "U" 'Interchange Control Standards Identifier
oSegment.DataElementValue(12) = oRsInterchange("Version").Value 'Interchange Control Version Number
oSegment.DataElementValue(13) = oRsInterchange("InterchangeControlNo").Value 'Interchange Control Number
oSegment.DataElementValue(14) = "0" 'Acknowledgment Requested
oSegment.DataElementValue(15) = "T" 'Usage Indicator
oSegment.DataElementValue(16) = "!" 'Component Element Separator
'FUNCTIONAL GROUP INFO
oRsGroup.Open "select * from GroupIndex where InterchangeKey = " & Trim(Str(oRsInterchange("InterchangeKey").Value)), oConn
Do While Not oRsGroup.EOF
'CREATES THE GS SEGMENT
Set oGroup = oInterchange.CreateGroup("004010")
Set oSegment = oGroup.GetDataSegmentHeader
oSegment.DataElementValue(1) = oRsGroup("FunctionalIdCode").Value 'Functional Identifier Code
oSegment.DataElementValue(2) = oRsGroup("SenderDept").Value 'Application Sender's Code
oSegment.DataElementValue(3) = oRsGroup("ReceiverDept").Value 'Application Receiver's Code
oSegment.DataElementValue(4) = "01010101" 'Date
oSegment.DataElementValue(5) = "01010101" 'Time
oSegment.DataElementValue(6) = oRsGroup("GroupNo").Value 'Group Control Number
oSegment.DataElementValue(7) = "X" 'Responsible Agency Code
oSegment.DataElementValue(8) = oRsGroup("Version").Value 'Version / Release / Industry Identifier Code
'MESSAGE AND HEADER INFO
oRs130Header.Open "select * from 130Header where GroupKey = " & Trim(Str(oRsGroup("GroupKey").Value)), oConn
Do While Not oRs130Header.EOF
'CREATES THE ST SEGMENT
Set oTransactionset = oGroup.CreateTransactionSet("130")
Set oSegment = oTransactionset.GetDataSegmentHeader
oSegment.DataElementValue(1) = oRs130Header("TransactionSetNo").Value 'Transaction Set Identifier Code
oSegment.DataElementValue(2) = oRs130Header("TransactionSetControlNo").Value 'Transaction Set Control Number
'BGN - BEGINNING SEGMENT
Set oSegment = oTransactionset.CreateDataSegment("BGN")
oSegment.DataElementValue(1) = oRs130Header("PurposeCode").Value 'Transaction Set Purpose Code
oSegment.DataElementValue(2) = oRs130Header("ReferenceId").Value 'Reference Identification
oSegment.DataElementValue(3) = oRs130Header("Date").Value 'Date
oSegment.DataElementValue(4) = "103020" 'Time
oSegment.DataElementValue(5) = "ET" 'Time Code
'ERP - EDUCATIONAL RECORD PURPOSE
Set oSegment = oTransactionset.CreateDataSegment("ERP")
oSegment.DataElementValue(1) = oRs130Header("TranscriptType").Value 'Transaction Type Code
oSegment.DataElementValue(2) = oRs130Header("ReasonCode").Value 'Status Reason Code
'REF - REFERENCE IDENTIFICATION
Set oSegment = oTransactionset.CreateDataSegment("REF")
oSegment.DataElementValue(1) = "SY" 'Reference Identification Qualifier
oSegment.DataElementValue(2) = oRs130Header("SSN").Value 'Reference Identification
'SENDER INFORMATION
'N1 - NAME
Set oSegment = oTransactionset.CreateDataSegment("N1\N1")
oSegment.DataElementValue(1) = "AS" 'Entity Identifier Code
oSegment.DataElementValue(2) = oRs130Header("SenderName").Value 'Name
'N3 - ADDRESS INFORMATION
Set oSegment = oTransactionset.CreateDataSegment("N1\N3")
oSegment.DataElementValue(1) = oRs130Header("SenderAddress").Value 'Address Information
'N4 - GEOGRAPHIC LOCATION
Set oSegment = oTransactionset.CreateDataSegment("N1\N4")
oSegment.DataElementValue(1) = oRs130Header("SenderCity").Value 'City Name
'RECEIVER INFORMATION
'N1 - NAME
Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N1")
oSegment.DataElementValue(1) = "AS" 'Entity Identifier Code
oSegment.DataElementValue(2) = oRs130Header("ReceiverName").Value 'Name
'N3 - ADDRESS INFORMATION
Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N3")
oSegment.DataElementValue(1) = oRs130Header("ReceiverAddress").Value 'Address Information
'N4 - GEOGRAPHIC LOCATION
Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N4")
oSegment.DataElementValue(1) = oRs130Header("ReceiverCity").Value 'City Name
'IN1 - INDIVIDUAL IDENTIFICATION
Set oSegment = oTransactionset.CreateDataSegment("IN1\IN1")
oSegment.DataElementValue(1) = "1" 'Entity Type Qualifier
oSegment.DataElementValue(2) = "04" 'Name Type Code
oRs130IndividualInfo.Open "select * from 130IndividualInfo where TsKey = " & Trim(Str(oRs130Header("TsKey").Value)), oConn
Do While Not oRs130IndividualInfo.EOF
'IN2 - INDIVIDUAL NAME STRUCTURE COMPONENTS
Set oSegment = oTransactionset.CreateDataSegment("IN1\IN2")
oSegment.DataElementValue(1) = "05" 'Name Component Qualifier
oSegment.DataElementValue(2) = oRs130IndividualInfo("LastName").Value 'Name
Set oSegment = oTransactionset.CreateDataSegment("IN1\IN2(2)")
oSegment.DataElementValue(1) = "02" 'Name Component Qualifier
oSegment.DataElementValue(2) = oRs130IndividualInfo("Firstname").Value 'Name
Set oSegment = oTransactionset.CreateDataSegment("IN1\IN2(3)")
oSegment.DataElementValue(1) = "15" 'Name Component Qualifier
oSegment.DataElementValue(2) = oRs130IndividualInfo("MiddleInitial").Value 'Name
'SST - STUDENT ACADEMIC STATUS
Set oSegment = oTransactionset.CreateDataSegment("SST\SST")
oSegment.DataElementValue(1) = oRs130IndividualInfo("HSGraduationType").Value 'Status Reason Code
oSegment.DataElementValue(3) = oRs130IndividualInfo("HSGraduationDate").Value
'N1 - NAME
Set oSegment = oTransactionset.CreateDataSegment("SST\N1")
oSegment.DataElementValue(1) = oRs130IndividualInfo("InstitutionType").Value 'Entity Identifier Code
oSegment.DataElementValue(2) = oRs130IndividualInfo("InstitutionName").Value 'Name
Set oSegment = oTransactionset.CreateDataSegment("SST\N4")
oSegment.DataElementValue(1) = oRs130IndividualInfo("InstitutionCity").Value
oSegment.DataElementValue(2) = oRs130IndividualInfo("InstitutionState").Value
oRs130IndividualInfo.MoveNext
Loop 'oRs130IndividualInfo
oRs130IndividualInfo.Close
oRs130Awards.Open "select * from 130Awards where TsKey = " & Trim(Str(oRs130Header("TsKey").Value)), oConn
Do While Not oRs130Awards.EOF
Set oSegment = oTransactionset.CreateDataSegment("ATV\ATV")
oSegment.DataElementValue(3) = oRs130Awards("Title").Value
Set oSegment = oTransactionset.CreateDataSegment("ATV\DTP")
oSegment.DataElementValue(1) = "103"
oSegment.DataElementValue(2) = "D8"
oSegment.DataElementValue(3) = oRs130Awards("Date").Value
oRs130Awards.MoveNext
Loop 'oRs130Awards
oRs130Awards.Close
oRs130TestScores.Open "select * from 130TestScores where TsKey = " & Trim(Str(oRs130Header("TsKey").Value)), oConn
Do While Not oRs130TestScores.EOF
'TST - TEST SCORE RECORD
Set oSegment = oTransactionset.CreateDataSegment("TST\TST")
oSegment.DataElementValue(1) = oRs130TestScores("EducationCode").Value 'Educational Test or Requirement Code
oSegment.DataElementValue(2) = oRs130TestScores("TestName").Value 'Name
oSegment.DataElementValue(3) = "D8" 'Date Time Period Format Qualifier
oSegment.DataElementValue(4) = oRs130TestScores("TestDate").Value 'Date Time Period
oSegment.DataElementValue(7) = oRs130TestScores("StudentGradeLevel").Value 'Level of Individual, Test, or Course Code
Set oSegment = oTransactionset.CreateDataSegment("TST\SBT\SBT")
oSegment.DataElementValue(1) = oRs130TestScores("TestCode").Value
Set oSegment = oTransactionset.CreateDataSegment("TST\SBT\SRE")
oSegment.DataElementValue(1) = 3
oSegment.DataElementValue(2) = oRs130TestScores("StandardScore").Value
oRs130TestScores.MoveNext
Loop 'oRs130TestScores
oRs130TestScores.Close
'LX - ASSIGNED NUMBER
Set oSegment = oTransactionset.CreateDataSegment("LX\LX")
oSegment.DataElementValue(1) = "123456" 'Assigned Number
'HS - HEALTH SCREENING
Set oSegment = oTransactionset.CreateDataSegment("LX\HS")
oSegment.DataElementValue(1) = "IDIDID" 'Health Screening Type Code
oSegment.DataElementValue(2) = "CC" 'Date Time Period Format Qualifier
oSegment.DataElementValue(3) = "A1B2C3D4E5" 'Date Time Period
oSegment.DataElementValue(4) = "001" 'Status Reason Code
oRs130Immunization.Open "select * from 130Immunization where TsKey = " & Trim(Str(oRs130Header("TsKey").Value)), oConn
Do While Not oRs130Immunization.EOF
'IMM - IMMUNIZATION STATUS CODE
Set oSegment = oTransactionset.CreateDataSegment("LX\IMM")
oSegment.DataElementValue(1) = oRs130Immunization("ImmunCode").Value 'Immunization Type Code
oSegment.DataElementValue(2) = "D8" 'Date Time Period Format Qualifier
oSegment.DataElementValue(3) = oRs130Immunization("ImmunDate").Value 'Date Time Period
oRs130Immunization.MoveNext
Loop 'oRs130Immunization
oRs130Immunization.Close
oRs130AcademicSession.Open "select * from 130AcademicSession where TsKey = " & Trim(Str(oRs130Header("TsKey").Value)), oConn
Do While Not oRs130AcademicSession.EOF
'SES - ACADEMIC SESSION HEADER
Set oSegment = oTransactionset.CreateDataSegment("LX\SES\SES")
oSegment.DataElementValue(1) = oRs130AcademicSession("SessionDate").Value 'Date Time Period
oSegment.DataElementValue(4) = oRs130AcademicSession("SessionCode").Value
oSegment.DataElementValue(5) = oRs130AcademicSession("SessionName").Value 'Name
oSegment.DataElementValue(7) = oRs130AcademicSession("SessionStartDate").Value
oSegment.DataElementValue(9) = oRs130AcademicSession("SessionEndDate").Value
oSegment.DataElementValue(10) = oRs130AcademicSession("SessionGradeCode").Value
oSegment.DataElementValue(14) = oRs130AcademicSession("StatusCode").Value 'Status Reason Code
oRs130CourseRecord.Open "select * from 130CourseRecord where SessionKey = " & Trim(Str(oRs130AcademicSession("SessionKey").Value)), oConn
Do While Not oRs130CourseRecord.EOF
'CRS - COURSE RECORD
Set oSegment = oTransactionset.CreateDataSegment("LX\SES\CRS\CRS")
oSegment.DataElementValue(1) = oRs130CourseRecord("CreditCode").Value 'Basis for Academic Credit Code
oSegment.DataElementValue(2) = oRs130CourseRecord("CreditTypeCode").Value 'Academic Credit Type Code
oSegment.DataElementValue(6) = oRs130CourseRecord("CourseGrade").Value 'Academic Grade
oSegment.DataElementValue(8) = oRs130CourseRecord("GradeLevel").Value
oSegment.DataElementValue(12) = oRs130CourseRecord("Points").Value
oSegment.DataElementValue(14) = oRs130CourseRecord("CourseSubject").Value 'Name
oSegment.DataElementValue(15) = oRs130CourseRecord("CourseNumber").Value 'Reference Identification
oSegment.DataElementValue(16) = oRs130CourseRecord("CourseTitle").Value 'Name
oRs130CourseRecord.MoveNext
Loop 'oRs130CourseRecord
oRs130CourseRecord.Close
oRs130AcademicSession.MoveNext
Loop 'oRs130AcademicSession
oRs130AcademicSession.Close
oRs130Header.MoveNext
Loop 'oRs130Header
oRs130Header.Close
oRsGroup.MoveNext
Loop 'oRsGroup
oRsGroup.Close
oRsInterchange.MoveNext
Loop 'oRsInterchange
oRsInterchange.Close
'TRAILING SEGMENTS ARE AUTOMATICALLY CREATED WHEN FREDI COMMITS (SAVES)
'THE EDIDOC OBJECT INTO AN EDI FILE.
oEdiDoc.Save sPath & sEdiFile
'DESTROYS OBJECTS
Set oSegment = Nothing
Set oTransactionset = Nothing
Set oGroup = Nothing
Set oSchema = Nothing
Set oSchemas = Nothing
Set oInterchange = Nothing
Set oEdiDoc = Nothing
MsgBox "Done"
End Sub
