COMPILE FUNCTION React_Targ(EntID,Event,Parm1,Parm2,Parm3,Parm4,Parm5) /* Commuter module for REACT_TARG (Reactor Shift Targets) window 12/12/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, RList DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window, Create_Note DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Popup, Collect.Ixvals DECLARE FUNCTION Send_Message, Msg, Security_Check, obj_React_Run_CI, obj_Popup, obj_Calendar $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT LSL_USERS_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT REACT_TARG_EQUATES EQU CRLF$ TO \0D0A\ EQU TAB$ TO \09\ EQU COL$SIG_BY TO 1 EQU COL$SIG_DTM TO 2 EQU COL$REACT_NO TO 1 EQU COL$TARGET TO 2 EQU COL$TODAY TO 3 EQU COL$DELTA TO 4 EQU COL$NOTE TO 5 EQU COL$CURR_MODE TO 6 ErrTitle = 'Error in React_Targ commuter module.' 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 = 'READ' ; GOSUB Read CASE Event[1,3] = 'QBF' ; GOSUB Refresh END CASE CASE EntID = @WINDOW:'.REACT_NO' BEGIN CASE CASE Event = 'DBLCLK' ; GOSUB ReactDC CASE Event = 'POSCHANGED' ; GOSUB ReactPC CASE Event = 'GOTFOCUS' ; GOSUB ReactPC CASE Event = 'INSERTROW' ; GOSUB ReactInsertRow CASE Event = 'DELETEROW' ; GOSUB ReactDeleteRow END CASE CASE EntID = @WINDOW:'.LU_TARG_DT' AND Event = 'CLICK' ; GOSUB LUTargDate CASE EntID = @WINDOW:'.TARG_DT' AND Event = 'GOTFOCUS' ; GOSUB TargDtGF CASE EntID = @WINDOW:'.SIG_UPDATE' AND Event = 'CLICK' ; GOSUB SigUpdate 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: * * * * * * * obj_Appwindow('Create',@WINDOW) GOSUB Refresh RETURN * * * * * * * Clear: * * * * * * * 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: * * * * * * * * 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 '') IF ETCols<1,I,N> NE COL$DELTA THEN stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$) END ELSE BEGIN CASE CASE ETList = '' ; Color = WHITE$ CASE ETList EQ ETList ; Color = LS1_GREEN$ CASE ETList LT ETList ; Color = LS2_GREEN$ CASE ETList GT ETList ; Color = CMB_YELLOW$ END CASE stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,Color) END NEXT N END NEXT I NEXT I RETURN * * * * * * * Read: * * * * * * * IF Get_Property(@WINDOW,'RECORD') = '' THEN * New Record TargDt = Get_Property(@WINDOW:'.TARG_DT','INVALUE') PrevRec = XLATE('REACT_TARG',(TargDt - 1),'','X') OPEN 'REACTOR' TO ReactTable ELSE ErrMsg('Unable to open "REACTOR" table for read') RETURN END SELECT ReactTable ReactData = '' Done = 0 LOOP READNEXT ReactNo ELSE Done = 1 UNTIL Done LOCATE ReactNo IN ReactData BY 'AR' USING @VM SETTING Pos ELSE ReactData = INSERT(ReactData,COL$REACT_NO,Pos,0,ReactNo) LOCATE ReactNo IN PrevRec BY 'AR' USING @VM SETTING PrevPos THEN ReactData = PrevRec ReactData = PrevRec END ;* End of React No locate in previous record END ;* End of React No locate in new record REPEAT Set_Property(@WINDOW:'.REACT_NO','DEFPROP',ReactData) Send_Event(@WINDOW:'.REACT_NO','CALCULATE',COL$CURR_MODE) Send_Event(@WINDOW:'.REACT_NO','CALCULATE',COL$TODAY) Send_Event(@WINDOW:'.REACT_NO','CALCULATE',COL$DELTA) END GOSUB Refresh RETURN * * * * * * * Write: * * * * * * * RETURN * * * * * * * Delete: * * * * * * * RETURN * * * * * * * Close: * * * * * * * RETURN * * * * * * * SigUpdate: * * * * * * * SigArray = Get_Property(@WINDOW:'.UPDATE_BY','INVALUE') CurrDTM = ICONV(obj_Calendar('CurrDTM'),'DT') SigArray = INSERT(SigArray,COL$SIG_BY,1,0,@USER4) SigArray = INSERT(SigArray,COL$SIG_DTM,1,0,CurrDTM) Set_Property(@WINDOW:'.UPDATE_BY','INVALUE',SigArray) Send_Event(@WINDOW,'WRITE') Post_Event(@WINDOW,'CLOSE') RETURN * * * * * * * LUTargDate: * * * * * * * ReturnCtrl = Parm1[1,@RM] IF ReturnCtrl = '' THEN ReturnCtrl = Get_Property(@WINDOW,'FOCUS') DateSelected = Dialog_Box('POPUP_YEAR',@WINDOW) RetVal = OCONV(DateSelected, 'D4/') IF RetVal NE '' THEN obj_Appwindow('LUValReturn',RetVal:@RM:ReturnCtrl) END RETURN * * * * * * * TargDtGF: * * * * * * * RETURN TargDt = Get_Property(@WINDOW:'.TARG_DT','DEFPROP') IF TargDt = '' THEN TargDt = Date() Set_Property(@WINDOW:'.TARG_DT','INVALUE',TargDt) Set_Property(@WINDOW:'.TARG_DT','SELECTION',1:@FM:99) END RETURN * * * * * * * ReactDC: * * * * * * * CtrlEntID = @WINDOW:'.REACT_NO' CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> Note = Get_Property(CtrlEntID,'CELLPOS',COL$NOTE:@FM:CurrRow) * * * Open Dialog for Memo * * * DialogResult = Dialog_Box("DIALOG_ZOOM",@WINDOW,Note) IF DialogResult = 'Cancel' THEN RETURN IF DialogResult NE '' THEN Set_Property(CtrlEntID,'CELLPOS',DialogResult,COL$NOTE:@FM:CurrRow) END RETURN * * * * * * * ReactPC: * * * * * * * CtrlEntID = @WINDOW:'.REACT_NO' CurrList = Get_Property(CtrlEntID,'LIST') CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> CurrMode = CurrList CurrReactNo = CurrList IF CurrList = '' THEN IF CurrReactNo = '73' THEN Set_Property(CtrlEntID,'CELLPOS','* Reserved for Cleans Passdown *',COL$NOTE:@FM:CurrRow) END ELSE CurrMode = obj_Popup('DescCode','REACTOR_MODE':@RM:CurrMode) IF CurrMode = 'D' THEN Set_Property(CtrlEntID,'CELLPOS','DNM',COL$NOTE:@FM:CurrRow) END IF CurrMode = 'S' THEN Set_Property(CtrlEntID,'CELLPOS','Out of Service',COL$NOTE:@FM:CurrRow) END END END GOSUB Refresh RETURN * * * * * * * ReactInsertRow: * * * * * * * CtrlEntID = @WINDOW:'.REACT_NO' RowNum = Parm1 Send_Message(CtrlEntID,'DELETE',RowNum) RETURN * * * * * * * ReactDeleteRow: * * * * * * * CtrlEntID = @WINDOW:'.REACT_NO' RowNum = Parm1 DeletedRow = Parm2 Send_Message(CtrlEntID,'INSERT',RowNum,DeletedRow) RETURN