midrange.com code scratchpad
Name:
Course Catalog Report
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
08/14/2015 05:16:43 pm
IP:
Logged
Description:
RPG service program which generates school course catalog report in HTML and PDF formats.
Code:
  1.      h copyright('2012 Relational Data Corporation') nomain
  2.  
  3.       //-----------------------------------------------------------------
  4.       // copy members
  5.       //-----------------------------------------------------------------
  6.  
  7.       /copy *libl/qrpglesrc,xrpt100#1
  8.       /copy *libl/qrpglesrc,rdcsrapi#1
  9.       /copy *libl/qrpglesrc,rdrptapi#1
  10.       /copy *libl/qrpglesrc,rdwtnapi#1
  11.       /copy *libl/qrpglesrc,rdfmtapi#1
  12.       /copy *libl/qsissrc,sisssch#1
  13.  
  14.       //-----------------------------------------------------------------
  15.       // module level variables
  16.       //-----------------------------------------------------------------
  17.  
  18.      d ytmlink         ds                  import qualified
  19.      d  district                     10a
  20.      d  school                       10a
  21.      d  fyr                           4a
  22.      d  term                          4a
  23.  
  24.      d dept            ds                  qualified dim(3)
  25.      d  id                           10a
  26.  
  27.      d c1              s               *   inz(*null)
  28.      d r1              s               *   inz(*null)
  29.      d filter          s            128a   varying
  30.      d odd             s               n
  31.      d str             s            256a   varying
  32.      d ext             s             10a   varying
  33.  
  34.      d squote          c                   ''''
  35.  
  36.       //-----------------------------------------------------------------
  37.       // write popup variables to header
  38.       //-----------------------------------------------------------------
  39.  
  40.      p rptxPop         b                   export
  41.  
  42.       /free
  43.  
  44.        wtnRecWrt('POP01');
  45.        wtnRecSet('POP02');
  46.        wtnFldSet('var':'district');
  47.        wtnFldSet('val':%trimr(ytmlink.district));
  48.        wtnRecWrt('POP02');
  49.  
  50.        wtnRecSet('POP02');
  51.        wtnFldSet('var':'school');
  52.        wtnFldSet('val':%trimr(ytmlink.school));
  53.        wtnRecWrt('POP02');
  54.        wtnRecWrt('POP03');
  55.  
  56.       /end-free
  57.  
  58.      p rptxPop         e
  59.  
  60.       //-----------------------------------------------------------------
  61.       // initialization
  62.       //-----------------------------------------------------------------
  63.  
  64.      p rptxInit        b                   export
  65.  
  66.       /free
  67.  
  68.        csrInit();
  69.  
  70.        c1 = csrNew('SCRS100P');
  71.  
  72.       /end-free
  73.  
  74.      p rptxInit        e
  75.  
  76.       //-----------------------------------------------------------------
  77.       // generate report
  78.       //-----------------------------------------------------------------
  79.  
  80.      p rptxGen         b                   export
  81.      d rptxGen         pi              n
  82.  
  83.       /free
  84.  
  85.        clear dept;
  86.  
  87.        r1 = rptOpen('SCRS100A');
  88.  
  89.        csrSetInst(c1);
  90.        csrSetOrder('DEPT, TITLL, COURSE, EXTENSION');
  91.  
  92.        dept(1).id = wtnFldGet('DEPT');
  93.  
  94.        filter = 'DISTRICT = ' + squote + ytmlink.district + squote +
  95.         ' AND SCHOOL = ' + squote + ytmlink.school + squote;
  96.  
  97.        if dept(1).id <> *blanks;
  98.         filter = filter + ' AND DEPT = ' +
  99.          squote + %trimr(dept(1).id) + squote;
  100.        endif;
  101.  
  102.        filter = filter + ' AND SCRUB <> ' + squote + '1' + squote;
  103.  
  104.        csrSetFilter(filter);
  105.        csrRefresh();
  106.  
  107.        if csrGoto(csr_next);
  108.         rptRecWrt('BEGRPT');
  109.         exsr page_head;
  110.        else;
  111.         return *on;
  112.        endif;
  113.  
  114.        csrGoto(csr_bof);
  115.  
  116.        dow csrGoto(csr_next);
  117.         exsr report_detail;
  118.        enddo;
  119.  
  120.        rptRecWrt('ENDCRS');
  121.        rptRecWrt('ENDRPT');
  122.  
  123.        return *on;
  124.  
  125.        //-----------------------------------------------------------------
  126.        // output detail lines
  127.        //-----------------------------------------------------------------
  128.  
  129.        begsr report_detail;
  130.  
  131.         dept(3).id = csrColStr('DEPT');
  132.  
  133.         if dept(2) <> dept(3);
  134.          rptRecWrt('ENDCRS');
  135.          rptPageBreak();
  136.          exsr page_head;
  137.         endif;
  138.  
  139.         dept(2) = dept(3);
  140.  
  141.         rptRecSet('DETAIL');
  142.  
  143.         if odd;
  144.          rptVarSet('cls':'odd');
  145.         else;
  146.          rptVarSet('cls':'even');
  147.         endif;
  148.  
  149.         odd = not odd;
  150.  
  151.         ext = %trimr(csrColStr('EXTENSION'));
  152.         str = %trimr(csrColStr('TITLL')) +
  153.          ' (' + %trimr(csrColStr('COURSE'));
  154.  
  155.         if ext <> '';
  156.          str = str + '-' + ext;
  157.         endif;
  158.  
  159.         str = str + ')';
  160.         str = str + ' [' + %trimr(csrColStr('GRADESCL')) + ']';
  161.  
  162.         rptVarSet('crs':str);
  163.         rptVarSet('fr':%char(csrColInt('TERMFROM')));
  164.         rptVarSet('to':%char(csrColInt('TERMTO')));
  165.         rptVarSet('tm':%char(csrColInt('TERMS')));
  166.         rptVarSet('cd':%editc(%dech(csrColFloat('CREDITS'):4:2):'2'));
  167.         rptVarSet('pt':%char(csrColInt('PARTCRED')));
  168.         rptVarSet('gp':%editc(%dech(csrColFloat('GRDPNTADJ'):4:2):'2'));
  169.         rptVarSet('nl':%char(csrColInt('MINLEVEL')));
  170.         rptVarSet('xl':%char(csrColInt('MAXLEVEL')));
  171.         rptVarSet('na':%editc(%dech(csrColFloat('MINAGE'):3:1):'2'));
  172.         rptVarSet('xa':%editc(%dech(csrColFloat('MAXAGE'):3:1):'2'));
  173.         rptVarSet('gn':%trimr(csrColStr('GENDERS')));
  174.         rptVarSet('ps':%editc(%dech(csrColFloat('PASSPCT'):4:1):'2'));
  175.         rptVarSet('ap':%trimr(csrColStr('APPROVAL')));
  176.  
  177.         rptRecWrt('DETAIL');
  178.  
  179.        endsr;
  180.  
  181.        //-----------------------------------------------------------------
  182.        // output page headers
  183.        //-----------------------------------------------------------------
  184.  
  185.        begsr page_head;
  186.  
  187.         odd = *on;
  188.         csrGoto(csr_relative:0);
  189.  
  190.         dept(3).id = csrColStr('DEPT');
  191.         dept(2) = dept(3);
  192.  
  193.         rptRecSet('PAGEHEAD');
  194.  
  195.         rptVarSet('school':sschDesc(ytmlink.school));
  196.         rptVarSet('date':fmtDate(%date():4));
  197.         rptVarSet('dept'
  198.          :%trimr(dept(3).id));
  199.  
  200.         rptRecWrt('PAGEHEAD');
  201.         rptRecWrt('BEGCRS');
  202.  
  203.        endsr;
  204.  
  205.       /end-free
  206.  
  207.      p rptxGen         e
  208.  
  209.       //-----------------------------------------------------------------
  210.       // generate PDF and return file name
  211.       //-----------------------------------------------------------------
  212.  
  213.      p rptxCrtPdf      b                   export
  214.      d rptxCrtPdf      pi              n
  215.  
  216.       /free
  217.  
  218.         return rptToPdf(600);
  219.  
  220.       /end-free
  221.  
  222.      p rptxCrtPdf      e
  223.  
  224.       //-----------------------------------------------------------------
  225.       // return name of report
  226.       //-----------------------------------------------------------------
  227.  
  228.      p rptxGetName     b                   export
  229.      d rptxGetName     pi           128a   varying
  230.  
  231.       /free
  232.  
  233.         return 'sch_crs_catlg';
  234.  
  235.       /end-free
  236.  
  237.      p rptxGetName     e
  238.  
  239.       //-----------------------------------------------------------------
  240.       // close report
  241.       //-----------------------------------------------------------------
  242.  
  243.      p rptxClose       b                   export
  244.  
  245.       /free
  246.  
  247.        if r1 <> *null;
  248.         csrClose();
  249.         rptClose(*off);
  250.         r1 = *null;
  251.        endif;
  252.  
  253.       /end-free
  254.  
  255.      p rptxClose       e
  256.  
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css