COMPILE FUNCTION WO_PURGE(WONo)

* Removes Work Order and all information related to it from the system.

DECLARE SUBROUTINE ErrMsg, Send_Dyn, Send_Info, Btree.Extract, ErrMsg, Set_Property
DECLARE FUNCTION obj_WM_In, obj_WM_Out, WO_Mat_Purge, ErrMsg, Msg


$INSERT WO_LOG_EQUATES
$INSERT WO_MAT_EQUATES
$INSERT WO_STEP_EQUATES
$INSERT WM_IN_EQUATES
$INSERT WM_OUT_EQUATES
$INSERT RDS_EQUATES
$INSERT SURFACE_SCAN_EQUATES
$INSERT RDS_LAYER_EQUATES
$INSERT RDS_TEST_EQUATES
$INSERT TW_USE_EQUATES
$INSERT NCR_EQUATES
$INSERT REACT_RUN_EQUATES
$INSERT CLEAN_INSP_EQUATES
$INSERT MSG_EQUATES

equ CRLF$       to char(13):char(10)

Result = ''

IF NOT(ASSIGNED(WONo)) THEN WONo = ''

IF WONo = '' THEN
	ErrMsg('Null WONO passed to routine.')
	RETURN Result
END

Open 'WO_LOG' To WOTable Else
	ErrMsg('Unable to Open DICT.WO_LOG')
	Return
END


* Build KeyLists of all records "attached" to this Work Order

* All Tables with WO or WO_NO Btree indexes

Open 'DICT.WO_MAT' 		To DictWOMat		Else
	ErrMsg('Unable to Open DICT.WO_MAT')
	Return
End

Open 'DICT.WO_MAT_QA'	To DictWOMatQA		Else
	ErrMsg('Unable to Open DICT.WO_MAT_QA')
	Return
End


Open 'DICT.WO_MAT_WFR' 		To DictWOMatWfr		Else
	ErrMsg('Unable to Open DICT.WO_MAT')
	Return
End

Open 'DICT.WO_WFR'	To DictWOWfr		Else
	ErrMsg('Unable to Open DICT.WO_WFR')
	Return
End


Open 'DICT.RUN_STAGE_WFR'	To DictRunStageWfr	Else
	ErrMsg('Unable to Open DICT.RUN_STAGE_WFR')
	Return
End


Open 'DICT.WM_IN'		To DictWMIn			Else
	ErrMsg('Unable to Open DICT.WM_IN')
	Return
End

Open 'DICT.WM_OUT'		To DictWMOut 		Else
 	ErrMsg('Unable to Open DICT.WM_IN')
	Return
End
Open 'DICT.RDS' 		To DictRDS			Else
 	ErrMsg('Unable to Open DICT.RDS')
	Return
End
Open 'DICT.REACT_RUN'	To DictReactRun		Else
 	ErrMsg('Unable to Open DICT.REACT_RUN')
	Return
End
Open 'DICT.CLEAN_INSP' 	To DictCleanInsp	Else
 	ErrMsg('Unable to Open DICT.CLEAN_INSP')
	Return
End

Open 'DICT.RDS_TEST' 	To DictRDSTest		Else
 	ErrMsg('Unable to Open DICT.RDS_TEST')
	Return
End
Open 'DICT.NCR'			To DictNCR			Else
 	ErrMsg('Unable to Open DICT.NCR')
	Return
End
Open 'DICT.COC'			To DictCOC			Else
	ErrMsg('Unable to Open DICT.COC')
	Return
End

Open 'DICT.SCHED_DET'	To DictSchedDet		Else
	ErrMsg('Unable to Open DICT.SCHED_DET')
	Return
End


AllTables = ''
AllTables<1> = 'SCHED_DET'
AllTables<2> = 'TW_USE'
AllTables<3> = 'NCR'
AllTables<4> = 'RDS_TEST'
AllTables<5> = 'RDS_LAYER'
AllTables<6> = 'CLEAN_INSP'
AllTables<7> = 'COC'
AllTables<8> = 'REACT_RUN'
AllTables<9> = 'RDS'
AllTables<10> = 'COC'
AllTables<11> = 'WO_WFR_WIP'
AllTables<12> = 'WO_WFR'
AllTables<13> = 'WO_MAT_WFR'
AllTables<14> = 'WO_MAT_QA'
AllTables<15> = 'WM_IN'
AllTables<16> = 'WM_OUT'
AllTables<17> = 'WO_MAT'
AllTables<18> = 'WO_STEP'
AllTables<19> = 'WO_LOG'


AllKeys = ''
AllTableVars = ''

	
* *  WO_MAT Table  * *	

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'WO_MAT',DictWOMat,WOMatKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG


If WOMatKeys NE '' Then
	Open 'WO_MAT' To WOMatTable Else
		DEBUG
		Return
	End
	
	LOCATE 'WO_MAT' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos>		= WOMatKeys
		AllTableVars<FPos>	= WOMatTable
	END
End

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 

* *  WO_MAT_WFR Table  * *	

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'WO_MAT_WFR',DictWOMatWfr,WOMatWfrKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG


If WOMatWfrKeys NE '' Then
	Open 'WO_MAT_WFR' To WOMatWfrTable Else
		DEBUG
		Return
	End
	
	LOCATE 'WO_MAT' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos>		= WOMatWfrKeys
		AllTableVars<FPos>	= WOMatWfrTable
	END
End


* *  WO_WFR Table  * *	

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'WO_WFR',DictWOWfr,WOWfrKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG


If WOWfrKeys NE '' Then
	Open 'WO_WFR' To WOWfrTable Else
		DEBUG
		Return
	End
	
	LOCATE 'WO_WFR' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos>		= WOWfrKeys
		AllTableVars<FPos>	= WOWfrTable
	END
End


* *  RUN_STAGE_WFR Table  * *	

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'RUN_STAGE_WFR',DictRunStageWfr,RunStageWfrKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG


If RunStageWfrKeys NE '' Then
	Open 'RUN_STAGE_WFR' To RunStageWfrTable Else
		DEBUG
		Return
	End
	
	LOCATE 'RUN_STAGE_WFR' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos>		= RunStageWfrKeys
		AllTableVars<FPos>	= RunStageWfrTable
	END
End



* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 



* *  WO_MAT_QA Table  * *	

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'WO_MAT_QA',DictWOMatQA,WOMatQAKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG


If WOMatQAKeys NE '' Then
	Open 'WO_MAT_QA' To WOMatQATable Else
		DEBUG
		Return
	End
	
	LOCATE 'WO_MAT_QA' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= WOMatQAKeys
		AllTableVars<FPos>	= WOMatQATable
	END
End


* *  WM_IN Table  * *	

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'WM_IN',DictWMIn,WMIKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG

If WMIKeys NE '' Then
	Open 'WM_IN' To WMITable Else
		DEBUG
		Return
	End
	LOCATE 'WM_IN' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= WMIKeys
		AllTableVars<FPos>	= WMITable
	END
End

* *  WM_OUT Table  * *	

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'WM_OUT',DictWMOut,WMOKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG

If WMOKeys NE '' Then
	Open 'WM_OUT' To WMOTable Else
		DEBUG
		Return
	End
	
	LOCATE 'WM_OUT' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= WMOKeys
		AllTableVars<FPos>	= WMOTable
	END
End

* RDS Table *

Search = 'WO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'RDS',DictRDS,RDSKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG

IF RDSKeys = '' THEN

	*Index broken - RDS keys not showing up in Btree.Extract
	
	WOStepKeys = XLATE('WO_LOG',WONo,WO_LOG_WO_STEP_KEY$,'X')
	RDSKeys = XLATE('WO_STEP',WOStepKeys,WO_STEP_RDS_KEY$,'X')
	
END


If RDSKeys NE '' Then
	OPEN 'RDS' TO RDSTable ELSE
		DEBUG
		RETURN 
	End
	LOCATE 'RDS' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= RDSKeys
		AllTableVars<FPos>	= RDSTable
	END
End

* RDS_TEST Table *

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'RDS_TEST',DictRDSTest,RDSTestKeys,Option,Flag)

If Get_Status(errCode) Then DEBUG

If RDSTestKeys NE '' Then
	OPEN 'RDS_TEST' TO RDSTestTable ELSE
		DEBUG
		RETURN 
	End
	LOCATE 'RDS_TEST' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= RDSTestKeys
		AllTableVars<FPos>	= RDSTestTable
	END
End



* *  REACT_RUN table  * *

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'REACT_RUN',DictReactRun,ReactRunKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG

If ReactRunKeys NE '' Then
	OPEN 'REACT_RUN' TO ReactRunTable ELSE
		DEBUG
		RETURN Result
	End
	LOCATE 'REACT_RUN' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= ReactRunKeys
		AllTableVars<FPos>	= ReactRunTable
	END
End

* * CLEAN_INSP  * *

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'CLEAN_INSP',DictCleanInsp,CleanInspKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG

If CleanInspKeys NE '' Then
	OPEN 'CLEAN_INSP' TO CleanInspTable ELSE
		DEBUG
		RETURN 
	End
	LOCATE 'CLEAN_INSP' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= CleanInspKeys
		AllTableVars<FPos>	= CleanInspTable
	END
End


* * COC - Shipments  * *

Search = 'WO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'COC',DictCOC,COCKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG

If COCKeys NE '' Then
	OPEN 'COC' TO COCTable ELSE
		DEBUG
		RETURN 
	End
	LOCATE 'COC' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= COCKeys
		AllTableVars<FPos>	= COCTable
	END
END



* * SCHED_DET * *

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'SCHED_DET',DictSchedDet,SchedDetKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG

If	SchedDetKeys NE '' Then
	OPEN 'SCHED_DET' TO SchedDetTable ELSE
		DEBUG
		RETURN 
	End
	LOCATE 'SCHED_DET' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= SchedDetKeys
		AllTableVars<FPos>	= SchedDetTable
	END
End


* *  NCR  * *

Search = 'WO_NO':@VM:WONo:@FM
Option = ''
Flag = ''

Btree.Extract(Search,'NCR',DictNCR,NCRKeys,Option,Flag)

IF Get_Status(errCode) THEN DEBUG

If	NCRKeys NE '' Then
	OPEN 'NCR' TO NCRTable ELSE
		DEBUG
		RETURN 
	End
	LOCATE 'NCR' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= NCRKeys
		AllTableVars<FPos>	= NCRTable
	END
End




* * * * * * * * * * * * * * *
* Get Related from data fields
* * * * * * * * * * * * * * *


RDSLayerKeys = Xlate('REACT_RUN',ReactRunKeys,REACT_RUN_RDS_LAYER_KEYS$,'X')

If RDSLayerKeys NE '' Then
	Open 'RDS_LAYER' To RDSLayerTable Else
		DEBUG
		Return
	END
	LOCATE 'RDS_LAYER' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= RDSLayerKeys
		AllTableVars<FPos>	= RDSLayerTable
	END
End

rtCnt = Count(RDSTestKeys,@VM) + (RDSTestKeys NE '')

TWUseKeys = ''

For I = 1 To rtCnt
	ReadO MetRecord From RDSTestTable,RDSTestKeys<1,I> Then
		MetTWUseKeys = MetRecord<RDS_TEST_TW_USE_ID$>
		If MetTWUseKeys NE '' THEN
			TWUseKeys<1,-1> = MetTWUseKeys
		END
	END
Next I



If TWUseKeys NE '' Then
	Open 'TW_USE' To TWUseTable Else
		DEBUG
		Return
	End
	LOCATE 'TW_USE' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= TWUseKeys
		AllTableVars<FPos>	= TWUseTable
	END
END

Read WORec From WOTable,WONo THEN
	WOStepKeys = WORec<WO_LOG_WO_STEP_KEY$>
End Else
	WOStepKeys = ''
End

If WOStepKeys NE '' Then
	Open 'WO_STEP' To WOStepTable Else
		DEBUG
		Return
	End
	LOCATE 'WO_STEP' IN AllTables USING @FM SETTING FPos THEN
		AllKeys<FPos> 		= WOStepKeys
		AllTableVars<FPos>	= WOStepTable
	END
End

LOCATE 'WO_LOG' IN AllTables USING @FM SETTING FPos THEN
	AllKeys<FPos> = WoNo
	AllTableVars<FPos> = WOTable
END

Log = ''

PurgeKeys = ''
PurgeTables = ''
PurgeTableVars = ''

aCnt = COUNT(AllTables,@FM) + (AllTables NE '')
pCnt = 0
FOR I = 1 TO aCnt
	IF AllKeys<I> NE '' THEN
		RecKeys = AllKeys<I>
		TableName = AllTables<I>
		TableVar = AllTableVars<I>
		
		rCnt = COUNT(RecKeys,@VM) + (RecKeys NE '')
		
		
		Def = ""
		Def<MCAPTION$> 		= "Purging Work Order ":WONo:"..."
		Def<MTYPE$> 		= "GC"
		Def<MTEXTWIDTH$>	= 600
		Def<MEXTENT$> 		= rCnt
		
		MsgUp = Msg(@WINDOW, Def)
	
		FOR N = 1 TO rCnt
			RecKey = RecKeys<1,N>
			GOSUB DeleteRec
		WHILE Msg(@WINDOW, MsgUp, N, MSGINSTUPDATE$)
		NEXT N
		
		Msg(@window, MsgUp)         ;* take down the gauge
	
		pCnt += 1
		PurgeKeys<pCnt> = AllKeys<I>
		PurgeTables<pCnt> = AllTables<I>
		PurgeTableVars<pCnt> = AllTableVars<I>
	END
NEXT I

Set_Property('BATCH_WO_PURGE.STATUSLINE','TEXT','')

BAIL:

CONVERT @FM TO @VM IN Log


RETURN Log





* * * * * * *
DeleteRec:
* * * * * * *

*Send_Dyn('Deleting ':TableName:' ':RecKey)

Set_Property('BATCH_WO_PURGE.STATUSLINE','TEXT','Deleting ':TableName:' ':RecKey )

DELETE TableVar,RecKey THEN
	Log<-1> = TableName:' ':RecKey:' purged.'
	Gone = 1
END ELSE
	IF @FILE_ERROR NE '' AND @FILE_ERROR<1> NE '100'  THEN
		Log<-1> = '*** Unable to purge ':TableName:' ':RecKey:'   ***'
		Gone = 0
	END ELSE
		Gone = 1
	END
END


RETURN