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.
337 lines
7.8 KiB
Plaintext
337 lines
7.8 KiB
Plaintext
COMPILE FUNCTION DIALOG_EMAIL_SHIPMENT(EntID,Event,Parm1,Parm2,Parm3,Parm4,Parm5)
|
|
|
|
/*
|
|
Commuter module for DIALOG_EMAIL_SHIPMENT (Select waiting shipments and calls PRINT_SHIPMENT_DEV to transmit to destination.
|
|
|
|
07/16/2015 - 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, Print_Shipment_Dev, RList, Database_Services
|
|
|
|
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Popup, Collect.Ixvals
|
|
DECLARE FUNCTION Send_Message, Msg, Security_Check, obj_Shipment, obj_Tables, Database_Services
|
|
|
|
|
|
$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$EMAIL_DTM TO 7
|
|
EQU COL$EMAIL_USER TO 8
|
|
EQU COL$EMAIL_REASON TO 9
|
|
|
|
|
|
ErrTitle = 'Error in Dialog_eMail_Shipment 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 = 'SHIP_DOC_FLAG':@VM:'#'
|
|
SearchString = 'SHIP_DOC_FLAG':@VM:'1'
|
|
|
|
OPEN 'DICT.COMPANY' TO DictVar ELSE
|
|
ErrMsg('Unable to open DICT.COMPANY for Btree.Extract')
|
|
RETURN
|
|
END
|
|
|
|
CustNos = ''
|
|
Btree.Extract(SearchString,'COMPANY',DictVar,CustNos,'','')
|
|
|
|
errCode = ''
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
RETURN
|
|
END
|
|
|
|
CustArray = '' ;* Array of customers with the EMAIL_SHIP_DOC 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:
|
|
* * * * * * *
|
|
|
|
Sentence = 'SELECT SHIP_EMAIL_QUEUE WITH SHIP_DTM GE ' : Quote(Oconv(Date() - 90, 'DT4/')) : ' BY-DSND SHIP_DTM'
|
|
Set_Status(0)
|
|
RList(Sentence, 5, '', '', '')
|
|
ShipNos = Popup(@WINDOW,'','SHIP_EMAIL_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')
|
|
|
|
LastEmailDTM = ShipRec<COC_EMAIL_DTM$>[-1,'B':@VM]
|
|
LastEmailUser = ShipRec<COC_EMAIL_USER$>[-1,'B':@VM]
|
|
LastEmailReason = ShipRec<COC_EMAIL_REASON$ >[-1,'B':@VM]
|
|
|
|
ShipArray<COL$SHIP_NO,I> = ShipNo
|
|
ShipArray<COL$SAP_DEL_NO,I> = ShipRec<COC_SAP_DEL_NO$>
|
|
ShipArray<COL$WO_NO,I> = ShipRec<COC_WO_NO$>
|
|
ShipArray<COL$SHIP_CUST_NO,I> = XLATE('COC',ShipNo,'CUST_NO','X')
|
|
ShipArray<COL$SHIP_CUST_INFO,I> = XLATE('COC',ShipNo,'CUST_CITY','X')
|
|
ShipArray<COL$SHIP_DTM,I> = OCONV(ShipRec<COC_ENTRY_DATE$>,'D4/')
|
|
|
|
ShipArray<COL$EMAIL_DTM,I> = OCONV(LastEmailDTM,'DT4/^S')
|
|
ShipArray<COL$EMAIL_USER,I> = LastEmailUser
|
|
ShipArray<COL$EMAIL_REASON,I> = LastEmailReason
|
|
|
|
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$EMAIL_DTM,Row> = OCONV(ShipRec<COC_SEND_DTM$>[-1,'B':@VM],'DT4/^S')
|
|
ShipArray<COL$EMAIL_USER,Row> = ShipRec<COC_SEND_USER$>[-1,'B':@VM]
|
|
ShipArray<COL$EMAIL_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>
|
|
|
|
ShipRec = Database_Services('ReadDataRow', 'COC', ShipNo)
|
|
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg('Unable to eMail Ship No ':ShipNo)
|
|
END
|
|
|
|
|
|
IF ShipRec<COC_EMAIL_DTM$> NE '' THEN
|
|
|
|
SendReason = Msg(@WINDOW,'','RESEND_REASON') ;* This has already been sent
|
|
IF SendReason = CHAR(27) OR SendReason = '' THEN
|
|
obj_Tables('UnlockRec',OtParms)
|
|
RETURN
|
|
END
|
|
|
|
END ELSE
|
|
SendReason = 'Initial Tx'
|
|
END
|
|
|
|
SendDtm = ICONV(OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS'),'DT')
|
|
SendUser = @USER4
|
|
|
|
Print_Shipment_Dev(ShipNo,ShipRec,1)
|
|
|
|
IF Get_Status(errCode) THEN
|
|
|
|
ErrMsg(errCode)
|
|
obj_Tables('UnlockRec',OtParms)
|
|
|
|
END ELSE
|
|
|
|
*otParms = 'SHIP_EMAIL_QUEUE':@RM:ShipNo:@RM:@RM ;* This is done in the Print_Shipment_Dev routine
|
|
*obj_Tables('DeleteRec',otParms) ;* This is done in the Print_Shipment_Dev routine
|
|
|
|
CurrTxCnt = COUNT(ShipRec<COC_EMAIL_DTM$>,@VM) + (ShipRec<COC_EMAIL_DTM$> NE '')
|
|
|
|
NewTxPos = CurrTxCnt + 1
|
|
|
|
ShipRec<COC_EMAIL_DTM$,NewTxPos> = SendDtm
|
|
ShipRec<COC_EMAIL_USER$,NewTxPos> = SendUser
|
|
ShipRec<COC_EMAIL_REASON$,NewTxPos> = SendReason
|
|
ShipRec<COC_FTP_SHOULD_EXIST$> = True$
|
|
ShipRec<COC_FTP_EXISTS$> = True$
|
|
|
|
Database_Services('WriteDataRow', 'COC', ShipNo, ShipRec, True$, False$, True$)
|
|
|
|
END
|
|
|
|
NEXT I
|
|
|
|
|
|
NullArray = Get_Property(@WINDOW,'@NULL_TX_ARRAY')
|
|
|
|
Set_Property(@WINDOW:'.TX_SHIP','DEFPROP',NullArray)
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|