//  ______________________________________________________________________
      //   ___             _    _     __ __             _    _
      //  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      //  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      //  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      //
      //    Nov, 2019                                   booth@martinvt.com
      //  ______________________________________________________________________
      //    Comments:
      //    Web demo of Seas & Oceans drop-down box
      //
      //  ______________________________________________________________________
       ctl-opt
       copyright('(C) Copyright 2019, All rights reserved.')
       option(*nodebugio) dftactgrp(*no) actgrp(*new);

       dcl-f WEBSEASF4D workstn sfile(SFL1: SF1NUM);

      *  ..................................................
       dcl-c cYLW x'32';
       dcl-c cURL 'http://the.service/api/';
       dcl-s URL varchar(400);

       //  ...................... Prototype
       dcl-s wNbrCols int(10);
       dcl-pr GetScreenSize extproc('QsnRtvScrDim');
        *n int(10) options(*omit); // NbrRows
        *n int(10) options(*omit); // NbrCols
        *n int(10) options(*omit); // Handle
        *n char(32767) options(*varsize: *omit); // ErrorCode
       end-pr;

       dcl-s wSeas varchar(20);
       dcl-s wCount int(5);
       dcl-s wNdx int(5);

       dcl-pr WEBSEASF4;
        *n char(20);
        *n char(2);
        *n char(3);
       end-pr;
       // ....................... Procedure interface
       dcl-pi WEBSEASF4;
        pOCEAN char(20);
        pRow char(2);
        pCol char(3);
       end-pi;

      /free
        //====================================================================*
        // SQL definitions (must be first lines of all sql lines in source.)  *
        //====================================================================*
        // The immediately following /EXEC SQL is SQL's version of RPG's H Spec
        // It is never executed.  Just used at compile time.
         exec sql set option
           Commit = *Chg,
           DatFmt = *ISO,
           SrtSeq = *LangIDShr;   // allows sort & search with upper/lower
        //====================================================================*
        // MAINLINE-Begin                                                     *
        //====================================================================*
         if %parms = 3;   // position the dropdown box under the correct field
           WROW = %int(pRow);
           WCOL = %int(PCol);
         endif;
         //check current screen size, configure to match
         GetScreenSize(*omit:wNbrCols:*omit:*omit);
         if wNbrCols = 132;
           *in91 = *on;
         else;
           *in91 = *off;
         endif;
         // Clear subfile.
         *in90 = *off;
         write FMT01;
         *in90 = *on;
         // Fill the subfile:
         SF1NUM = *zero;
         SFLTOP = 1;
         // Read the file.
         URL = cURL + 'oceans';
         exec sql select * into :wCount
         from json_table(systools.httpgetclob(:URL, ''), '$'
             columns(entries dec(5) path '$.wData_length') );

         exec sql declare C1 cursor for
           select * from json_table(systools.httpgetclob(:URL, ''),
            'lax $.SeasOceans[*]'
             columns(oceans varchar(20)  path 'lax $')
             );
         exec sql open C1;
         for wNdx = 1 to wCount;
           exec sql fetch C1 into :wSeas;
           if sqlcode = 0;
             S1OCEAN = wSeas;
             SF1NUM += 1;
             write SFL1;
           endif;
         endfor;
         exec sql close C1;

         // If subfile is empty, make a line
         if SF1NUM = *zero;
           S1OCEAN = cYLW + 'No records';
           SF1NUM += 1;
           write SFL1;
         endif;
         SFL1RECS = SF1NUM;
         SFL1RECS = RRNA;
         if WROW = 0;
           WROW = 5;
         endif;
         if WCOL = 0;
           WCOL =  3;
         endif;
         exfmt FMT01;

       // If a choice was made, save it to PARM for return:
       if %parms > 0 and RRNA > *zeros and not *inkl;
         chain RRNA SFL1;
         pOCEAN = S1OCEAN;
       endif;
       *inlr = *on;
        //====================================================================*
        // MAINLINE-End                                                       *
        //====================================================================*
      /end-free  

      //  ______________________________________________________________________
      //   ___             _    _     __ __             _    _
      //  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      //  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      //  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      //
      //    Nov, 2019                                        booth@martinvt.com
      //  ______________________________________________________________________
      //    Web demo of Seas & Oceans drop-down box
      //
      //  ______________________________________________________________________
       ctl-opt
       copyright('(C) Copyright, 2019, All rights reserved.')
       option(*nodebugio) dftactgrp(*no) actgrp(*new);

       dcl-f WEBSEASD workstn;

       dcl-c cTrq x'30';

       dcl-ds *n PSDS;
        USERID char(10) pos(358);
       end-ds;

       dcl-pr ShowDropDown extpgm('WEBSEASF4');
        *n char(20);
        *n char(2) const;
        *n char(3) const;
       end-pr;

        //==================================================================== *
        // MAINLINE                                                            *
        //==================================================================== *
        // The immediately following /EXEC SQL set options is SQL's version
        // of RPG's H Spec.  It is never executed.  Just used at compile time.
        // MUST be in source code above any other exec SQL statements.
          exec sql set option
           Commit = *None,
           SrtSeq = *LangIDShr;   // allows sort & search with upper/lower
        //  ____________________________________________________________________
       /free
         exsr GetHeading;
         dow *inkc = *off;
           exsr ChangeColors;
           exfmt FMT01;
           select;
             when *inkc;        // exit
             when *inkd or CSRFLD = 'F4PROMPT'
                        or (*in71 and CSRFLD = 'S1OCEAN');
               ShowDropDown(S1OCEAN: '11': '19'); // Drop-down box (row&column)
             other;
           endsl;
         enddo;
         *inlr = *on;
        //====================================================================*
        // MAINLINE-END                                                       *
        //====================================================================*
        //-------------------------------*  Sub-Routine  *
        // GetHeading()                  *---------------*
        //-----------------------------------------------*
        begsr GetHeading;
          HDG5X40 =
                    '   _      __    __                      '
                  + '  | | /| / /__ / /    -= Prompt for a =-'
                  + '  | |/ |/ / -_) _ \   -= Sea/Ocean w/ =-'
                  + '  |__/|__/\__/_.__/   -= drop-down.   =-';
          HDG7X23 =
                    '                       '
                  + '                       '
                  + '          ,,,          '
                  + '         (O-O)         '
                  + '  ----oo0-(_)-0oo----  '
                  + '                       '
                  + '                       ';
         exec SQL                              // Get user's name to display.
           select CID.ODOBTX
             into :S1USERNAME
             from Table( QSYS2/USERS() ) AS CID
             where CID.ODOBNM = :USERID;
         evalr S1USERNAME = 'with' + cTrq + %trim(S1USERNAME);
        endsr;
        //-------------------------------*  Sub-Routine  *
        // Change Heading Colors         *---------------*
        //-----------------------------------------------*
        begsr ChangeColors;
          select;
            when *in61;
              *in61 = *off;
              *in62 = *on;
            when *in62;
              *in62 = *off;
              *in63 = *on;
            when *in63;
              *in63 = *off;
              *in64 = *on;
            when *in64;
              *in64 = *off;
              *in65 = *on;
            when *in65;
              *in65 = *off;
              *in66 = *on;
            when *in66;
              *in66 = *off;
              *in67 = *on;
            other;
              *in67 = *off;
              *in61 = *on;
          endsl;
        endsr;