COMPILE FUNCTION Comm_RDS_Layer(Instruction, Parm1, Parm2)
#pragma precomp SRP_PreCompiler

/*
	Commuter module for RDS_Layer Window
	
	02/09/2006 - John C. Henry, J.C. Henry & Co., Inc.
*/

DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window,Print_Vend_CofA
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow
DECLARE SUBROUTINE Post_Event, Forward_Event, Security_Err_Msg, obj_RDS_Layer, Msg

DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup, Collect.Ixvals
DECLARE FUNCTION Send_Message, Security_Check

$INSERT RDS_LAYER_EQUATES
$INSERT RDS_EQU
$INSERT REACT_RUN_EQUATES
$INSERT RECIPE_PARMS_EQU
$INSERT PROD_SPEC_EQU
$INSERT WO_STEP_EQU
$INSERT POPUP_EQUATES
$INSERT LOGICAL
$INSERT DICT_EQUATES
$INSERT APPCOLORS
$INSERT SECURITY_RIGHTS_EQU


EQU COL$MET_NO		TO 1
EQU COL$ZONE		TO 2
EQU COL$THICK_AVG	TO 3
EQU COL$THICK_STDV	TO 4
EQU COL$RES_AVG		TO 5
EQU COL$RES_STDV	TO 6
EQU COL$RES_UNITS	TO 7
EQU COL$OUT_OF_SPEC	TO 8


EQU CRLF$	TO \0D0A\

EQU HIDDEN$	TO 32

EQU COL$TEST_NO		TO 1

ErrTitle = 'Error in Comm_RDS_Layer'
ErrorMsg = ''

Result = ''

BEGIN CASE
	CASE Instruction = 'Create' 				; GOSUB Create
	CASE Instruction = 'Read'					; GOSUB Read
	CASE Instruction = 'Clear'					; GOSUB Clear
	CASE Instruction = 'Refresh'				; GOSUB Refresh
	CASE Instruction = 'Write'					; GOSUB Write
	CASE Instruction = 'Delete'					; GOSUB Delete
	CASE Instruction = 'Close'					; GOSUB Close
	CASE Instruction = 'Page'					; GOSUB Page
	CASE Instruction = 'RParmsDeleteRow'		; GOSUB RParmsDeleteRow
	CASE Instruction = 'RParmsInsertRow'		; GOSUB RParmsInsertRow
	CASE Instruction = 'RParmsPC'				; GOSUB RParmsPC
	CASE Instruction = 'NewTest'				; GOSUB NewTest
	CASE Instruction = 'TestKeyDC'				; GOSUB TestKeyDC
	CASE Instruction = 'OverRideRecipeLimits'	; GOSUB OverRideRecipeLimits
	CASE Instruction = 'OverRideDC'				; GOSUB OverRideDC
	CASE Instruction = 'OverRidePC'				; GOSUB OverRidePC
	CASE Instruction = 'UpdateLimits'			; GOSUB UpdateLimits
	
	CASE 1
		ErrorMsg = 'Unknown Instruction passed to routine.'
		ErrMsg(ErrorMsg)
END CASE

RETURN Result



* * * * * * *
Create:
* * * * * * *


obj_Appwindow('Create',@WINDOW)

IF Parm1 NE '' THEN
	obj_AppWindow('LoadFormKeys',@WINDOW:@RM:Parm1)
END

GOSUB Refresh


RETURN

* * * * * * * 
Clear:
* * * * * * * 

Send_Event(@WINDOW,'PAGE',1)

GOSUB Refresh

RETURN


* * * * * * *
Page:
* * * * * * *

	Page = Parm1
	
	IF Page = '' THEN
		Page = Get_Property(@WINDOW:'.TAB_MAIN','VALUE')
	END ELSE
		Set_Property(@WINDOW:'.TAB_MAIN','VALUE',Page)
	END
	
	Set_Property(@WINDOW,'VPOSITION', Page)

RETURN


* * * * * * *
Read:
* * * * * * * 

CurrRecord = Get_Property(@WINDOW,'RECORD')
Set_Property(@WINDOW,'@ORG_RECORD',CurrRecord)

* * * * * * *
Refresh:
* * * * * * *

LSId = Get_Property(@WINDOW:'.LS_ID','TEXT')

BEGIN CASE
	CASE LSId = 'L1'
		Set_Property(@WINDOW:'.LS_ID','BACKCOLOR',RCV_BLUE$)
		
	CASE LSId = 'L2'
		Set_Property(@WINDOW:'.LS_ID','BACKCOLOR',PRE_BLUE$)
		
	CASE LSId = '2'
		Set_Property(@WINDOW:'.LS_ID','BACKCOLOR',INP_BLUE$)
		
	CASE 1
		Set_Property(@WINDOW:'.LS_ID','BACKCOLOR',KEY_YELLOW$)
		
END CASE

Set_Property(@WINDOW:'.OVERRIDE_LIMITS_GROUP','ENABLED',0)

RDSNo	= Get_Property( @WINDOW:'.RDS_NO', 'DEFPROP' )
RDSRec	= XLATE('RDS',RDSNo,'','X')

LayerSetID	= Get_Property(@WINDOW:'.LS_ID','DEFPROP')

PSNId		= RDSRec< RDS_PROD_SPEC_ID$ >
RecipeNo	= Get_Property(@WINDOW:'.RECIPE_NO','DEFPROP')

RecipeParms = Get_Property(@WINDOW:'.RECIPE_PARMS','ARRAY')						;* Entered by user
RecipeLimits = Get_Property(@WINDOW:'.RECIPE_LIMITS','LIST')<1>

CONVERT @VM TO @FM IN RecipeLimits

ColCnt = COUNT(RecipeLimits,@FM) + (RecipeLimits NE '')							;* This is 16 columns as of the development of this window

RecipeParms = Get_Property(@WINDOW:'.RECIPE_PARMS','ARRAY')

ParameterStyles	= Send_Message( @WINDOW:'.RECIPE_PARMS', "COLSTYLE", 0, '' )
LimitStyles		= Send_Message( @WINDOW:'.RECIPE_LIMITS', "COLSTYLE", 0, '' )

CONVERT @VM TO '' IN RecipeParms

ColNames	= Get_Property( @WINDOW:'.RECIPE_PARMS', 'COLUMN' )

OutOfSpecCols = ''
FOR Col = 1 TO ColCnt
	IF RecipeLimits<Col> = '' AND RecipeParms<Col> = '' THEN
		ParameterStyles<Col>	= BitOr( ParameterStyles<Col>, HIDDEN$ )				;* Column not used -> Hide
		LimitStyles<Col>		= BitOr( LimitStyles<Col>, HIDDEN$ )
	END ELSE
		ParameterStyles<Col>	= BitAnd( ParameterStyles<Col>, BitNot(HIDDEN$) )		;* Column used -> Show
		LimitStyles<Col>		= BitAnd( LimitStyles<Col>, BitNot(HIDDEN$) )
		
		LimitData	= RecipeLimits<Col>
		ParamData	= RecipeParms<Col>
		
		ColName		= ColNames<1,1,Col>
		Conversion	= XLATE('DICT.RDS_LAYER',ColName,DICT_CONV$,'X')
		
		SWAP ' ~ ' WITH @VM IN LimitData
		
		IF Conversion NE '' THEN
			ParamData = ICONV(ParamData,Conversion)
			LimitData = ICONV(LimitData,Conversion)
		END
		
		Minimum = LimitData<1,1>
		Maximum = LimitData<1,2>

		IF ParamData NE '' THEN
			IF ParamData < Minimum OR ParamData > Maximum THEN
				Send_Message(@WINDOW:'.RECIPE_PARMS','COLOR_BY_POS',Col,1,RED$)
				OutOfSpecCols = INSERT(OutOfSpecCols,Col,0,0,1)
			END ELSE
				Send_Message(@WINDOW:'.RECIPE_PARMS','COLOR_BY_POS',Col,1,WHITE$)
			END
		END ELSE
			Send_Message(@WINDOW:'.RECIPE_PARMS','COLOR_BY_POS',Col,1,WHITE$)
		END
		
	END

NEXT Col

LOCATE '1' IN OutOfSpecCols USING @FM SETTING Pos THEN
	Set_Property(@WINDOW:'.OUT_OF_SPEC','CHECK',1)
END ELSE
	Set_Property(@WINDOW:'.OUT_OF_SPEC','CHECK',0)
END

Parameter_Styles	= Send_Message( @WINDOW:'.RECIPE_PARMS', "COLSTYLE", 0, ParameterStyles  )
LimitStyles			= Send_Message( @WINDOW:'.RECIPE_LIMITS', "COLSTYLE", 0, LimitStyles  )	   

Set_Property( @WINDOW:'.RECIPE_INFO', "AUTOSIZECOL", 16 )
Set_Property( @WINDOW:'.RECIPE_LIMITS', "AUTOSIZECOL", 16 )



* QBF buttons

Ctrls  = @WINDOW:'.QBF_FIRST_FIX':@RM		; Props  = 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_PREV_FIX':@RM		; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_ABS_FIX':@RM			; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_NEXT_FIX':@RM		; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_LAST_FIX':@RM		; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_STOP_FIX'			; Props := 'ENABLED'

IF Get_Property(@WINDOW,'QBFLIST') = '' THEN
	Vals = 0:@RM:0:@RM:0:@RM:0:@RM:0:@RM:0
END ELSE
	Vals = 1:@RM:1:@RM:1:@RM:1:@RM:1:@RM:1
END

Set_Property(Ctrls,Props,Vals)

* Turn edit table symbolic column backgrounds to green

ETSymbolics = Get_Property(@WINDOW,'@ET_SYMBOLICS')		;* Loaded during 'Create' in obj_Appwindow

ETCtrls	= ETSymbolics<1>
ETCols	= ETSymbolics<2>

FOR I = 1 TO COUNT(ETCtrls,@VM) + (ETCtrls NE '')
	ETCtrl	= ETCtrls<1,I>
	ETList = Get_Property(ETCtrl,'LIST')
	FOR Line = 1 TO COUNT(ETList,@FM) + (ETList NE '')
		IF ETList<Line,1> NE '' THEN
			FOR N = 1 TO COUNT(ETCols<1,I>,@SVM) + (ETCols<1,I> NE '')
				stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$)
			NEXT N
		END
	NEXT I
NEXT I


TestList = Get_Property(@WINDOW:'.RDS_TEST_KEYS','LIST')

FOR I = 1 TO COUNT(TestList,@FM) + (TestList NE '')
	IF ICONV(TestList<I,COL$OUT_OF_SPEC>,'B') = 1 THEN
		Send_Message(@WINDOW:'.RDS_TEST_KEYS','COLOR_BY_POS',0,I,RED$)
	END ELSE
		Send_Message(@WINDOW:'.RDS_TEST_KEYS','COLOR_BY_POS',0,I,WHITE$)
	END
NEXT I

RPCopy = RecipeParms
Convert @FM to '' in RPCopy
If RPCopy EQ '' then
    Set_Property(@Window : '.BTN_SET_CURR_RUN_PARMS', 'ENABLED', False$)
end else
    Set_Property(@Window : '.BTN_SET_CURR_RUN_PARMS', 'ENABLED', True$)
end

RETURN


* * * * * * *
Write:
* * * * * * *

SkipScriptEvent = Get_Property(@Window, '@SKIPSCRIPT')
If (SkipScriptEvent EQ False$) or (SkipScriptEvent EQ '') then
    RDSLayerKey = Get_Property(@WINDOW,'ID')

    CurrRecord = Get_Property(@WINDOW,'RECORD')
    OrgRecord = Get_Property(@WINDOW,'@ORG_RECORD')

    IF CurrRecord NE OrgRecord THEN
        CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS')
        NewLine = @USER4:@VM:CurrDTM
        Send_Message(@WINDOW:'.MODIFY_USER','INSERT',1,NewLine)
    END

    Post_Event(@WINDOW,'CLOSE')
end
Result = 1

RETURN 



* * * * * * *
Delete:
* * * * * * * 

ErrMsg('Records may not be modified or deleted.')

Result = 0	;* No Deletes

RETURN


* * * * * * *
Close:
* * * * * * *

obj_Appwindow('DetailReturn')

RETURN


* * * * * * *
RParmsDeleteRow:
* * * * * * *

DeletedRowIndex = Parm1
DeletedRowText = Parm2

CurrCtrl = @WINDOW:'.RECIPE_PARMS'

Dummy = Send_Message(CurrCtrl, "INSERT",DeletedRowIndex, DeletedRowText)

Set_Property(CurrCtrl,'SELPOS',1:@FM:1)

ErrMsg('Rows may not be inserted or deleted.')

RETURN


* * * * * * *
RParmsInsertRow:
* * * * * * *

RowIndex = Parm1

CurrCtrl = @WINDOW:'.RECIPE_PARMS'

ErrMsg('Rows may not be inserted or deleted.')

RETURN


* * * * * * *
RParmsPC:
* * * * * * *

CurrCtrl = @WINDOW:'.RECIPE_PARMS'

PrevSelPos	= Get_Property(CurrCtrl,"PREVSELPOS")
PrevCol 	= PrevSelPos<1>
PrevRow 	= PrevSelPos<2>

CurrSelPos	= Get_Property(CurrCtrl,"SELPOS")
CurrCol 	= CurrSelPos<1>
CurrRow 	= CurrSelPos<2>

ColStyles	= Send_Message( @WINDOW:'.RECIPE_PARMS', 'COLSTYLE', 0, '' )
ColNames	= Get_Property( @WINDOW:'.RECIPE_PARMS', 'COLUMN' )

IF CurrRow > 1 THEN
	Set_Property(CurrCtrl,'SELPOS',CurrCol:@FM:1)						;* Can't move off of the first row
END

ListData = Get_Property(CurrCtrl,'LIST')

IF ListData<1,PrevCol> NE '' THEN
	VisibleColumn = NOT(BitAnd( ColStyles<PrevCol>, HIDDEN$ ))			;* Gives @VM list of flags for visible columns in the edit table
	IF VisibleColumn THEN
		LimitData	= Get_Property(@WINDOW:'.RECIPE_LIMITS','LIST')<1,PrevCol>
		ParamData	= ListData<1,PrevCol>
		
		ColName		= ColNames<1,1,PrevCol>
		Conversion	= XLATE('DICT.RDS_LAYER',ColName,DICT_CONV$,'X')
		
		CONVERT '~' TO @VM IN LimitData
		
		IF Conversion NE '' THEN
			ParamData = ICONV(ParamData,Conversion)
			LimitData = ICONV(LimitData,Conversion)
		END
		
		Minimum = LimitData<1,1>
		Maximum = LimitData<1,2>
		
		IF ParamData < Minimum OR ParamData > Maximum THEN
			*ErrMsg('Data Entered for ':QUOTE(ColName):' is out of specified limits!')
		END
		
		
		IF ColName = 'EPI_TIME' THEN
			LSId = Get_Property(@WINDOW:'.LS_ID','DEFPROP')
			RDSNo = Get_Property(@WINDOW:'.RDS_NO','DEFPROP')
			
			ReactRunRec = XLATE('REACT_RUN',RDSNo,'','X')
			
			WONo	= ReactRunRec<REACT_RUN_WO_NO$>
			WOStep	= ReactRunRec<REACT_RUN_WO_STEP$>

			PSNo = XLATE('WO_STEP',WONo:'*':WOStep,WO_STEP_PROD_SPEC_ID$,'X')
			
			DepTimeRatio = XLATE('PROD_SPEC',PSNo,PROD_SPEC_DEP_TIME_RATIO$,'X')

			
			IF DepTimeRatio = 1 THEN
				IF LSId = 'L1' THEN
					LS1DepTime = ParamData
					LS2DepTime = XLATE('RDS_LAYER',RDSNo:'*L2',RDS_LAYER_EPI_TIME$,'X')
				END
				IF LSId = 'L2' THEN
					LS1DepTime = XLATE('RDS_LAYER',RDSNo:'*L1',RDS_LAYER_EPI_TIME$,'X')
					LS2DepTime = ParamData
				END
				
				IF LS1DepTime NE '' AND LS2DepTime NE '' THEN
						
					LS1DepTime = OCONV(LS1DepTime,'MD1')
					LS2DepTime = OCONV(LS2DepTime,'MD1')
					TotDepTime = LS1DepTime + LS2DepTime
					LS1Ratio = OCONV(ICONV(LS1DepTime/TotDepTime,'MD6'),'MD6')
					
					IF LS1Ratio <= 0.112 OR LS1Ratio >= 0.114 THEN
						Msg(@WINDOW,'','DEP_TIME_RATIO','',LS1DepTime:@FM:LS2DepTime:@FM:LS1Ratio)
					END
				END
			
			END ;* End of check for DepTimeRatio flag
		END	;* End of check for column = 'EPI_TIME"
		
	END	;* End of Check for Visible Column
	
END

GOSUB Refresh

RETURN



* * * * * * *
NewTest:
* * * * * * *

RETURN



* * * * * * * 
TestKeyDC:
* * * * * * *

CurrCtrl = @WINDOW:'.RDS_TEST_KEYS'

CurrPos		= Get_Property(CurrCtrl,"SELPOS")
CurrCol 	= CurrPos<1>
CurrRow 	= CurrPos<2>

RDSTestNo	= Get_Property(CurrCtrl,'CELLPOS',COL$TEST_NO:@FM:CurrRow)
RDSLsID		= Get_Property(@WINDOW,'ID')

IF RDSTestNo NE '' AND RDSLsID NE '' THEN
	
	CardWindow	= 'RDS_TEST'
	CardKey		= RDSTestNo					;* Null values for CardKey creates new card
	NewCardCtrl	= ''						;* Name of button control to create new Card on Card window
	RecalcCtrl	= CurrCtrl					;* Symbolic Control to recalculate upon return
	RecalcPos	= ''						;* Position in edit list or edit table for recalc
	RetCtrl		= CurrCtrl					;* This can be called from both a window and a process
	RetPos		= CurrPos					;* Position in edit list or edit table to return to

	oAParms = CardWindow:@RM:CardKey:@RM:NewCardCtrl:@RM:RecalcCtrl:@RM:RecalcPos:@RM:RetCtrl:@RM:RetPos

	obj_AppWindow('ViewNewCard',oAParms)
	
	IF Get_Status(errCode) THEN
		ErrMsg(errCode)
	END	
	
END

RETURN


* * * * * * *
OverRideRecipeLimits:
* * * * * * *


IF Security_Check( 'Recipe', Write$ ) THEN
	Set_Property(@WINDOW:'.OVERRIDE_LIMITS_GROUP','ENABLED',1)
END ELSE
	Security_Err_Msg( 'Recipe', Write$ )
END

RETURN

* * * * * * *
UpdateLimits:
* * * * * * *

IF Security_Check( 'Recipe', Write$ ) THEN
	RDSNo = Get_Property(@WINDOW:'.RDS_NO','DEFPROP')
	LSId = Get_Property(@WINDOW:'.LS_ID','DEFPROP')
	
	IF RDSNo = '' OR LSId = '' THEN RETURN
	
	Send_Event(@WINDOW,'WRITE')
	
	obj_RDS_Layer('UpdateLimits',RDSNo:@RM:LSId)
	
	IF Get_Status(errCode) THEN ErrMsg(errCode)
		
	obj_AppWindow('LoadFormKeys',@WINDOW:@RM:RDSNo:'*':LSId)
	
END ELSE
	Security_Err_Msg( 'Recipe', Write$ )
END


RETURN

* * * * * * *
OverRideDC:
* * * * * * * 



RETURN



* * * * * * *
OverRidePC:
* * * * * * *
/*

CtrlEntID = @WINDOW:'.CUST_LOT_NO'

OrderNo = Get_Property(@WINDOW:'.ORDER_NO','TEXT')
ItemNo	= Get_Property(@WINDOW:'.ITEM_NO','TEXT')

OrderDetKey = OrderNo:'*':ItemNo

PrevSelPos	= Get_Property(CtrlEntId,"PREVSELPOS")
PrevCol 	= PrevSelPos<1>
PrevRow 	= PrevSelPos<2>

CurrPos = Get_Property(CtrlEntId,'SELPOS')
CurrCol = CurrPos<1>
CurrRow = CurrPos<2>

ListData	= Get_Property(CtrlEntId,'LIST')

ColCnt = 2		;* Number of columns in the edit table

IF ListData<CurrRow,CurrCol> = '' THEN
	
	ColPointer = CurrCol
	LinePointer = CurrRow
	
	* Find the first non-empty cell
	
	LOOP
		Test = ListData<LinePointer,(ColPointer) >
	UNTIL Test NE '' OR (LinePointer = 0 AND ColPointer = 1)
		ColPointer -= 1
		IF ColPointer = 0 THEN
			ColPointer = ColCnt
			LinePointer -= 1
		END
	REPEAT
	
	* Move one past the non empty cell
	
	BEGIN CASE
		CASE LinePointer = 0 
			* Empty Table
			LinePointer = 1
			CoilPointer = 1
			
		CASE ColPointer = ColCnt
			LinePointer += 1
			ColPointer = 1
			
		CASE 1
			ColPointer += 1
			
	END CASE
	Set_Property(CtrlEntId,"SELPOS",ColPointer:@FM:LinePointer)
END

IF ListData<PrevRow,PrevCol> NE '' THEN

	IF PrevCol = COL$CUST_LOT_NO THEN
			
		LotNo = ListData<PrevRow,PrevCol>
		
		IF INDEX(LotNo,' ',1) THEN
			ListData<PrevRow,PrevCol> = TRIM(LotNo)
			Set_Property(CtrlEntId,'LIST',ListData)
			LotNo = TRIM(LotNo)
		END
		Extract_SI_Keys('ORDER_DET','CUST_LOT_NO',LotNo,OrderDetKeys)	;* Check for previous use of customer lot number in new data structure
		
		IF OrderDetKeys NE '' THEN
		
			LOCATE OrderDetKey IN OrderDetKeys USING @VM SETTING FPos THEN
				OrderDetKeys = DELETE(OrderDetKeys,1,FPos,0)					;* Exclude the current Order Item from this check
			END
		
			IF OrderDetKeys NE '' THEN
				SWAP @VM WITH ', ' IN OrderDetKeys
				
				Message  = 'Lot No ':QUOTE(LotNo):' has been used in Order Item(s) |':OrderDetKeys:'||'
				Message := 'Do you wish to use this duplicate Lot Number?|'
				
				MsgInfo = ''
				MsgInfo<MTEXT$> = Message
				
				Resp = Msg( @WINDOW, MsgInfo,'CUST_LOT_USED' )
				IF Resp = CHAR(27) THEN
					Set_Property(CtrlEntId,'CELLPOS','',PrevSelPos)
					Set_Property(CtrlEntId,"SELPOS",PrevSelPos)	
				END

			END
		END	ELSE
		
			* Try looking in the old format Orders
			
			Extract_SI_Keys('ORDER','LOT_NUM',LotNo,OrderNos)				;* Check for previous use of customer lot number in old data structure	
			IF OrderNos NE '' THEN
			
				LOCATE OrderNo IN OrderNos USING @VM SETTING FPos THEN
					OrderNos = DELETE(OrderNos,1,FPos,0)					;* Exclude the current Order No from this check
				END
			
				IF OrderNos NE '' THEN
					SWAP @VM WITH ', ' IN OrderNos
					
					Message  = 'Lot No ':QUOTE(LotNo):' has been used in Order Number |':OrderNos:'||'
					Message := 'Do you wish to use this duplicate Lot Number?|'
						
					MsgInfo = ''
					MsgInfo<MTEXT$> = Message
					
					Resp = Msg( @WINDOW, MsgInfo,'CUST_LOT_USED' )
					IF Resp = CHAR(27) THEN
						Set_Property(CtrlEntId,'CELLPOS','',PrevSelPos)
						Set_Property(CtrlEntId,"SELPOS",PrevSelPos)	
					END

				END
			END	
		END	;* End of checks for Lot Nos used elswhere
			
	END 
		
END	 ;* End of check for Previous Cell NE Null

GOSUB Refresh

RETURN
*/


RETURN