100 ************************************************************************** 200 * * 300 * Property of xxxxxxxxxxxxxxxx * 400 * * 500 * Name: SENDEMR0 * 600 * Description: Send Email PDF Mapping Program. * 700 * * 800 * Compiler Overrides: * 900 * * 1000 * Author: JBM Programming Services - Jim Mabee * 1100 * Written: 08/29/2006 * 1200 * * 1300 * Modification Log * 1400 * Ref No Date Programmer Description * 1500 * * 1600 * * 1700 * * 1800 ************************************************************************** 1900 2000 * PDF Email Address file 2100 fSendEmF1 IF E K Disk 2200 2300 * PDF Email Subject Text file 2400 fSendEmF2 IF E K Disk 2500 2600 * PDF Email Body Text file 2700 fSendEmF3 IF E K Disk 2800 2900 ************************************************************************** 3000 3100 * Program Constants 3200 d Yes C '1' 3300 d No C '0' 3400 d TagId1 C 'I1[' 3500 d TagId2 C 'I2[' 3600 d TagSubject C 'S[' 3700 d TagOvrAddr C 'A[' 3800 d TagTerm C ']' 3900 d SngQuote C x'7D' 4000 d Active C 'A' 4100 d Inactive C 'I' 4200 4300 * Program variables 4400 d TId1 S Like(S1TId1) 4500 d TId2 S Like(S1TId2) 4600 d AddressType S Like(S1AdTy) 4700 d Subject S 100A 4800 d OvrAddr S 100A 4900 5000 d StartPos S 4S 0 5100 d EndPos S 4S 0 5200 5300 * Program Entry parameters 5400 d InputLength S 9B 0 5500 d BufferLength S 9B 0 5600 d NeededLength S 9B 0 5700 5800 * PDF Input Data Structure 5900 d InputDS DS 6000 * Qualified Job Name 6100 d JobName 1 26A 6200 6300 * Spool File Name 6400 d SplFileName 27 36A 6500 6600 * Spool File Number 6700 d SplFileNo 37 40B 0 6800 6900 * Mail Tag 7000 * This field will contain the Id's to read the files, the subject text, 7100 * the body text, and an override email address. 7200 * If an override email address is included, the email will not be sent to 7300 * any other address and the Id's will only be used to get the subject text 7400 * and the body text 7500 * If the Id's are not included, email addresses, subject text, and body text 7600 * will not be used. 7700 * Either Id's or an override address must be included in the mail tag. 7800 * 7900 * For Id 1 use I1 with the value in brackets; Id 2 use I2 8000 * Example: I1[00006138]I2[INVOICE] 8100 * 8200 * For subject text use S with the value in brackets. 8300 * Example: S[338082] 8400 * If a subject record exists for the Id Tags than the email subject will 8500 * be PREFIX + SUBJECT TEXT + SUFFIX 8600 * 8700 * For an override email address use A with the address in brackets. 8800 * Example: A[myplace@usa.com] 8900 d MailTag 41 290A 9000 9100 * PDF File Name and Path 9200 d FilePath 291 630A 9300 9400 * Mail Server Type: 1 = Send Distribution (SNDDST), 2 = SMTP 9500 d MailServer 631 631A 9600 9700 * Reserved 9800 d Reserved1 632 632A 9900 10000 * Path and Name CCSID 10100 d PathCCSID 633 636B 0 10200 10300 * Mail Sender 10400 d Sender 637 646A 10500 10600 * User Data (USRDTA) 10700 d UserData 647 656A 10800 10900 * Job System Name 11000 d SystemName 657 664A 11100 11200 * Creation Time Stamp 11300 d Created 665 672A 11400 11500 * Spooled file Output Queue 11600 d OutQ 673 682A 11700 11800 * Output Queue Library 11900 d OutQLibr 683 692A 12000 12100 * PDF Mapping Object Name 12200 d PDFMapObjName 693 702A 12300 12400 * PDF Mapping Object Library 12500 d PDFMapObjLibr 703 712A 12600 12700 * Form Type 12800 d FormType 713 722A 12900 13000 * PDF Output Data Structure 13100 d OutputDS DS 13200 * Disposition of the PDF file: 0 = Do not mail PDF file, 1 = Email PDF file 13300 d DispEmail 1A 13400 13500 * More Processing: 0 (X'F0') = Do not call PDF mapping prog again 13600 * 1 (X'F1') = Call the PDF mapping program again 13700 d CallAgain 1A 13800 13900 * Reserved (set each byte to X'00') 14000 d Reserved2 2A 14100 14200 * Length of Message Text 14300 d MsgTextLength 9B 0 14400 14500 * Length of Mail Address 14600 d AddrLength 9B 0 14700 14800 * Message Text 14900 d MsgText 255A 15000 15100 * Reserved (set to X'00') 15200 d Reserved3 1A 15300 15400 * Offset to Extension Area 15500 d ExtOffset 9B 0 15600 15700 * CCSID of Message Text and Subject 15800 d MsgCCSID 9B 0 15900 16000 * Disposition of PDF Streamfile 16100 d DispStream 1A 16200 16300 * Disposition of PDF Spoolfile 16400 d DispSpool 1A 16500 16600 * Disposition of PDF Error 16700 d DispError 1A 16800 16900 * Disposition of AFPDS Spoolfile 17000 d DispAFPDS 1A 17100 17200 * Reserved (set each byte to X'00') 17300 d Reserved4 7A 17400 17500 * Email Address 17600 d EmailAddr 1000A 17700 17800 ***** Extension Area Format ***** 17900 * Length of Extension Area Format 18000 d ExtLength 9B 0 18100 18200 * Offset to Subject 18300 d SubjOffset 9B 0 18400 18500 * Length of Subject 18600 d SubjLength 9B 0 18700 18800 * Offset to ReplyTo Email Address 18900 d RplyOffset 9B 0 19000 19100 * Length of ReplyTo Email Address 19200 d RplyLength 9B 0 19300 19400 * Offset to CC Email Address 19500 d CCOffset 9B 0 19600 19700 * Length of CC Email Address 19800 d CCLength 9B 0 19900 20000 * Offset to BCC Email Address 20100 d BCCOffset 9B 0 20200 20300 * Length of BCC Email Address 20400 d BCCLength 9B 0 20500 20600 * Offset to list of path names for body of email 20700 d BodyOffset 9B 0 20800 20900 * Offset to path name for directory for files 21000 d DirOffset 9B 0 21100 21200 * Length of path name for directory for files 21300 d DirLength 9B 0 21400 21500 * Offset to list of path names of attachments 21600 d AttchOffset 9B 0 21700 21800 * Offset to PDF file name for storing as a file 21900 d PDFFileOffset 9B 0 22000 22100 * Length of PDF file name for storing as a file 22200 d PDFFileLength 9B 0 22300 22400 * Offset to PDF attachment for e-mail 22500 d PDFMailOffset 9B 0 22600 22700 * Length of PDF attachment for e-mail 22800 d PDFMailLength 9B 0 22900 23000 * Offset to PDF file public authority 23100 d PDFAuthOffset 9B 0 23200 23300 * Length of PDF file public authority 23400 d PDFAuthLength 9B 0 23500 23600 * Offset to spooled file PDF distribution 23700 d PDFDistOffset 9B 0 23800 23900 * Length of spooled file PDF distribution 24000 d PDFDistLength 9B 0 24100 24200 * Offset to spooled file AFP distribution 24300 d AFPDistOffset 9B 0 24400 24500 * Length of spooled file AFP distribution 24600 d AFPDistLength 9B 0 24700 24800 * Offset to PDF encryption information 24900 d PDFEncrOffset 9B 0 25000 25100 * Length to PDF encryption information 25200 d PDFEncrLength 9B 0 25300 25400 ***** Extension Area Data ***** 25500 * Subject Text 25600 d SubjText 100A 25700 25800 * ReplyTo Email Addresses 25900 d RplyAddr 80A 26000 26100 * CC Email Addresses 26200 d CCAddr 250A 26300 26400 * BCC Email Addresses 26500 d BCCAddr 250A 26600 26700 ************************************************************************** 26800 26900 * If the PDF file path and name is blank than this is the first call 27000 * to the mapping program for encryption values 27100 c If FilePath = *Blanks 27200 c Eval *InLr = *On 27300 c Return 27400 c EndIf 27500 27600 * Check if the output buffer is large enough. If not, set the Call Again 27700 * flag and return to calling program. 27800 c Eval Neededlength = %Len(OutputDS) 27900 c If Neededlength > BufferLength 28000 c Eval CallAgain = x'F1' 28100 c Return 28200 c EndIf 28300 28400 * Initialize static output values 28500 c Exsr InitValues 28600 28700 * Parse out values frm Mail Tag 28800 c Exsr ParseMailTag 28900 29000 * Get Email Addresses 29100 c If OvrAddr = *Blanks 29200 c Exsr GetAddress 29300 c Else 29400 c Eval EmailAddr = OvrAddr 29500 c EndIf 29600 29700 * Get Email Subject 29800 c SubjKey Chain(e) SendEm2R 29900 c If %Found 30000 c Eval SubjText = %Trim(S2Prfx) + ' ' 30100 c + %Trim(Subject) + ' ' 30200 c + %Trim(S2Sufx) 30300 c Else 30400 c Eval SubjText = Subject 30500 c EndIf 30600 30700 * Beg: Get Body Message loop 30800 c SubjKey SetLL SendEm3R 30900 c DoW ' ' = ' ' 31000 31100 c SubjKey ReadE(e) SendEm3R 31200 c If %EOF 31300 c Leave 31400 c EndIf 31500 31600 c Eval MsgText = %Trim(MsgText) + ' ' 31700 c + %Trim(S3Text) 31800 31900 * End: Get Body Message loop 32000 c EndDo 32100 32200 * Validate and set disposition 32300 c Exsr Validate 32400 32500 * End program and return 32600 c Eval *InLr = *On 32700 c Return 32800 32900 ************************************************************************** 33000 * *InzSr - Program Initialization Subroutine * 33100 ************************************************************************** 33200 c *InzSr BegSr 33300 33400 * Program entry parameters 33500 c *Entry PList 33600 c Parm InputDS 33700 c Parm InputLength 33800 c Parm OutputDS 33900 c Parm BufferLength 34000 c Parm NeededLength 34100 34200 * Address file key list 34300 c AddrKey KList 34400 c KFld TId1 34500 c KFld TId2 34600 c KFld AddressType 34700 34800 * Address file key list 34900 c SubjKey KList 35000 c KFld TId1 35100 c KFld TId2 35200 35300 c EndSr 35400 35500 ************************************************************************** 35600 * InitValues - Initialize static output values * 35700 ************************************************************************** 35800 c InitValues BegSr 35900 36000 * Initialize the data structure to ensure there is no stray data 36100 c Eval OutputDS = *Allx'00' 36200 36300 * Initialize static fields 36400 c Eval DispEmail = Yes 36500 c Eval CallAgain = x'F0' 36600 c Eval Reserved2 = *Allx'00' 36700 c Eval MsgTextLength = 255 36800 c Eval Addrlength = 1000 36900 c Eval Reserved3 = *Allx'00' 37000 c Eval ExtOffset = 1287 37100 c Eval MsgCCSID = 0 37200 c Eval DispStream = No 37300 c Eval DispSpool = No 37400 c Eval DispError = No 37500 c Eval DispAFPDS = No 37600 c Eval Reserved4 = *Allx'00' 37700 c Eval ExtLength = 100 37800 c Eval SubjOffset = 1387 37900 c Eval SubjLength = 100 38000 c Eval RplyOffset = 1487 38100 c Eval RplyLength = 80 38200 c Eval CCOffSet = 1567 38300 c Eval CCLength = 250 38400 c Eval BCCOffSet = 1817 38500 c Eval BCCLength = 250 38600 c Eval BodyOffset = *Zeros 38700 c Eval DirOffset = *Zeros 38800 c Eval DirLength = *Zeros 38900 c Eval AttchOffset = *Zeros 39000 c Eval PDFFileOffset = *Zeros 39100 c Eval PDFFileLength = *Zeros 39200 c Eval PDFMailOffset = *Zeros 39300 c Eval PDFMailLength = *Zeros 39400 c Eval PDFAuthOffset = *Zeros 39500 c Eval PDFAuthLength = *Zeros 39600 c Eval PDFDistOffset = *Zeros 39700 c Eval PDFDistLength = *Zeros 39800 c Eval AFPDistOffset = *Zeros 39900 c Eval AFPDistLength = *Zeros 40000 c Eval PDFEncrOffset = *Zeros 40100 c Eval PDFEncrLength = *Zeros 40200 40300 * Clear (set to blanks) address and text fields 40400 c Clear EmailAddr 40500 c Clear BCCAddr 40600 c Clear CCAddr 40700 c Clear RplyAddr 40800 c Clear SubjText 40900 c Clear MsgText 41000 41100 c EndSr 41200 41300 ************************************************************************** 41400 * ParseMailTag - Parse out the values form the Mail Tag * 41500 ************************************************************************** 41600 c ParseMailTag BegSr 41700 41800 * Find Id 1 41900 c Eval StartPos = %Scan(TagId1: MailTag) 42000 c If StartPos > *Zeros 42100 c Eval StartPos = StartPos + %Len(TagId1) 42200 c Eval EndPos = %Scan(TagTerm: MailTag: StartPos) 42300 42400 c If EndPos > StartPos 42500 c Eval TId1 = %Subst(MailTag: StartPos: 42600 c EndPos - StartPos) 42700 c EndIf 42800 c EndIf 42900 43000 * Find Id 2 43100 c Eval StartPos = %Scan(TagId2: MailTag) 43200 c If StartPos > *Zeros 43300 c Eval StartPos = StartPos + %Len(TagId2) 43400 c Eval EndPos = %Scan(TagTerm: MailTag: StartPos) 43500 43600 c If EndPos > StartPos 43700 c Eval TId2 = %Subst(MailTag: StartPos: 43800 c EndPos - StartPos) 43900 c EndIf 44000 c EndIf 44100 44200 * Find Subject 44300 c Eval StartPos = %Scan(TagSubject: MailTag) 44400 c If StartPos > *Zeros 44500 c Eval StartPos = StartPos + %Len(TagSubject) 44600 c Eval EndPos = %Scan(TagTerm: MailTag: StartPos) 44700 44800 c If EndPos > StartPos 44900 c Eval Subject = %Subst(MailTag: StartPos: 45000 c EndPos - StartPos) 45100 c EndIf 45200 c EndIf 45300 45400 * Find Override Address 45500 c Eval StartPos = %Scan(TagOvrAddr: MailTag) 45600 c If StartPos > *Zeros 45700 c Eval StartPos = StartPos + %Len(TagOvrAddr) 45800 c Eval EndPos = %Scan(TagTerm: MailTag: StartPos) 45900 46000 c If EndPos > StartPos 46100 c Eval OvrAddr = %Subst(MailTag: StartPos: 46200 c EndPos - StartPos) 46300 c EndIf 46400 c EndIf 46500 46600 c EndSr 46700 46800 ************************************************************************** 46900 * GetAddress - Get the Email Addresses * 47000 * First check for Std Addresses (Address Type = ' ') * 47100 * Than check for BCC Addresses (Address Type = 'B') * 47200 * Than check for CC Addresses (Address Type = 'C') * 47300 * Than check for Reply To Addresses (Address Type = 'R') * 47400 ************************************************************************** 47500 c GetAddress BegSr 47600 47700 * Beg: Get Email Addresses loop 47800 c Eval AddressType = *Blanks 47900 c AddrKey SetLL SendEm1R 48000 c DoW ' ' = ' ' 48100 48200 c AddrKey ReadE(e) SendEm1R 48300 c If %EOF 48400 c Select 48500 c When AddressType = *Blanks 48600 c Eval AddressType = 'B' 48700 c AddrKey SetLL SendEm1R 48800 c Iter 48900 49000 c When AddressType = 'B' 49100 c Eval AddressType = 'C' 49200 c AddrKey SetLL SendEm1R 49300 c Iter 49400 49500 c When AddressType = 'C' 49600 c Eval AddressType = 'R' 49700 c AddrKey SetLL SendEm1R 49800 c Iter 49900 50000 c When AddressType = 'R' 50100 c Leave 50200 c EndSl 50300 c EndIf 50400 50500 * Address must be active 50600 c If S1ASts <> Active 50700 c Iter 50800 c EndIf 50900 51000 * Load Address to data structure 51100 c Select 51200 c When AddressType = ' ' 51300 c Eval EmailAddr = %Trim(EmailAddr) + SngQuote 51400 c + %Trim(S1Addr) + SngQuote 51500 51600 c When AddressType = 'B' 51700 c Eval BCCAddr = %Trim(BCCAddr) + SngQuote 51800 c + %Trim(S1Addr) + SngQuote 51900 52000 c When AddressType = 'C' 52100 c Eval CCAddr = %Trim(CCAddr) + SngQuote 52200 c + %Trim(S1Addr) + SngQuote 52300 52400 c When AddressType = 'R' 52500 c Eval RplyAddr = %Trim(RplyAddr) + SngQuote 52600 c + %Trim(S1Addr) + SngQuote 52700 c EndSl 52800 52900 * End: Get Email Addresses loop 53000 c EndDo 53100 53200 c EndSr 53300 53400 ************************************************************************** 53500 * Validate - Validate that required data exists and set disposition * 53600 * Also, Set offsets to zero if not being used * 53700 ************************************************************************** 53800 c Validate BegSr 53900 54000 * Email address cannot be blank 54100 c If EmailAddr = *Blanks 54200 c Eval DispError = Yes 54300 c Eval DispEmail = No 54400 c LeaveSr 54500 c endIf 54600 54700 * Set offset to zero if not being used 54800 c If MsgText = *Blanks 54900 c Eval MsgTextLength = *Zeros 55000 c EndIf 55100 55200 c If SubjText = *Blanks 55300 c Eval SubjOffset = *Zeros 55400 c Eval SubjLength = *Zeros 55500 c EndIf 55600 55700 c If RplyAddr = *Blanks 55800 c Eval RplyOffset = *Zeros 55900 c Eval RplyLength = *Zeros 56000 c EndIf 56100 56200 c If CCAddr = *Blanks 56300 c Eval CCOffset = *Zeros 56400 c Eval CCLength = *Zeros 56500 c EndIf 56600 56700 c If BCCAddr = *Blanks 56800 c Eval BCCOffset = *Zeros 56900 c Eval BCCLength = *Zeros 57000 c EndIf 57100 57200 * Set disposition to 'Yes, Send Email' 57300 c Eval DispEmail = Yes 57400 57500 c EndSr 57600 * * * * E N D O F S O U R C E * * * *