8dce7988c6
transmission. Commit to save progress. Commit to save progress. Finished ListDirectory service with full 'mls' command functionality. Final commit for COC availability checks. Implement further changes requested by Daniel. Add notifications to critical statuses and automatic status clearing. Change Mona resource from dev to prod.
318 lines
6.8 KiB
Plaintext
318 lines
6.8 KiB
Plaintext
COMPILE FUNCTION DIALOG_FTP_QUEUE(EntID,Event,Parm1,Parm2,Parm3,Parm4,Parm5)
|
|
|
|
/*
|
|
Commuter module for DIALOG_FTP_QUEUE (Select waiting shipments and calls obj_Shipment('SendTechnical' to transmit to destination.
|
|
|
|
09/18/2014 - John C. Henry, J.C. Henry & Co., Inc.
|
|
*/
|
|
|
|
DECLARE SUBROUTINE Set_Property, End_Dialog, Set_Status, obj_Shipment, obj_Tables
|
|
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow,
|
|
DECLARE SUBROUTINE End_Window, Mona_Services
|
|
|
|
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Popup, Collect.Ixvals
|
|
DECLARE FUNCTION Send_Message, Msg, Security_Check, obj_Shipment
|
|
|
|
|
|
$INSERT MSG_EQUATES
|
|
$INSERT APPCOLORS
|
|
$INSERT LSL_USERS_EQU
|
|
$INSERT SECURITY_RIGHTS_EQU
|
|
$INSERT COC_EQUATES
|
|
$INSERT FTP_QUEUE_EQUATES
|
|
$INSERT COMPANY_EQUATES
|
|
$INSERT POPUP_EQUATES
|
|
$INSERT LOGICAL
|
|
|
|
EQU CRLF$ TO \0D0A\
|
|
EQU TAB$ TO \09\
|
|
|
|
EQU COL$CUST_NO TO 1
|
|
EQU COL$CUST_NAME TO 2
|
|
|
|
|
|
EQU COL$SHIP_NO TO 1
|
|
EQU COL$SAP_DEL_NO TO 2
|
|
EQU COL$WO_NO TO 3
|
|
EQU COL$SHIP_CUST_NO TO 4
|
|
EQU COL$SHIP_CUST_INFO TO 5
|
|
EQU COL$SHIP_DTM TO 6
|
|
EQU COL$SEND_DTM TO 7
|
|
EQU COL$SEND_USER TO 8
|
|
EQU COL$SEND_REASON TO 9
|
|
|
|
|
|
ErrTitle = 'Error in Dialog_FTP_Queue commuter module'
|
|
ErrorMsg = ''
|
|
|
|
Result = ''
|
|
|
|
BEGIN CASE
|
|
CASE EntID = @WINDOW
|
|
BEGIN CASE
|
|
CASE Event = 'CREATE' ; GOSUB Create
|
|
CASE Event = 'CLOSE' ; GOSUB Close
|
|
END CASE
|
|
|
|
CASE EntID = @WINDOW:'.SELECT_QUEUE' AND Event = 'CLICK' ; GOSUB SelectQueue
|
|
CASE EntID = @WINDOW:'.SELECT_SHIPMENTS' AND Event = 'CLICK' ; GOSUB SelectShipments
|
|
CASE EntID = @WINDOW:'.TX_BUTTON' AND Event = 'CLICK' ; GOSUB TxShipments
|
|
CASE EntID = @WINDOW:'.CANCEL_BUTTON' AND Event = 'CLICK' ; GOSUB Cancel
|
|
|
|
|
|
CASE 1
|
|
ErrorMsg = 'Unknown Parameters ':EntID:' - ':Event:' passed to commuter'
|
|
ErrMsg(ErrorMsg)
|
|
|
|
END CASE
|
|
|
|
IF ErrorMsg NE '' THEN
|
|
ErrMsg(ErrTitle:@SVM:ErrorMsg)
|
|
END
|
|
|
|
RETURN Result
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Create:
|
|
* * * * * * *
|
|
|
|
|
|
obj_Appwindow('Create',@WINDOW)
|
|
|
|
|
|
TimeStamp = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS')
|
|
*Set_Property(@WINDOW:'.READ_DTM','DEFPROP',TimeStamp)
|
|
|
|
SearchString = 'FTP_QUEUE':@VM:'#'
|
|
|
|
OPEN 'DICT.COMPANY' TO DictVar ELSE
|
|
ErrMsg('Unable to open DICT.COMPANY for Btree.Extract')
|
|
RETURN
|
|
END
|
|
|
|
Btree.Extract(SearchString,'COMPANY',DictVar,CustNos,'','')
|
|
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
RETURN
|
|
END
|
|
|
|
CustArray = '' ;* Array of customers with the FTP_QUEUE flag set on
|
|
|
|
CustCnt = COUNT(CustNos,@VM) + (CustNos NE '')
|
|
|
|
FOR I = 1 TO CustCnt
|
|
CustNo = CustNos<1,I>
|
|
CustRec = XLATE('COMPANY',CustNo,'','X')
|
|
CustName = CustRec<COMPANY_CO_NAME$>
|
|
IF CustRec<COMPANY_CITY$> NE '' THEN
|
|
CustName := ', ':CustRec<COMPANY_CITY$>
|
|
END
|
|
|
|
CustArray<COL$CUST_NO,I> = CustNo
|
|
CustArray<COL$CUST_NAME,I> = CustName
|
|
|
|
NEXT I
|
|
|
|
Set_Property(@WINDOW:'.QUEUED_CUST','DEFPROP',CustArray)
|
|
|
|
NullTxArray = Get_Property(@WINDOW:'.TX_SHIP','DEFPROP')
|
|
Set_Property(@WINDOW,'@NULL_TX_ARRAY',NullArray)
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Close:
|
|
* * * * * * * *
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Refresh:
|
|
* * * * * * *
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Cancel:
|
|
* * * * * * *
|
|
|
|
End_Dialog(@WINDOW,'Cancel')
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
SelectQueue:
|
|
* * * * * * *
|
|
|
|
ShipNos = Popup(@WINDOW,'','FTP_QUEUE')
|
|
|
|
IF ShipNos = '' THEN RETURN
|
|
IF ShipNos = CHAR(27) THEN RETURN
|
|
|
|
ShipArray = ''
|
|
ShipCnt = COUNT(ShipNos,@VM) + (ShipNos NE '')
|
|
ShipLine = 0
|
|
|
|
FOR I = 1 TO ShipCnt
|
|
ShipNo = ShipNos<1,I>
|
|
ShipRec = XLATE('COC',ShipNo,'','X')
|
|
|
|
SendDTM = ShipRec<COC_SEND_DTM$,1>
|
|
|
|
* IF SendDTM = '' THEN
|
|
ShipLine += 1
|
|
|
|
ShipArray<COL$SHIP_NO,ShipLine> = ShipNo
|
|
ShipArray<COL$SAP_DEL_NO,ShipLine> = ShipRec<COC_SAP_DEL_NO$>
|
|
ShipArray<COL$WO_NO,ShipLine> = ShipRec<COC_WO_NO$>
|
|
ShipArray<COL$SHIP_CUST_NO,ShipLine> = XLATE('COC',ShipNo,'CUST_NO','X')
|
|
ShipArray<COL$SHIP_CUST_INFO,ShipLine> = XLATE('COC',ShipNo,'CUST_CITY','X')
|
|
ShipArray<COL$SHIP_DTM,ShipLine> = OCONV(SendDTM,'DT4/^S')
|
|
|
|
SendDTMs = ShipRec<COC_SEND_DTM$>[-1,'B':@VM]
|
|
SendUsers = ShipRec<COC_SEND_DTM$>[-1,'B':@VM]
|
|
SendReasons = ShipRec<COC_SEND_REASON$>[-1,'B':@VM]
|
|
|
|
ShipArray<COL$SEND_DTM,ShipLine> = OCONV(ShipRec<COC_SEND_DTM$>[-1,'B':@VM],'DT4/^S')
|
|
ShipArray<COL$SEND_USER,ShipLine> = ShipRec<COC_SEND_USER$>[-1,'B':@VM]
|
|
ShipArray<COL$SEND_REASON,ShipLine> = ShipRec<COC_SEND_REASON$>[-1,'B':@VM]
|
|
|
|
* END ELSE
|
|
* otParms = 'FTP_QUEUE':@RM:ShipNo
|
|
* obj_Tables('DeleteRec',otParms)
|
|
*
|
|
* IF Get_Status(errCode) THEN
|
|
* ErrMsg(errCode)
|
|
* END
|
|
* END ;* End of check for null SEND_DTM
|
|
NEXT I
|
|
|
|
|
|
Set_Property(@WINDOW:'.TX_SHIP','ARRAY',ShipArray)
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
SelectShipments:
|
|
* * * * * * *
|
|
|
|
SelShipNos = obj_Shipment('Find')
|
|
|
|
TypeOver = ''
|
|
TypeOver<PMODE$> = 'K'
|
|
TypeOver<PDISPLAY$> = SelShipNos
|
|
TypeOver<PSELECT$> = 2
|
|
TypeOver<PShowGauge$> = 1
|
|
|
|
ShipNos = Popup(@WINDOW,TypeOver,'COC_QUERY')
|
|
|
|
IF ShipNos = '' THEN RETURN
|
|
IF ShipNos = CHAR(27) THEN RETURN
|
|
|
|
ShipArray = ''
|
|
ShipCnt = COUNT(ShipNos,@VM) + (ShipNos NE '')
|
|
Row = 0
|
|
|
|
FOR I = 1 TO ShipCnt
|
|
ShipNo = ShipNos<1,I>
|
|
ShipRec = XLATE('COC',ShipNos,'','X')
|
|
|
|
SendDTM = ShipRec<COC_SEND_DTM$,1>
|
|
|
|
IF SendDTM = '' THEN
|
|
Row += 1
|
|
ShipArray<COL$SHIP_NO,Row> = ShipNo
|
|
ShipArray<COL$SAP_DEL_NO,Row> = ShipRec<COC_SAP_DEL_NO$>
|
|
ShipArray<COL$WO_NO,Row> = ShipRec<COC_WO_NO$>
|
|
ShipArray<COL$SHIP_CUST_NO,Row> = XLATE('COC',ShipNo,'CUST_NO','X')
|
|
ShipArray<COL$SHIP_CUST_INFO,Row> = XLATE('COC',ShipNo,'CUST_CITY','X')
|
|
ShipArray<COL$SHIP_DTM,Row> = OCONV(XLATE('FTP_QUEUE',ShipNo,1,'X'),'DT4/^S')
|
|
|
|
SendDTMs = ShipRec<COC_SEND_DTM$>[-1,'B':@VM]
|
|
SendUsers = ShipRec<COC_SEND_DTM$>[-1,'B':@VM]
|
|
SendReasons = ShipRec<COC_SEND_REASON$>[-1,'B':@VM]
|
|
|
|
ShipArray<COL$SEND_DTM,Row> = OCONV(ShipRec<COC_SEND_DTM$>[-1,'B':@VM],'DT4/^S')
|
|
ShipArray<COL$SEND_USER,Row> = ShipRec<COC_SEND_USER$>[-1,'B':@VM]
|
|
ShipArray<COL$SEND_REASON,Row> = ShipRec<COC_SEND_REASON$>[-1,'B':@VM]
|
|
END
|
|
NEXT I
|
|
|
|
Set_Property(@WINDOW:'.TX_SHIP','ARRAY',ShipArray)
|
|
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
TxShipments:
|
|
* * * * * * *
|
|
|
|
CtrlEntID = @WINDOW:'.TX_SHIP'
|
|
|
|
ShipNos = Get_Property(@WINDOW:'.TX_SHIP','DEFPROP')<COL$SHIP_NO>
|
|
|
|
LOOP
|
|
LastChar = ShipNos[-1,1]
|
|
UNTIL LastChar NE @VM OR ShipNos = ''
|
|
ShipNos[-1,1] = ''
|
|
REPEAT
|
|
|
|
|
|
ShipCnt = COUNT(ShipNos,@VM) + (ShipNos NE '')
|
|
FOR I = 1 TO ShipCnt
|
|
ShipNo = ShipNos<1,I>
|
|
|
|
obj_Shipment('SendTechnical',ShipNo) ;* Replace with new code
|
|
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
END ELSE
|
|
otParms = 'FTP_QUEUE':@RM:ShipNo:@RM:@RM
|
|
obj_Tables('DeleteRec',otParms)
|
|
END
|
|
|
|
NEXT I
|
|
|
|
|
|
NullArray = Get_Property(@WINDOW,'@NULL_TX_ARRAY')
|
|
|
|
Set_Property(@WINDOW:'.TX_SHIP','DEFPROP',NullArray)
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|