'This is just an example program to show how to generate an EDI X12 856 file in Visual Basic 6
'with Framework EDI component

Option Explicit
Private oEdiDoc As Fredi.ediDocument
Private oSchema As Fredi.ediSchema
Private oSchemas As Fredi.ediSchemas
Private oInterchange As Fredi.ediInterchange
Private oGroup As Fredi.ediGroup
Private oTransactionset As Fredi.ediTransactionSet
Private oSegment As Fredi.ediDataSegment
Private sSefFile As String
Private sEdiFile As String

Private Sub cmdGenerate_Click()
    Dim i As Integer
    Dim nCount As Integer
    Dim sPath As String
    Dim sEntity As String
    Dim nIndex As Integer
    Dim sSefFile As String
    Dim sEdiFile As String
    Dim nInstance As Integer
    Dim iItemCount As Integer
    Dim nTotalQty As Double
    Dim nTotalWeight As Double
    
    Dim nShipmentCounter As Integer
    Dim nShipments As Integer
    Dim nOrderCounter As Integer
    Dim nOrders As Integer
    Dim nItemCounter As Integer
    Dim nItems As Integer

    Dim nHlCounter As Integer
    Dim nHlShipmentParent As Integer
    Dim nHlOrderParent As Integer
    Dim nHlItemParent As Integer
    
    
    Me.MousePointer = vbHourglass
    sPath = App.Path & "\"
    
    sSefFile = "856_X12-4010.sef"
    sEdiFile = "856OUTPUT.x12"
    
    'instantiate edi document object
    Set oEdiDoc = New Fredi.ediDocument
    
    'change cursor type to forwardwrite to improve performance
    oEdiDoc.CursorType = Cursor_ForwardWrite
    
    'disable internal standard reference library to make certian SEF file is used
    Set oSchemas = oEdiDoc.GetSchemas
    oSchemas.EnableStandardReference = False
    
    'load sef file
    Set oSchema = oEdiDoc.ImportSchema(sPath & sSefFile, 0)
    
    'set terminators
    oEdiDoc.SegmentTerminator = "~" & vbCrLf
    oEdiDoc.ElementTerminator = "*"
    oEdiDoc.CompositeTerminator = ">"
    
    'create ISA segment
    Set oInterchange = oEdiDoc.CreateInterchange("X", "004010")
    Set oSegment = oInterchange.GetDataSegmentHeader
    oSegment.DataElementValue(1) = "00"
    oSegment.DataElementValue(3) = "00"
    oSegment.DataElementValue(5) = "14"
    oSegment.DataElementValue(6) = "0073268795005"
    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) = ">"
    
    'create GS segment
    Set oGroup = oInterchange.CreateGroup("004010")
    Set oSegment = oGroup.GetDataSegmentHeader
    oSegment.DataElementValue(1) = "SH"
    oSegment.DataElementValue(2) = "007326879"
    oSegment.DataElementValue(3) = "RECEIVERGS"
    oSegment.DataElementValue(4) = "19960807"
    oSegment.DataElementValue(5) = "1548"
    oSegment.DataElementValue(6) = "1"
    oSegment.DataElementValue(7) = "X"
    oSegment.DataElementValue(8) = "004010"
    
    'create ST segment
    Set oTransactionset = oGroup.CreateTransactionSet("856")
    Set oSegment = oTransactionset.GetDataSegmentHeader
    oSegment.DataElementValue(1) = "856"
    oSegment.DataElementValue(2) = "00001"
    
    'create BSN segment
    Set oSegment = oTransactionset.CreateDataSegment("BSN")
    oSegment.DataElementValue(1) = "00"
    oSegment.DataElementValue(2) = txtShipmentNo.Text
    oSegment.DataElementValue(3) = "20020301"
    oSegment.DataElementValue(4) = "1340"
    oSegment.DataElementValue(5) = "0002"
    
    'hypothetical numbers of shipments, orders and items
    nShipmentCounter = 1
    nShipments = 1
    nOrderCounter = 1
    nOrders = 1
    nItemCounter = 1
    nItems = 6
    
    '********************************************************************************************
    'HL - HIERARCHICAL LEVEL - SHIPMENTS ********************************************************
    Do While nShipmentCounter <= nShipments
    
        nHlCounter = nHlCounter + 1
        nHlOrderParent = nHlCounter
    
        Set oSegment = oTransactionset.CreateDataSegment("HL\HL")
        oSegment.DataElementValue(1) = nHlCounter
        oSegment.DataElementValue(2) = ""
        oSegment.DataElementValue(3) = "S"
        oSegment.DataElementValue(4) = "1"
        
        nTotalQty = 0
        nTotalWeight = 0
        For i = 0 To 7
            If Len(Trim(txtCatalogNo(i).Text)) > 0 Then
                nTotalQty = nTotalQty + Val(txtQty(i).Text)
                nTotalWeight = nTotalWeight + Val(txtWeights(i).Text)
            End If
        Next
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\TD1")
        oSegment.DataElementValue(1) = "TKT"
        oSegment.DataElementValue(2) = nTotalQty
        oSegment.DataElementValue(6) = "A3"
        oSegment.DataElementValue(7) = nTotalWeight
        oSegment.DataElementValue(8) = "01"
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\TD5")
        oSegment.DataElementValue(2) = 2
        oSegment.DataElementValue(3) = txtRoutingCode.Text
        oSegment.DataElementValue(4) = "M"
        oSegment.DataElementValue(5) = txtRoutingDesc.Text
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\TD3")
        oSegment.DataElementValue(1) = txtEquipCode.Text
        oSegment.DataElementValue(2) = txtEquipInitial.Text
        oSegment.DataElementValue(3) = txtEquipNo.Text
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\REF")
        oSegment.DataElementValue(1) = "BM"
        oSegment.DataElementValue(2) = txtBOLNo.Text
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\DTM")
        oSegment.DataElementValue(1) = "011"
        oSegment.DataElementValue(2) = Format(txtShippedDate.Text, "YYYYMMDD")
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\DTM(2)")
        oSegment.DataElementValue(1) = "017"
        oSegment.DataElementValue(2) = Format(txtEstDeliveryDate.Text, "YYYYMMDD")
        
        'Bill To address information
        Set oSegment = oTransactionset.CreateDataSegment("HL\N1\N1")
        oSegment.DataElementValue(1) = "BT"
        oSegment.DataElementValue(2) = txtBillToName.Text
        oSegment.DataElementValue(3) = "1"
        oSegment.DataElementValue(4) = txtBillToDUNS.Text
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\N1\N3")
        oSegment.DataElementValue(1) = txtBillToAddress.Text
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\N1\N4")
        oSegment.DataElementValue(1) = txtBillToCity.Text
        oSegment.DataElementValue(2) = txtBillToState.Text
        oSegment.DataElementValue(3) = txtBillToZip.Text
        
        'Ship-To address information
        Set oSegment = oTransactionset.CreateDataSegment("HL\N1(2)\N1") 'Note: it is not necessary to include the loop instance counter (2) in the syntx when cursor type is set to forwardwrite
        oSegment.DataElementValue(1) = "ST"
        oSegment.DataElementValue(2) = txtShipToName.Text
        oSegment.DataElementValue(3) = "1"
        oSegment.DataElementValue(4) = txtShipToDUNS.Text
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\N1(2)\N3")
        oSegment.DataElementValue(1) = txtShipToAddress.Text
        
        Set oSegment = oTransactionset.CreateDataSegment("HL\N1(2)\N4")
        oSegment.DataElementValue(1) = txtShipToCity.Text
        oSegment.DataElementValue(2) = txtShipToState.Text
        oSegment.DataElementValue(3) = txtShipToZip.Text
    
        '********************************************************************************************
        'HL - HIERARCHICAL LEVEL - ORDER ************************************************************
        Do While nOrderCounter <= nOrders

            nHlCounter = nHlCounter + 1
            nHlItemParent = nHlCounter
        
            Set oSegment = oTransactionset.CreateDataSegment("HL\HL")
            oSegment.DataElementValue(1) = nHlCounter
            oSegment.DataElementValue(2) = nHlOrderParent
            oSegment.DataElementValue(3) = "O"
            oSegment.DataElementValue(4) = "1"
            
            Set oSegment = oTransactionset.CreateDataSegment("HL\PRF")
            oSegment.DataElementValue(1) = txtPONumber.Text
            oSegment.DataElementValue(2) = txtReleaseNo.Text
            oSegment.DataElementValue(3) = ""
            oSegment.DataElementValue(4) = Format(txtPODate.Text, "YYYYMMDD")
            
            Set oSegment = oTransactionset.CreateDataSegment("HL\REF")
            oSegment.DataElementValue(1) = "IV"
            oSegment.DataElementValue(2) = txtInvoiceNo.Text
            
            Set oSegment = oTransactionset.CreateDataSegment("HL\FOB")
            oSegment.DataElementValue(1) = "PS"
            oSegment.DataElementValue(2) = "DE"
            oSegment.DataElementValue(3) = ""
            
            '********************************************************************************************
            'HL - HIERARCHICAL LEVEL - ITEMS ************************************************************
            Do While nItemCounter <= nItems
                nHlCounter = nHlCounter + 1
            
                Set oSegment = oTransactionset.CreateDataSegment("HL\HL")
                oSegment.DataElementValue(1) = nHlCounter
                oSegment.DataElementValue(2) = nHlItemParent
                oSegment.DataElementValue(3) = "I"
                oSegment.DataElementValue(4) = "0"
            
                Set oSegment = oTransactionset.CreateDataSegment("HL\LIN")
                oSegment.DataElementValue(1) = nItemCounter
                oSegment.DataElementValue(2) = "UA"
                oSegment.DataElementValue(3) = txtEAN(nItemCounter - 1).Text
            
                Set oSegment = oTransactionset.CreateDataSegment("HL\SN1")
                oSegment.DataElementValue(2) = txtQtyShipped(nItemCounter - 1).Text
                oSegment.DataElementValue(3) = txtUnit(nItemCounter - 1).Text
                oSegment.DataElementValue(5) = txtQty(nItemCounter - 1).Text
                oSegment.DataElementValue(6) = txtUnit(nItemCounter - 1).Text
                oSegment.DataElementValue(8) = txtStatusCode(nItemCounter - 1).Text
                
                Set oSegment = oTransactionset.CreateDataSegment("HL\PRF")
                oSegment.DataElementValue(1) = txtPONumber.Text
                oSegment.DataElementValue(2) = txtReleaseNo.Text
                oSegment.DataElementValue(3) = ""
                oSegment.DataElementValue(4) = Format(txtPODate.Text, "YYYYMMDD")
                
                Set oSegment = oTransactionset.CreateDataSegment("HL\PID")
                oSegment.DataElementValue(1) = "F"
                oSegment.DataElementValue(5) = txtDescription(nItemCounter - 1).Text
        
                nItemCounter = nItemCounter + 1 'increment nItemCounter
            Loop    'nItemCounter

            nOrderCounter = nOrderCounter + 1   'increment nOrderCounter
        Loop    'nOrderCounter

        nShipmentCounter = nShipmentCounter + 1     'increment nShipmentCounter
    Loop    'Shipment
    
    'CTT - TRANSACTION TOTALS
    Set oSegment = oTransactionset.CreateDataSegment("CTT")
    oSegment.DataElementValue(1) = nItems      'Number of Line Items
    
    'save edi object to file
    oEdiDoc.Save sPath & sEdiFile
    
    Me.MousePointer = vbNormal
    MsgBox ("Done. Output = " & sPath & sEdiFile)
    cmdGenerate.Enabled = False
    
End Sub