616 lines
12 KiB
Plaintext
616 lines
12 KiB
Plaintext
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
|