phares3757/open-insight
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
open-insight/LSL2/STPROC/COMM_ICAR.txt
Infineon\Mitchem 741a8450e3 Removed referenced to QUOTE_SIG_PWD_ENTRY and 
replaced with NDW_VERIFY_USER. Added barcode
scan function to NDW_VERIFY_USER.

fixed two instances of ohms square unit characters being garbled by git

minor modification to NDW_VERIFY_USER_EVENTS lost focus events

minor change to gotfocus event logic
2025-04-09 12:49:28 -07:00

1006 lines
33 KiB
Plaintext
Raw Blame History

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<ICAR_RESP_SUPERVISOR_ID$>
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<ProdMgr$>
CASE DeptResp = 'Engineering'
DeptManager = QSRec<EngMgr$>
CASE DeptResp = 'Maintenance'
DeptManager = QSRec<MaintMgr$>
CASE DeptResp = 'Facilities'
DeptManager = QSRec<FacilMgr$>
CASE DeptResp = 'Shipping'
DeptManager = QSRec<ShipMgr$>
CASE DeptResp = 'Receiving'
DeptManager = QSRec<RcvMgr$>
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<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
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<PDISPLAY$> = ICarKeys
TypeOver<PMODE$> = '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<PDISPLAY$> = '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<PDISPLAY$> = '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<PDISPLAY$> = '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<mtext$> = 'This ICAR has already been signed by the Employee.'
MsgInfo<micon$> = '!'
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<mtext$> = 'This ICAR has already been signed by Supervisor.'
MsgInfo<micon$> = '!'
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<mtext$> = 'This ICAR has already been signed by the Department Manager.'
MsgInfo<micon$> = '!'
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
Reference in New Issue View Git Blame Copy Permalink