387 lines
8.5 KiB
Plaintext
387 lines
8.5 KiB
Plaintext
COMPILE FUNCTION Comm_NCR_Query(Method, Parm1)
|
|
|
|
/*
|
|
Commuter module for NCR_Query window.
|
|
|
|
03/27/2006 - John C. Henry, J.C. Henry & Co., Inc.
|
|
*/
|
|
|
|
DECLARE SUBROUTINE Set_Property, End_Dialog, Set_Status, ErrMsg, Utility
|
|
DECLARE SUBROUTINE obj_Appwindow, Start_Window, Msg, Send_Message, Btree.Extract
|
|
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Popup
|
|
|
|
EQU CRLF$ TO \0D0A\
|
|
|
|
$INSERT POPUP_EQUATES
|
|
$INSERT LSL_USERS_EQU
|
|
$INSERT MSG_EQUATES
|
|
|
|
|
|
ErrTitle = 'Error in Comm_NCR_Query'
|
|
ErrorMsg = ''
|
|
|
|
Result = ''
|
|
|
|
BEGIN CASE
|
|
CASE Method = 'Create' ; GOSUB Create
|
|
CASE Method = 'LUReactor' ; GOSUB LUReactor
|
|
CASE Method = 'LUDate' ; GOSUB LUDate
|
|
CASE Method = 'CustChar' ; GOSUB CustChar
|
|
CASE Method = 'LUCustNo' ; GOSUB LUCustNo
|
|
CASE Method = 'LUPsnNo' ; GOSUB LUPsnNo
|
|
CASE Method = 'RespDeptDC' ; GOSUB RespDeptDC
|
|
CASE Method = 'Query' ; GOSUB Query
|
|
CASE Method = 'Cancel' ; GOSUB Cancel
|
|
CASE Method = 'Refresh' ; GOSUB Refresh
|
|
CASE 1
|
|
ErrMsg(ErrTitle:@SVM:'Unknown method ':QUOTE(Method):' passed to routine.')
|
|
|
|
END CASE
|
|
|
|
|
|
RETURN Result
|
|
|
|
|
|
* * * * * * *
|
|
Create:
|
|
* * * * * * *
|
|
|
|
obj_AppWindow('Create')
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Refresh:
|
|
* * * * * * *
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Close:
|
|
* * * * * * *
|
|
|
|
|
|
* * * * * * *
|
|
Cancel:
|
|
* * * * * * *
|
|
|
|
End_Dialog(@WINDOW,'Cancel')
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUDate:
|
|
* * * * * * *
|
|
|
|
ReturnCtrl = Parm1[1,@RM]
|
|
|
|
IF ReturnCtrl = '' THEN ReturnCtrl = Get_Property(@WINDOW,'FOCUS')
|
|
|
|
DateSelected = Dialog_Box('POPUP_YEAR',@WINDOW)
|
|
|
|
RetVal = OCONV(DateSelected, 'D4/')
|
|
|
|
IF RetVal NE '' THEN
|
|
obj_Appwindow('LUValReturn',RetVal:@RM:ReturnCtrl)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
LUReactor:
|
|
* * * * * * *
|
|
|
|
ReturnCtrl = Parm1
|
|
|
|
IF ReturnCtrl = '' THEN Return
|
|
|
|
|
|
IF INDEX(ReturnCtrl,'.',1) ELSE
|
|
ReturnCtrl = @WINDOW:'.':ReturnCtrl
|
|
END
|
|
|
|
|
|
ReactorNo = Popup(@WINDOW,'','REACTORS')
|
|
IF ReactorNo = '' THEN
|
|
RETURN
|
|
END ELSE
|
|
obj_AppWindow('LUValReturn',ReactorNo:@RM:ReturnCtrl)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
CustChar:
|
|
* * * * * * *
|
|
|
|
CtrlName = @WINDOW:'.CUST_NO'
|
|
|
|
DataIn = Get_Property(CtrlName,'TEXT')
|
|
|
|
IF LEN(DataIn) > 2 THEN
|
|
|
|
ReturnToCtrl = CtrlName
|
|
|
|
IF NOT(NUM(DataIn)) THEN
|
|
Set_Property(CtrlName,'TEXT','') ;* Clear characters input
|
|
Start_Window('COMP_LOOKUP',@WINDOW,DataIn:@VM:'C':@FM:ReturnToCtrl,'','')
|
|
END
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUCustNo:
|
|
* * * * * * *
|
|
|
|
IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1
|
|
IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2
|
|
|
|
TypeOver = ''
|
|
TypeOver<PSELECT$> = 1
|
|
|
|
CustNo = Popup(@WINDOW,TypeOver,'CUSTOMER')
|
|
IF CustNo NE '' THEN
|
|
obj_Appwindow('LUValReturn',CustNo:@RM:FocusControl:@RM:FocusPos)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUPsnNo:
|
|
* * * * * * *
|
|
|
|
CPSKeys = Dialog_Box( 'PROD_SPEC_QUERY', @WINDOW, '' )
|
|
|
|
CONVERT @FM TO @VM IN CPSKeys
|
|
|
|
TypeOver = ''
|
|
TypeOver<PDISPLAY$> = CPSKeys
|
|
TypeOver<PMODE$> = 'K'
|
|
TypeOver<PTYPE$> = 'K'
|
|
TypeOver<PSELECT$> = 1
|
|
|
|
PsnNo = Popup(@WINDOW,TypeOver,'PROD_SPEC_QUERY')
|
|
|
|
IF PsnNo = '' THEN
|
|
RETURN
|
|
END ELSE
|
|
obj_AppWindow('LUValReturn',PsnNo:@RM:ReturnCtrl)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
RespDeptDC:
|
|
* * * * * * *
|
|
|
|
CtrlEntID = @WINDOW:'.RESP_DEPARTMENTS'
|
|
|
|
CurrList = Get_Property(CtrlEntID,'ARRAY')
|
|
|
|
LastItemNo = 0
|
|
RespDeptNo = 0
|
|
ListCnt = COUNT(CurrList,@VM) + (CurrList NE '')
|
|
|
|
FOR I = 1 TO ListCnt
|
|
RespDept = CurrList<1,I>
|
|
IF RespDept = '' THEN
|
|
RespDeptNo = 0
|
|
END ELSE
|
|
RespDeptNo = I
|
|
END
|
|
|
|
IF RespDeptNo > LastItemNo THEN LastItemNo = RespDeptNo
|
|
NEXT I
|
|
|
|
TypeOver = ''
|
|
TypeOver<PSELECT$> = 2
|
|
NewDepts = Popup(@WINDOW,TypeOver,'RESP_DEPARTMENT')
|
|
|
|
|
|
IF NewDepts = '' THEN
|
|
RETURN
|
|
END ELSE
|
|
FOR N = 1 TO COUNT(NewDepts,@VM) + (NewDepts NE '')
|
|
NewDept = NewDepts<1,N>
|
|
LOCATE NewDept IN CurrList USING @VM SETTING Dummy ELSE
|
|
Send_Message(CtrlEntID, 'INSERT', LastItemNo + 1, NewDepts<1,N>)
|
|
LastItemNo += 1
|
|
END
|
|
|
|
NEXT N
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Query:
|
|
* * * * * * *
|
|
|
|
Ctrls = @WINDOW:'.NCR_DATE_FROM':@RM ; Props = 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.NCR_DATE_THRU':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.OPEN_CHECK':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.CLOSED_CHECK':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.VERIFIED_CHECK':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.STAGE_PRE':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.STAGE_POST':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.BY_MANUFACTURING':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.BY_CUSTOMER':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.CHK_TEAM_A':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.CHK_TEAM_B':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.CHK_TEAM_C':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.CHK_TEAM_D':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.REACTOR':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.CUST_NO':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.PROD_SPEC_NO':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.RDS_IDS':@RM ; Props := 'DEFPROP':@RM
|
|
Ctrls := @WINDOW:'.RESP_DEPARTMENTS' ; Props := 'DEFPROP'
|
|
|
|
Props = Get_Property(Ctrls,Props)
|
|
|
|
DateFrom = Props[1,@RM]
|
|
DateThru = Props[COL2()+1,@RM]
|
|
OpenCheck = Props[COL2()+1,@RM]
|
|
ClosedCheck = Props[COL2()+1,@RM]
|
|
VerifiedCheck = Props[COL2()+1,@RM]
|
|
StagePre = Props[COL2()+1,@RM]
|
|
StagePost = Props[COL2()+1,@RM]
|
|
ByManufacturing = Props[COL2()+1,@RM]
|
|
ByCustomer = Props[COL2()+1,@RM]
|
|
TeamA = Props[COL2()+1,@RM]
|
|
TeamB = Props[COL2()+1,@RM]
|
|
TeamC = Props[COL2()+1,@RM]
|
|
TeamD = Props[COL2()+1,@RM]
|
|
Reactor = Props[COL2()+1,@RM]
|
|
CustNo = Props[COL2()+1,@RM]
|
|
PsnNo = Props[COL2()+1,@RM]
|
|
RDSIds = Props[COL2()+1,@RM]
|
|
RespDepartments = Props[COL2()+1,@RM]
|
|
|
|
SWAP @VM:@VM WITH '' IN RDSIds
|
|
IF RDSIds[-1,1] = @VM THEN RDSIds[-1,1] = ''
|
|
|
|
SWAP @VM:@VM WITH '' in RespDepartments
|
|
IF RespDepartments[-1,1] = @VM THEN RespDepartments[-1,1] = ''
|
|
|
|
SearchStr = ''
|
|
|
|
IF DateFrom NE '' AND DateThru NE '' THEN
|
|
SearchStr<-1> = 'ENTRY_DATE':@VM:DateFrom:'...':DateThru
|
|
END ELSE
|
|
IF DateFrom THEN SearchStr<-1> = 'ENTRY_DATE':@VM:'>=':DateFrom
|
|
IF DateThru THEN SearchStr<-1> = 'ENTRY_DATE':@VM:'<=':DateThru
|
|
END
|
|
|
|
|
|
StatusVar = '' ;* * * * * * NCR Status
|
|
|
|
IF OpenCheck THEN StatusVar<1,-1> = 'O'
|
|
IF ClosedCheck THEN StatusVar<1,-1> = 'C'
|
|
IF VerifiedCheck THEN StatusVar<1,-1> = 'V'
|
|
|
|
IF StatusVar NE '' THEN SearchStr<-1> = 'STATUS':@VM:StatusVar
|
|
|
|
|
|
PrePost = '' ;* * * * * * Loss Stage
|
|
|
|
IF StagePre THEN PrePost<1,-1> = 'PRE'
|
|
IF StagePost THEN PrePost<1,-1> = 'POST'
|
|
|
|
IF PrePost NE '' THEN SearchStr<-1> = 'LOSS_STAGE':@VM:PrePost
|
|
|
|
|
|
CausedBy = '' ;* * * * * * Loss By
|
|
|
|
IF ByManufacturing THEN CausedBy<1,-1> = 'M'
|
|
IF ByCustomer THEN CausedBy<1,-1> = 'C'
|
|
|
|
IF CausedBy THEN SearchStr<-1> = 'LOSS_BY':@VM:CausedBy
|
|
|
|
Shifts = '' ;* * * * * * Teams (Shift)
|
|
|
|
IF TeamA THEN
|
|
Shifts<1,-1> = 'A'
|
|
Shifts<1,-1> = '1'
|
|
end
|
|
IF TeamB THEN
|
|
Shifts<1,-1> = 'B'
|
|
Shifts<1,-1> = '2'
|
|
end
|
|
IF TeamC THEN
|
|
Shifts<1,-1> = 'C'
|
|
Shifts<1,-1> = '3'
|
|
end
|
|
IF TeamD THEN
|
|
Shifts<1,-1> = 'D'
|
|
Shifts<1,-1> = '4'
|
|
end
|
|
|
|
IF Shifts NE '' THEN SearchStr<-1> = 'SHIFT':@VM:Shifts
|
|
|
|
IF Reactor NE '' THEN SearchStr<-1> = 'REACTOR':@VM:Reactor
|
|
IF CustNo NE '' THEN SearchStr<-1> = 'CUST_ID':@VM:CustNo
|
|
IF PsnNo NE '' THEN SearchStr<-1> = 'PSN_NO':@VM:PsnNo
|
|
|
|
IF RDSIds NE '' THEN SearchStr<-1> = 'RDS_ID':@VM:RDSIds
|
|
|
|
IF RespDepartments NE '' THEN SearchStr <-1> = 'DEPT_RESP':@VM:RespDepartments
|
|
|
|
OPEN 'DICT.NCR' TO DictNCRTable ELSE
|
|
ErrMsg( 'Unable to open DICT.NCR...' )
|
|
GOTO Cancel
|
|
END
|
|
|
|
IF SearchStr THEN
|
|
SearchStr := @FM
|
|
Utility( 'CURSOR', 'H' )
|
|
Set_Status(0)
|
|
Btree.Extract( SearchStr, 'NCR', DictNCRTable, NCRKeys, '', Flag )
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
RETURN
|
|
END
|
|
|
|
IF NCRKeys THEN
|
|
|
|
NCRKeys := @VM
|
|
CONVERT @VM TO @RM IN NCRKeys
|
|
CALL V119('S','','D','R',NCRKeys,'')
|
|
IF Get_Status(errCode) THEN DEBUG
|
|
CONVERT @RM TO @VM IN NCRKeys
|
|
NCRKeys[-1,1] = '' ;* Strip trailing delimiter
|
|
|
|
End_Dialog( @WINDOW, NCRKeys )
|
|
END ELSE
|
|
MsgInfo = ''
|
|
MsgInfo<mtext$> = 'No records found meeting your criteria...'
|
|
MsgInfo<micon$> = '!'
|
|
Void = msg( '', MsgInfo )
|
|
END
|
|
Utility( 'CURSOR', 'A' )
|
|
END ELSE
|
|
MsgInfo = ''
|
|
MsgInfo<mtext$> = 'You have not entered any search criteria...'
|
|
MsgInfo<micon$> = '!'
|
|
Void = msg( '', MsgInfo )
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
|