added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
430
LSL2/STPROC/COMM_SCHEDULE.txt
Normal file
430
LSL2/STPROC/COMM_SCHEDULE.txt
Normal file
@ -0,0 +1,430 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user