COMPILE FUNCTION Comm_Warehouse(Instruction, Parm1,Parm2) /* Commuter module for WAREHOUSE (Inventory Warehouse ) window 10/19/2006 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, Set_Status, ErrMsg, Set_Property, obj_AppWindow, Send_Message DECLARE SUBROUTINE Btree.Extract, Send_Event, Security_Err_Msg, DECLARE FUNCTION Get_Property, Get_Status, Popup, Send_Message, Msg, Security_Check, Dialog_Box $INSERT POPUP_EQUATES $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT WAREHOUSE_EQUATES $INSERT LSL_USERS_EQU $INSERT SECURITY_RIGHTS_EQU EQU CRLF$ TO \0D0A\ ErrTitle = 'Error in Comm_Warehouse' ErrorMsg = '' Result = '' BEGIN CASE CASE Instruction = 'Create' ; GOSUB Create CASE Instruction = 'Refresh' ; GOSUB Refresh CASE Instruction = 'Read' ; GOSUB Read CASE Instruction = 'Write' ; GOSUB Write CASE Instruction = 'Clear' ; GOSUB Clear CASE Instruction = 'Delete' ; GOSUB Delete CASE Instruction = 'Close' ; GOSUB Close CASE Instruction = 'LUWhCd' ; GOSUB LUWhCd CASE Instruction = 'LocDC' ; GOSUB LocDC CASE 1 ErrorMsg = 'Unknown Instruction passed to routine' END CASE RETURN Result * * * * * * * Create: * * * * * * * obj_Appwindow('Create',@WINDOW) GOSUB Refresh RETURN * * * * * * * Read: * * * * * * * GOSUB Refresh RETURN * * * * * * * Write: * * * * * * * RETURN * * * * * * * Clear: * * * * * * * GOTO Refresh RETURN * * * * * * * Delete: * * * * * * * RETURN * * * * * * * Close: * * * * * * * 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> IF ETCtrl NE @WINDOW:'.CASSETTES' THEN 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 END NEXT I RETURN * * * * * * * LUWhCd: * * * * * * * IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1 IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2 WHCd = Popup(@WINDOW,'','WAREHOUSE') IF WHCd NE '' THEN obj_Appwindow('LUValReturn',WHCd:@RM:FocusControl:@RM:FocusPos) END RETURN * * * * * * * LocDC: * * * * * * * WhNo = Get_Property(@WINDOW:'.WH_CD','DEFPROP') IF WhNo = '' THEN RETURN CtrlEntID = @WINDOW:'.LOCATION' CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> LocCd = Get_Property(CtrlEntID,'CELLPOS',1:@FM:CurrRow) IF WHNo NE '' AND LocCd NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'LOCATION' DetKeys = WhNo:'*':LocCd DefaultRec = '' RetKey = WhNo 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 RETURN