COMPILE FUNCTION Comm_Prod_Avg(CtrlEntID,Event,Parm1, Parm2, Parm3, Parm4, Parm5) /* Commuter module for PROD_AVG (Production Average) window 07/23/2012 - 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, Post_Event, Start_Window DECLARE FUNCTION Get_Property, Get_Status, Popup, Send_Message, Msg DECLARE FUNCTION Security_Check, obj_Calendar $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT POPUP_EQUATES $INSERT LOGICAL $INSERT FISCAL_QTR_EQUATES EQU FISCAL_ENT_NO$ TO 1 ;* Results of obj_Calendar('IRFiscal...',DateIn) methods EQU FISCAL_ENT_START_DT$ TO 2 EQU FISCAL_ENT_STOP_DT$ TO 3 EQU FISCAL_ENT_ID$ TO 4 ;* YYYY.Q or YYYY.MM or YYYY.WW EQU CRLF$ TO \0D0A\ ErrTitle = 'Error in Comm_Prod_Avg' 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:'.NEW_BUTTON' AND Event = 'CLICK' ; GOSUB New CASE CtrlEntID = @WINDOW:'.LU_STOP_DT' AND Event = 'CLICK' ; GOSUB LUStopDt 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) GOSUB Refresh RETURN * * * * * * * Read: * * * * * * * 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: * * * * * * * *Forward_Event() 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 * * * * * * * New: * * * * * * * FiscalEnt = Get_Property(@WINDOW:'.FISCAL_ENTITY','DEFPROP') OneYearAgo = OCONV(Date() - 365,'D4') DEBUG BEGIN CASE CASE FiscalEnt = 'Q' FiscalQtrKey = Popup(@WINDOW,TypeOver,'FISCAL_QTR') IF FiscalQtrKey NE '' THEN obj_Appwindow('LoadFormKeys',Window:@RM:Key) *obj_Appwindow('LUValReturn',FiscalQtrStartDt:@RM:@WINDOW:'.START_DT':@RM:'') END CASE FiscalEnt = 'W' StartWeekResult = obj_Calendar('IRFiscalWeek',DisplayStartDt) StartWeek = StartWeekResult StartDate = StartWeekResult iStartDt = ICONV(StartDate,'D') CONVERT @FM TO @VM IN StartWeekResult DispResults = StartWeekResult:@FM LOOP iStartDt += 7 StartWeekResult = obj_Calendar('IRFiscalWeek',OCONV(iStartDt,'D')) CONVERT @FM TO @VM IN StartWeekResult DispResults := StartWeekResult:@FM Delta = Date() - iStartDt UNTIL Delta <= 7 REPEAT DispResults[-1,1] = '' ;* Trailing @FM EndWeekResult = obj_Calendar('IRFiscalWeek',OCONV(Date(),'D4/')) EndWeek = EndWeekResult EndDate = EndWeekResult debug CASE 1 RETURN END CASE DEBUG RETURN TypeOver = '' TypeOver = 1 CustNo = Popup(@WINDOW,TypeOver,'CUSTOMER') IF CustNo NE '' THEN obj_Appwindow('LUValReturn',CustNo:@RM:FocusControl:@RM:FocusPos) END RETURN * * * * * * * LUStopDt: * * * * * * * 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