431 lines
8.8 KiB
Plaintext
431 lines
8.8 KiB
Plaintext
COMPILE FUNCTION Comm_Schedule(Instruction, Parm1,Parm2)
|
|
|
|
/*
|
|
Commuter module for SCHEDULE2 (Schedule) window
|
|
|
|
08/18/2004 - John C. Henry, J.C. Henry & Co., Inc.
|
|
*/
|
|
|
|
DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window, Post_Event, obj_Order
|
|
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow, Set_List_Box_Data
|
|
DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window
|
|
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup
|
|
DECLARE FUNCTION Send_Message, Msg, Security_Check, RowExists, NextKey, obj_Order
|
|
|
|
$INSERT POPUP_EQUATES
|
|
$INSERT MSG_EQUATES
|
|
$INSERT APPCOLORS
|
|
$INSERT QUOTE_SIGS_EQU
|
|
$INSERT LSL_USERS_EQU
|
|
$INSERT SECURITY_RIGHTS_EQU
|
|
$INSERT SCHEDULE_EQU
|
|
|
|
EQU CRLF$ TO \0D0A\
|
|
|
|
EQU COL$RUN_ORD TO 1 ;* RUN_ORDER edittable columns
|
|
EQU COL$RDS_NO TO 2
|
|
EQU COL$HOT TO 3
|
|
EQU COL$CASS_QTY TO 4
|
|
EQU COL$SCHED_DT TO 5
|
|
EQU COL$PROD_TEST TO 6
|
|
EQU COL$REJECTS TO 7
|
|
EQU COL$OUT TO 8
|
|
EQU COL$SHIP_NO TO 9
|
|
|
|
|
|
ErrTitle = 'Error in Comm_Schedule'
|
|
ErrorMsg = ''
|
|
|
|
Result = ''
|
|
|
|
BEGIN CASE
|
|
CASE Instruction = 'Create' ; GOSUB Create
|
|
CASE Instruction = 'Refresh' ; GOSUB Refresh
|
|
CASE Instruction = 'Read' ; GOSUB Read
|
|
CASE Instruction = 'Write' ; GOSUB Write
|
|
CASE Instruction = 'Clear' ; GOSUB Clear
|
|
CASE Instruction = 'Delete' ; GOSUB Delete
|
|
CASE Instruction = 'Page' ; GOSUB Page
|
|
CASE Instruction = 'Close' ; GOSUB Close
|
|
CASE Instruction = 'LUSchedNo' ; GOSUB LUSchedNo
|
|
CASE Instruction = 'RunOrderPC' ; GOSUB RunOrderPC
|
|
CASE Instruction = 'RunOrderDC' ; GOSUB RunOrderDC
|
|
|
|
|
|
CASE 1
|
|
ErrorMsg = 'Unknown Instruction ':QUOTE(Instruction):' passed to routine.'
|
|
ErrMsg(ErrorMsg)
|
|
END CASE
|
|
|
|
RETURN Result
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Create:
|
|
* * * * * * *
|
|
|
|
IF NOT(Security_Check('Schedule',READ$)) THEN
|
|
Security_Err_Msg('Schedule',READ$)
|
|
End_Window(@WINDOW)
|
|
RETURN
|
|
END
|
|
|
|
obj_Appwindow('Create',@WINDOW)
|
|
|
|
Set_List_Box_Data(@WINDOW)
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Clear:
|
|
* * * * * * *
|
|
|
|
Send_Event(@WINDOW,'PAGE',1)
|
|
|
|
obj_AppWindow('ReadOnly',@RM:1) ;* Reenables data bound controls
|
|
|
|
|
|
* * * * * * *
|
|
Refresh:
|
|
* * * * * * *
|
|
|
|
IF Security_Check('Schedule',EDIT$) THEN
|
|
obj_AppWindow('ReadOnly',@WINDOW:@RM:1) ;* enable all database controls
|
|
END ELSE
|
|
obj_AppWindow('ReadOnly',@WINDOW) ;* disable all database controls
|
|
END
|
|
|
|
|
|
CloseDt = Get_Property(@WINDOW:'.CLOSE_DT','TEXT')
|
|
|
|
IF CloseDt = '' THEN
|
|
Set_Property(@WINDOW:'.CLOSE_DT','ENABLED',1)
|
|
END ELSE
|
|
Set_Property(@WINDOW:'.CLOSE_DT','ENABLED',0)
|
|
END
|
|
|
|
/*
|
|
IF CloseDt = '' THEN
|
|
Set_Property(@WINDOW:'.STATUS','TEXT','Open')
|
|
END ELSE
|
|
Set_Property(@WINDOW:'.STATUS','TEXT','Closed')
|
|
END
|
|
*/
|
|
|
|
RunOrdArray = Get_Property(@WINDOW:'.RUN_ORDER','ARRAY')
|
|
|
|
RunOrders = RunOrdArray<COL$RUN_ORD>
|
|
|
|
LOOP
|
|
UNTIL RunOrders[-1,1] NE @VM OR RunOrders = ''
|
|
RunOrders[-1,1] = ''
|
|
REPEAT
|
|
|
|
RunOrdCnt = COUNT(RunOrders,@VM) + (RunOrders NE '')
|
|
|
|
IF RunOrdCnt = 0 THEN
|
|
ReadyToCreateRDS = 0
|
|
END ELSE
|
|
ReadyToCreateRDS = 1
|
|
END
|
|
|
|
FOR I = 1 TO RunOrdCnt
|
|
RunOrd = RunOrdArray<COL$RUN_ORD,I>
|
|
RDSNo = RunOrdArray<COL$RDS_NO,I>
|
|
CassQty = RunOrdArray<COL$CASS_QTY,I>
|
|
SchedDt = RunOrdArray<COL$SCHED_DT,I>
|
|
IF RunOrd = '' OR RDSNo NE '' OR CassQty <= 0 OR SchedDt = '' THEN ReadyToCreateRDS = 0
|
|
UNTIL ReadyToCreateRDS = 0
|
|
NEXT I
|
|
|
|
IF ReadyToCreateRDS THEN
|
|
Set_Property(@WINDOW:'.CREATE_RDS_BUTTON','ENABLED',1)
|
|
END ELSE
|
|
Set_Property(@WINDOW:'.CREATE_RDS_BUTTON','ENABLED',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>
|
|
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 I
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Page:
|
|
* * * * * * *
|
|
|
|
obj_Appwindow('Page')
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Read:
|
|
* * * * * * *
|
|
|
|
SchedNo = Get_Property(@WINDOW:'SCHED_NO','TEXT')
|
|
|
|
IF NOT(RowExists('SCHEDULE',SchedNo)) THEN
|
|
IF NOT(Security_Check('Schedule',WRITE$)) THEN
|
|
Send_Event(@WINDOW,'CLEAR')
|
|
Security_Err_Msg('Schedule',WRITE$)
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
EnterBy = Get_Property(@WINDOW:'.ENTER_BY','TEXT')
|
|
IF EnterBy = '' THEN
|
|
CurrDate = OCONV(Date(),'D4/')
|
|
CurrTime = OCONV(Time(),'MTH')
|
|
CurrDTM = CurrDate:' ':CurrTime
|
|
IF @USER4 = '' THEN @USER4 = 'TESTING'
|
|
Set_Property(@WINDOW:'.ENTER_BY','TEXT',OCONV(@USER4,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'))
|
|
Set_Property(@WINDOW:'.ENTER_DTM','TEXT',CurrDTM)
|
|
END
|
|
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Write:
|
|
* * * * * * *
|
|
|
|
RETURN
|
|
|
|
* * * * * * *
|
|
Delete:
|
|
* * * * * * *
|
|
|
|
IF Security_Check('Schedule',Delete$) THEN
|
|
Result = 1 ;* Proceed with delete
|
|
END ELSE
|
|
Security_Err_Msg('Schedule',Delete$)
|
|
Result = 0 ;* Stop event chain
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUSchedNo:
|
|
* * * * * * *
|
|
|
|
return
|
|
*************************************************************
|
|
IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1
|
|
IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2
|
|
|
|
Set_Status(0)
|
|
|
|
OrderKeys = obj_Order('Find')
|
|
|
|
IF INDEX(OrderKeys,@VM,1) THEN
|
|
Send_Event(@WINDOW,'QBFINIT')
|
|
Set_Property(@WINDOW,'QBFLIST',OrderKeys)
|
|
GOSUB Refresh
|
|
Send_Event(@WINDOW,'QBFIRST')
|
|
END ELSE
|
|
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:OrderKeys)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Close:
|
|
* * * * * * *
|
|
|
|
obj_Notes('Inbox',@USER4) ;* Checks for any new messages
|
|
|
|
obj_Appwindow('DetailReturn',@WINDOW)
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
* * * * * * *
|
|
RunOrderPC:
|
|
* * * * * * *
|
|
|
|
SchedNo = Get_Property(@WINDOW,'ID')
|
|
|
|
CtrlEntID = @WINDOW:'.RUN_ORDER'
|
|
|
|
CurrPos = Get_Property(CtrlEntID,'SELPOS')
|
|
CurrCol = CurrPos<1>
|
|
CurrRow = CurrPos<2>
|
|
|
|
GOSUB Refresh
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * * *
|
|
CurrArray = Get_Property(CtrlEntId,'ARRAY')
|
|
PartNos = CurrArray<COL$PART_NO>
|
|
|
|
|
|
IF CurrCol = COL$PART_NO THEN
|
|
|
|
IF PartNos<1,CurrRow> = '' THEN
|
|
SearchRow = CurrRow
|
|
|
|
LOOP
|
|
DupPartNo = PartNos<1,SearchRow>
|
|
UNTIL DupPartNo NE '' OR SearchRow = 1
|
|
SearchRow -= 1
|
|
REPEAT
|
|
|
|
IF SearchRow = 0 THEN Return ;* No part number found
|
|
|
|
FOR I = SearchRow+1 TO CurrRow
|
|
CurrArray<COL$PART_NO,I> = DupPartNo
|
|
NEXT I
|
|
|
|
Set_Property(CtrlEntID,'DEFPROP',CurrArray)
|
|
END
|
|
|
|
END ;* End of check for Part No column
|
|
|
|
* * * * * *
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
RunOrderDC:
|
|
* * * * * * *
|
|
|
|
SchedNo = Get_Property(@WINDOW,'ID')
|
|
|
|
CtrlEntID = @WINDOW:'.RUN_ORDER'
|
|
|
|
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)
|
|
|
|
IF SchedNo NE '' AND RDSNo NE '' THEN
|
|
IF Get_Property(@WINDOW,'QBFLIST') = '' THEN
|
|
Send_Event(@WINDOW,'WRITE')
|
|
END
|
|
|
|
DetWindow = 'RDS'
|
|
DetKeys = RDSNo
|
|
DefaultRec = ''
|
|
RetKey = SchedNo
|
|
RetPage = 1
|
|
RetCtrl = CtrlEntID
|
|
RetPos = CurrPos
|
|
|
|
oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos
|
|
|
|
obj_AppWindow('ViewNewDetail',oAParms)
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
END
|
|
|
|
END
|
|
END ;* End of check for RDS column
|
|
|
|
CurrArray = Get_Property(CtrlEntId,'ARRAY')
|
|
SchedDTs = CurrArray<COL$SCHED_DT>
|
|
|
|
IF CurrCol = COL$SCHED_DT THEN
|
|
|
|
IF SchedDTs<1,CurrRow> = '' THEN
|
|
SearchRow = CurrRow
|
|
|
|
LOOP
|
|
DupSchedDT = SchedDTs<1,SearchRow>
|
|
UNTIL DupSchedDT NE '' OR SearchRow = 1
|
|
SearchRow -= 1
|
|
REPEAT
|
|
|
|
IF SearchRow = 0 THEN Return ;* No part number found
|
|
|
|
FOR I = SearchRow+1 TO CurrRow
|
|
CurrArray<COL$SCHED_DT,I> = DupSchedDT
|
|
NEXT I
|
|
|
|
Set_Property(CtrlEntID,'DEFPROP',CurrArray)
|
|
END
|
|
|
|
END ;* End of check for SchedDt column
|
|
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
EQU COL$RUN_ORD TO 1 ;* RUN_ORDER edittable columns
|
|
EQU COL$RDS_NO TO 2
|
|
EQU COL$HOT TO 3
|
|
EQU COL$CASS_QTY TO 4
|
|
EQU COL$SCHED_DT TO 5
|
|
EQU COL$PROD_TEST TO 6
|
|
EQU COL$REJECTS TO 7
|
|
EQU COL$OUT TO 8
|
|
*/
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|