*---
****FUNCTION PREFILCK
****This function checkes a XXXXXXXX.dat file
*	to see if the file has the proper format.
************************************************************
****                 DataBase   SECTION                 ****
****DataBases Used
*	None
****DataBases Created
*	None
************************************************************
****                 Files      SECTION                 ****
****Files Used
*	A viking file is used. (ASCII)
****Files Created
************************************************************
****                 VARIABLES  SECTION                 ****
****Parameters GLOBAL
*	
*	No changes are made.
*	They are defined in main menu setup.
****Parameters pased to procedure
*	PATHTO	-	The path to the .dat file
*	FNAME	-	The .dat file to be checked
****Parameters Used
*	Main_H		- File handle	
*	ifp_size	- 
*	ifp_top		- 
*	llQuit		- loop controll .T. means quit
*	RecTC		- Record type current
*	RecTP		- Record type previous
*   HeadSID		- Header ship ID
*	HeadSIDNP	- Header ship ID Numeric Part
*	llRetVal	- File ok ret .T. else ret .F.
*	DATFILE 	- The path and the .dat file to be checked
*	DATFILEE	- Data error file has the same name as 
*				datfile but with .prb ext
*	lnLineNO	- Line number in text file where current position is
*	llQced		- Flag to tell if any rec don't have a "T" follow buy a "U"
****ARRAY USED
*	NONE
****Parameters returned
*	FUNCTION RETURNS TRUE IF FILE IS OK FALSE IF NOT
*--
*
FUNCTION PREFILCK
PARAMETERS PATHTO, FNAME
PRIVATE Main_H, File handle, ifp_size, ifp_top
PRIVATE RecTC, RecTP, HeadSID, HeadSIDNP, RecSID, llRetVal
PRIVATE DATFILE, DATFILEE
PRIVATE llQced
****************************************************
llQced = .T.

llRetVal = .T.
lnLineNO = 0
*DO BUGFIND
DATFILE  = FNAME
DATFILEE = FNAME
DATFILEE = STRTRAN(DATFILEE, ".DAT", ".PRB")

WAIT "FUNCTION PREFILCK PROGRAMED YET FILE IS-->"+;
PATHTO + DATFILE WINDOW NOWAIT 

IF FILE(PATHTO + DATFILE)              && Does file exist? 
	Main_H = FOPEN(PATHTO + DATFILE,0) && If so, open read/write
	Main_HE = FCREATE(PATHTO + DATFILEE,0) && If so, create error file

ENDIF
IF Main_H < 0 .OR. Main_HE < 0         && Check for error opening file
	WAIT "Can not open file "+ DATFILE WINDOW NOWAIT 
	llQuit = .T.
ELSE
	llQuit = .F.
ENDIF
*READ STUFF################################################
*ifp_size = FSEEK(Main_H, 0, 2)  && Move pointer to EOF
STORE FSEEK(Main_H, 0, 2) TO ifp_size  && Move pointer to EOF
*ifp_top =  FSEEK(Main_H, 0)  && Move pointer to BOF
STORE FSEEK(Main_H, 0) TO ifp_top && Move pointer to BOF
ifp_size = 1000

IF ifp_size <= 0 && Is File empty? 
	WAIT WINDOW 'This file is empty!' NOWAIT 
	llQuit = .T.
ENDIF 
*READ STUFF################################################
*RecTC, RecTP, HeadSID, RecSID
RecTP = "T"
DO WHILE !llQuit .AND. !FEOF(Main_H)
*CASE--&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
l_string = FGETS(Main_H,ifp_size) && Store contents to memory
lnLineNO = lnLineNO + 1
RecTC = LEFT(l_string,1)
DO CASE
	CASE RecTC = "H"
		HeadSID = SUBSTR(l_string,6,8)
		HeadSIDNP = SUBSTR(l_string,8,6)
		IF !ISDIGIT(HeadSIDNP)
*		do bugfind
		tlcString = "PreFilCK program CASE RecTC = H"
		=FPUTS(Main_HE,tlcString)

		tlcString = "SHIP ID ->" + HeadSID + "  NOT NUMERIC "
		WAIT tlcString WINDOW NOWAIT
		=FPUTS(Main_HE,tlcString)
		tlcString = "The error is on or near line->" + STR(lnLineNO)
		=FPUTS(Main_HE,tlcString)

		=FPUTS(Main_HE,l_string)
		llRetVal = .F.
		ENDIF
		IF RecTP = "H"
*		do bugfind
		tlcString = "PreFilCK program CASE RecTC = H"
		=FPUTS(Main_HE,tlcString)
  		tlcString = "PROBLEM TWO HEADER RECS IN A ROW" 
		WAIT  tlcString WINDOW NOWAIT 
		=FPUTS(Main_HE,tlcString)
		tlcString = "The error is on or near line->" + STR(lnLineNO)
		=FPUTS(Main_HE,tlcString)
		=FPUTS(Main_HE,l_string)
********		RecTP = "H"
		llRetVal = .F.
		ENDIF
		RecTP = "H"
		
	CASE RecTC = "T"
		IF RecTP = "T"
		llQced = .F.
		ENDIF
		
		RecTP = "T"
		RecSID = SUBSTR(l_string,6,8)
		IF RecSID <> HeadSID
		
*		do bugfind
		tlcString = "PreFilCK program CASE RecTC = T"
		=FPUTS(Main_HE,tlcString)

		tlcString = "ship IDS mis match Header-> "+ HeadSID + " data sid-> " + RecSID
		WAIT tlcString WINDOW NOWAIT 
		=FPUTS(Main_HE,tlcString)
		tlcString = "The error is on or near line->" + STR(lnLineNO)
		=FPUTS(Main_HE,tlcString)
		=FPUTS(Main_HE,l_string)
		llRetVal = .F.
		ENDIF
*	CASE RecTC = "U"
*		WAIT "This flie has been through the qc process once all ready." WINDOW NOWAIT
*		WAIT "CALL SYS ADMIN" WINDOW NOWAIT
*		llQuit = .T.
	OTHERWISE
		IF ((RecTC = "U") .AND. llQced)
		WAIT "This flie has been through the qc process once all ready." WINDOW NOWAIT
*		WAIT "CALL SYS ADMIN if this is not true" WINDOW NOWAIT
		llQuit = .T.
		llRetVal = .T.
		ELSE		


*		do bugfind
		tlcString = "PreFilCK program OTHERWISE"
		=FPUTS(Main_HE,tlcString)
		WAIT"OTHERWISE RecTC->"+ RecTC WINDOW NOWAIT
		WAIT"OTHERWISE RecTP->"+ RecTP WINDOW NOWAIT
		WAIT"OTHERWISE HeadSID->"+ HeadSID WINDOW NOWAIT
		WAIT"OTHERWISE RecSID->"+ RecSID WINDOW NOWAIT
		tlcString = "The record identifyer is wrong should be T or H"
		WAIT tlcString WINDOW NOWAIT
		=FPUTS(Main_HE,tlcString)
		tlcString = "Record type current->"+ RecTC + " Record type previous->" + RecTP
		=FPUTS(Main_HE,tlcString)
		tlcString = "Header ship id->" + HeadSID + " Record ship id->" + RecSID
		=FPUTS(Main_HE,tlcString)
		tlcString = "The error is on or near line->" + STR(lnLineNO)
		=FPUTS(Main_HE,tlcString)
		=FPUTS(Main_HE,l_string)
		llRetVal = .F.
		ENDIF
ENDCASE
*CASE--&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
ENDDO
IF llRetVal
DO DUPRECS WITH Main_H, Main_HE, ifp_size, llRetVal
ENDIF
=FCLOSE(Main_H)                   && Close file
=FCLOSE(Main_HE)                   && Close file

*MODIFY FILE errors.txt NOWAIT      && Open file in edit window


IF !llRetVal
	IF FILE(PATHTO + DATFILEE)
	COPY FILE (PATHTO + DATFILEE) TO (gcDrvLan + gcAVIK + gcDATA + DATFILEE)
	ERASE (PATHTO + DATFILEE)
	ENDIF
ELSE
	IF FILE(PATHTO + DATFILEE)
	ERASE (PATHTO + DATFILEE)
	ENDIF
WAIT "The file checks out."WINDOW 
ENDIF
****************************************************
*WAIT  "FIXIT" WINDOW
RETURN(llRetVal)
*RETURN(.T.)





PROCEDURE DUPRECS
PARAMETERS Main_H, Main_HE, ifp_size, llRetVal
PRIVATE l_string ,ifp_top, tlcString
DIMENSION lcStriP[20], lcStriC[20]
SELECT 0
CREATE DBF C:\AQCVIK\DUPS.DBF (SHIPID C(20))
USE C:\AQCVIK\DUPS.DBF
STORE FSEEK(Main_H, 0) TO ifp_top
DO WHILE !FEOF(Main_H)
l_string = FGETS(Main_H,ifp_size) && Store contents to memory
IF (!EMPTY(l_string) .AND. LEFT(l_string,1) =="H")
APPEND BLANK
SCATTER MEMVAR
SHIPID = LEFT(l_string,13)
GATHER MEMVAR
ENDIF

ENDDO
*do bugfind
select DUPS
GO TOP
SORT TO C:\AQCVIK\tdTemp.DBF ON DUPS.shipid
select 0
use C:\AQCVIK\tdTemp.DBF
select tdTemp
lcStriP = "01234567890123456789"
lcStriC = "12345678901234567890"
go top
SCAN
scatter memvar
lcStriC = tdTemp.shipid
if lcStriP = lcStriC
WAIT "DUP HEADER " + lcStriC WINDOW NOWAIT
tlcString = "dup header "
=FPUTS(Main_HE,tlcString)
tlcString = "Do search for the following headers "
=FPUTS(Main_HE,tlcString)
=FPUTS(Main_HE,lcStriC)
llRetVal = .F.
endif
lcStriP = lcStriC
ENDSCAN
SELECT DUPS
USE
erase C:\AQCVIK\DUPS.DBF
SELECT tdTemp
USE
erase C:\AQCVIK\tdTemp.DBF
SELECT BATCHSEL
RETURN