COMPILE FUNCTION Comm_Invoice(Instruction, Parm1,Parm2) /* Commuter module for Invoice window 02/27/2005 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window, Post_Event, Set_List_Box_Data 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 DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup DECLARE FUNCTION Send_Message, Msg, Security_Check, NextKey $INSERT POPUP_EQUATES $INSERT LOGICAL $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT COC_EQU $INSERT LSL_USERS_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT WO_LOG_EQU $INSERT WO_STEP_EQU $INSERT COMPANY_EQU $INSERT INVOICE_EQU ErrTitle = 'Error in Comm_Invoice' ErrorMsg = '' Result = '' /* Most of this is not used. Invoicing will be moving to the Vision system so the only things this is used for is button events from the OLD Invoice window. Leave the rest of the stuff here just in case. JCH 7/24/2005 */ 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 = 'Page' ; GOSUB Page CASE Instruction = 'Close' ; GOSUB Close CASE Instruction = 'ViewCust' ; GOSUB ViewCust CASE Instruction = 'ViewOrder' ; GOSUB ViewOrder CASE Instruction = 'ViewWO' ; GOSUB ViewWO CASE Instruction = 'ViewShipment' ; GOSUB ViewShipment CASE 1 ErrorMsg = 'Unknown Instruction ':QUOTE(Instruction):' passed to routine.' ErrMsg(ErrorMsg) END CASE RETURN Result * * * * * * * Create: * * * * * * * IF NOT(Security_Check('COC',READ$)) THEN Security_Err_Msg('COC',READ$) End_Window(@WINDOW) RETURN END obj_Appwindow('Create',@WINDOW) Set_List_Box_Data(@WINDOW) GOSUB Refresh RETURN * * * * * * * Clear: * * * * * * * Send_Event(@WINDOW,'PAGE',1) obj_AppWindow('ReadOnly',@RM:1) ;* Reenables data bound controls * * * * * * * Refresh: * * * * * * * IF Security_Check('COC',EDIT$) AND (Get_Property(@WINDOW:'.POST_BUTTON','TEXT') = 'Post') THEN obj_AppWindow('ReadOnly',@WINDOW:@RM:1) ;* enable all database controls END ELSE obj_AppWindow('ReadOnly',@WINDOW) ;* disable all database controls END Ctrls = @WINDOW:'.POST_BUTTON':@RM ; Props = 'TEXT':@RM Ctrls := @WINDOW:'.POST_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.POSTED_FIX':@RM ; Props := 'VISIBLE':@RM Ctrls := @WINDOW:'.UNPOST_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.UNPOST_BUTTON' ; Props := 'VISIBLE' Vals = '' IF Get_Property(@WINDOW:'.POST_DTM','TEXT') NE '' THEN * Timesheet is Posted Vals<1> = 'Posted' ;* PostButton text Vals<2> = 0 ;* PostButton Disabled Vals<3> = 1 ;* Posted Text Visisble Vals<4> = 1 ;* Unpost button Enabled Vals<5> = 1 ;* UnPost button Visible END ELSE Vals<1> = "Post" ;* PostButton text Vals<2> = 1 ;* PostButton Enabled Vals<3> = 0 ;* Posted Text invisible END CONVERT @FM TO @RM IN Vals Set_Property(Ctrls,Props,Vals) Ctrls = @WINDOW:'.ENTER_BY':@RM ; Props = 'TEXT':@RM Ctrls := @WINDOW:'.ENTER_DTM' ; Props := 'TEXT' Vals = Get_Property(Ctrls,Props) EnterBy = Vals[1,@RM] EnterDTM = Vals[COL2()+1,@RM] IF EnterBy = '' THEN Vals = 1:@RM ELSE Vals = 0:@RM IF EnterDTM = '' THEN Vals := 1 ELSE Vals := 0 Props = 'ENABLED':@RM:'ENABLED' Set_Property(Ctrls,Props,Vals) NextNumber = XLATE('DICT.COC','%SK%',1,'X') Set_Property(@WINDOW:'.NEW_BUTTON','TEXT',NextNumber) * 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) * All cassette detail background colors CtrlName = @WINDOW:'.RDS_DETAIL' RDSArray = Get_Property(CtrlName,'INVALUE') RdsStatuses = RDSArray FOR I = 1 TO COUNT(RdsStatuses,@VM) + (RdsStatuses NE '') RdsStatus = RdsStatuses<1,I> RdsHold = RDSArray RdsHotLot = RDSArray IF RdsHold OR RdsHotLot THEN IF RdsHold THEN LineColor = YELLOW$ IF RdsHotLot THEN LineColor = RED$ END ELSE BEGIN CASE CASE RdsStatus[1,3] = 'Rec' ; LineColor = RCV_BLUE$ CASE RdsStatus[1,3] = 'Pre' ; LineColor = PRE_BLUE$ CASE RdsStatus[1,3] = 'In ' ; LineColor = INP_BLUE$ CASE RdsStatus[1,3] = 'Pos' ; LineColor = POS_BLUE$ CASE RdsStatus[1,3] = 'Rea' ; LineColor = GREEN$ CASE RdsStatus[1,3] = 'Shi' ; LineColor = LTGREY$ CASE RdsStatus[1,3] = 'Pro' ; LineColor = RED$ CASE 1 ; LineColor = WHITE$ END CASE END stat = Send_Message(CtrlName,'COLOR_BY_POS',0,I,LineColor) NEXT I * 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:'.RDS_DETAIL' 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 I END NEXT I RETURN * * * * * * * Page: * * * * * * * obj_Appwindow('Page') GOSUB Refresh RETURN * * * * * * * Read: * * * * * * * ShipNo = Get_Property(@WINDOW:'SHIP_NO','TEXT') IF NOT(RowExists('COC',ShipNo)) THEN IF NOT(Security_Check('COC',WRITE$)) THEN Send_Event(@WINDOW,'CLEAR') Security_Err_Msg('COC',WRITE$) RETURN END END EnterBy = Get_Property(@WINDOW:'.ENTER_BY','TEXT') IF EnterBy = '' THEN CurrDate = OCONV(Date(),'D4/') CurrTime = OCONV(Time(),'MTH') CurrDTM = CurrDate:' ':CurrTime IF @USER4 = '' OR @USER4 = 'BRYCE_BARB' THEN @USER4 = 'TESTING' Set_Property(@WINDOW:'.ENTER_BY','TEXT',OCONV(@USER4,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')) Set_Property(@WINDOW:'.ENTER_DTM','TEXT',CurrDTM) END GOSUB Refresh RETURN * * * * * * * Write: * * * * * * * IF Get_Property(@WINDOW:'.POST_DTM','TEXT') = '' THEN Result = 1 END ELSE ErrMsg('Record is posted and may not be saved.') Result = 0 ;* Posted -> No write END RETURN * * * * * * * Delete: * * * * * * * IF Security_Check('COC',Delete$) THEN IF Get_Property(@WINDOW:'.POST_DTM','TEXT') = '' THEN Result = 1 END ELSE ErrMsg('Record is posted and may not be deleted.') Result = 0 ;* Posted -> No write END END ELSE Security_Err_Msg('COC',Delete$) Result = 0 ;* Stop event chain END RETURN * * * * * * * ShipInfoGF: * * * * * * * CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') ShipperInfo = Get_Property(@WINDOW:'.SHIPPERINFO','TEXT') IF CustNo NE '' AND ShipperInfo = '' THEN CustRec = XLATE('COMPANY',CustNo,'','X') ShipperInfos = CustRec IF INDEX(ShipperInfos,@VM,1) THEN Display = '' FOR I = 1 TO COUNT(ShipperInfos,@VM) + (ShipperInfos NE '') Display<1,I> = ShipperInfos<1,I>:@SVM:CustRec NEXT I TypeOver = '' TypeOver = Display SelectedItems = Popup(@WINDOW,TypeOver,'ORDER_SHIPPER_INFO') IF SelectedItems = '' THEN RETURN ShipperInfo = SelectedItems<1,1> AcctNo = SelectedItems<1,2> END ELSE ShipperInfo = ShipperInfos AcctNo = CustRec END Set_Property(@WINDOW:'.SHIPPERINFO','TEXT',ShipperInfo) Set_Property(@WINDOW:'.ACCT_NO','TEXT',AcctNo) END RETURN * * * * * * * Close: * * * * * * * obj_Notes('Inbox',@USER4) ;* Checks for any new messages obj_Appwindow('CardReturn',@WINDOW) RETURN * * * * * * * ViewCust: * * * * * * * CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') IF CustNo NE '' THEN obj_Appwindow('ViewRelated','COMPANY':@RM:CustNo) END RETURN * * * * * * * ViewOrder: * * * * * * * OrderNo = Get_Property(@WINDOW:'.ORDER_NO','TEXT') IF OrderNo NE '' THEN obj_Appwindow('ViewRelated','ORDER2':@RM:OrderNo) END RETURN * * * * * * * ViewWO: * * * * * * * WONo = Get_Property(@WINDOW:'.INVOICE_DETAIL','LIST')<1,4> ;* 4th column in 1st line IF WONo NE '' THEN WOStepKeys = XLATE('WO_LOG',WONo,34,'X') LastStepKey = WOStepKeys[-1,'B':@VM] obj_Appwindow('ViewRelated','WO_PROD':@RM:LastStepKey) END RETURN * * * * * * * ViewShipment: * * * * * * * ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT') IF ShipNo NE '' THEN obj_Appwindow('ViewRelated','SHIPMENT':@RM:ShipNo) END RETURN