COMPILE FUNCTION Comm_ICAR_QUERY(Method, Parm1) /* Commuter module for ICAR_QUERY dialog window 1/13/2009 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE ErrMsg, obj_Appwindow, Set_Property,MAKE.LIST, Set_Status,FSMsg DECLARE FUNCTION Collect.IXVals, Popup, Get_Property, Send_Message $INSERT POPUP_EQUATES $INSERT ICAR_NONCONFORMANCE_EQU $INSERT APPCOLORS EQU CRLF$ TO \0D0A\ EQU COL$CODE TO 1 ;* Equates used in the supervisor, employee and EQU COL$DESC TO 2 ErrTitle = 'Error in Comm_Dialog_Order_Find' ErrorMsg = '' Result = '' BEGIN CASE CASE Method = 'Create' ; GOSUB Create CASE Method = 'LURespSupID' ; GOSUB LURespSupID CASE Method = 'LUNonConfNo' ; GOSUB LUNonConfNo CASE Method = 'LUUserID' ; GOSUB LUUserID CASE Method = 'Cancel' ; GOSUB Cancel CASE Method = 'Refresh' ; GOSUB Refresh CASE Method = 'PerformQuery' ; GOSUB PerformQuery CASE 1 ErrMsg(ErrTitle:@SVM:'Unknown method ':QUOTE(Method):' passed to routine.') END CASE RETURN Result * * * * * * * Create: * * * * * * * obj_AppWindow('Create') Set_Property(@WINDOW,'STATUSLINE',@WINDOW:'.STATUSLINE_FIX') GOSUB Refresh RETURN * * * * * * * Cancel: * * * * * * * RETURN * * * * * * * Refresh: * * * * * * * ETCtrls = @WINDOW:'.RESP_SUPERVISOR_ID':@VM:@WINDOW:'.NONCONFORMANCES':@VM:@WINDOW:'.EMP_ID_INFO' ETCols = 2:@VM:2:@VM: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 I NEXT I RETURN * * * * * * * LURespSupID: * * * * * * * IDList = Collect.IXVals('ICAR', 'RESP_SUPERVISOR_ID') IF IDList = '' THEN ErrMsg('No Values on file.') RETURN END OPEN 'ICAR' TO FileICAR ELSE ErrMsg('Unable to open file ICAR in COMM_ICAR_QUERY Routine') RETURN END OPEN 'DICT.ICAR' TO DictICAR ELSE ErrMsg('Unable to open DICT.ICAR in COMM_ICAR_QUERY Routine') RETURN END Set_Status(0) MAKE.LIST(0, IDList, FileICAR, DictICAR) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END TypeOver = '' TypeOver = 'Responsible Supervisors on File' UserIDs = Popup(@WINDOW,TypeOver,'USER_ID') ;* Popup uses active select list created with MAKE.LIST IF UserIDs = '' THEN ErrMsg('No users selected...') RETURN END UserCnt = COUNT(UserIDs,@VM) + (UserIDs NE '') IF UserCnt < 3 THEN UserCnt = 3 ;* Number of lines displayed in the window IDList = '' FOR I = 1 TO UserCnt UserID = UserIDs<1,I> IDList = UserID IDList = OCONV(UserID,'[XLATE_CONV,LSL_USERS*FIRST_LAST]') NEXT I Set_Property(@WINDOW:'.RESP_SUPERVISOR_ID','LIST',IDList) GOSUB Refresh RETURN * * * * * * * LUNonConfNo: * * * * * * * IDList = Collect.IXVals('ICAR', 'NON_CONF') IF IDList = '' THEN ErrMsg('No Values on file.') RETURN END NonConfData = XLATE('CONFIG','ICAR_NONCONFORMANCE','','X') AllProcRevs = NonConfData AllProcDescs = NonConfData IDCnt = COUNT(IDList,@FM) + (IDList NE '') ProcDescs = '' FOR I = 1 TO IDCnt ProcID = IDList UCProcID = ProcID CONVERT @LOWER_CASE TO @UPPER_CASE IN UCProcID IF UCProcID[1,2] = 'GP' THEN ProcRev = FIELD(ProcID,'-',1,2) END ELSE ProcRev = FIELD(ProcID,'-',1,3) END LOCATE ProcRev IN AllProcRevs USING @VM SETTING Pos THEN ProcDescs<1,I,1> = ProcID ProcDescs<1,I,2> = AllProcDescs<1,Pos> END ELSE ProcDescs<1,I,1> = ProcID ProcDescs<1,I,2> = ' - Removed - ' END NEXT I TypeOver = '' TypeOver = ProcDescs ProcData = Popup(@WINDOW,TypeOver,'ICAR_NONCONF_IDX_VALS') ;* Popup uses active select list created with MAKE.LIST IF ProcData = '' THEN ErrMsg('No Procedures selected...') RETURN END ProcCnt = COUNT(ProcData,@FM) + (ProcData NE '') IF ProcCnt < 3 THEN ProcCnt = 3 ;* Number of lines displayed in the window ProcList = '' FOR I = 1 TO ProcCnt ProcList = ProcData NEXT I Set_Property(@WINDOW:'.NONCONFORMANCES','LIST',ProcList) GOSUB Refresh RETURN * * * * * * * LUUserID: * * * * * * * IDList = Collect.IXVals('ICAR', 'USER_ID') IF IDList = '' THEN ErrMsg('No Values on file.') RETURN END OPEN 'ICAR' TO FileICAR ELSE ErrMsg('Unable to open file ICAR in COMM_ICAR_QUERY Routine') RETURN END OPEN 'DICT.ICAR' TO DictICAR ELSE ErrMsg('Unable to open DICT.ICAR in COMM_ICAR_QUERY Routine') RETURN END Set_Status(0) MAKE.LIST(0, IDList, FileICAR, DictICAR) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END TypeOver = '' TypeOver = 'Employee IDs on File' UserIDs = Popup(@WINDOW,TypeOver,'USER_ID') ;* Popup uses active select list created with MAKE.LIST IF UserIDs = '' THEN ErrMsg('No users selected...') RETURN END UserCnt = COUNT(UserIDs,@VM) + (UserIDs NE '') IF UserCnt < 3 THEN UserCnt = 3 ;* Number of lines displayed in the window IDList = '' FOR I = 1 TO UserCnt UserID = UserIDs<1,I> IDList = UserID IDList = OCONV(UserID,'[XLATE_CONV,LSL_USERS*FIRST_LAST]') NEXT I Set_Property(@WINDOW:'.EMP_ID_INFO','LIST',IDList) GOSUB Refresh RETURN * * * * * * * PerformQuery: * * * * * * * RETURN