212 lines
		
	
	
		
			3.9 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
			
		
		
	
	
			212 lines
		
	
	
		
			3.9 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
| 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<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 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
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 |