COMPILE FUNCTION Comm_React_Servs(EntID,Event,Parm1,Parm2,Parm3,Parm4,Parm5) /* TCommuter module for REACT_SERVS (Reactor Services) window 10/23/2013 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window, Post_Event DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow, DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window, Create_Note DECLARE SUBROUTINE React_Servs_Services DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup, Collect.Ixvals DECLARE FUNCTION Send_Message, Msg, Security_Check, RowExists, NextKey, End_Window, React_Servs_Services $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT LSL_USERS_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT REACT_SERVS_EQUATES $INSERT POPUP_EQUATES $INSERT LOGICAL EQU CRLF$ TO \0D0A\ EQU TAB$ TO \09\ ErrTitle = 'Error in Comm React Servs' ErrorMsg = '' Result = '' BEGIN CASE CASE EntID = @WINDOW BEGIN CASE CASE Event = 'CLEAR' ; GOSUB Clear CASE Event = 'CREATE' ; GOSUB Create CASE Event = 'CLOSE' ; GOSUB Close CASE Event = 'WRITE' ; GOSUB Write CASE Event = 'READ' ; GOSUB Read CASE Event = 'DELETE' ; GOSUB Delete CASE Event[1,3] = 'QBF' ; GOSUB Refresh END CASE CASE EntID = @WINDOW:'.LU_SYSTEM' AND Event = 'CLICK' ; GOSUB LUSystem CASE EntID = @WINDOW:'.LU_REACT_ITEM' AND Event = 'CLICK' ; GOSUB LUReactItem CASE EntID = @WINDOW:'.LU_ITEM_TYPE' AND Event = 'CLICK' ; GOSUB LUReactItemType /* CASE EntID = @WINDOW:'.SIGN_INSP' AND Event = 'CLICK' ; GOSUB SignInsp CASE EntID = @WINDOW:'.SIGN_SCAN' AND Event = 'CLICK' ; GOSUB SignScan CASE EntID = @WINDOW:'.SPEC_BRIGHTLIGHT' AND Event = 'CLICK' ; GOSUB Refresh CASE EntID = @WINDOW:'.SPEC_MICROSCOPE' AND Event = 'CLICK' ; GOSUB Refresh CASE EntID = @WINDOW:'.REFRESH_SPEC' AND Event = 'CLICK' ; GOSUB RefreshSpec CASE EntID = @WINDOW:'.CI_TAB' AND Event = 'CLICK' ; GOSUB Page CASE FIELD(EntID,'.',2) = 'ROTR_ACTION' AND Event = 'CLICK' ; GOSUB Refresh CASE EntID = @WINDOW:'.CLEAN_RESULTS' BEGIN CASE CASE Event = 'POSCHANGED' ; GOSUB CleanPC CASE Event = 'DBLCLK' ; GOSUB CleanDC END CASE CASE EntID = @WINDOW:'.INSP_RESULTS' BEGIN CASE CASE Event = 'POSCHANGED' ; GOSUB InspPC CASE Event = 'DBLCLK' ; GOSUB InspDC END CASE CASE EntID = @WINDOW:'.SCAN_RESULTS' BEGIN CASE CASE Event = 'POSCHANGED' ; GOSUB ScanPC CASE Event = 'DBLCLK' ; GOSUB ScanDC END CASE CASE EntID = @WINDOW:'.SEND_SPC' AND Event = 'CLICK' ; GOSUB SendSPC */ CASE 1 ErrorMsg = 'Unknown Parameters ':EntID:' - ':Event:' passed to commuter' ErrMsg(ErrorMsg) END CASE IF ErrorMsg NE '' THEN ErrMsg(ErrTitle:@SVM:ErrorMsg) END RETURN Result * * * * * * * Create: * * * * * * * IF NOT(Security_Check('React Servs',Read$)) THEN Security_Err_Msg('React Servs',Read$) void = End_Window( @WINDOW, '' ) RETURN END IF NOT(Security_Check('React Servs',Edit$)) THEN Security_Err_Msg('React Servs',Edit$) END ReactMetrics = React_Servs_Services('GetReactMetrics') Set_Property(@Window:'.ASSOC_METRICS', 'LIST', ReactMetrics) obj_Appwindow('Create',@WINDOW) GOSUB Refresh RETURN * * * * * * * Clear: * * * * * * * Send_Event(@WINDOW,'PAGE',1) IF Get_Property(@WINDOW,'@READONLY') THEN obj_AppWindow('ReadOnly',@RM:1) ;* Reenables data bound controls Set_Property(@WINDOW,'@READONLY',0) ;* Clear flag on window END * * * * * * * Refresh: * * * * * * * /* * * * * * Samples * * * * * * ACStatus = Get_Property(@WINDOW:'.AC_STATUS','TEXT') IF ACStatus NE '' THEN IF ACStatus[1,1] = 'C' THEN Set_Property(@WINDOW:'.AC_STATUS','BACKCOLOR',RED$) END ELSE Set_Property(@WINDOW:'.AC_STATUS','BACKCOLOR',GREEN$) END END Captive = Get_Property(@WINDOW:'.CAPTIVE','CHECK') Consignment = Get_Property(@WINDOW:'.CONSIGNMENT','CHECK') BEGIN CASE CASE Captive Set_Property(@WINDOW:'.ORD_TYPE','BACKCOLOR',LTBLUE$) CASE Consignment Set_Property(@WINDOW:'.ORD_TYPE','BACKCOLOR',YELLOW$) CASE 1 Set_Property(@WINDOW:'.ORD_TYPE','BACKCOLOR',GREEN$) END CASE Ctrls = @WINDOW:'.CHANGE_VISION_ORD_NO':@RM ; Props = 'ENABLED':@RM Ctrls := @WINDOW:'.CUST_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.CONTACT_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.CREATE_WO_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.VIEW_AC':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.NEW_ITEM_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.SHIP_TO_EDIT':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.BILL_TO_EDIT':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.LU_CUST_NO':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.LU_COMP_CONTACT':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.LU_AC' ; Props := 'ENABLED' IF Get_Property(@WINDOW,'@READONLY') THEN Vals = STR('0':@RM,11) ;* ReadOnly mode - kill the buttons END ELSE Vals = STR('1':@RM,11) ;* Normal mode - enable the buttons END Vals[-1,1] = '' Set_Property(Ctrls,Props,Vals) ;* Kill the function buttons when in view only mode */ * * * * * End of Samples * * * * * * * 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 I NEXT I RETURN * * * * * * * Page: * * * * * * * obj_Appwindow('Page') RETURN * * * * * * * LUSystem: * * * * * * * ReturnCtrl = Parm1 IF ReturnCtrl NE '' THEN ReturnCtrl = @WINDOW:'.':ReturnCtrl END ELSE ReturnCtrl = '' END Set_Status(0) ReactSystem = Popup(@WINDOW,'','REACT_SYSTEM') IF ReactSystem = '' THEN RETURN obj_Appwindow('LUValReturn',ReactSystem:@RM:ReturnCtrl) RETURN * * * * * * * LUREactItem: * * * * * * * ReturnCtrl = Parm1 IF ReturnCtrl NE '' THEN ReturnCtrl = @WINDOW:'.':ReturnCtrl END ELSE ReturnCtrl = '' END Set_Status(0) ReactItem = Popup(@WINDOW,'','REACT_ITEMS') IF ReactItem = '' THEN RETURN obj_Appwindow('LUValReturn',ReactItem:@RM:ReturnCtrl) RETURN * * * * * * * LUReactItemType: * * * * * * * ReturnCtrl = Parm1 IF ReturnCtrl NE '' THEN ReturnCtrl = @WINDOW:'.':ReturnCtrl END ELSE ErrorMsg = 'ReturnCtrl not specified' RETURN END RetVal = Popup(@WINDOW,'','REACT_ITEM_TYPE') IF RetVal = '' THEN RETURN obj_Appwindow('LUValReturn',RetVal:@RM:ReturnCtrl) RETURN * * * * * * * Read: * * * * * * * /* NewRecord = false$ if rowexists( 'REACT_SERVS', .serv_id->text ) then ReadOk = true$ end else * user is trying to add new do they have write rights if security_check( 'React Servs', Write$ ) then ReadOk = true$ end else security_err_msg( 'React Servs', Write$ ) ReadOk = false$ .serv_id->text = '' Void = post_event( CtrlEntId, 'CLEAR', False$, True$ ) end NewRecord = true$ end if ReadOk then if get_property( @window, '@NoRead' ) then Void = set_property( @window, '@NoRead', 0 ) end else * no qbf active do the read * if it is active the read already took place forward_event() end ServId = .serv_id->text ProtectVar = 'ENTRY_ID/ENTRY_DATE/SERV_CAT_DESC' swap '/' with @rm:@window:'.' in ProtectVar ProtectVar = @window:'.':ProtectVar Void = set_property( ProtectVar, 'ENABLED', 0 ) if rowexists( 'REACT_SERVS', ServId ) else .entry_id->text = oconv( @user4, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ) .entry_date->text = oconv( date(), 'D2/' ) .graphite_or_tube->value = '' end if NewRecord else if security_check( 'React Servs', Edit$ ) else * protect all fields AllControls = utility( 'OBJECTLIST', @window, '' ) Acnt = fieldcount( AllControls, @fm ) for i = 1 to Acnt ThisControl = AllControls if ThisControl[-6,6] = '_LABEL' or index( ThisControl, 'MENU', 1 ) or index( ThisControl, 'TEXT', 1 ) else void = set_property( ThisControl, 'ENABLED', 0 ) end next i Void = scroll_enable() end end end */ /* NewRecord = false$ if rowexists( 'REACT_SERV_CAT', .cat_id->text ) then ReadOk = true$ end else * user is trying to add new do they have write rights if security_check( 'React Serv Cat', Write$ ) then ReadOk = true$ end else security_err_msg( 'React Serv Cat', Write$ ) ReadOk = false$ .cat_id->text = '' Void = post_event( CtrlEntId, 'CLEAR', False$, True$ ) end NewRecord = true$ end if ReadOk then if get_property( @window, '@NoRead' ) then Void = set_property( @window, '@NoRead', 0 ) end else * no qbf active do the read * if it is active the read already took place forward_event() end CatId = .cat_id->text ProtectVar = 'ENTRY_ID/ENTRY_DATE' swap '/' with @rm:@window:'.' in ProtectVar ProtectVar = @window:'.':ProtectVar Void = set_property( ProtectVar, 'ENABLED', 0 ) if rowexists( 'REACT_SERV_CAT', CatId ) else .entry_id->text = oconv( @user4, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ) .entry_date->text = oconv( date(), 'D2/' ) end if NewRecord else if security_check( 'React Serv Cat', Edit$ ) else * protect all fields AllControls = utility( 'OBJECTLIST', @window, '' ) Acnt = fieldcount( AllControls, @fm ) for i = 1 to Acnt ThisControl = AllControls if ThisControl[-6,6] = '_LABEL' or index( ThisControl, 'MENU', 1 ) or index( ThisControl, 'TEXT', 1 ) else void = set_property( ThisControl, 'ENABLED', 0 ) end next i Void = scroll_enable() end end end RETURN 0 */ /* OrderNo = Get_Property(@WINDOW:'.ORD_NO','TEXT') IF RowExists('ORDER',OrderNo) 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: * * * * * * * /* OrderNo = Get_Property(@WINDOW:'.ORD_NO','TEXT') Message = '' IF RowExists('ORDER',OrderNo) THEN IF Get_Property(@WINDOW,'SAVEWARN') THEN Message = 'Order No. ':OrderNo:' has been changed.' END END ELSE Message = 'New Order ':QUOTE(OrderNo):' entered into system.' END IF Message NE '' THEN Recipients = XLATE('NOTIFICATION','ORDER_ENTRY',NOTIFICATION_USER_ID$,'X') SentFrom = @USER4 Subject = 'New/Update Order':OrderNo AttachWindow = 'ORDER2' AttachKey = OrderNo SendToGroup = '' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup *obj_Notes('Create',Parms) ;* Per Request from Customer Service IF Get_Status(errCode) THEN ErrMsg(errCode) END END */ Result = 1 RETURN * * * * * * * Delete: * * * * * * * IF Security_Check('React Servs',Delete$ ) THEN Result = 1 ;* Proceed with delete END ELSE Security_Err_Msg('React Servs',Delete$) Result = 0 ;* Stop event chain (and delete) END RETURN * * * * * * * Close: * * * * * * * obj_Notes('Inbox',@USER4) ;* Checks for any new messages obj_Appwindow('CardReturn',@WINDOW) RETURN * * * * * * * ItemDC: * * * * * * * /* OrderNo = Get_Property(@WINDOW,'ID') CtrlEntID = @WINDOW:'.ORDER_DET' CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> IF CurrCol = COL$ITEM_NO THEN ItemNo = Get_Property(CtrlEntID,'CELLPOS',COL$ITEM_NO:@FM:CurrRow) IF OrderNo NE '' AND ItemNo NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'ORDER_DET' DetKeys = OrderNo:'*':ItemNo DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END END END ;* End of ItemNo column IF CurrCol = COL$QUOTE_NO THEN QuoteNo = Get_Property(CtrlEntID,'CELLPOS',COL$QUOTE_NO:@FM:CurrRow) IF OrderNo NE '' AND QuoteNo NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'QUOTE2' DetKeys = QuoteNo DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END END END ;* End of QuoteNo column IF CurrCol = COL$WO_NO THEN WONo = Get_Property(CtrlEntID,'CELLPOS',COL$WO_NO:@FM:CurrRow) IF OrderNo NE '' AND WONo NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'WO_LOG2' DetKeys = WONo DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END END END ;* End of WO column IF CurrCol = COL$EPI_PN THEN EpiPN = Get_Property(CtrlEntID,'CELLPOS',COL$EPI_PN:@FM:CurrRow) IF OrderNo NE '' AND EpiPN NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'EPI_PART' DetKeys = EpiPN DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END END END ;* End of Epi Part Number column */ RETURN