This program emails a report in .pdf (using magic not show in program)
to a user on the iseries...using the iseries as a mail server.
Its just an example you cant compile cause you dont have the
tables 0r the print file...but you can follow the code to see
how this is used:
As an added feature you get page number...
to a user on the iseries...using the iseries as a mail server.
Its just an example you cant compile cause you dont have the
tables 0r the print file...but you can follow the code to see
how this is used:
PHP Code:
~
d PrintFDS ds
d LineNumber 367 368I 0
d PageNumber 369 372I 0
PHP Code:
~
//*--------------------------------------------------------
//
// PROGRAM - LOP06
// PURPOSE - Print Labor out Po items not received
// WRITTEN - 05/05/2007
// AUTHOR - jamie
//
// PROGRAM DESCRIPTION
// This program will read open labor out PO's
// by vendor and print only those PO's that have
// eta days beyone report run date.
//
// INPUT PARAMETERS
// DESCRIPTION TYPE SIZE HOW USED
// ----------- ---- ---- --------
// Userid *Char 10 If passed used to get email address else
// userid of person calling program is used.
// INDICATOR USAGE
// 70 - overflow
// 80 - if duplicate customer name dont show
// 81 - print third vendor address line
//--------------------------------------------------------
FLODLPCHA if e k disk
FPCAVENDA if e k disk
FPCAINFOA if e k disk
fQAOKL02A if e k disk
fQATMSMTPA if e k disk
FLOP06AP o e printer usropn oflind(*in70)
F infds(PrintFDS)
//
d LOP06 pr extpgm('LOP06')
d Inuser 10
d LOP06 pi
d Inuser 10
//
// Program Info
//
d SDS
d @PGM 1 10
d @PARMS 37 39 0
d @MSGDTA 91 170
d @MSGID 171 174
d @JOB 244 253
d @USER 254 263
d @JOB# 264 269 0
//
// Variable Definition
//
d Company s 2 0
d CmdLength s 15 5 inz(0)
d CmdString s 256 inz(*blanks)
d datereqinfo s 27
d deleted s 1
d DQ s 1 inz('"')
d emailaddress s 40
d emailaddress2 s 40 inz('default01@liebovich.com')
d inname s 30
d inside s 2
d ISODate s D
d lastcname s 30
d lastvendorread s 5 0
d lenstr s 4 0
d Lo c CONST('abcdefghijklmnopqrstuvwxyz')
d openorhist s 1
d ordertype s 1
d overflow# s 3 0 inz(60)
d outcounter s 3 0
d outpro# s 7
d ponumber s 16
d pos s 3 0
d printlines s 4 0
d Q s 1 inz('''')
d soldto s 5
d sqlstmt s 512 varying
d Subject s 40
d title s 40
d Up c CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
d workuser s 10
d workcompany s 2s 0
d workoutq s 10
d PrintFDS ds
d LineNumber 367 368I 0
d PageNumber 369 372I 0
d sqldata ds Qualified
d lhven# 5 0
d lipo# 7 0
d licntp 3 0
d liqt07 7 0
d limat 3
d lianal 4
d lisize 7
d lisdes 40
d lieta 7 0
d lhvsubgrp 1 0
//
// external calls
//
d $getcustinfo pr extpgm('INV06')
d outpro# 7
d outcounter 3 0
d inname 30
d datereqinfo 27
d soldto 5
d openorhist 1
d deleted 1
d ordertype 1
d ponumber 16
d inside 2
d $command pr extpgm('QCMDEXC')
d command 5000 options(*varsize)
d Length 15 5
d openList PR
d FetchNext PR N
d closeList PR
/copy qpgmsrc,lop1ctrl
/Free
//--------------------------------------------------------
// MAIN PROGRAM
//--------------------------------------------------------
exsr Hskpg;
sqlstmt = 'Select ' +
'LHVEN#, ' +
'LIPO#, ' +
'LICNTP, ' +
'LIQT07, ' +
'LIMAT, ' +
'LIANAL, ' +
'LISIZE, ' +
'LISDES, ' +
'LIETA, ' +
'LHVSUBGRP' +
' from LOHLPCH t1 inner join loilpch t2' +
' inner join PCAVENDA t3 ' +
' on t1.lhpo# = t2.lipo# ' +
' on t1.LHVEN# = t3.PAVEN# ' +
' where t2.licomp = ' + Q + ' ' + Q +
' order by t3.PAALPH , t3.PAVEN#, ' +
' t2.lieta desc, ' +
' t2.lipo#, t2.licntp ';
write header;
clear P1FSTRING1;
clear P1FSTRING2;
clear P1FSTRING3;
openList();
dow fetchNext();
// eta date from CYMD to MDY
p1eta =
%uns(%char(%Date(sqldata.lieta :*cymd)
:*MDY0));
Isodate = %date(sqldata.lieta :*cymd);
p1days = %diff(%date() : Isodate :*DAYS);
if p1days > *zeros;
// when vendor number changes then write new vendor address
if sqldata.lhven# <> lastvendorread;
exsr $vendorAddress;
lastvendorread = sqldata.lhven#;
endif;
// PO detail line
p1po# = sqldata.lipo#;
p1pocnt = sqldata.licntp;
//Disposition(s)
exsr $disposition;
printlines = 2;
if *in70 or linenumber + printlines >= overflow#;
*in80 = *off;
write header;
write vendoradr;
*in70 = *off;
endif;
write POLINE;
endif;
enddo;
closeList();
write endrpt;
cmdstring = 'dltovr file(LOP06AP)';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring:cmdlength);
on-error;
endmon;
*inlr = *on;
//--------------------------------------------------------
// $Disposition - get disposition information
//--------------------------------------------------------
begsr $disposition;
chain (sqldata.LIPO#:sqldata.LICNTP) LODLPCHA;
if %found(LODLPCHA);
// use pronumber to get customer information
outpro# = %editc(LDPRO7:'X');
$getcustinfo(outpro# :
outcounter :
inname :
datereqinfo :
soldto :
openorhist :
deleted :
ordertype :
ponumber :
inside );
if lastcname = inname;
*in80 = *on;
else;
*in80 = *off;
lastcname = inname;
endif;
if inname <> *blanks;
p1cname = inname;
p1pro# = LDPRO7;
endif;
endif;
endsr;
//--------------------------------------------------------
// $vendoraddress - get info for vendor address
//--------------------------------------------------------
begsr $vendoraddress;
chain (sqldata.LHVEN#) PCAVENDA;
if %found(PCAVENDA);
p1vendor = PAVABR;
p1vname = PAVNAM;
p1vadr1 = PAVAD1;
p1vadr2 = PAVAD2;
if PAVAD3 <> *blanks;
*in81 = *on;
p1vadr3 = PAVAD3;
p1vadr3 = %trim(p1vadr3) + ' ' + %editc(PAVZIP:'X');
if PAVZI4 > *zeros;
p1vadr3 = %trim(p1vadr3) + '-' + %editc(PAVZI4:'X');
endif;
else;
*in81 = *off;
p1vadr3 = *blanks;
p1vadr2 = %trim(p1vadr2) + ' ' + %editc(PAVZIP:'X');
if PAVZI4 > *zeros;
p1vadr2 = %trim(p1vadr2) + '-' + %editc(PAVZI4:'X');
endif;
endif;
chain (PAVABR : sqldata.LHVSUBGRP ) PCAINFOA;
if %found(PCAINFOA);
p1phone = '(' + %editc(PAAREA:'X') + ') ' +
%subst(%editc(PAPHON:'X'):1:3) + ' - ' +
%subst(%editc(PAPHON:'X'):4:4) ;
endif;
printlines = 12;
if *in70 or linenumber + printlines >= overflow#;
*in80 = *off;
write header;
*in70 = *off;
endif;
if linenumber > 7;
write blank;
endif;
write vendoradr;
endif;
endsr;
//--------------------------------------------------------
// Hskpg - one time run subroutine
//--------------------------------------------------------
begsr Hskpg;
in dactrl;
Company = DACNUM;
P1COMPANY = DACONM;
P1PROGRAM = @PGM;
Title = 'Outstanding Labor Out POs ';
LenStr = ((%len(Title) - %len(%trim(Title))) / 2) + 1;
%subst(P1TITLE:LenStr) = %trim(Title);
// setup the users email address
if %parms > *zeros;
workuser = inuser;
else;
workuser = @USER;
endif;
clear emailaddress;
chain (workuser) QAOKL02A;
if %found(QAOKL02A);
chain (WOS1DDEN) QATMSMTPA;
if %found(QATMSMTPA);
pos = %scan('MAIL.' : %trim(DOMROUTE));
if pos > 0;
DOMROUTE = %subst(DOMROUTE:6:59);
endif;
emailaddress = %trim(%xlate(up:lo:SMTPUID)) +
%trim('@') +
%trim(%xlate(up:lo:DOMROUTE));
endif;
endif;
Subject = DQ +
'Outstanding Labor Out POs ' +
%char(%date()) + DQ;
p1fstring1 = ' **(MAIL)' +
' ' + %trim(emailaddress) +
' **MCONFIRM ' + %trim(emailaddress);
p1fstring2 = '**(REPLYTO) ' + %trim(emailaddress2);
if DACNUM = 18 or
DACNUM = 70;
workcompany = 15;
else;
workcompany = DACNUM;
endif;
p1fstring2 = %trim(p1fstring2) +
' **(MAILBODY) ' + ' body' +
%editc(workcompany:'X') + '.htm';
p1fstring3 = ' **(SUBJECT) ' + %trim(subject) +
' **(MAILFORMAT) PDF ' ;
p1theend = '**END';
if company = 20;
workoutq = 'FAXTOLBI';
else;
workoutq = 'FAXCONTROL';
endif;
cmdstring = 'ovrprtf file(LOP06AP) OUTQ(' + %trim(workoutq) + ')';
cmdlength = %len(%trim(cmdstring));
$command(cmdstring:cmdlength);
if not%open(LOP06AP);
open LOP06AP;
endif;
endsr;
/end-free
*--------------------------------------------------------
* openList - Open a cursor to read file
*--------------------------------------------------------
p openList b
d openList pi
c/exec sql
c+ declare MyCursor cursor
c+ for statement
c/end-exec
c/exec sql
c+ prepare statement from :sqlstmt
c/end-exec
c/exec sql
c+ open mycursor
c/end-exec
p openList e
*--------------------------------------------------------
* fetchNext - read one record at a time
*--------------------------------------------------------
p fetchNext b
d fetchNext pi n
c/exec sql
c+ fetch next from mycursor
c+ into :sqldata
c/end-exec
/free
if sqlstt < '02000';
return *on;
else;
return *off;
endif;
/end-free
p fetchNext e
*--------------------------------------------------------
* closeOrderList - Close the OrderHdr cursor
*--------------------------------------------------------
p closeList b
d closeList pi
c/exec sql
c+ close MyCursor
c/end-exec
p closeList e