Option Explicit

'SCHEDULING: This script will be run on demand

'Script parameters
Const constFeedName = "Data Parsing"
Const constRecordLayout = "OncoRecordLayout-A.txt" 
Const constAppTitle = "Record Parsing"
Const constRejectFilesWithIncompleteRecords = False

'Environment-specific feed processing parameters are defined immediately after processing INCLUDES

Dim objFSO
Dim objFile
Dim arrIncludes
Dim iCount
Dim sText
Dim sLog
Dim sErrMsg
Dim sProcName
Dim arrFields
Dim arrRecords
Dim sFile

ReDim arrIncludes(2)
arrIncludes(0) = "GlobalParms.vbs" 'This file must be included first
arrIncludes(1) = "Logger.vbs"
arrIncludes(2) = "GeneralFunctions.vbs"

For iCount = 0 To UBound(arrIncludes)
	sText = fnIncludeScript(arrIncludes(iCount))
	If Not sText = "" Then
		wscript.Echo "Unable to include script " & arrIncludes(iCount) & " (Err " & Split(sText, "|")(0) & "): " & Split(sText, "|")(1)
		wscript.Quit
	End If
Next

REM On Error Resume Next

'Construct error log file name
sLog = constLogFolder & fnConstructLogName(constFeedName, Date)

'Prompt for parameters
'sFile = InputBox("File name with full path:", constAppTitle, "SaveONCOa")
sFile = InputBox("File name with full path:", constAppTitle)
If Trim(sFile) = "" Then wscript.Quit

'Establish required global objects
Set objFSO = CreateObject("Scripting.FileSystemObject")

	'Retrieve record layout
	If fnReadRecordDefinition Then
		If objFSO.FileExists(sFile) Then
			Err.Clear 
			Set objFile = objFSO.GetFile(sFile)
			If Err.Number = 0 Then
				If fnReadRecords(objFile) Then
					If fnOutputTabDelimited(constLogFolder & objFile.Name & ".txt") Then
					Else
						sErrMsg = "Unable to output data to " & constLogFolder & objFile.Name & ".txt"
						fnLogEntry sLog, sErrMsg, constError 
					End If
				Else
					sErrMsg = "Records couldn't be parsed in file " & sFile
					fnLogEntry sLog, sErrMsg, constError
				End If
			Else
				sErrMsg = "Specified file " & sFile & " couldn't be accessed (" & Err.Description & ")"
				fnLogEntry sLog, sErrMsg, constError & " " & Err.Number
			End If
		Else
			sErrMsg = "Specified file " & sFile & " couldn't be found" 
			fnLogEntry sLog, sErrMsg, constError
		End If
	End If

'Clean up

On Error Resume Next

objFile.Close
Set objFile = Nothing
Set objFSO = Nothing

Function fnIncludeScript(strScriptFile)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''    Author:     ebgreen (http://www.visualbasicscript.com/m29285.aspx)
''    Purpose:    Implements Include functionality
''    Takes:      strScriptFile - The name of the file containing the script
''                    			  to import. Must be a valid path.
''	  Returns:    sResult 	- Empty string on success,
'                             |-delimited string containing the error code
'                             and error description on failure.
''    Revision History:
''        06/03/10    ZG	Modified error handling
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

	Dim objFSO
	Dim objFile
	Dim strFile

	On Error Resume Next

	Set objFSO = CreateObject ("Scripting.FileSystemObject")

	'Check to see if the INCLUDE file exists. If it does not, return an error
	If objFSO.FileExists(strScriptFile) Then
		'Open the file to be loaded. If the open fails, return an error.
		Err.Clear
		Set objFile = objFSO.OpenTextFile(strScriptFile)
		If Err.Number = 0 Then
			'The file object is created so read all of the file and ececute it globally to load the class for use
			strFile = objFile.ReadAll
			ExecuteGlobal strFile
			If Err.Number = 0 Then
				fnIncludeScript = ""
			Else
				fnIncludeScript = Err.Number & "|" & "The specified INCLUDE file " & strScriptFile & " could not be loaded: " & Err.Description
			End If
		Else
			fnIncludeScript = Err.Number & "|" & "The specified INCLUDE file " & strScriptFile & " could not be opened for reading: " & Err.Description
		End If
	Else
		fnIncludeScript = "53" & "|" & "The specified INCLUDE file " & strScriptFile & " does not exist"
	End If

	objFile.Close
	Set objFile = Nothing
	Set objFSO = Nothing

End Function

Function fnReadRecordDefinition()
'*********************************************************************
' Purpose	:	Read record definition file. Columns in this  file are:
'				1. Field_Number
'				2. Start_Position
'				3. Length
'				4. Name
'				5. Required_Value
' Parameters:	None
' Returns:		True on success, false on failure
' Revision History:
' 07/01/11    ZPG	Original creation
'*********************************************************************

	Dim l_bResult
	Dim l_objRecordLayout
	Dim l_sLine
	Dim l_arrField

	'Assume success
	l_bResult = True

	If objFSO.FileExists(constRecordLayout) Then
		Set l_objRecordLayout = objFSO.OpenTextFile(constRecordLayout, ForReading)
		'Verify that the first line contains correct column headers
		If l_objRecordLayout.AtEndOfStream Then
			l_bResult = False
			sErrMsg = "Missing column header in the record layout definition file " & constRecordLayout
			fnLogEntry sLog, sErrMsg, constError
		Else
			l_sLine = l_objRecordLayout.ReadLine() 'Read a new line of file list
			'Parse column names in the header
			l_arrField = Split(l_sLine, vbTab)
			If UBound(l_arrField) < 4 Then
				l_bResult = False
				sErrMsg = "Invalid column header in the record layout definition file " & constRecordLayout
				fnLogEntry sLog, sErrMsg, constError
			Else
				If l_arrField(0) = "Field_Number" And l_arrField(1) = "Start_Position" And l_arrField(2) = "Length" And l_arrField(3) = "Name" And l_arrField(4) = "Required_Value" Then
					'Save column headers as the first element of the array (this will make it 1-based for data storage)
					ReDim arrFields(4, 0)
					arrFields(0, 0) = l_arrField(0)	'Field_Number
					arrFields(1, 0) = l_arrField(1)	'Start_Position
					arrFields(2, 0) = l_arrField(2)	'Length
					arrFields(3, 0) = l_arrField(3)	'Name
					arrFields(4, 0) = l_arrField(4)	'Required_Value
					'Read attributes for each field
					Do While Not l_objRecordLayout.AtEndOfStream
						l_sLine = l_objRecordLayout.ReadLine() 'Read a new line of file
						If Not Trim(l_sLine) = "" Then
							ReDim Preserve arrFields(4, UBound(arrFields, 2) + 1)
							l_arrField = Split(l_sLine, vbTab)
							If UBound(l_arrField) < 4 Then
								l_bResult = False
								sErrMsg = "Invalid definition for field " & UBound(arrFields, 2) & " in the record layout definition file " & constRecordLayout
								fnLogEntry sLog, sErrMsg, constError
							Else
								If IsNumeric(l_arrField(0)) And IsNumeric(l_arrField(1)) And IsNumeric(l_arrField(2)) Then
									'Save field attributes
									arrFields(0, UBound(arrFields, 2)) = l_arrField(0)	'Field_Number
									arrFields(1, UBound(arrFields, 2)) = l_arrField(1)	'Start_Position
									arrFields(2, UBound(arrFields, 2)) = l_arrField(2)	'Length
									arrFields(3, UBound(arrFields, 2)) = l_arrField(3)	'Name
									arrFields(4, UBound(arrFields, 2)) = l_arrField(4)	'Required_Value
								Else
									l_bResult = False
									sErrMsg = "Invalid definition for field " & UBound(arrFields, 2) & " in the record layout definition file " & constRecordLayout
									fnLogEntry sLog, sErrMsg, constError
								End If
							End If
						End If
					Loop
				Else
					l_bResult = False
					sErrMsg = "Invalid column name in the header of the record layout definition file " & constRecordLayout
					fnLogEntry sLog, sErrMsg, constError
				End If
			End If
		End If
	Else
		l_bResult = False
		sErrMsg = "Record layout definition file " & constRecordLayout & " is not found"
		fnLogEntry sLog, sErrMsg, constError
	End If

	fnReadRecordDefinition = l_bResult

	'Clean up
	On Error Resume Next
	l_objRecordLayout.Close
	Set l_objRecordLayout = Nothing

End Function

Function fnReadRecords(p_objFile)
'*********************************************************************
' Purpose	:	Read records from specified file. Fields will be parsed
'				according to previously retrieved record layout
'				(see fnReadRecordDefinition)
' Parameters:	p_objFile - File containing records to be read
' Returns:		True on success, false on failure
'NOTE: 	Depending on constRejectFilesWithIncompleteRecords, a file containing
'		an incomplete record will either be rejected in its entirety (return FALSE)
'		or accepted with just the incomplete record discarded (return TRUE)
' Revision History:
' 07/01/11    ZPG	Original creation
'*********************************************************************

	Dim l_bResult
	Dim l_objData
	Dim l_iRecLength
	Dim l_sRecord
	Dim l_iCount

	'Assume success
	l_bResult = True

	'Calculate record length based on record definition
	l_iRecLength = CInt(arrFields(1, UBound(arrFields, 2))) + CInt(arrFields(2, UBound(arrFields, 2)) - 1)

	'Prepare array that will hold records field by field
	ReDim arrRecords(UBound(arrFields, 2), 0)

	If objFSO.FileExists(p_objFile.Path) Then
		Set l_objData = objFSO.OpenTextFile(p_objFile.Path, ForReading)
		Do While Not l_objData.AtEndOfStream
			'Read record
			l_sRecord = l_objData.ReadLine() 
			If Not (Len(l_sRecord) = l_iRecLength) Then 
				If constRejectFilesWithIncompleteRecords Then
					l_bResult = False
					sErrMsg = "Record of incorrect length (" & Len(l_sRecord) & " bytes instead of expected "
					sErrMsg = sErrMsg & l_iRecLength & ") is found in file " & p_objFile.Path
					fnLogEntry sLog, sErrMsg, constError
				End If
			Else
				'Parse record into individual fields
				ReDim Preserve arrRecords(UBound(arrFields, 2), UBound(arrRecords, 2) + 1)
				For l_iCount = 1 to UBound(arrFields, 2)
					arrRecords(l_iCount, UBound(arrRecords, 2)) = Mid(l_sRecord, arrFields(1, l_iCount), arrFields(2, l_iCount))
				Next
			End If
		Loop
	Else
		l_bResult = False
		sErrMsg = "Data file " & p_objFile.Path & " is not found"
		fnLogEntry sLog, sErrMsg, constError
	End If

	fnReadRecords = l_bResult

	'Clean up
	On Error Resume Next
	l_objData.Close
	Set l_objData = Nothing

End Function

Function fnOutputTabDelimited(p_sTargetFile)
'*********************************************************************
' Purpose	:	Writes current set of records to a tab-delimited file 
'				by record and by field
' Parameters:	p_sTargetFile	- Full path and name of the file where
'								  records will be written out
' Returns:		True on success, false on failure
' Revision History:
' 07/14/11    ZPG	Original creation
'*********************************************************************

	Dim l_bResult
	Dim l_objOutputFile
	Dim l_iCount
	Dim l_iCount1
	Dim l_sText
	Dim l_bErr

	sProcName = "fnOutputTabDelimited"

	'Assume failure
	l_bResult = False

	'Create output file
	Err.Clear
	Set l_objOutputFile = objFSO.CreateTextFile(p_sTargetFile, True)	'Overwrite if file already exists
	If Err.Number = 0 Then
		'Create header
		l_sText = ""
		For l_iCount = 1 To UBound(arrFields, 2)
			'Construct field name header
			l_sText = l_sText & vbTab & "(" & arrFields(0, l_iCount) & ") " & arrFields(3, l_iCount)
		Next
		
		'Remove leading tab
		If Left(l_sText, 1) = vbTab Then l_sText = Right(l_sText, Len(l_sText) - 1)
		
		'Output header to the file
		Err.Clear
		l_objOutputFile.WriteLine(l_sText)
		If Err.Number = 0 Then
			'Scroll through all existing records in current set
			For l_iCount = 1 To UBound(arrRecords, 2)
				'Construct the record field by field
				l_sText = ""
				For l_iCount1 = 1 To UBound(arrFields, 2)
					l_sText = l_sText & vbTab & arrRecords(l_iCount1, l_iCount)
				Next
				
				'Remove leading tab
				If Left(l_sText, 1) = vbTab Then l_sText = Right(l_sText, Len(l_sText) - 1)
				
				'Output record to the file
				Err.Clear
				l_objOutputFile.WriteLine(l_sText)
				If Not Err.Number = 0 Then
					sErrMsg = "Unable to write record to the file (" & Err.Description & ")"
					fnLogEntry sLog, sErrMsg, constError & " " & Err.Number 
					l_bErr = True
					Exit For 'l_iCount loop
				End If		
			Next	
			
			If Not l_bErr Then l_bResult = True
		Else
			sErrMsg = "Unable to write record header to the file (" & Err.Description & ")"
			fnLogEntry sLog, sErrMsg, constError & " " & Err.Number 
		End If		
	Else
		sErrMsg = "Unable to create output file " & p_sTargetFile & " (" & Err.Description & ")"
		fnLogEntry sLog, sErrMsg, constError & " " & Err.Number
	End If

	fnOutputTabDelimited = l_bResult

	'Clean up
	On Error Resume Next
	l_objOutputFile.Close
	Set l_objOutputFile = Nothing

End Function

