ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

using infds to retrieve current line printing

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • using infds to retrieve current line printing

    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:
    PHP Code:
    ~
         
    d PrintFDS        ds
         d LineNumber            367    368I 0
         d PageNumber            369    372I 0 
    As an added feature you get page number...



    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 = ' ' ' +
                          
    ' 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 =
                 &
    #37;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 (workuserQAOKL02A;
                  if %
    found(QAOKL02A);
                   
    chain (WOS1DDENQATMSMTPA;
                   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 
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com
Working...
X