VERSION 5.00
Object = "{09E60688-07A2-11CF-BD27-10005AE6AFFA}#1.0#0"; "rrw32.ocx"
Begin VB.Form frmMain 
   Caption         =   "Main Menu"
   ClientHeight    =   8265
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   11880
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   8265
   ScaleWidth      =   11880
   StartUpPosition =   3  'Windows Default
   Begin RrocxLib.RRReport rrHistory 
      Left            =   8610
      Top             =   -30
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      WindowControlBox=   0   'False
      WindowBorderStyle=   0
      WindowTitle     =   ""
      Destination     =   1
      PrintFileName   =   ""
      ReportName      =   "C:\CMSWIN70\SWJData\Oe00005xc.rrw"
      ReportLibrary   =   ""
      MemoFileName    =   "?"
      Printer         =   ""
      Port            =   ""
      MasterTable     =   "C:\CMSWIN70\SWJData\Swjpshis.dbf"
      Filter          =   ""
      RelatedTables   =   ""
      Query           =   2
      WindowParentHandle=   0
      DataDirectory   =   ""
      ReportDirectory =   ""
      ImageDirectory  =   ""
      LastErrorCode   =   0
      LastErrorString =   ""
      LastErrorPage   =   0
      SuppressTitle   =   0   'False
      Parameters      =   ""
      DBContainer     =   ""
      SortFields      =   ""
      GroupFields     =   ""
      ReportSortFields=   "+PSHID->PSHDINVNO;+PSHIS->PSHIREC;+PSHID->Group2"
      ReportGroupFields=   "PSHIS->PSHIREC;PSHID->Group2"
      ControlFile     =   ""
      SuitableGroupFields=   $"frmMain.frx":08CA
      SuitableSortFields=   $"frmMain.frx":1D2B
      ReportsRTString =   "OESHI=Swjoeshi.dbf,swjOESHI.MDX,OESHCODE;PSHID=Swjpshid.dbf,SWJPSHID.MDX,PSHDREC;"
      RelatedTablesString=   ""
      ParametersString=   ""
      ReportParametersString=   "InvNo=;RI_FIELD1=;RI_FIELD2=;RI_FIELD3=;RI_FIELD4=;RI_FLAG2=;RI_FIELD5=;RI_FIELD6=;RI_FLAG6=;RI_FLAG7=;"
      StatusFileName  =   ""
      MasterIndex     =   ""
      Scope           =   2
      LowScope        =   ""
      HighScope       =   ""
      IndexExtension  =   0
      PageSize        =   ""
   End
   Begin VB.ComboBox cboARCode 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   11040
      Style           =   2  'Dropdown List
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   105
      Width           =   735
   End
   Begin VB.ListBox lstDetail 
      Height          =   3960
      Left            =   75
      Sorted          =   -1  'True
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   4200
      Width           =   11775
   End
   Begin VB.ListBox lstInvoice 
      Height          =   3375
      Left            =   5820
      Sorted          =   -1  'True
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   480
      Width           =   5985
   End
   Begin VB.ListBox lstCustomer 
      Height          =   3375
      Left            =   60
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   480
      Width           =   5655
   End
   Begin VB.Label lblMessage 
      Alignment       =   2  'Center
      BackColor       =   &H0080FFFF&
      Caption         =   "Creating List - Please Wait!"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   300
      Left            =   1740
      TabIndex        =   8
      Top             =   150
      Visible         =   0   'False
      Width           =   3735
   End
   Begin VB.Label lblARCode 
      Alignment       =   1  'Right Justify
      Caption         =   "AR Code:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   9720
      TabIndex        =   7
      Top             =   210
      Width           =   1260
   End
   Begin VB.Label lblDetail 
      AutoSize        =   -1  'True
      Caption         =   "Invoice Detail"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   120
      TabIndex        =   5
      Top             =   3960
      Width           =   1440
   End
   Begin VB.Label lblInvList 
      AutoSize        =   -1  'True
      Caption         =   "Customer Invoice List"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   5820
      TabIndex        =   2
      Top             =   225
      Width           =   2220
   End
   Begin VB.Label lblCustomer 
      AutoSize        =   -1  'True
      Caption         =   "Customer List"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   60
      TabIndex        =   1
      Top             =   225
      Width           =   1410
   End
   Begin VB.Menu mnuPrint 
      Caption         =   "&Print Form"
   End
   Begin VB.Menu mnuInvoice 
      Caption         =   "Print I&nvoice"
   End
   Begin VB.Menu mnuSwitch 
      Caption         =   "&Inventory"
   End
   Begin VB.Menu mnuARCode 
      Caption         =   "AR &Code"
   End
   Begin VB.Menu mnuExit 
      Caption         =   "E&xit"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mstrCUSTOMER As String * 20, mstrINVOICE As String * 15
Dim mlngINVOICE As Long, mstrCUSTOMER2 As String * 20
Dim mintPOS As Integer
Dim mstrCUSTNO As String, mstrCUSTNAME As String
Dim moRSINVOICE As ADODB.Recordset
Dim moRSDETAIL As ADODB.Recordset

Private Sub cboARCode_Click()
   If cboARCode.ListIndex = -1 Then
      Exit Sub
   End If
   Call ButtonReset
   lstInvoice.Clear
   lstDetail.Clear
   Me.MousePointer = vbHourglass
   gstrARCODE = cboARCode.Text
   Call CustomerLoad
   Me.MousePointer = vbDefault
   Call ButtonReset
   cboARCode.Enabled = False

End Sub

Private Sub cmdExit_Click()
   Unload Me
End Sub

Private Sub CustomerFind()
Dim oSTATUS As Long
Dim strSQL As String, strSQLL As String
Dim strLINE As String, strCode As String, strCompany As String
Dim strNAME As String, strCUST As String, lngRECORD As Long
Dim lngNAME As Long

'TAG4 pointers
Dim lngCustTag As Long
   
   On Error GoTo Error_EH
   
   strSQL = gstrCOMPANY & "ARMSD"
   db2 = d4open(cb, fPath + strSQL)
   
   lngCustTag = d4tag(db2, "AR_CUST")
'    codeTag = d4tag(db, "CODE_TAG")
   rc2 = d4seek(db2, mstrCUSTOMER2)


'   If d4top(db2) = r4success Then
   If rc2 = r4success Then

      oSTATUS = d4deleted(db2)
      If oSTATUS = 0 Then
         lngRECORD = d4field(db2, "AR_CUST")
         mstrCUSTNO = f4str(lngRECORD)
         lngNAME = d4field(db2, "AR_NAME")
         mstrCUSTNAME = f4str(lngNAME)
      End If
   End If
   
   rc = d4close(db2)
   
   Exit Sub
   
Error_EH:
   gstrMODULE = "Form Main - Module CustomerFind"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

Private Sub CustomerLoad()
Dim oSTATUS As Long
Dim strSQL As String, strSQLL As String
Dim strLINE As String, strCode As String, strCompany As String
Dim strNAME As String, strCUST As String
Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long
Dim lngNAME As Long, lngCUST As Long

'TAG4 pointers
Dim lngCustTag As Long
   
   On Error GoTo Error_EH
   
   aTabs(0) = 100
   aTabs(1) = 120
   aTabs(2) = 200
   
   strSQL = gstrCOMPANY & "ARMSD"
   db = d4open(cb, fPath + strSQL)
   
   lngRET = SendMessage(lstCustomer.hWnd, LB_SETTABSTOPS, 3, aTabs(0))
   strSQLL = cboARCode.Text
   rc = d4top(db)

   lstCustomer.Clear

   If d4top(db) = r4success Then

   Do
      oSTATUS = d4deleted(db)
         If oSTATUS = 0 Then
'            lngRECORD = d4field(db, "AR_CODE")
'            strCode = f4str(lngRECORD)
'            If strCode = strSQLL Then
               With lstCustomer
                  lngNAME = d4field(db, "AR_NAME")
                  lngCUST = d4field(db, "AR_CUST")
                  strNAME = f4str(lngNAME)
                  strCUST = f4str(lngCUST)
                  .AddItem RTrim$(strCUST) & vbTab & Trim$(strNAME)
               End With
'            End If
         End If
         rc = d4skip(db, 1)
      Loop While rc = r4success
   End If
   
   rc = d4close(db)
   
   If lstCustomer.ListCount Then
      lstCustomer.ListIndex = 0
   Else
      MsgBox "No Customers Were Found For That AR Code", vbInformation + vbOKOnly, "No Customers"
   End If
    
   Exit Sub
   
Error_EH:
   gstrMODULE = "Form Main - Module CustomerLoad"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

Private Sub InventoryLoad()
Dim oSTATUS As Long
Dim strSQL As String, strSQLL As String
Dim strLINE As String, strCode As String, strCompany As String
Dim strNAME As String, strCUST As String
Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long
Dim lngNAME As Long, lngCUST As Long

'TAG4 pointers
Dim lngCustTag As Long
   
   On Error GoTo Error_EH
   
   aTabs(0) = 100
   aTabs(1) = 120
   aTabs(2) = 200
   
   strSQL = gstrCOMPANY & "INMAS"
   db = d4open(cb, fPath + strSQL)
   
   lngRET = SendMessage(lstCustomer.hWnd, LB_SETTABSTOPS, 3, aTabs(0))
   strSQLL = cboARCode.Text
   rc = d4top(db)

   lstCustomer.Clear

   If d4top(db) = r4success Then

   Do
      oSTATUS = d4deleted(db)
         If oSTATUS = 0 Then
'            lngRECORD = d4field(db, "AR_CODE")
'            strCode = f4str(lngRECORD)
'            If strCode = strSQLL Then
               With lstCustomer
                  lngNAME = d4field(db, "IN_STOCK")
                  lngCUST = d4field(db, "IN_DES")
                  strNAME = f4str(lngNAME)
                  strCUST = f4str(lngCUST)
                  .AddItem RTrim$(strNAME) & vbTab & Trim$(strCUST)
               End With
'            End If
         End If
         rc = d4skip(db, 1)
      Loop While rc = r4success
   End If
   
   rc = d4close(db)
   
   If lstCustomer.ListCount Then
      lstCustomer.ListIndex = 0
   Else
      MsgBox "No Inventory Items Were Found For That AR Code", vbInformation + vbOKOnly, "No Customers"
   End If
    
   Exit Sub
   
Error_EH:
   gstrMODULE = "Form Main - Module CustomerLoad"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

Private Sub cmdSwitch_Click()
   lblMessage.Visible = True
   If mnuSwitch.caption = "&Inventory" Then
'      lblMessage.Visible = True
      Call ButtonReset
      DoEvents
      lstCustomer.Clear
      lstDetail.Clear
      lstInvoice.Clear
      cboARCode.ListIndex = -1
      lstInvoice.Visible = False
      lblInvList.Visible = False
      cboARCode.Visible = False
      lblARCode.Visible = False
'      lstDetail.Sorted = False
      lblCustomer.caption = "Inventory Items"
      lblDetail.caption = "Item Sales History"
      mnuSwitch.caption = "&Invoices"
      gboolTYPE = False
      Call InventoryLoad
      Call ButtonReset
      lstCustomer.SetFocus
      lblMessage.Visible = False
      Exit Sub
   End If
   If mnuSwitch.caption = "&Invoices" Then
      Call ButtonReset
      DoEvents
'      lblMessage.Visible = True
      lstCustomer.Clear
      lstDetail.Clear
      lstInvoice.Clear
      cboARCode.ListIndex = 0
      lstInvoice.Visible = True
      lblInvList.Visible = True
      cboARCode.Visible = True
      lblARCode.Visible = True
'      lstDetail.Sorted = True
      lblCustomer.caption = "Customer List"
      lblDetail.caption = "Invoice Detail"
      mnuSwitch.caption = "&Inventory"
      gboolTYPE = True
      Call ButtonReset
      lblMessage.Visible = False
      Exit Sub
   End If
End Sub

Private Sub Form_Load()
Dim oRS As Recordset, strSQL As String, strFILE As String
   
'   gstrCOMPANY = "LVT"
   gstrCOMPANY = "SWJ"
'   gstrCOMPANY = "JHD"
'   gstrCOMPANY = "DMO"
'   gstrCOMPANY = "PSI"
'   gstrCOMPANY = "ACE"
'   gstrCOMPANY = "201"
'   gstrCOMPANY = "202"
'   gstrCOMPANY = "200"
'   gstrCOMPANY = "RMX"
'   gstrCOMPANY = "TSS"

   gboolTYPE = True
   
   fPath = App.Path + "\"
   
   Call ARCodeLoad
End Sub
Private Sub ARCodeLoad()
Dim ARCode As Long, oSTATUS As Long
Dim strSQL As String, strFILE As String

   strFILE = gstrCOMPANY & "ARCOD.DBF"
   
   db = d4open(cb, fPath + strFILE)
   
   cboARCode.Clear

   If d4top(db) = r4success Then
      Do
      oSTATUS = d4deleted(db)
         If oSTATUS = 0 Then
            With cboARCode
               ARCode = d4field(db, "ARCOCODE")
               .AddItem f4str(ARCode)
            End With
         End If
         rc = d4skip(db, 1)
      Loop While rc = r4success
   End If
   rc = d4close(db)
   cboARCode.ListIndex = 0
End Sub
Private Sub InvoiceLoad()
Dim strSQL As String, oSTATUS As Long
Dim strLINE As String
Dim lngRET As Long, aTabs(4) As Long, strAmount As String * 12

'FIELD4 pointers
Dim lngNAME As Long, lngCUST As Long, lngINVTOT As Long
Dim lngINVNO As Long, lngINVDATE As Long, lngINVPOA As Long
Dim lngRECORD As Long

'TAG4 pointers
Dim lngCustTag As Long

'INDEX4 pointers
Dim ind1 As Long

'Field value holders
Dim dblINVTOT As Double, dblINVPOA As Double, dblAMOUNT As Double
Dim strNAME As String, strCUST As String, lngPSHIREC As Long
Dim strINVNO As String, strINVDATE As String, strNEWDATE As String
Dim lngSPC As Long, lngTERMS As Long
Dim strSPC As String, strTERMS As String

'Others
Dim fldArray As Long, tagArray As Long
Dim FileName As String, db2 As Long

Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer
Dim rc1 As Integer, rc2 As Integer
   
   On Error GoTo Error_EH
   
   cb = code4init
   
   aTabs(0) = 70
   aTabs(1) = 130
   aTabs(2) = 190
   aTabs(3) = 230
   
   lngRET = SendMessage(lstInvoice.hWnd, LB_SETTABSTOPS, 5, aTabs(0))
   strSQL = gstrCOMPANY & "PSHIS"
   
   db = d4open(cb, fPath + strSQL)
   lngCustTag = d4tag(db, "PSHINUM")
   Call d4tagSelect(db, lngCustTag)
   
   rc = d4seek(db, mstrCUSTOMER)
   
   lstInvoice.Clear

   Do Until rc <> r4success
      oSTATUS = d4deleted(db)
      If oSTATUS = 0 Then
   
         With lstInvoice
            lngINVTOT = d4field(db, "PSHITOT")
            lngINVPOA = d4field(db, "PSHIPOA")
            lngINVDATE = d4field(db, "PSHIDATE")
            lngINVNO = d4field(db, "PSHIINVNO")
            lngRECORD = d4field(db, "PSHIREC")
            lngSPC = d4field(db, "PSHISPC")
            lngTERMS = d4field(db, "PSHITERM")
            
            dblINVTOT = f4double(lngINVTOT)
            dblINVPOA = f4double(lngINVPOA)
            strINVDATE = f4str(lngINVDATE)
            Call date4format(strINVDATE, strNEWDATE, "MM/DD/CCYY")
            strINVNO = f4str(lngINVNO)
            lngPSHIREC = f4long(lngRECORD)
            strSPC = f4str(lngSPC)
            strTERMS = f4str(lngTERMS)
            
            If dblINVTOT > 0 Then
               RSet strAmount = FormatCurrency(dblINVTOT, 2)
            ElseIf dblINVPOA > 0 Then
               RSet strAmount = FormatCurrency((dblINVPOA * -1), 2)
            Else
               RSet strAmount = FormatNumber(0, 2)
            End If
            strLINE = strINVNO & vbTab & strNEWDATE & vbTab & strAmount & vbTab & strSPC & vbTab & strTERMS
            .AddItem strLINE
            .ItemData(.NewIndex) = lngPSHIREC
         End With
         End If
         rc = d4seekNext(db, mstrCUSTOMER)
      
      Loop
   
   If lstInvoice.ListCount Then
      lstInvoice.ListIndex = 0
   Else
      MsgBox "No Invoice Information Found For The Selected Customer", vbOKOnly, "No Invoices"
   End If
   
   rc = d4close(db)
   Exit Sub
   
Error_EH:
   gstrMODULE = "Form Main - Module CustomerLoad"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

Private Sub HistoryLoad()
Dim strSQL As String, oSTATUS As Long, strINDEX As String
Dim strLINE As String, strLINE2 As String
Dim lngRET As Long, aTabs(7) As Long, strAmount As String * 12

'FIELD4 pointers
Dim lngNAME As Long, lngCUST As Long, lngINVTOT As Long
Dim lngINVNO As Long, lngINVDATE As Long, lngTYPE As Long
Dim lngRECORD As Long, lngQTY As Long, lngPRICE As Long
Dim lngDOC As Long, lngSTOCK As Long

'TAG4 pointers
Dim lngCustTag As Long

'INDEX4 pointers
Dim ind1 As Long

'Field value holders
Dim dblINVTOT As Double, dblTYPE As Double, dblAMOUNT As Double
Dim strNAME As String, strCUST As String, lngPSHIREC As Long
Dim strINVNO As String, strINVDATE As String, strNEWDATE As String
Dim dblQTY As Double, dblPRICE As Double, strDOC As String, strSTOCK As String
Dim strTYPE As String, lngCOST As Long, dblCOST As Double, strCOST As String * 12

'Others
Dim fldArray As Long, tagArray As Long
Dim FileName As String, db2 As Long

Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer
Dim rc1 As Integer, rc2 As Integer
Dim indexInfo() As TAG4INFO
   
   On Error GoTo Error_EH
   
   cb = code4init
   
   aTabs(0) = 50
   aTabs(1) = 200
   aTabs(2) = 300
   aTabs(3) = 330
   aTabs(4) = 360
   aTabs(5) = 380
   aTabs(6) = 410
   aTabs(7) = 450
   
   lngRET = SendMessage(lstDetail.hWnd, LB_SETTABSTOPS, 8, aTabs(0))
   strSQL = gstrCOMPANY & "INHIS"
   
'   ReDim indexInfo(1) As TAG4INFO
'   indexInfo(1).name = "INDESDATE"
'   indexInfo(1).expression = "UPPER(INHISTOCK) + DTOS(INHIDATE)"
'   indexInfo(1).descending = r4descending
   
   db = d4open(cb, fPath + strSQL)
'   strINDEX = fPath + "INHIX"
'   ind1 = i4open(db, strINDEX) ', indexInfo())
'   ind1 = i4create(db, strINDEX, indexInfo())
'   rc = i4reindex(ind1)
'   On Error GoTo Error_EH
'   i4close (ind1)
   
   lngCustTag = d4tag(db, "INHISTOCK")
'   lngCustTag = i4tag(ind1, "INDESDATE")
   Call d4tagSelect(db, ind1)
   
   rc = d4seek(db, mstrCUSTOMER)
   lstDetail.Clear

   Do Until rc <> r4success
      oSTATUS = d4deleted(db)
      mstrCUSTOMER2 = ""
      If oSTATUS = 0 Then
         With lstDetail
            lngNAME = d4field(db, "INHICV")
            lngDOC = d4field(db, "INHIDOC")
            lngINVDATE = d4field(db, "INHIDATE")
            lngINVNO = d4field(db, "INHISOURCE")
            lngRECORD = d4field(db, "INHIUNIQ")
            lngTYPE = d4field(db, "INHITYPE")
            lngPRICE = d4field(db, "INHIPRICE")
            lngQTY = d4field(db, "INHIQTY")
            lngCOST = d4field(db, "INHICOST")
            
            strDOC = f4str(lngDOC)
            strNAME = f4str(lngNAME)
            If strNAME <> "" Then
               If strNAME <> mstrCUSTNO Then
                  mstrCUSTNO = ""
                  mstrCUSTNAME = ""
                  mstrCUSTOMER2 = strNAME
                  Call CustomerFind
               End If
            Else
               mstrCUSTNO = ""
               mstrCUSTNAME = ""
            End If
            strINVDATE = f4str(lngINVDATE)
            Call date4format(strINVDATE, strNEWDATE, "CCYY/MM/DD")
            dblPRICE = f4double(lngPRICE)
            RSet strAmount = FormatCurrency(dblPRICE, 2)
            strINVNO = f4str(lngINVNO)
            lngPSHIREC = f4long(lngRECORD)
            dblTYPE = f4double(lngTYPE)
            dblQTY = f4double(lngQTY)
            dblCOST = f4double(lngCOST)
            If dblQTY > 0 Then
               dblCOST = dblCOST / dblQTY
            End If
            RSet strCOST = FormatCurrency(dblCOST, 2)
            
            If dblTYPE = 0 Then
               strTYPE = "ADD"
            ElseIf dblTYPE = 1 Then
               strTYPE = "SUB"
            Else
               strTYPE = "TRANS"
            End If
            strLINE = strNEWDATE & vbTab & mstrCUSTNAME & vbTab & strDOC & vbTab & strTYPE & vbTab ' & strINVNO & vbTab & dblQTY & vbTab & strAmount & vbTab & strCOST
            strLINE2 = strINVNO & vbTab & dblQTY & vbTab & strAmount & vbTab & strCOST
            strLINE = strLINE & strLINE2
'            strLINE = strNEWDATE & vbTab & mstrCUSTNAME & vbTab & strDOC & vbTab & strTYPE & vbTab & strINVNO & vbTab & dblQTY & vbTab & strAmount & vbTab & strCOST
'            strLINE = strINVNO & vbTab & strNEWDATE & vbTab & strAmount
            .AddItem strLINE
            .ItemData(.NewIndex) = lngPSHIREC
         End With
         End If
         rc = d4seekNext(db, mstrCUSTOMER)
      
      Loop
   
   If lstDetail.ListCount Then
      lstDetail.ListIndex = 0
   Else
      MsgBox "No Inventory History Information Found For The Selected Stock Item", vbOKOnly, "No Invoices"
   End If
   
   rc = d4close(db)
   Exit Sub
   
Error_EH:
   gstrMODULE = "Form Main - Module HistoryLoad"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   rc = code4initUndo(cb)
End Sub

Private Sub lstCustomer_Click()
   lstInvoice.Clear
   lstDetail.Clear

End Sub

Private Sub DetailLoad()
'FIELD4 pointers
Dim lngTYPE As Long, lngDETAIL As Long
Dim lngSTOCK As Long, lngDESC As Long, lngEXTTOT As Long
Dim lngQTY As Long
Dim lngRECORD As Long

'TAG4 pointers
Dim lngInvTag As Long

'INDEX4 pointers
Dim ind1 As Long

'Field value holders
Dim intTYPE As Integer, intDETAIL As Integer, dblEXTTOT As Double
Dim strSTOCK As String, strDESC As String, lngPSHDREC As Long
Dim strQTY As String, strDETAIL As String

'Others
Dim strSQL As String, strFILE As String, oSTATUS As Long
Dim strLINE As String, strCode As String, strCompany As String

Dim lngRET As Long, aTabs(4) As Long, strAmount As String * 12
   On Error GoTo Error_EH
   
   aTabs(0) = 20
   aTabs(1) = 40
   aTabs(2) = 120
   aTabs(3) = 400
   aTabs(4) = 450
   
   
   lngRET = SendMessage(lstDetail.hWnd, LB_SETTABSTOPS, 5, aTabs(0))
   
   mintPOS = InStr(1, lstInvoice.Text, (Chr(9))) ',vbTextCompare)
   mstrINVOICE = Left(lstInvoice.Text, (mintPOS - 1))
   
   strSQL = gstrCOMPANY & "PSHID"
   
   lstDetail.Clear
   db = d4open(cb, fPath + strSQL)
   lngInvTag = d4tag(db, "PSHDINVNO")
   Call d4tagSelect(db, lngInvTag)
   
   rc = d4seek(db, mstrINVOICE)

   Do Until rc <> r4success
      oSTATUS = d4deleted(db)
      If oSTATUS = 0 Then
         With lstDetail
            lngTYPE = d4field(db, "PSHDLTYPE")
            lngDETAIL = d4field(db, "PSHDDETAIL")
            lngSTOCK = d4field(db, "PSHDSTK")
            lngDESC = d4field(db, "PSHDDES")
            lngEXTTOT = d4field(db, "PSHDEXT")
            lngQTY = d4field(db, "PSHDQTY")
            
            dblEXTTOT = f4double(lngEXTTOT)
            intTYPE = f4int(lngTYPE)
            intDETAIL = f4int(lngDETAIL)
            strDETAIL = Format(intDETAIL, "000")
            strSTOCK = f4str(lngSTOCK)
            strQTY = f4str(lngQTY)
            strDESC = f4str(lngDESC)
            
            RSet strAmount = FormatCurrency(dblEXTTOT, 2)
            strLINE = strDETAIL & vbTab & intTYPE & vbTab & strSTOCK
            strLINE = strLINE & vbTab & strDESC & vbTab & strQTY & vbTab & strAmount
            .AddItem strLINE
         End With
      End If
      rc = d4seekNext(db, mstrINVOICE)
      
   Loop
   rc = d4close(db)
   
   If lstDetail.ListCount = 0 Then
      MsgBox "No Detail Information Found For The Selected Invoice - THIS MAY BE A PAYMENT", vbOKOnly, "No Invoice Detail"
   End If
   Exit Sub
   
Error_EH:
   gstrMODULE = "Form Main - Module DetailLoad"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

Private Sub lstCustomer_DblClick()
   On Error GoTo Error_EH
   Me.MousePointer = vbHourglass
   Call ButtonReset
   If gboolTYPE = True Then
      If lstCustomer.ListIndex <> -1 Then
         mintPOS = InStr(1, lstCustomer.Text, (Chr(9))) ',vbTextCompare)
         mstrCUSTOMER = Left(lstCustomer.Text, (mintPOS - 1))
         Call InvoiceLoad
         lstCustomer.SetFocus
      End If
   ElseIf gboolTYPE = False Then
      If lstCustomer.ListIndex <> -1 Then
         mintPOS = InStr(1, lstCustomer.Text, (Chr(9))) ',vbTextCompare)
         mstrCUSTOMER = Left(lstCustomer.Text, (mintPOS - 1))
         Call HistoryLoad
         lstCustomer.SetFocus
      End If
   End If
   Call ButtonReset
   Me.MousePointer = vbDefault
   Exit Sub
   
Error_EH:
   gstrMODULE = "Form Main - Module lstCustomer_DblClick"
   Call ErrorHandler2
   gstrMODULE = ""
   Call ButtonReset
   Me.MousePointer = vbDefault
   Exit Sub

End Sub

Private Sub lstInvoice_Click()
   On Error GoTo Error_EH
   Me.MousePointer = vbHourglass
   
   If gboolTYPE = True Then
   
      lstDetail.Clear
      DoEvents
      
      Call DetailLoad
      
      lstCustomer.SetFocus
   End If
   Me.MousePointer = vbDefault
   Exit Sub
   
Error_EH:
   gstrMODULE = "Form Main - Module lstInvoice_Click"
   Call ErrorHandler2
   gstrMODULE = ""
   Me.MousePointer = vbDefault
   Exit Sub
End Sub

Private Sub cmdPrint_Click()
   Me.PrintForm
End Sub

Private Sub ARMasLoad()
Dim oRS As Recordset, strSQL As String, strFILE As String
Dim oRSS As Recordset, strSQL2 As String
   On Error Resume Next

   strFILE = gstrCOMPANY & "ARMSD.DBF"
   strSQL = "SELECT * from " & strFILE
   Set oRS = New Recordset
   oRS.Open strSQL, goConn2, adOpenForwardOnly, adLockReadOnly
   
   strSQL2 = "DELETE * FROM tblarMSD"
   goConn.Execute strSQL2
      
   strSQL2 = "SELECT * FROM tblARMSD"
   Set oRSS = New Recordset
   oRSS.Open strSQL2, goConn, adOpenDynamic, adLockOptimistic
   
   Do Until oRS.EOF
      With oRSS
         oRSS.AddNew
         oRSS!AR_CUST = Field2Str(oRS!AR_CUST)
         oRSS!ar_code = Field2Str(oRS!ar_code)
         oRSS!AR_TYPE = Field2Str(oRS!AR_TYPE)
         oRSS!AR_NAME = Field2Str(oRS!AR_NAME)
         oRSS!AR_TERMS = Field2Str(oRS!AR_TERMS)
         oRSS!AR_MISC = Field2Str(oRS!AR_MISC)
         oRSS.Update
         oRS.MoveNext
      End With
   Loop
   oRS.Close
   oRSS.Close
   On Error GoTo 0
   Exit Sub
Error_EH:
   gstrMODULE = "Form Main - Module ARMAS Load"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

Private Sub ButtonReset()

'   cmdExit.Enabled = Not cmdExit.Enabled
'   cmdSwitch.Enabled = Not cmdSwitch.Enabled
'   cmdPrint.Enabled = Not cmdPrint.Enabled
   
   mnuExit.Enabled = Not mnuExit.Enabled
   mnuSwitch.Enabled = Not mnuSwitch.Enabled
   mnuPrint.Enabled = Not mnuPrint.Enabled

End Sub

Private Sub mnuARCode_Click()
   cboARCode.Enabled = Not cboARCode.Enabled
End Sub

Private Sub mnuExit_Click()
   Call cmdExit_Click
End Sub

Private Sub mnuInvoice_Click()
Dim strSQL As String, strINVOICE As String, lngLENGTH As Long, strSQL2 As String
Dim strTABLE As String, strINDEX As String, strRELATE1 As String, strRELATE2 As String
   lngLENGTH = InStr(1, lstInvoice.Text, vbTab, vbTextCompare)
   strINVOICE = Trim$(Mid$(lstInvoice.Text, 1, (lngLENGTH - 1)))
   strTABLE = App.Path & "\" & gstrCOMPANY & "PSHIS.DBF"
   strINDEX = App.Path & "\" & gstrCOMPANY & "PSHIS.MDX"
   strRELATE1 = "OESHI = " & App.Path & "\" & gstrCOMPANY & "OESHI.DBF, " & App.Path & "\" & gstrCOMPANY & "OESHI.MDX, OESHCODE"
   strRELATE2 = "PSHID = " & App.Path & "\" & gstrCOMPANY & "PSHID.DBF, " & App.Path & "\" & gstrCOMPANY & "PSHID.MDX, PSHDREC"
   rrHistory.ReportName = App.Path & "\OE00005xc.rrw"
   rrHistory.RelatedTables(0) = strRELATE1
   rrHistory.RelatedTables(1) = strRELATE2
'   rrHistory.RelatedTables(0) = App.Path & "\" & gstrCOMPANY & "OESHI.DBF"
'   rrHistory.Scope = 2
'   rrHistory.Query = 2
   strSQL = "PSHIS->PSHIINVNO = '" & strINVOICE '& "'"
'   strSQL = "PSHIS->PSHIINVNO is equal to '" & strINVOICE & "'"
'   strSQL = "PSHIS->PSHIREC is equal to PSHID->PSHDREC and PSHIS->PSHIINVNO is equal to '" & strINVOICE
   strSQL = strSQL & "' and PSHIS->PSHISOURCE = 'OE'"
   rrHistory.MasterTable = strTABLE
   rrHistory.MasterIndex = strINDEX
'   rrHistory.MasterIndex
'   rrHistory.Scope = 2
 '  rrHistory.LowScope = strINVOICE
  ' rrHistory.HighScope = strINVOICE
   rrHistory.Query = 2
   rrHistory.filter = strSQL
'   strSQL2 = "InvNo = '" & strINVOICE & "'"
'   rrHistory.ParametersString = strSQL2
'   rrHistory.printer = "HP OfficeJet G Series"
   rrHistory.printer = "?"
   rrHistory.RunReport (1)
   
End Sub

Private Sub mnuPrint_Click()
   Call cmdPrint_Click
End Sub

Private Sub mnuSwitch_Click()
   Call cmdSwitch_Click
End Sub