Get Euro Exchange Rates from ECB/BCE WebService

gistfile1.txt

        ctl-opt dftactgrp(*no) ;

      //-----------------------------------------------------------------------*
      // TS_BCE: Get Exchange Rate from ECB/BCE Web Service
      // This source is part of Faq400 Blog's post
      // https://blog.faq400.com/it/?p=2648
      //-----------------------------------------------------------------------*


        dcl-pr qCmdExc ExtPgm('QCMDEXC');
            Cmd char(1000) options(*varsize) const ;
            CmdLenn packed(15:5) const ;
        END-PR;

        dcl-s Currency varchar(30);
        dcl-s ExcDate date(*DMY);
        DCL-S ExcRate Packed(11:4);
        dcl-s reply  char(10);


        ExcDate=%date();
        Currency='USD';

        ExcRate=Get_ExcRate(Currency:ExcDate);

        dsply Excdate;
        dsply %editc(ExcRate:'K');
        Dsply ( 'Press <Enter> to end program' ) ' ' reply;

        *inlr=*on;


      //-----------------------------------------------------------------------*
      // ExchageRate Get last exchange rate from BCE WbeService
      //-----------------------------------------------------------------------*
       dcl-proc Get_ExcRate       export;
       dcl-pi   Get_ExcRate       Packed(11:4);
        i_currency                varchar(30) value;
        i_date                    date(*MDY) value;
       end-pi;

       DCL-S Returnval Packed(11:4);
       DCL-S Cmd char(1000);

       // Change CCSID for HTTP Functions
       Cmd='CHGJOB CCSID(37)';
       qCmdExc(Cmd:%len(Cmd));

       // Gest last ExchangeRate from BCE WebService
         exec sql
           select rate into :returnval  from (
           SELECT * FROM XMLTABLE ( XMLNAMESPACES
           ( DEFAULT 'http://www.ecb.int/vocabulary/2002-08-01/eurofxref' ,
            'http://www.gesmes.org/xml/2002-08-01' AS "gesmes" ) ,
            'gesmes:Envelope/Cube/Cube/Cube' PASSING XMLPARSE
           ( DOCUMENT SYSTOOLS.HTTPGETBLOB
        ('https://www.ecb.europa.eu/stats/eurofxref/eurofxref-hist-90d.xml'
        , ''))
            COLUMNS currency CHAR(3) PATH '@currency',
                           rate REAL PATH '@rate',
                           time DATE PATH '../@time' ) AS ExchangeRates) x
          where CURRENCY = :i_currency
            and TIME    <= :i_date
          order by  TIME DESC;

         // Reset Current JOB to DEFAULT Values
        Cmd='CHGJOB CCSID(*USRPRF)';
        qCmdExc(Cmd:%len(Cmd));

         return returnval;
       end-proc;