COMPILE FUNCTION Comm_Cust_TW_Part(CtrlEntID,Event,Parm1, Parm2, Parm3, Parm4, Parm5) /* Commuter module for CUST_TW_PART (Test Wafer Use) window 12/2/2010 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, Set_Status, ErrMsg, Set_Property, obj_AppWindow, Btree.Extract DECLARE SUBROUTINE Send_Event, obj_TW_Use, Security_Err_Msg, Post_Event, Start_Window DECLARE FUNCTION Get_Property, Get_Status, Popup, Send_Message, Msg DECLARE FUNCTION obj_Quote, Security_Check $INSERT QUOTE_SIGS_EQU $INSERT NOTIFICATION_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT ANNUAL_CONTRACTS_EQU $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT POPUP_EQUATES EQU CRLF$ TO \0D0A\ ErrTitle = 'Error in Comm_Cust_TW_Part' ErrorMsg = '' Result = '' BEGIN CASE CASE CtrlEntID = @WINDOW AND Event = 'CREATE' ; GOSUB Create CASE CtrlEntID = @WINDOW AND Event = 'READ' ; GOSUB Read CASE CtrlEntID = @WINDOW AND Event = 'DELETE' ; GOSUB Delete CASE CtrlEntID = @WINDOW AND Event = 'CLEAR' ; GOSUB Refresh CASE CtrlEntID = @WINDOW AND Event[1,3] = 'QBF' ; GOSUB Refresh CASE CtrlEntID = @WINDOW:'.CUST_NO' BEGIN CASE CASE Event = 'CHAR' ; GOSUB CustChar CASE Event = 'LOSTFOCUS' ; GOSUB LU_TWPartNo END CASE CASE CtrlEntID = @WINDOW:'.LU_CUSTOMER' AND Event = 'CLICK' ; GOSUB LUCustNo CASE CtrlEntID = @WINDOW:'.LU_TW_PART' AND Event = 'CLICK' ; GOSUB LU_TWPartNo CASE 1 ErrorMsg = 'Unknown Instruction passed to routine':CRLF$:CtrlEntID:' - ':Event END CASE IF ErrorMsg NE '' THEN ErrMsg(ErrTitle:@SVM:ErrorMsg) END RETURN Result * * * * * * * Create: * * * * * * * obj_Appwindow('Create',@WINDOW) * Provides compatibility with the existing messaging attachment system IF Parm1 NE '' THEN PassedKeys = FIELD(Parm1,'*',1) obj_Appwindow('ViewRelated',@WINDOW:@RM:PassedKeys) END IOOptions = Get_Property(@WINDOW,'IOOPTIONS') IOOptions<10> = 1 ;* Check for required fields on WRITE event IOOptions<11> = 1 ;* Create READ event on QBF load Set_Property(@WINDOW,'IOOPTIONS',IOOptions) GOSUB Refresh Return * * * * * * * Read: * * * * * * * OrderNo = Get_Property(@WINDOW:'.ORDER_NO','TEXT') ItemNo = Get_Property(@WINDOW:'.ITEM_NO','TEXT') IF RowExists('ORDER_DET',OrderNo:'*':ItemNo) THEN IF NOT(Security_Check('Order',EDIT$)) THEN obj_AppWindow('ReadOnly',@WINDOW) ;* disable all database controls Set_Property(@WINDOW,'@READONLY',1) END END ELSE IF NOT(Security_Check('Order',WRITE$)) THEN Send_Event(@WINDOW,'CLEAR') Security_Err_Msg('Order',WRITE$) RETURN END END GOSUB Refresh Return * * * * * * * Write: * * * * * * * Post_Event(@WINDOW,'CLOSE') Return * * * * * * * Clear: * * * * * * * obj_AppWindow('ReadOnly',@RM:1) ;* Reenables data bound controls Set_Property(@WINDOW,'@READONLY',0) ;* Clear flag on window GOTO Refresh Return * * * * * * * Close: * * * * * * * RETURN * * * * * * * Delete: * * * * * * * IF NOT(Security_Check('Order',DELETE$)) THEN Security_Err_Msg('Order',DELETE$) RETURN END *Forward_Event() obj_AppWindow('ReadOnly',@WINDOW:@RM:1) ;* Clear Read Only Result = 0 RETURN * * * * * * * Refresh: * * * * * * * * 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 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 Line NEXT I 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 = 1 CustNo = Popup(@WINDOW,TypeOver,'CUSTOMER') IF CustNo NE '' THEN obj_Appwindow('LUValReturn',CustNo:@RM:FocusControl:@RM:FocusPos) END RETURN * * * * * * * ViewCust: * * * * * * * CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') IF CustNo NE '' THEN obj_Appwindow('ViewRelated','CUSTOMER_EPI':@RM:CustNo) END RETURN * * * * * * * LU_TWPartNo: * * * * * * * CustNo = Get_Property(@WINDOW:'.CUST_NO','DEFPROP') TWPartNo = Get_Property(@WINDOW:'.TW_PART_NO','DEFPROP') IF TWPartNo NE '' THEN RETURN IF CustNo = '' THEN OPEN 'CUST_TW_PART' TO FileIn THEN SELECT FileIn TypeOver = '' TypeOver = 'C' TypeOver = '0' CustTWPartKeys = Popup(@WINDOW,TypeOver,'CUST_TW_PART') IF Get_Status(errCode) THEN ErrMsg(errCode) END END ELSE IF NOT(NUM(CustNo)) THEN * Doing customer lookup based on typed in name Set_Property(CtrlName,'TEXT','') ;* Clear characters input RETURN END SearchString = 'CUST_NO':@VM:CustNo:@FM OPEN 'DICT.CUST_TW_PART' TO DictVar ELSE ErrMsg('Unable to open DICT.CUST_TW_PART for index lookup.') RETURN END Options = '' Flag = '' BTREE.EXTRACT(SearchString, 'CUST_TW_PART', DictVar, CustTWPartKeys, Options, flag) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END IF CustTWPartKeys = '' THEN ErrMsg('No TW Part Numbers on file for Customer ':QUOTE(CustNo):'.') RETURN END TypeOver = '' TypeOver = CustTWPartKeys CustTWPartKeys = Popup(@WINDOW,TypeOver,'CUST_TW_PART') IF Get_Status(errCode) THEN ErrMsg(errCode) END ;* End of check for null Customer numer IF CustTWPartKeys NE '' THEN IF INDEX(CustTWPartKeys,@VM,1) THEN Send_Event(@WINDOW,'QBFINIT') Set_Property(@WINDOW,'QBFLIST',CustTWPartKeys) Send_Event(@WINDOW,'QBFFIRST') END ELSE obj_Appwindow('LoadFormKeys',@WINDOW:@RM:CustTWPartKeys) END END RETURN