705 lines
17 KiB
Plaintext
705 lines
17 KiB
Plaintext
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
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|