647 lines
20 KiB
Plaintext
647 lines
20 KiB
Plaintext
COMPILE FUNCTION obj_Notes(Method,Parms)
|
|
/*
|
|
Methods for Notes table
|
|
|
|
07/11/2004 JCH - Initial Coding
|
|
|
|
Properties:
|
|
|
|
Methods:
|
|
|
|
Inbox(UserName) ;* Displays annoying message box that the user has new notes (was check_notes() function)
|
|
Create() ;* Creates new Note
|
|
RebuildPointers(UserName) ;* Rebuilds NOTE_PTRS record if it gets clobbered
|
|
ForwardEMail ;* Checks EMAIL_BOX and sends any messages via Outlook eMail
|
|
*/
|
|
|
|
|
|
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey, SRP_Send_Mail, obj_Calendar, Database_Services, SRP_Stopwatch
|
|
DECLARE FUNCTION Email_Services, Environment_Services, Logging_Services
|
|
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, RList, ErrMsg, obj_Notes_Sent, Btree.Extract, Send_Info, obj_Notes
|
|
DECLARE SUBROUTINE Obj_Post_Log, SRP_Stopwatch, Notes_Services, Mona_Services, Logging_Services
|
|
|
|
$INSERT MSG_EQUATES
|
|
$INSERT NOTES_EQU
|
|
$INSERT NOTE_PTRS_EQU
|
|
$INSERT LSL_USERS_EQU
|
|
$INSERT EMAIL_BOX_EQUATES
|
|
$INSERT RLIST_EQUATES
|
|
$INSERT APP_INSERTS
|
|
$INSERT SRPMail_Inserts
|
|
|
|
LogDate = Oconv(Date(), 'D4/')
|
|
LogTime = Oconv(Time(), 'MTS')
|
|
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
|
|
|
|
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\EmailService'
|
|
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' EmailService.csv'
|
|
Headers = 'Logging DTM' : @FM : 'Error'
|
|
objLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$)
|
|
|
|
ErrTitle = 'Error in Stored Procedure "obj_Notes"'
|
|
ErrorMsg = ''
|
|
|
|
IF NOT(ASSIGNED(Method)) THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine'
|
|
IF NOT(ASSIGNED(Parms)) THEN Parms = ''
|
|
|
|
IF ErrorMsg NE '' THEN
|
|
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
|
RETURN ''
|
|
END
|
|
|
|
Result = ''
|
|
|
|
BEGIN CASE
|
|
CASE Method = 'Inbox' ; GOSUB Inbox
|
|
CASE Method = 'Create' ; GOSUB Create
|
|
CASE Method = 'Rebuild' ; GOSUB Rebuild
|
|
CASE Method = 'AllActiveUsers' ; GOSUB AllActiveUsers
|
|
CASE Method = 'PostEMail' ; GOSUB PostEMail
|
|
CASE Method = 'ForwardEMail' ; GOSUB ForwardEMail
|
|
CASE Method = 'EMail' ; GOSUB EMail
|
|
CASE Method = 'BulkCreate' ; GOSUB BulkCreate
|
|
CASE 1
|
|
ErrorMsg = 'Unknown Method ':QUOTE(Method):' passed to object.'
|
|
|
|
END CASE
|
|
|
|
IF ErrorMsg NE '' THEN
|
|
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
|
RETURN ''
|
|
END
|
|
|
|
RETURN Result
|
|
|
|
|
|
* * * * * * *
|
|
Inbox:
|
|
* * * * * * *
|
|
|
|
UserName = Parms[1,@RM]
|
|
|
|
IF UserName = '' THEN UserName = @USER4
|
|
|
|
IF XLATE( 'NOTE_PTRS', UserName, 'NEW_MESSAGES', 'X' ) THEN
|
|
NotePtrRec = XLATE( 'NOTE_PTRS', UserName, '', 'X' )
|
|
IF NotePtrRec<NOTE_PTRS_NEW$,1> = 'Yes' THEN
|
|
|
|
* the top one is new
|
|
|
|
MsgInfo = ''
|
|
MsgInfo<MICON$> = '!'
|
|
Mtext = 'You have a new message from ':NotePtrRec<note_ptrs_from$,1>:'.'
|
|
MsgInfo<MTEXT$> = MText
|
|
MsgInfo<MCOL$> = -2
|
|
MsgInfo<MROW$> = -2
|
|
Msg( @WINDOW, MsgInfo )
|
|
END
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Create:
|
|
* * * * * * *
|
|
|
|
Recipients = Parms[1,@RM]
|
|
SentFrom = Parms[COL2()+1,@RM]
|
|
Subject = Parms[COL2()+1,@RM]
|
|
Message = Parms[COL2()+1,@RM]
|
|
AttachWindow = Parms[COL2()+1,@RM]
|
|
AttachKeys = Parms[COL2()+1,@RM]
|
|
SendToGroup = Parms[COL2()+1,@RM]
|
|
|
|
IF ( NOT(ASSIGNED(Recipients)) AND NOT(ASSIGNED(SendToGroup)) ) THEN
|
|
ErrorMsg = 'Unassigned Parameter "Recipients" or "SendToGroup" passed to object. (':Method:')'
|
|
end
|
|
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
|
|
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
|
|
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
|
|
|
|
IF NOT(ASSIGNED(AttachWindow)) THEN AttachWindow = ''
|
|
IF NOT(ASSIGNED(AttachKeys)) THEN AttachKeys = ''
|
|
IF NOT(ASSIGNED(SendToGroup)) THEN SendToGroup = ''
|
|
|
|
IF ErrorMsg NE '' THEN RETURN
|
|
|
|
thisRecipients = ''
|
|
RecipCnt = 0
|
|
|
|
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
|
|
Recipient = Recipients<1,I>
|
|
IF Recipient NE '' THEN
|
|
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
|
|
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
|
|
RecipCnt += 1
|
|
END
|
|
END
|
|
NEXT I
|
|
|
|
NextNoteKey = NextKey('NOTES')
|
|
|
|
NoteRec = ''
|
|
NoteRec<notes_message_type$> = 'I'
|
|
NoteRec<notes_entry_date$> = Date()
|
|
NoteRec<notes_entry_time$> = Time()
|
|
NoteRec<notes_send_to$> = thisRecipients
|
|
NoteRec<notes_from$> = SentFrom
|
|
NoteRec<notes_message$> = Message
|
|
NoteRec<notes_entry_id$> = @USER4
|
|
NoteRec<notes_subject$> = Subject
|
|
NoteRec<notes_attach_window$> = AttachWindow
|
|
NoteRec<notes_attach_keys$> = AttachKeys
|
|
NoteRec<notes_msg_groups_ids$> = SendToGroup
|
|
|
|
OtParms = 'NOTES':@RM:NextNoteKey:@RM:@RM:NoteRec
|
|
obj_Tables('WriteRec',OtParms) ;* Writes the Note record to disk
|
|
|
|
Notes_Services('AddToQueue', NextNoteKey)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Rebuild:
|
|
* * * * * * *
|
|
|
|
thisRecipient = Parms[1,@RM]
|
|
|
|
IF thisRecipient = '' THEN thisRecipient = @USER4
|
|
|
|
SelectSent = 'SELECT NOTES WITH SEND_TO "':thisRecipient:'" AND WITH ENTRY_DATE GE ':QUOTE(OCONV(Date()-90,'D4/'))
|
|
|
|
RList(SelectSent,'NOTES',TARGET_ACTIVELIST$,'','')
|
|
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
END
|
|
|
|
NoteIDs = ''
|
|
|
|
Done = 0
|
|
LOOP
|
|
READNEXT NoteID ELSE Done = 1
|
|
UNTIL Done
|
|
LOCATE NoteID IN NoteIDs BY 'DR' USING @FM SETTING Pos ELSE
|
|
NoteIDs = INSERT(NoteIDs,Pos,0,0,NoteID)
|
|
END
|
|
REPEAT
|
|
|
|
|
|
OtParms = 'NOTE_PTRS':@RM:thisRecipient
|
|
obj_Tables('LockRec',OtParms) ;* If not found then returns null, otherwise reads and sets the lock
|
|
NPRec = ''
|
|
|
|
FOR I = 1 TO COUNT(NoteIDs,@FM) + (NoteIDs NE '')
|
|
|
|
NoteID = NoteIDs<I>
|
|
|
|
NoteRec = XLATE('NOTES',NoteID,'','X')
|
|
|
|
Subject = NoteRec<NOTES_SUBJECT$>
|
|
SentFrom = NoteRec<NOTES_FROM$>
|
|
NoteDt = OCONV(NoteRec<NOTES_ENTRY_DATE$>,'D2/')
|
|
NoteTime = OCONV(NoteRec<NOTES_ENTRY_TIME$>,'MTH')
|
|
AttachWindow = NoteRec<notes_attach_window$>
|
|
AttachKeys = NoteRec<notes_attach_keys$>
|
|
|
|
IF AttachWindow NE '' AND AttachKeys NE '' THEN
|
|
Attachment = 'Yes'
|
|
END ELSE
|
|
Attachment = 'No'
|
|
END
|
|
|
|
LOCATE NoteID IN NPRec<note_ptrs_note_ids$> BY 'DR' USING @VM SETTING Pos ELSE
|
|
|
|
NPRec = INSERT( NPRec, note_ptrs_subject$, Pos, 0, Subject ) ;* Add the subject
|
|
|
|
ConvSentFrom = OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
|
|
|
|
IF ConvSentFrom NE '' THEN SentFrom = ConvSentFrom
|
|
|
|
NPRec = INSERT( NPRec, note_ptrs_from$, Pos, 0, SentFrom )
|
|
NPRec = INSERT( NPRec, note_ptrs_date$, Pos, 0, NoteDt )
|
|
NPRec = INSERT( NPRec, note_ptrs_time$, Pos, 0, NoteTime )
|
|
NPRec = INSERT( NPRec, note_ptrs_new$, Pos, 0, 'Yes' )
|
|
NPRec = INSERT( NPRec, note_ptrs_note_ids$, Pos, 0, NoteID )
|
|
NPRec = INSERT( NPRec, note_ptrs_attachment$, Pos, 0, Attachment )
|
|
NPRec = INSERT( NPRec, note_ptrs_archived$, Pos, 0, '0')
|
|
END
|
|
|
|
|
|
UNTIL LEN(NPRec) > 128000
|
|
NEXT I
|
|
|
|
OtParms = FIELDSTORE(OtParms,@RM,4,0,NPRec)
|
|
obj_Tables('WriteRec',OtParms)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
AllActiveUsers:
|
|
* * * * * * *
|
|
|
|
OPEN 'DICT.LSL_USERS' TO DictVar ELSE RETURN
|
|
|
|
SearchString = 'ACTIVE':@VM:'1':@FM
|
|
TableName = 'LSL_USERS'
|
|
Option = ''
|
|
Flag = ''
|
|
|
|
Btree.Extract(SearchString, TableName, DictVar, AllUserList, Option, Flag )
|
|
|
|
IF Get_Status(errCode) THEN RETURN
|
|
|
|
Result = AllUserList
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
PostEMail:
|
|
* * * * * * *
|
|
|
|
NoteKey = Parms[1,@RM]
|
|
|
|
IF NoteKey = '' THEN RETURN
|
|
|
|
NoteRec = XLATE('NOTES',NoteKey,'','X')
|
|
|
|
SentFrom = NoteRec<NOTES_FROM$>
|
|
Recipients = NoteRec<NOTES_SEND_TO$>
|
|
Subject = NoteRec<NOTES_SUBJECT$>
|
|
Message = NoteRec<NOTES_MESSAGE$>
|
|
AttachWindow = NoteRec<NOTES_ATTACH_WINDOW$>
|
|
AttachKeys = NoteRec<NOTES_ATTACH_KEYS$>
|
|
SendToGroup = NoteRec<NOTES_MSG_GROUPS_IDS$>
|
|
|
|
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS')
|
|
|
|
RecipientsText = Recipients
|
|
|
|
SWAP @VM WITH ', ' IN RecipientsText
|
|
|
|
|
|
RecipCnt = COUNT(Recipients,@VM) + (Recipients NE '')
|
|
|
|
FOR I = 1 TO RecipCnt
|
|
|
|
Recipient = Recipients<1,I>
|
|
|
|
UserRec = XLATE('LSL_USERS',Recipient,'','X')
|
|
FwdFlag = UserRec<LSL_USERS_FWD_EMAIL$>
|
|
eMailAddr = UserRec<LSL_USERS_EMAIL$>
|
|
|
|
IF FwdFlag = 1 AND eMailAddr NE '' THEN
|
|
|
|
Text = ''
|
|
Text<-1> = 'OI eMail from: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
|
|
Text<-1> = ''
|
|
Text<-1> = 'Recipients: ':RecipientsText
|
|
Text<-1> = ''
|
|
Text<-1> = 'Subject: ':Subject
|
|
Text<-1> = ''
|
|
Text<-1> = 'Message: '
|
|
Text<-1> = ''
|
|
Text<-1> = Message
|
|
Text<-1> = ''
|
|
|
|
IF AttachWindow NE '' THEN
|
|
Text<-1> = ''
|
|
Text<-1> = 'Attached Window: ':AttachWindow
|
|
END
|
|
|
|
IF AttachKeys NE '' THEN
|
|
Text<-1> = ''
|
|
Text<-1> = 'Record Key: ':AttachKeys
|
|
END
|
|
|
|
IF SendToGroup NE '' THEN
|
|
Text<-1> = ''
|
|
Text<-1> = 'Sent to Group: ':SendToGroup
|
|
END
|
|
|
|
HeaderText = TEXT<1>
|
|
|
|
CONVERT \00\ TO ',' IN Text
|
|
SWAP @VM WITH ':@VM:' IN Text
|
|
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
|
|
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
|
|
|
|
eMailBoxKey = NoteKey:'*':Recipient
|
|
eMailBoxRec = ''
|
|
eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$> = eMailAddr
|
|
eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$> = Text
|
|
eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$> = HeaderText
|
|
eMailBoxRec<EMAIL_BOX_FROM_USER$> = SentFrom
|
|
|
|
ebParms = 'EMAIL_BOX':@RM:eMailBoxKey:@RM:@RM:eMailBoxRec
|
|
obj_Tables('WriteRec',ebParms)
|
|
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
END
|
|
|
|
END ;* End of check for forwarding flag
|
|
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ForwardEMail:
|
|
* * * * * * *
|
|
|
|
hSysLists = Database_Services('GetTableHandle', 'SYSLISTS')
|
|
ServiceKeyID = 'Obj_Notes*ForwardEMail'
|
|
Lock hSysLists, ServiceKeyID then
|
|
rv = Set_Status(0)
|
|
RList('SELECT EMAIL_BOX BY NOTE_KEY', 5, '', '', '')
|
|
Done = 0
|
|
LOOP
|
|
ReadNext eMailBoxKey else Done = 1
|
|
UNTIL Done
|
|
mbParms = 'EMAIL_BOX':@RM:eMailBoxKey
|
|
eMailBoxRec = obj_Tables('ReadRec',mbParms)
|
|
If @File_Error EQ '' then
|
|
|
|
eMailAddr = eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$>
|
|
eMailText = eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$>
|
|
eMailHeader = eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$>
|
|
OISentFrom = eMailBoxRec<EMAIL_BOX_FROM_USER$>
|
|
SentFrom = 'oinotify@infineon.com'
|
|
SendTo = eMailAddr
|
|
IF OISentFrom = 'OI_ERROR' THEN SendTo := XLATE('SEC_GROUPS', 'OI_ADMIN', 'USER', 'X')
|
|
Success = Email_Services('SendEmail', SentFrom, SendTo, eMailHeader, eMailText)
|
|
If Success then
|
|
Mona_Services('SendBufferedStatus', 'OPENINSIGHT_MES_OP_FE', 'Email-Service', 'ok')
|
|
end else
|
|
LogData = ''
|
|
LogData<1> = LoggingDtm
|
|
LogData<2> = Error_Services('GetMessage')
|
|
Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
|
|
Mona_Services('SendBufferedStatus', 'OPENINSIGHT_MES_OP_FE', 'Email-Service', 'critical')
|
|
end
|
|
obj_Tables('DeleteRec',mbParms)
|
|
end
|
|
REPEAT
|
|
Unlock hSysLists, ServiceKeyID else Null
|
|
end
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
EMail:
|
|
* * * * * * *
|
|
|
|
* Direct outside eMail without creating a NOTES record
|
|
|
|
Recipients = Parms[1,@RM]
|
|
SentFrom = Parms[COL2()+1,@RM]
|
|
Subject = Parms[COL2()+1,@RM]
|
|
Message = Parms[COL2()+1,@RM]
|
|
|
|
IF NOT(ASSIGNED(Recipients)) THEN ErrorMsg = 'Unassigned Parameter "Recipients" passed to object. (':Method:')'
|
|
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
|
|
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
|
|
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
|
|
|
|
IF ErrorMsg NE '' THEN RETURN
|
|
|
|
thisRecipients = ''
|
|
RecipCnt = 0
|
|
|
|
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
|
|
Recipient = Recipients<1,I>
|
|
IF Recipient NE '' THEN
|
|
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
|
|
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
|
|
RecipCnt += 1
|
|
END
|
|
END
|
|
NEXT I
|
|
|
|
RecipientsText = OCONV(thisRecipients,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
|
|
|
|
SWAP @VM WITH ', ' IN RecipientsText
|
|
|
|
CurrDTM = obj_Calendar('CurrDTM')
|
|
|
|
|
|
FOR I = 1 TO RecipCnt
|
|
thisRecipient = thisRecipients<1,I>
|
|
|
|
UserRec = XLATE('LSL_USERS',thisRecipient,'','X')
|
|
eMailAddr = UserRec<LSL_USERS_EMAIL$>
|
|
|
|
IF eMailAddr NE '' THEN
|
|
|
|
Text = ''
|
|
Text<-1> = 'OI eMail from: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
|
|
Text<-1> = ''
|
|
Text<-1> = 'Recipients: ':RecipientsText
|
|
Text<-1> = ''
|
|
Text<-1> = 'Subject: ':Subject
|
|
Text<-1> = ''
|
|
Text<-1> = 'Message: '
|
|
Text<-1> = ''
|
|
Text<-1> = Message
|
|
Text<-1> = ''
|
|
|
|
HeaderText = TEXT<1>
|
|
|
|
CONVERT \00\ TO ',' IN Text
|
|
SWAP @VM WITH ':@VM:' IN Text
|
|
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
|
|
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
|
|
|
|
ConfigFile = ''
|
|
ConfigFile<1> = SendUsing_Port$
|
|
ConfigFile<2> = ''
|
|
ConfigFile<3> = 25 ;* Server port
|
|
ConfigFile<4> = 'mailrelay-external.infineon.com'
|
|
ConfigFile<5> = Yes$ ;* Authenticate
|
|
ConfigFile<6> = 'oinotify@infineon.com' ;* Username
|
|
ConfigFile<7> = 'oinotify1' ;* Password
|
|
ConfigFile<8> = No$ ;* Use SSL
|
|
|
|
SentFrom = 'oinotify@infineon.com'
|
|
SendTo = eMailAddr
|
|
|
|
Message = ''
|
|
Message<1> = HeaderText ; * Subject
|
|
Message<2> = SentFrom ; * From (email address)
|
|
Message<3> = eMailAddr ; * Send to (email address)
|
|
Message<5> = '' ; * Blind Carbon Copy (email address)
|
|
Message<6> = '' ; * Reply To (email address)
|
|
Message<7> = 'TEXT' ; * Content Type (TEXT or HTML)
|
|
Message<8> = Text ; * Content / Body
|
|
Message<9> = '' ; * Attachment(s) (path to file name(s))
|
|
|
|
MsgSent = SRP_Send_Mail(Message, ConfigFile)
|
|
|
|
|
|
END
|
|
|
|
NEXT I ;* End of Recipient Loop
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
BulkCreate:
|
|
* * * * * * *
|
|
|
|
Recipients = Parms[1,@RM]
|
|
SentFrom = Parms[COL2()+1,@RM]
|
|
Subject = Parms[COL2()+1,@RM]
|
|
Message = Parms[COL2()+1,@RM]
|
|
AttachWindow = Parms[COL2()+1,@RM]
|
|
AttachKeys = Parms[COL2()+1,@RM]
|
|
SendToGroup = Parms[COL2()+1,@RM]
|
|
|
|
IF NOT(ASSIGNED(Recipients)) THEN ErrorMsg = 'Unassigned Parameter "Recipients" passed to object. (':Method:')'
|
|
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
|
|
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
|
|
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
|
|
|
|
IF NOT(ASSIGNED(AttachWindow)) THEN AttachWindow = ''
|
|
IF NOT(ASSIGNED(AttachKeys)) THEN AttachKeys = ''
|
|
IF NOT(ASSIGNED(SendToGroup)) THEN SendToGroup = ''
|
|
|
|
IF ErrorMsg NE '' THEN RETURN
|
|
|
|
thisRecipients = ''
|
|
RecipCnt = 0
|
|
|
|
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
|
|
Recipient = Recipients<1,I>
|
|
IF Recipient NE '' THEN
|
|
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
|
|
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
|
|
RecipCnt += 1
|
|
END
|
|
END
|
|
NEXT I
|
|
|
|
NextNoteKey = NextKey('NOTES')
|
|
|
|
NoteRec = ''
|
|
NoteRec<notes_message_type$> = 'I'
|
|
NoteRec<notes_entry_date$> = Date()
|
|
NoteRec<notes_entry_time$> = Time()
|
|
NoteRec<notes_send_to$> = thisRecipients
|
|
NoteRec<notes_from$> = SentFrom
|
|
NoteRec<notes_message$> = Message
|
|
NoteRec<notes_entry_id$> = @USER4
|
|
NoteRec<notes_subject$> = Subject
|
|
NoteRec<notes_attach_window$> = AttachWindow
|
|
NoteRec<notes_attach_keys$> = AttachKeys
|
|
NoteRec<notes_msg_groups_ids$> = SendToGroup
|
|
|
|
OtParms = 'NOTES':@RM:NextNoteKey:@RM:@RM:NoteRec
|
|
|
|
Fields = notes_message_type$:@VM ; Values = 'I' :@VM
|
|
Fields := notes_entry_date$:@VM ; Values := Date() :@VM
|
|
Fields := notes_entry_time$:@VM ; Values := Time() :@VM
|
|
Fields := notes_send_to$:@VM ; Values := thisRecipients :@VM
|
|
Fields := notes_from$:@VM ; Values := SentFrom :@VM
|
|
Fields := notes_message$:@VM ; Values := Message :@VM
|
|
Fields := notes_entry_id$:@VM ; Values := @USER4 :@VM
|
|
Fields := notes_subject$:@VM ; Values := Subject :@VM
|
|
Fields := notes_attach_window$:@VM ; Values := AttachWindow :@VM
|
|
Fields := notes_attach_keys$:@VM ; Values := AttachKeys :@VM
|
|
Fields := notes_msg_groups_ids$ ; Values := SendToGroup
|
|
|
|
oblParms = 'NOTES' :@RM
|
|
oblParms := NextNoteKey :@RM
|
|
oblParms := Fields :@RM
|
|
oblParms := Values :@RM
|
|
oblParms := "TOP" :@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP"
|
|
|
|
obj_Tables('WriteRec',OtParms) ;* Writes the Note record to disk
|
|
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS')
|
|
|
|
RecipientsText = thisRecipients
|
|
|
|
SWAP @VM WITH ', ' IN RecipientsText
|
|
|
|
FOR I = 1 TO RecipCnt
|
|
|
|
thisRecipient = thisRecipients<1,I>
|
|
|
|
obj_Notes_Sent('Create',thisRecipient:@RM:NextNoteKey:@RM:CurrDTM) ;* Add to Notes Sent buffer table
|
|
|
|
UserRec = XLATE('LSL_USERS',thisRecipient,'','X')
|
|
FwdFlag = UserRec<LSL_USERS_FWD_EMAIL$>
|
|
eMailAddr = UserRec<LSL_USERS_EMAIL$>
|
|
|
|
IF FwdFlag = 1 AND eMailAddr NE '' THEN
|
|
|
|
Text = ''
|
|
Text<-1> = 'OI eMail From: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
|
|
Text<-1> = ''
|
|
Text<-1> = 'Recipients: ':RecipientsText
|
|
Text<-1> = ''
|
|
Text<-1> = 'Subject: ':Subject
|
|
Text<-1> = ''
|
|
Text<-1> = 'Message: '
|
|
Text<-1> = ''
|
|
Text<-1> = Message
|
|
Text<-1> = ''
|
|
|
|
IF AttachWindow NE '' THEN
|
|
Text<-1> = ''
|
|
Text<-1> = 'Attached Window: ':AttachWindow
|
|
END
|
|
|
|
IF AttachKeys NE '' THEN
|
|
Text<-1> = ''
|
|
Text<-1> = 'Record Key: ':AttachKeys
|
|
END
|
|
|
|
IF SendToGroup NE '' THEN
|
|
Text<-1> = ''
|
|
Text<-1> = 'Sent to Group: ':SendToGroup
|
|
END
|
|
|
|
HeaderText = Text<1>
|
|
|
|
CONVERT \00\ TO ',' IN Text
|
|
SWAP @VM WITH ':@VM:' IN Text
|
|
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
|
|
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
|
|
|
|
eMailBoxKey = NextNoteKey:'*':thisRecipient
|
|
|
|
eMailBoxRec = ''
|
|
eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$> = eMailAddr
|
|
eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$> = Text
|
|
eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$> = HeaderText
|
|
eMailBoxRec<EMAIL_BOX_FROM_USER$> = SentFrom
|
|
SRP_Stopwatch('Start', 'Email Write')
|
|
ebParms = 'EMAIL_BOX':@RM:eMailBoxKey:@RM:@RM:eMailBoxRec
|
|
|
|
Fields = EMAIL_BOX_EMAIL_ADDR$:@VM ; Values = eMailAddr :@VM
|
|
Fields := EMAIL_BOX_EMAIL_TEXT$:@VM ; Values := Text :@VM
|
|
Fields := EMAIL_BOX_EMAIL_HEADER$:@VM ; Values := HeaderText :@VM
|
|
Fields := EMAIL_BOX_FROM_USER$:@VM ; Values := SentFrom :@VM
|
|
|
|
eblParms = 'EMAIL_BOX' :@RM
|
|
eblParms := eMailBoxKey :@RM
|
|
eblParms := Fields :@RM
|
|
eblParms := Values :@RM
|
|
eblParms := "TOP" :@VM: "TOP" :@VM: "TOP":@VM: "TOP"
|
|
Obj_Post_Log('Create' eblParms)
|
|
END ;* End of check for forwarding flag
|
|
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
|