COMPILE FUNCTION Comm_ICAR(Instruction, Parm1,Parm2) /* Commuter module for ICAR2 (Opportunity For Improvement/Individual Corrective Action Report) window 06/29/2007 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, Set_Status, ErrMsg, Set_Property, obj_AppWindow, obj_Notes, Create_Note DECLARE SUBROUTINE Btree.Extract, Send_Event, Security_Err_Msg, Forward_Event, End_Window DECLARE SUBROUTINE obj_Tables, Set_List_Box_Data, Start_Window DECLARE FUNCTION Get_Property, Get_Status, Popup, Send_Message, Msg, Security_Check, Dialog_Box, RowExists DECLARE FUNCTION Create_Dialog, obj_Tables, NextKey, Get_Sup_or_Qtl, MemberOf, Admin_User $INSERT POPUP_EQUATES $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT QUOTE_SIGS_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT NOTIFICATION_EQU $INSERT LSL_USERS_EQU $INSERT ICAR_EQUATES EQU CRLF$ TO \0D0A\ EQU COL$RDS_NO TO 1 EQU COL$REACTOR TO 2 EQU COL$WO_NO TO 3 ErrTitle = 'Error in Comm_ICAR' ErrorMsg = '' Result = '' BEGIN CASE CASE Instruction = 'Create' ; GOSUB Create CASE Instruction = 'Refresh' ; GOSUB Refresh CASE Instruction = 'Page' ; GOSUB Page CASE Instruction = 'Read' ; GOSUB Read CASE Instruction = 'Write' ; GOSUB Write CASE Instruction = 'Clear' ; GOSUB Clear CASE Instruction = 'Delete' ; GOSUB Delete CASE Instruction = 'TabClick' ; GOSUB TabClick CASE Instruction = 'Close' ; GOSUB Close CASE Instruction = 'LU_ICarNo' ; GOSUB LU_ICarNo CASE Instruction = 'NewICAR' ; GOSUB NewICAR CASE Instruction = 'LUEmpID' ; GOSUB LUEmpID CASE Instruction = 'UserIdLF' ; GOSUB UserIdLF CASE Instruction = 'LURespSupervisorID' ; GOSUB LURespSupervisorID CASE Instruction = 'LUForm_Proc' ; GOSUB LUForm_Proc CASE Instruction = 'SignEmpSup' ; GOSUB SignEmpSup CASE Instruction = 'SignEmpReview' ; GOSUB SignEmpReview CASE Instruction = 'SignSecSup' ; GOSUB SignSecSup CASE Instruction = 'LotInfoDC' ; GOSUB LotInfoDC CASE Instruction = 'LUDeptMgrID' ; GOSUB LUDeptMgrID CASE Instruction = 'StatusChange' ; GOSUB StatusChange CASE Instruction = 'SetDeptMgr' ; GOSUB SetDeptMgr CASE 1 ErrorMsg = 'Unknown Instruction ':QUOTE(Instruction):' passed to routine' END CASE IF ErrorMsg NE '' THEN ErrMsg(ErrTitle:@SVM:ErrorMsg) END RETURN Result * * * * * * * Create: * * * * * * * IF NOT(Security_Check('ICAR',READ$)) THEN Security_Err_Msg('ICAR',READ$) End_Window(@WINDOW) RETURN END obj_Appwindow('Create',@WINDOW) ShiftOptions = XLATE('LISTBOX_CONFIG', 'SHIFT', 1,'X') Swap @VM with @FM in ShiftOptions Set_Property(@Window : '.SHIFT', 'LIST', ShiftOptions) IOOptions = Get_Property(@WINDOW,'IOOPTIONS') IOOptions<11> = 1 ;* QBF event generates READ event Set_Property(@WINDOW,'IOOPTIONS',IOOptions) * Provides compatibility with the existing messaging attachment system IF Parm1 NE '' THEN PassedKeys = FIELD(Parm1,'*',1) obj_Appwindow('ViewRelated',@WINDOW:@RM:PassedKeys) END IF Admin_User( @USER4 ) THEN Set_Property(@WINDOW:'.BUTTON_21', 'ENABLED', 1) end RespSupervisorSig = Get_Property(@WINDOW:'.RESP_SUPERVISOR_SIGNATURE','TEXT') IF RespSupervisorSig<> '' THEN Set_Property(@WINDOW:'.BUTTON_20', 'ENABLED', 0) end GOSUB Refresh RETURN * * * * * * * Read: * * * * * * * ICAR_RefID = Get_Property(@WINDOW:'.ICAR_REF_ID','TEXT') IF MemberOf(@USER4,'ICAR_RESP_SUP') THEN SupervisorFlag = 1 END ELSE SupervisorFlag = 0 END IF NOT(Security_Check('ICAR',READ$)) THEN Send_Event(@WINDOW,'CLEAR') Security_Err_Msg('ICAR',READ$) RETURN END IF NOT(RowExists('ICAR',ICAR_RefID)) THEN * New Record IF NOT(SupervisorFlag) THEN Send_Event(@WINDOW,'CLEAR') ErrMsg('User is not authorized to create new OFI records.') RETURN END IF NOT(Security_Check('ICAR',WRITE$)) THEN Send_Event(@WINDOW,'CLEAR') Security_Err_Msg('ICAR',WRITE$) END END UserID = Get_Property(@WINDOW:'.USER_ID','DEFPROP') IF UserID NE '' THEN IF NOT(@USER4 = UserID) AND NOT(SupervisorFlag) THEN Send_Event(@WINDOW,'CLEAR') ErrMsg('User not authorized to view OFI record.') RETURN END END EntryID = Get_Property(@WINDOW:'.ENTRY_ID','TEXT') IF EntryID = '' THEN CurrDate = OCONV(Date(),'D4/') CurrTime = OCONV(Time(),'MTH') CurrDTM = CurrDate:' ':CurrTime Ctrls = @WINDOW:'.ENTRY_ID':@RM ; Props = 'DEFPROP':@RM ; Vals = OCONV(@USER4,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):@RM Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM ; Vals := CurrDate:@RM Ctrls := @WINDOW:'.CONFIRM_STATUS':@RM ; Props := 'VALUE':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.PROBLEM_TYPE' ; Props := 'VALUE' ; Vals := '' Set_Property(Ctrls,Props,Vals) END GOSUB Refresh RETURN * * * * * * * Write: * * * * * * * ICAR_RefID = Get_Property(@WINDOW:'.ICAR_REF_ID','TEXT') EmpSupervisorID = Get_Property(@WINDOW:'.RESP_SUPERVISOR_ID','TEXT') IF RowExists( 'ICAR', ICAR_RefId ) THEN OrgRec = XLATE('ICAR',ICAR_RefID,'','X') OrgEmpSupervisorID = OrgRec EmpSupervisorID = Get_Property(@WINDOW:'.RESP_SUPERVISOR_ID','TEXT') IF EmpSupervisorID NE OrgEmpSupervisorID THEN IF EmpSupervisorID NE '' THEN Recipients = EmpSupervisorID SentFrom = 'System' Subject = 'ICAR No ':ICAR_RefID:' redefined as you being responsible' Message = 'This ICAR was modified by ':oconv( @user4, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ):' on ':oconv( date(), 'D2/' ):' at ':oconv( time(), 'MTH' ):'.' AttachWindow = 'ICAR' AttachKey = ICAR_RefID SendToGroup = '' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) END ELSE ErrMsg('You must define a responsible supervisor...') Set_Property('SYSTEM','FOCUS',@WINDOW:'.RESP_SUPERVISOR_ID') ;* This form of FOCUS preserves the event chain generated by the GOTFOCUS RETURN END END END ELSE IF EmpSupervisorID NE '' THEN IF Get_Property(@WINDOW:'.PROBLEM_TYPE','VALUE') = '' THEN ErrMsg('You must choose a problem type...') RETURN END IF Get_Property(@WINDOW:'.USER_ID','TEXT') = '' THEN ErrMsg('You must choose an employee...') RETURN END ELSE EmployeeID = Get_Property(@WINDOW:'.USER_ID','TEXT') END IF Get_Property(@WINDOW:'.DEPARTMENTRESP','TEXT') = '' THEN ErrMsg('You must choose a responsible department...') RETURN END DeptManager = Get_Property(@WINDOW:'.DEPT_MANAGER_ID','TEXT') Shift = Get_Property(@WINDOW:'.SHIFT','TEXT') SendTo = DeptManager :@VM: EmpSupervisorID Recipients = SendTo SendFrom = 'System' Subject = 'New ICAR No ':ICAR_RefID:' created' Message = 'This ICAR was created by ':oconv( @user4, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ):' on ':OCONV( DATE(), 'D2/' ):' at ':OCONV( TIME(), 'MTH' ):'.' AttachWindow = 'ICAR' AttachKey = ICAR_RefID SendToGroup = '' Parms = Recipients:@RM:SendFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) END ELSE ErrMsg('You must define a responsible supervisor...') Set_Property('SYSTEM','FOCUS',@WINDOW:'.RESP_SUPERVISOR_ID') ;* This form of FOCUS preserves the event chain generated by the GOTFOCUS RETURN END END Result = 1 RETURN * * * * * * * Clear: * * * * * * * Send_Event(@WINDOW,'PAGE',1) Set_Property(@WINDOW:'.TAB_CONTROL','VALUE',1) *Set_Property(@WINDOW,'VPOSITION',Page) GOTO Refresh RETURN * * * * * * * Delete: * * * * * * * IF NOT(Security_Check('ICAR',DELETE$)) THEN Security_Err_Msg('ICAR',DELETE$) RETURN END Result = 1 RETURN * * * * * * * Page: * * * * * * * obj_Appwindow('Page') GOSUB Refresh RETURN * * * * * * * Close: * * * * * * * RETURN * * * * * * * StatusChange: * * * * * * * StatusState = Get_Property(@WINDOW:'.STATUS','VALUE') ICAR_RefID = Get_Property(@WINDOW:'.ICAR_REF_ID','TEXT') EmpSupervisorID = Get_Property(@WINDOW:'.RESP_SUPERVISOR_ID','TEXT') DeptManager = Get_Property(@WINDOW:'.DEPT_MANAGER_ID','TEXT') EmployeeID = Get_Property(@WINDOW:'.USER_ID','TEXT') IF StatusState = 'F' then SendTo = EmployeeID :@VM: DeptManager :@VM: EmpSupervisorID Recipients = SendTo SendFrom = 'System' Subject = 'New ICAR No ':ICAR_RefID:' completed' Message = 'This ICAR has been marked complete by ':oconv( @user4, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ):' on ':OCONV( DATE(), 'D2/' ):' at ':OCONV( TIME(), 'MTH' ):'.' AttachWindow = 'ICAR' AttachKey = ICAR_RefID SendToGroup = '' Parms = Recipients:@RM:SendFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) end RETURN * * * * * * * SetDeptMgr: * * * * * * * DeptResp = Get_Property(@WINDOW:'.DEPARTMENTRESP','TEXT') QSRec = XLATE( 'CONFIG', 'QUOTE_SIGS', '', 'X' ) DeptManager = Get_Property(@WINDOW:'.DEPT_MANAGER_ID','TEXT') EmployeeID = Get_Property(@WINDOW:'.USER_ID','TEXT') EmpSupervisorID = Get_Property(@WINDOW:'.RESP_SUPERVISOR_ID','TEXT') BEGIN CASE CASE DeptResp = 'Production' DeptManager = QSRec CASE DeptResp = 'Engineering' DeptManager = QSRec CASE DeptResp = 'Maintenance' DeptManager = QSRec CASE DeptResp = 'Facilities' DeptManager = QSRec CASE DeptResp = 'Shipping' DeptManager = QSRec CASE DeptResp = 'Receiving' DeptManager = QSRec END CASE Set_Property(@WINDOW:'.DEPT_MANAGER_ID','TEXT', DeptManager) DeptMgrName = OCONV( DeptManager, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ) Set_Property(@WINDOW:'.DEPT_MANAGER_NAME','TEXT', DeptMgrName) return * * * * * * * Refresh: * * * * * * * IF MemberOf(@USER4,'SUPERVISOR') THEN Set_Property(@WINDOW:'.NON_CONF_SETUP','VISIBLE',1) END ELSE Set_Property(@WINDOW:'.NON_CONF_SETUP','VISIBLE',0) END RespSuperID = Get_Property(@WINDOW:'.RESP_SUPERVISOR_ID','TEXT') EntryIDText = Get_Property(@WINDOW:'.ENTRY_ID','TEXT') CurrUserText = OCONV( @USER4, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ) IF RespSuperID NE '' AND CurrUserText NE EntryIDText THEN IF Security_Check('ICAR',Delete$) THEN Set_Property(@WINDOW:'.RESP_SUPERVISOR_ID','ENABLED',1) END ELSE Set_Property(@WINDOW:'.RESP_SUPERVISOR_ID','ENABLED',0) END END StatusVal = Get_Property(@WINDOW:'.STATUS','VALUE') IF StatusVal = 'V' THEN Set_Property(@WINDOW:'.CONFIRM_STATUS','ENABLED',0) END ELSE Set_Property(@WINDOW:'.CONFIRM_STATUS','ENABLED',1) END IF MemberOf(@USER4,'ICAR_RESP_SUP') THEN Set_Property(@WINDOW:'.LU_ICAR_NO','ENABLED',1) END ELSE Set_Property(@WINDOW:'.LU_ICAR_NO','ENABLED',0) END Ctrls = @WINDOW:'.RESP_SUPERVISOR_SIGNATURE':@RM ; Props = 'TEXT':@RM Ctrls := @WINDOW:'.EMP_REVIEW_ID':@RM ; Props := 'TEXT':@RM Ctrls := @WINDOW:'.SEC_SUP_REVIEW_ID':@RM ; Props := 'TEXT':@RM Ctrls := @WINDOW:'.RENG_SPEC_SIG':@RM ; Props := 'TEXT':@RM Ctrls := @WINDOW:'.MFG_MGR_SIG' ; Props := 'TEXT' SigVals = Get_Property(Ctrls,Props) Vals = '' IF SigVals[1,@RM] = '' THEN Vals<1> = 1 ELSE Vals<1> = 0 IF SigVals[COL2()+1,@RM] = '' THEN Vals<2> = 1 ELSE Vals<2> = 0 IF SigVals[COL2()+1,@RM] = '' THEN Vals<3> = 1 ELSE Vals<3> = 0 IF SigVals[COL2()+1,@RM] = '' THEN Vals<4> = 1 ELSE Vals<4> = 0 IF SigVals[COL2()+1,@RM] = '' THEN Vals<5> = 1 ELSE Vals<5> = 0 CONVERT @FM TO @RM IN Vals Props = STR('ENABLED':@RM,5) Props[-1,1] = '' Ctrls = @WINDOW:'.SIGN_EMP_SUP_BUTTON':@RM Ctrls := @WINDOW:'.SIGN_EMP_REVIEW_BUTTON':@RM Ctrls := @WINDOW:'.SIGN_SEC_SUP_BUTTON':@RM Ctrls := @WINDOW:'.SIGN_RENG_SPEC_BUTTON':@RM Ctrls := @WINDOW:'.SIGN_MFG_MGR_BUTTON' Set_Property(Ctrls,Props,Vals) * Disable controls if user is in window Ctrls = @WINDOW:'.USER_ID':@RM Ctrls := @WINDOW:'.RESP_SUPERVISOR_ID':@RM Ctrls := @WINDOW:'.NONCONFORMANCE':@RM Ctrls := @WINDOW:'.DEPARTMENTRESP':@RM Ctrls := @WINDOW:'.SHIFT':@RM Ctrls := @WINDOW:'.STATUS':@RM Ctrls := @WINDOW:'.CONFIRM_STATUS':@RM Ctrls := @WINDOW:'.ENTRY_ID':@RM Ctrls := @WINDOW:'.ENTRY_DATE':@RM Ctrls := @WINDOW:'.PROBLEM':@RM Ctrls := @WINDOW:'.PROBLEM_TYPE':@RM Ctrls := @WINDOW:'.LOT_INFO':@RM Ctrls := @WINDOW:'.NOTES':@RM Ctrls := @WINDOW:'.RESP_SUPERVISOR_SIGNATURE':@RM Ctrls := @WINDOW:'.RESP_SUPERVISOR_SIGNATURE_DTM':@RM * Ctrls := @WINDOW:'.SIGN_EMP_SUP_BUTTON':@RM Ctrls := @WINDOW:'.SEC_SUP_REVIEW_ID':@RM Ctrls := @WINDOW:'.SEC_SUP_REVIEW_DTM':@RM * Ctrls := @WINDOW:'.SIGN_SEC_SUP_BUTTON':@RM Ctrls := @WINDOW:'.RENG_SPEC_SIG_ID':@RM Ctrls := @WINDOW:'.RENG_SPEC_SIG_DTM':@RM Ctrls := @WINDOW:'.SIGN_RENG_SPEC_BUTTON':@RM Ctrls := @WINDOW:'.MFG_MGR_SIG_ID':@RM Ctrls := @WINDOW:'.MFG_MGR_SIG_DTM':@RM Ctrls := @WINDOW:'.SIGN_MFG_MGR_BUTTON':@RM Ctrls := @WINDOW:'.PS_NO':@RM Ctrls := @WINDOW:'.AWARD_AMT' Props = STR('ENABLED':@RM,25) ; Props[-1,1] = '' ;* Build string and remove trailing @RM character UserID = Get_Property(@WINDOW:'.USER_ID','TEXT') IF UserID = @USER4 THEN Vals = STR('0':@RM,25) ; Vals[-1,1] = '' END ELSE Vals = STR('1':@RM,25) ; Vals[-1,1] = '' END Set_Property(Ctrls,Props,Vals) * Set Entry stuff Ctrls = @WINDOW:'.ENTRY_ID':@RM ; Props = 'DEFPROP':@RM Ctrls := @WINDOW:'.ENTRY_DATE' ; Props := 'DEFPROP' Vals = Get_Property(Ctrls,Props) EntryID = Vals[1,@RM] EntryDt = Vals[COL2()+1,@RM] IF EntryID NE '' OR EntryDt NE '' THEN Set_Property(@WINDOW:'.ENTRY_ID','BACKCOLOR',GREEN$) Set_Property(@WINDOW:'.ENTRY_DATE','BACKCOLOR',GREEN$) Vals = '0':@RM:'0' Props = 'ENABLED':@RM:'ENABLED' Set_Property(Ctrls,Props,Vals) END NonConformance = Get_Property(@WINDOW:'.NONCONFORMANCE','DEFPROP') IF NonConformance = 'PSN' THEN Set_Property(@WINDOW:'.PS_NO_LABEL','VISIBLE',1) Set_Property(@WINDOW:'.PS_NO','VISIBLE',1) Set_Property(@WINDOW:'.PS_TYPE','VISIBLE',1) END ELSE Set_Property(@WINDOW:'.PS_NO_LABEL','VISIBLE',0) Set_Property(@WINDOW:'.PS_NO','VISIBLE',0) Set_Property(@WINDOW:'.PS_TYPE','VISIBLE',0) END * 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:'.ALL_RDS_KEYS' 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 RespSupervisorSig = Get_Property(@WINDOW:'.RESP_SUPERVISOR_SIGNATURE','TEXT') IF RespSupervisorSig<> '' THEN Set_Property(@WINDOW:'.BUTTON_20', 'ENABLED', 0) Set_Property(@WINDOW:'.BUTTON_19', 'ENABLED', 0) Set_Property(@WINDOW:'.DEPARTMENTRESP', 'ENABLED', 0) Set_Property(@WINDOW:'.SHIFT', 'ENABLED', 0) Set_Property(@WINDOW:'.SIGN_EMP_SUP_BUTTON', 'ENABLED', 0) end EmpReviewID = Get_Property(@WINDOW:'.EMP_REVIEW_ID','TEXT') IF EmpReviewID<> '' THEN Set_Property(@WINDOW:'.BUTTON_20', 'ENABLED', 0) Set_Property(@WINDOW:'.BUTTON_19', 'ENABLED', 0) Set_Property(@WINDOW:'.DEPARTMENTRESP', 'ENABLED', 0) Set_Property(@WINDOW:'.SHIFT', 'ENABLED', 0) Set_Property(@WINDOW:'.SIGN_EMP_REVIEW_BUTTON', 'ENABLED', 0) end SecSupReviewID = Get_Property(@WINDOW:'.SEC_SUP_REVIEW_ID','TEXT') IF SecSupReviewID<> '' THEN Set_Property(@WINDOW:'.BUTTON_20', 'ENABLED', 0) Set_Property(@WINDOW:'.BUTTON_19', 'ENABLED', 0) Set_Property(@WINDOW:'.DEPARTMENTRESP', 'ENABLED', 0) Set_Property(@WINDOW:'.SHIFT', 'ENABLED', 0) Set_Property(@WINDOW:'.SIGN_SEC_SUP_BUTTON', 'ENABLED', 0) end RETURN * * * * * * * TabClick: * * * * * * * IF Parm1 NE '' THEN Page = Parm1 END ELSE Page = Get_Property(@WINDOW:'.TAB_CONTROL','VALUE') END Set_Property(@WINDOW,'VPOSITION',Page) RETURN * * * * * * * LU_ICarNo: * * * * * * * IF MemberOf(@USER4,'ICAR_RESP_SUP') ELSE RETURN END ICarKeys = Dialog_Box( 'ICAR_QUERY', @WINDOW, '' ) CONVERT @FM TO @VM IN ICarKeys IF ICarKeys NE '' THEN IF INDEX(ICarKeys,@VM,1) THEN TypeOver = '' TypeOver = ICarKeys TypeOver = 'K' ICarKeys = Popup(@WINDOW,TypeOver,'ICAR_QUERY') IF Get_Status(errCode) THEN ErrMsg(errCode) END END IF ICarKeys NE '' THEN obj_Appwindow('ViewRelated',@WINDOW:@RM:ICarKeys) ;* Loads form key or QBFList as required END RETURN * * * * * * * NewICAR: * * * * * * * ICARNo = Get_Property(@WINDOW,'ID') IF NOT(Security_Check('ICAR',WRITE$)) THEN Security_Err_Msg('ICAR',WRITE$) RETURN END IF ICARNo = '' THEN NextICARNo = NextKey('ICAR') obj_Appwindow('LoadFormKeys',@WINDOW:@RM:NextICARNo) END RETURN * * * * * * * LUEmpID: * * * * * * * FocusControl = Parm1 TypeOver = '' TypeOver = 'BY LAST_FIRST WITH ACTIVE' Result = Popup(@WINDOW,TypeOver,'SHOW_USERS') IF Result NE '' THEN obj_AppWindow('LUValReturn',Result:@RM:FocusControl) END RETURN * * * * * * * UserIdLF: * * * * * * * Ctrls = @WINDOW:'.ICAR_REF_NO':@RM ; Props = 'TEXT':@RM Ctrls := @WINDOW:'.USER_ID':@RM ; Props := 'TEXT':@RM Ctrls := @WINDOW:'.ENTRY_BY' ; Props := 'TEXT' Vals = Get_Property(Ctrls,Props) ICAR_RefNo = Vals[1,@RM] UserID = Vals[COL2()+1,@RM] EntryID = Vals[COL2()+1,@RM] UserID = XLATE( 'LSL_USERS', UserID, 'FIRST_LAST', 'X' ) IF UserID = EntryID AND UserID NE '' THEN IF NOT(RowExists('ICAR',ICAR_RefNo)) THEN * This is a new record ErrMsg('You may not create new OFI records for yourself.') Set_Property(@WINDOW:'.USER_ID','DEFPROP','') Set_Property('SYSTEM','FOCUS',@WINDOW:'.USER_ID') RETURN END END RETURN * * * * * * * LUDeptMgrID: * * * * * * * FocusControl = Parm1 TypeOver = '' TypeOver = 'BY LAST_FIRST WITH ACTIVE AND WITH GROUPS = "ICAR_RESP_SUP"' Result = Popup(@WINDOW,TypeOver,'SHOW_USERS') IF Result NE '' THEN obj_AppWindow('LUValReturn',Result:@RM:FocusControl) END DeptManager = Get_Property(@WINDOW:'.DEPT_MANAGER_ID','TEXT') Set_Property(@WINDOW:'.DEPT_MANAGER_NAME','TEXT',XLATE( 'LSL_USERS', DeptManager, 'FIRST_LAST', 'X' )) RETURN * * * * * * * LURespSupervisorID: * * * * * * * FocusControl = Parm1 TypeOver = '' TypeOver = 'BY LAST_FIRST WITH ACTIVE AND WITH GROUPS = "ICAR_RESP_SUP"' Result = Popup(@WINDOW,TypeOver,'SHOW_USERS') IF Result NE '' THEN obj_AppWindow('LUValReturn',Result:@RM:FocusControl) END RETURN * * * * * * * LUForm_Proc: * * * * * * * FocusControl = Parm1 Result = Popup(@WINDOW,TypeOver,'ICAR_NONCONF') IF Result NE '' THEN obj_AppWindow('LUValReturn',Result:@RM:FocusControl) END RETURN // Employee * * * * * * * SignEmpReview: * * * * * * * ICAR_RefID = Get_Property(@WINDOW:'.ICAR_REF_ID','TEXT') EmpID = Get_Property(@WINDOW:'.USER_ID','TEXT') EmpReviewID = Get_Property(@WINDOW:'.EMP_REVIEW_ID','TEXT') RespSuperSig = Get_Property(@WINDOW:'.RESP_SUPERVISOR_SIGNATURE','TEXT') SecSupReviewID = Get_Property(@WINDOW:'.SEC_SUP_REVIEW_ID','TEXT') IF EmpReviewID<> '' THEN MsgInfo = '' MsgInfo = 'This ICAR has already been signed by the Employee.' MsgInfo = '!' Msg( '', MsgInfo ) END ELSE IF @USER4 = EmpID THEN Valid = Dialog_Box('NDW_VERIFY_USER', @Window, @User4) Valid = Valid<1> end else Valid = Dialog_Box('NDW_USER_OVERRIDE', @WINDOW, EmpId) End IF Valid THEN CurrDate = OCONV(Date(),'D4/') CurrTime = OCONV(Time(),'MTH') CurrDTM = CurrDate:' ':CurrTime Set_Property(@WINDOW:'.EMP_REVIEW_ID','TEXT', EmpID ) Set_Property(@WINDOW:'.EMP_REVIEW_NAME','TEXT',XLATE( 'LSL_USERS', EmpID, 'FIRST_LAST', 'X' )) Set_Property(@WINDOW:'.EMP_REVIEW_DTM','TEXT',CurrDTM) Set_Property(@WINDOW,'SAVEWARN',1) RespSuperID = Get_Property(@WINDOW:'.RESP_SUPERVISOR_ID','TEXT') SendTo = RespSuperID :@VM: SecSupReviewID Recipients = SendTo SendFrom = 'System' Subject = 'New ICAR No ':ICAR_RefID:' signed by employee' Message = 'This ICAR was signed by ':OCONV( EmpID, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ):' on ':OCONV( DATE(), 'D2/' ):' at ':OCONV( TIME(), 'MTH' ):'. You have been designated the resposible supervisor, and your signature is required.' AttachWindow = 'ICAR' AttachKey = ICAR_RefID SendToGroup = '' Parms = Recipients:@RM:SendFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) EmpReviewID = Get_Property(@WINDOW:'.EMP_REVIEW_ID','TEXT') IF EmpReviewID<> '' THEN Set_Property(@WINDOW:'.BUTTON_20', 'ENABLED', 0) Set_Property(@WINDOW:'.BUTTON_19', 'ENABLED', 0) Set_Property(@WINDOW:'.DEPARTMENTRESP', 'ENABLED', 0) Set_Property(@WINDOW:'.SHIFT', 'ENABLED', 0) Set_Property(@WINDOW:'.SIGN_EMP_REVIEW_BUTTON', 'ENABLED', 0) end If RespSuperSig NE '' AND EmpReviewID AND SecSupReviewID NE '' then Set_Property(@WINDOW:'.STATUS','VALUE','F') Gosub StatusChange End Gosub Write END ELSE ErrMsg('May only be signed by the Employee...') END END RETURN // Responsible Supervisor * * * * * * * SignEmpSup: * * * * * * * ICAR_RefID = Get_Property(@WINDOW:'.ICAR_REF_ID','TEXT') RespSupervisor = Get_Property(@WINDOW:'.RESP_SUPERVISOR_ID','TEXT') RespSupervisorSig = Get_Property(@WINDOW:'.RESP_SUPERVISOR_SIGNATURE','TEXT') EmpReviewID = Get_Property(@WINDOW:'.EMP_REVIEW_ID','TEXT') SecSupReviewID = Get_Property(@WINDOW:'.SEC_SUP_REVIEW_ID','TEXT') IF RespSupervisorSig<> '' THEN MsgInfo = '' MsgInfo = 'This ICAR has already been signed by Supervisor.' MsgInfo = '!' Msg( '', MsgInfo ) END ELSE IF @USER4 = RespSupervisor THEN Valid = Dialog_Box('NDW_VERIFY_USER', @Window, @User4) Valid = Valid<1> END else Valid = Dialog_Box('NDW_USER_OVERRIDE', @Window, RespSupervisor) END IF Valid THEN CurrDate = OCONV(Date(),'D4/') CurrTime = OCONV(Time(),'MTH') CurrDTM = CurrDate:' ':CurrTime Set_Property(@WINDOW:'.RESP_SUPERVISOR_SIGNATURE','TEXT', RespSupervisor ) Set_Property(@WINDOW:'.RESP_SUPERVISOR_SIGNATURE_NAME','TEXT',XLATE( 'LSL_USERS', RespSupervisor, 'FIRST_LAST', 'X' )) Set_Property(@WINDOW:'.RESP_SUPERVISOR_SIG_DTM','TEXT',CurrDTM) Set_Property(@WINDOW,'SAVEWARN',1) DeptManager = Get_Property(@WINDOW:'.DEPT_MANAGER_ID','TEXT') Recipients = DeptManager SentFrom = 'System' Subject = 'ICAR No ':ICAR_RefId:' signed by the Responsible Supervisor' Message = 'This ICAR was signed by ':OCONV( RespSupervisor, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ):' on ':OCONV( DATE(), 'D2/' ):' at ':OCONV( TIME(), 'MTH' ):'. You have been designated the Department Manager, and your signature is required.' AttachWindow = 'ICAR' AttachKey = ICAR_RefID SendToGroup = '' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) RespSupervisorSig = Get_Property(@WINDOW:'.RESP_SUPERVISOR_SIGNATURE','TEXT') IF RespSupervisorSig<> '' THEN Set_Property(@WINDOW:'.BUTTON_20', 'ENABLED', 0) Set_Property(@WINDOW:'.BUTTON_19', 'ENABLED', 0) Set_Property(@WINDOW:'.DEPARTMENTRESP', 'ENABLED', 0) Set_Property(@WINDOW:'.SHIFT', 'ENABLED', 0) Set_Property(@WINDOW:'.SIGN_EMP_SUP_BUTTON', 'ENABLED', 0) end If RespSupervisorSig NE '' AND EmpReviewID AND SecSupReviewID NE '' then Set_Property(@WINDOW:'.STATUS','VALUE','F') Gosub StatusChange End Gosub Write END ELSE ErrMsg('May only be signed by the responsible supervisor...') END END RETURN // Department Manager * * * * * * * SignSecSup: * * * * * * * DeptManager = Get_Property(@WINDOW:'.DEPT_MANAGER_ID','TEXT') ICAR_RefID = Get_Property(@WINDOW:'.ICAR_REF_ID','TEXT') RespSuperSig = Get_Property(@WINDOW:'.RESP_SUPERVISOR_SIGNATURE','TEXT') SecSupReviewID = Get_Property(@WINDOW:'.SEC_SUP_REVIEW_ID','TEXT') EmployeeID = Get_Property(@WINDOW:'.USER_ID','TEXT') EmpReviewID = Get_Property(@WINDOW:'.EMP_REVIEW_ID','TEXT') IF SecSupReviewID <> '' THEN MsgInfo = '' MsgInfo = 'This ICAR has already been signed by the Department Manager.' MsgInfo = '!' Msg( '', MsgInfo ) END ELSE IF @USER4 = DeptManager THEN Valid = Dialog_Box('NDW_VERIFY_USER', @Window, @User4) Valid = Valid<1> END else Valid = Dialog_Box('NDW_USER_OVERRIDE', @Window, DeptManager) END IF Valid THEN CurrDate = OCONV(Date(),'D4/') CurrTime = OCONV(Time(),'MTH') CurrDTM = CurrDate:' ':CurrTime Set_Property(@WINDOW:'.SEC_SUP_REVIEW_ID','TEXT', DeptManager ) Set_Property(@WINDOW:'.SEC_SUP_REVIEW_NAME','TEXT',XLATE( 'LSL_USERS', DeptManager, 'FIRST_LAST', 'X' )) Set_Property(@WINDOW:'.SEC_SUP_REVIEW_DTM','TEXT',CurrDTM) Set_Property(@WINDOW,'SAVEWARN',1) EntryId = XLATE( 'ICAR', ICAR_RefId, icar_entry_id$, 'X' ) Recipients = RespSuperSig SentFrom = 'System' Subject = 'ICAR No ':ICAR_RefId:' signed by Department Manager' Message = 'This ICAR was has been signed by ':OCONV( @USER4, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ):' on ':OCONV( DATE(), 'D2/' ):' at ':OCONV( TIME(), 'MTH' ):'.' AttachWindow = 'ICAR' AttachKey = ICAR_RefID SendToGroup = '' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) SecSupReviewID = Get_Property(@WINDOW:'.SEC_SUP_REVIEW_ID','TEXT') IF SecSupReviewID<> '' THEN Set_Property(@WINDOW:'.BUTTON_20', 'ENABLED', 0) Set_Property(@WINDOW:'.BUTTON_19', 'ENABLED', 0) Set_Property(@WINDOW:'.DEPARTMENTRESP', 'ENABLED', 0) Set_Property(@WINDOW:'.SHIFT', 'ENABLED', 0) Set_Property(@WINDOW:'.SIGN_SEC_SUP_BUTTON', 'ENABLED', 0) end If RespSuperSig NE '' AND EmpReviewID AND SecSupReviewID NE '' then Set_Property(@WINDOW:'.STATUS','VALUE','F') Gosub StatusChange End Gosub Write END ELSE ErrMsg('May only be signed by the Department Manager...') END END RETURN * * * * * * * LotInfoDC: * * * * * * * CtrlEntID = @WINDOW:'.LOT_INFO' CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> IF CurrCol >= COL$RDS_NO THEN RDSNo = Get_Property(CtrlEntID,'CELLPOS',COL$RDS_NO:@FM:CurrRow) ICAR_RefNo = Get_Property(@WINDOW,'ID') IF RDSNo NE '' THEN Set_Property(@WINDOW,'@RETURN_FROM_RDS',ICAR_RefNo) ;* Bullshit lashup to work with multiple RDS windows thisFormName = 'RDS' thisFormWindowUp = Get_Property(thisFormName,'VISIBLE') ;* Returns 0 = hidden, 1 = visible, 2 = minimized, 3 = maximized IF thisFormWindowUp = '' THEN If Get_Property('NDW_MAIN', 'VISIBLE') then AppMain = 'NDW_MAIN' end else AppMain = 'LSL_MAIN2' end Start_Window(thisFormName,AppMain,RDSNo:'*CENTER', '', '') ;* Put up the card window RETURN END IF thisFormWindowUp = 2 THEN Set_Property(thisFormName,'VISIBLE',9) ;* Restore the window if minimized IF Get_Property(thisFormName,'SAVEWARN') THEN Send_Event(thisFormName,'CLEAR') ;* Clear anything existing (prompts for save first) END END END RETURN