PMTCUSTR

**free
/TITLE Demo Expanding Subfile Search using SQL for IO
//=============================================================
// This is an customer master prompt/search program.
// It can be called to return a selected customer number or
// just to provide general inquiry functionality from a menu

// Detailed Item information is displayed in a window by
// calling another program, MTNCUSTR.

// Parameters:
// -----------
// 1  Char 1  Type of parameter
//            S - Return Selected Customer Id: 1=Select
//            M - Allow maintenance: 2=Edit, F6=Add
//            I - Inquiry, read only: 5=Display
// 2  Char 4  Selected customer id if parm 1 is S.

//=============================================================
// Program uses a full screen expanding subfile to select
// a Customer Master record.

// The screen layout is similar to PDM.

// Instead of using native IO it uses SQL to retrieve records.

// It is essentially without indicators.  (Indicators are still
// needed to control the display file, but they all have names.)

// It is possible to use F4 to prompt for the State abbreviation
// when the cursor is in the ST field.

// F09 is a toggle to display or not display inactive Customers.

//=============================================================
// Naming Conventions
// ==================
// - Lower case is the default for opcodes.
// - TitleCase is used for program variables, subroutines and procedure
//     names, e.g. MaxOrderQty, BldFkeyText, etc.
// - Temporary variables are prefixed with "wk", e.g., wkDate.  Such
//     variables contain valid data for only a short time and are never
//     carried across subroutines.
// - UPPERCASE is used for external names, i.e., files, fields, formats
//     and anything else not directly coded in the program.

// - In the display file, this field naming convention is used:
//     Screen Header:   Fields begin with SH_
//     Subfile:         Fields begin with SF_
//     Subfile Control: Fields begin with SC_
//     Screen footer:   Fields begin with SFT_

//=============================================================
// Compilation
//  This source is set up to compile from the IFS, with /COPY &
//  /INCLUDE files using relative paths. For example, a path
//  such as "/INCLUDE ../Copy_Mbrs/SRV_MSG_P.RPGLE".      
//
//  Use CRTSQLRPGI command with RPGPPOPT(*LVL2) specified. This means
//  the copy files are included using the relative path before the 
//  SQL preprocessor rewrites the code to a temporary location.

//  I edit using VS Code with the 'Code for IBM i" extension.
//============================================================
// 12/2023 Converted to totally **FREE
//         Changed to use SQLPROBLEM service pgm
// 01/2025 Require at least one parameter.
//         Remove commented SQLPROBLEM code.
//         Fix some issues with "Return selected customer" 
//============================================================

ctl-opt dftactgrp(*no) actgrp(*caller) option(*nodebugio: *srcstmt)
       bnddir('UTIL_BND':'SQL_BND');

// === Program parameters ====================================
dcl-pi *n;
    pParmType char(1);
    pCustID like(CUSTID);     
end-pi;

//=== External Programs Prototypes ============================
//--- Display/maintain customer ---
dcl-pr CustDsp extpgm('MTNCUSTR');
    *n options(*nopass) like(custid); // CustID
    *n char(1) options(*nopass); // Maintain
end-pr;
//--- Prompt for State
dcl-pr PmtState extpgm('PMTSTATER');
    *n like(state); // TheState
end-pr;

//=== Service Program Prototypes ==============================
/INCLUDE ../Copy_Mbrs/SRV_MSG_P.RPGLE
/INCLUDE ../Copy_Mbrs/SRV_STR_P.RPGLE 
/INCLUDE ../Copy_Mbrs/SRV_SQL_P.RPGLE

//=== Named hexadecimal constants for function keys ===========
/INCLUDE ../Copy_Mbrs/AIDBYTES.RPGLE

//=== Display File ===========================================
dcl-f PMTCUSTD workstn infds(dfInfDS) indds(dfIndDS) sfile(SFL:SflRRN)
       usropn;
// File is closed when returning with LR off. This avoids an
// annoying resdisplay of the last subfile on re-entry.

//=== Display File Information Data Structure =================
//    Allows us to determine which function key was pressed
dcl-ds dfInfDS;
    Key char(1) pos(369);
end-ds;

//=== Display File Indicator Data Structure ===================
// This is a "private" indicator area for the display file.
dcl-ds dfIndDS len(99);
    //--- 01-20 are not automatically cleared after EXFMT -----
    scIncActInc ind pos(3);
    //--- 21-99 automatically cleared after EXFMT -------------
    dfIndClr char(79) pos(21);
    SC_NAME_PC ind pos(79);
    // Subfile indicators (prefix "sf") ---
    sfSflNxtChg ind pos(80);
    sfOPT_RI ind pos(81);
    sfOPT_PC ind pos(82);
    sfInAct ind pos(83);
     // Subfile Control indicators (prefix "sc") -------------
    scSflEnd ind pos(97);
    scSflDsp ind pos(98);
    scSflClr ind pos(99);
end-ds;

//=== Fields to control the subfile screen ====================
dcl-s SflRRN packed(5);
dcl-s RcdsInSfl packed(5);
dcl-c SFLPAGESIZE 12;
// SC_CSR_RCD is defined in the display file and is set with a
// RRN which determines which subfile page is displayed and on
// which record the cursor is positioned.

//=== Search Criteria Screen Fields ===========================
dcl-ds SearchCriteria inz;
    SC_NAME;
    SC_CITY;
    SC_STATE;
end-ds;

//=== Last Search Criteria Fields =============================
dcl-ds LastSearchCriteria inz;
    LastSC_NAME like(sc_name);
    LastSC_CITY like(sc_city);
    LastSC_STATE like(sc_state);
end-ds;

//=== SQL State Constants =====================================
dcl-c SQLSUCCESS '00000';
dcl-c SQLNODATA '02000';
dcl-c SQLNOMOREDATA '02000';
dcl-c SQLDUPRECD '23505';
dcl-c SQLROWLOCKED '57033';

//== CUSTMAST - define fields for SQL =========================
dcl-ds CustMast extname('CUSTMAST') template end-ds;

// NOTE: !!! Only the fields read by SQL are populated !!!
// Records from SQL CURSOR read into CustCursor
dcl-ds CustCursor likeds(CustMast);

// Records from SQL SELECT read into CustSelect
dcl-ds CustSelect likeds(CustMast);

//=== Global Switches =========================================
dcl-s Quit_Pgm ind inz(*off);
dcl-s EofData ind;
dcl-s CursorOpen ind;
dcl-s NewSearchCriteria ind;
dcl-s SflMsgSnt ind;
dcl-s Opt1_OK ind;
dcl-s OptError ind;
dcl-s Maint_OK ind;
dcl-c COWSCOMEHOME const('0');
dcl-c MAXSFLRECDS const(9999);

//=== Parm fields for MTNCUSTR ================================
dcl-s wkCustid like(custid);
dcl-s CustDspParm char(1);
dcl-c CUSTDSPEDIT const('E');
dcl-c CUSTDSPADD const('A');
dcl-c CUSTDSPDSPLY const('D');

//=== Program Status Data Structure ===========================
dcl-ds ProgStatus PSDS;
    PgmName *PROC;
end-ds;

//=== Set SQL Options =========================================
// Note: Compile time settings 
exec sql set option datfmt=*iso,
                    closqlcsr=*endmod;
//=== SQL Cursor for SFL data selection =======================
    // Would prefer to defind these as  like(SC_NAME)
    // But SQL precompiler throws an error SQL0312, reason code 1
    dcl-s wkName varchar(13) ;
    dcl-s wkCity varchar(13) ;
    dcl-s wkStateLow varchar(2);
    dcl-s wkStateHigh varchar(2);
    dcl-s wkActiveLow char(1);
    dcl-s wkActiveHigh char(1);

exec sql declare ItemCur cursor for 
select NAME 
        ,CITY 
        ,STATE
        ,ZIP
        ,ACTIVE
        ,CUSTID
from    CUSTMAST
where   NAME LIKE :wkName
        and  CITY LIKE :wkCity 
        and STATE between :wkStateLow and :wkStateHigh
        and ACTIVE between :wkActiveLow and :wkActiveHigh
order by NAME, CITY, STATE
optimize for 13 rows
for fetch only
;

//=============================================================
// === Program Starts Here ====================================
//=============================================================
// Check at least one parameter. Calling from the command line
// without a parm caused confusion for newer developers.       
// In a production environment, this would be called from a 
// tested menu or some program that enforced security.
if %parms() = 0;
    snd-msg *DIAG (%trim(PgmName) + ': There must be at least one parameter'); 
    snd-msg *ESCAPE 'See previous diagnostic (*DIAG) message ';
endif;

// === Set up for the first screen IO =========================
Init(pParmType : pCustID);
BldFkeyText();
SflClear();

// Force evalualtion if enter pressed with no data
NewSearchCriteria = *on;

// If we are to return a customer number, Clear the return field
// in case nothing is selected
if  Opt1_OK = *on;
    clear pCustID;
endif;

// If just doing inquiry, load first subfile page
if %parms() > 0;
    if pParmType = 'I' ;
        SflFirstPage();
    endif;
endif;

//=============================================================
// === Main Program Loop ======================================
//=============================================================
dou COWSCOMEHOME;

  // Set "*More" display
    scSflEnd = EofData;

  // Write/Read the sreen
    ScreenIO();

    //-- Enter Key ---------------------------------------------
    If Key = Enter;
    // Either new Search Criteria entered or option(s) entered.
    // New Search Criteria takes precedence over option(s).
        if SearchCriteria <> LastSearchCriteria
             or NewSearchCriteria = *on;
            SflClear();
            SflFirstPage();
        else;
            ProcessOption();
        endif;
        if Quit_Pgm = *on;
            leave;
        endif;
        iter;
    endif;

    //--- Page Down --------------------------------------------
    if Key = PageDown;
        if RcdsInSfl > 0;
            SflFillPage();
            if SflRRN = MAXSFLRECDS;
                SflMsgSnt= SndSflMsg('DEM0006');
                iter;
            endif;
        else;
    // Key not active msg
            SflMsgSnt= SndSflMsg('DEM0003');
        endif;
        iter;
    endif;

    //--- Any other entry must be a function key ---------------
    ProcessFunctionKey();
    if (Quit_Pgm = *on);
        leave;
    endif;

enddo;

return;

//=============================================================
//=== End of Main Program Loop ================================
//=============================================================

//=== ScreenIO ================================================
// Writes and Reads the screen
Dcl-Proc ScreenIO;

    write SH_HDR;
    write SFT_FKEY;

  // Show any messages in the error subfile.
    if SflMsgSnt = *on;
        write MSGCTL;
    endif;

  // If we have records in the subfile, display them.
    if RcdsInSfl > 0;
        scSflDsp = *ON;
    else;
        scSflDsp = *OFF;
    ENDIF;

  // Write/read the subfile.  SC_CSR_RCD contains a RRN and
  // determines which page will be on the screen and where the
  // cursor will be.
    exfmt SFLCTL;

  // Clear most display file indicators
    clear dfIndClr;

  // Clear any messages in the error subfile.
    if SflMsgSnt = *on;
        SflMsgSnt = ClrMsgPgmQ(PgmName);
        write MSGCTL;
    endif;

End-Proc ScreenIO;

//=== ProcessFunctionKey ======================================
// Process whatever keyboard entry was made.
//   Will not return from subroutine if F3 or F12 was pressed.
//   May not return from subroutine when an option is entered.

Dcl-Proc ProcessFunctionKey;

    select;

        //--- F3: Exit, close down program -----------------------
        when Key = F03;
            CloseDownPgm();
            *inlr = *on;
            Quit_Pgm = *on;

        //--- F12: Return to caller, leave program active ---------
        when Key = F12;
            CloseDownPgm();
            Quit_Pgm = *on;

        //--- F4: Prompt to fill the field -----------------------
        when Key = F04;
        //  The result of a successful F4 is as if the field
        //   had been keyed from the screen.
            select;
                //  --- Prompt for State Code
                when SC_PMT_FLD = 'SC_STATE';
                    PmtState(SC_STATE);
                    if SC_STATE <> LastSC_STATE;
                        SflClear();
                        NewSearchCriteria = *on;
                    endif;
                // --- Field not promptable
                other;
                    //  Use F4 only in field followed by + sign
                    SflMsgSnt= SndSflMsg('DEM0005');
            endsl;

        //--- F5: Refresh all search fields ----------------------
        when Key = F05;
            clear LastSearchCriteria;
            clear SearchCriteria;
            SflClear();
            NewSearchCriteria = *on;
            scIncActInc = *off;

        //--- F6: Add a record. ----------------------------------
        when Key = F06;
            if Maint_OK = *on;
                CustDspParm = CUSTDSPADD;
                CustDsp(wkCustid : CustDspParm);
            else;
            // Function key not active
                SflMsgSnt= SndSflMsg('DEM0003');
            endif;

        //--- F9: Toggle Include InActive ------------------------
        when Key = F09;
            CloseCursor();
            scIncActInc = not scIncActInc;
            BldFkeyText();
            SflClear();
            NewSearchCriteria = *on;
            SflFirstPage();

        //--- Other keys: Function key not active message ---------
        other;
            SflMsgSnt= SndSflMsg('DEM0003');
    endsl;

End-Proc ProcessFunctionKey;

//=== ProcessOption ===========================================
// Did user enter one or more options?  Loop through the
//     subfile and process them all.
// May not return from this subroutine for some options.

Dcl-Proc ProcessOption;
    if RcdsInSfl > 0;
        OptError = *off;

        // Don't know yet which sfl page to display next time.
        SC_CSR_RCD = 0;

        // Loop through changed records in the subfile.
        readc SFL;
        dow not %eof;
            select;
                //--- 1 = Select -------------------------------------
                when SF_OPT = '1'
                     and  Opt1_OK = *on;
                    // Return customer number to caller
                    pCustID = SF_CUST_H;
                    CloseDownPgm();
                    Quit_Pgm = *on;
                    return;
                //--- 2 = Edit with external program -----------------
                when SF_OPT = '2' and Maint_OK = *on;
                    wkCustid = SF_CUST_H;
                    CustDspParm = CUSTDSPEDIT;
                    CustDsp(wkCustid : CustDspParm);
                    // Reset Opt and leave cursor at last valid option
                    SF_OPT = ' ';
                    SetCursorPosition();
                    // Re-read the changed record & update subfile
                    ReadByKey(wkCustid : CustSelect);
                    BuildSflRecd(CustSelect);
                    UpdSflRecd();

                //--- 5 = Display Detail with external program -------
                when SF_OPT = '5';
                    wkCustid = SF_CUST_H;
                    CustDspParm = CUSTDSPDSPLY;
                    CustDsp(wkCustid : CustDspParm);
                    // Reset Opt and leave cursor at last valid option
                    SF_OPT = ' ';
                    SetCursorPosition();
                    UpdSflRecd();

                //--- Opt is blank -----------------------------------
                when SF_OPT = ' ';
                // If changed, assume clearing an error from last time
                    sfOPT_PC = *off;
                    sfOPT_RI = *off;
                    UpdSflRecd();

               //--- Other ------------------------------------------
                other;
                // Send message about invalid selection.
                // Position cursor and page at first error.
                // Always force to be read again next time & reverse image.

                    // Not a valid option at this time
                    SflMsgSnt= SndSflMsg('DEM0004':SF_OPT);
                    // Leave cursor at first invalid option
                    SetCursorPosition();
                    OptError = *on;

                    // SFLNXTCHG forces this record to be read again
                    // (even if user doesn't correct it) so we can
                    // check it again for validity.
                    sfSflNxtChg = *on;
                    sfOPT_RI = *on;

                    UpdSflRecd();
                    // set off indicators applying to just this recd.
                    sfSflNxtChg = *off;
                    sfOPT_RI = *off;

            endsl;

            readc SFL;
        enddo;
        CustDsp();    // Closes Window DSPF & restores our subfile
    endif;

    // If no positioning done, display last page, cursor on 1st recd.
    // (Enter with no option takes you to the last page of subfile.)
    if SC_CSR_RCD = 0;
        SC_CSR_RCD =
               ( %int( (RcdsInSfl-1) / SFLPAGESIZE )
               * SFLPAGESIZE
               ) + 1;
    endif;

End-Proc ProcessOption;

//=== SflFirstPage ============================================
// Processes the Search fields in the Sub file control, then
// fills the first page of the subfile.
// If any errors in the search  fields then no records are
// are added to the subfile.

// Returns:
//   EofData = *on  if there are no more data records
//             *off if there is at least one more data
//                  record.
//   NewSearchCriteria = *on  Next time evaluate the
//                  search fields again.
//   RcdsInSfl  contains relative record number of last record
//              written to the subfile.

Dcl-Proc SflFirstPage;
    ProcessSearchCriteria();
    if NewSearchCriteria = *off;
        EofData = FetchNextData(CustCursor);
        if EofData = *off;
            SflFillPage();
        else;
            // No records match selection criteria
            SflMsgSnt= SndSflMsg('DEM0002');
            NewSearchCriteria = *on;
        endif;

    endif;
End-Proc SflFirstPage;

//=== SflFillPage =============================================
// Adds a page worth of records to the subfile.

// Assumes:
//   One record is already read from the SQL cursor.

// Returns:
//   EofData = *on  if no more data records.
//             *off if at least one data record is read
//                  and has not been displayed.
//   RcdsInSfl contains relative record number of last record
//             written to the subfile.
//   SC_CSR_RCD contains relative record number of 1st record
//             on the page & positions cursor there.

Dcl-Proc SflFillPage;

    dcl-s inx int(10);
    select;
        when EofData = *on;
        // do nothing
        other;
        // Add a subfile page.  If not EOF, then one extra recd is
        // read for the next time.
            // Position cursor at first record on the subfile page.
            SC_CSR_RCD = 0;
            // Build/Format the subfile record
            for inx = 1 to SFLPAGESIZE;
                clear SF_OPT;
                BuildSflRecd(CustCursor);

                RcdsInSfl = RcdsInSfl + 1;
                SflRRN = RcdsInSfl;
                write SFL;

                // Leave curson on first SFL record
                if SC_CSR_RCD = 0;
                    SC_CSR_RCD = SflRRN;
                endif;

                // Can't display more than 9,999 records.
                if SflRRN = MAXSFLRECDS;
                    EofData = *on;
                    SflMsgSnt= SndSflMsg('DEM0006');
                    leave;
                endif;
                // Get next record from SQL cursor
                EofData = FetchNextData(CustCursor);
                if EofData = *on;
                    leave;
                endIf;
            endfor;
    endsl;
End-Proc SflFillPage;


//=== Update Subfile Recd =====================================
Dcl-Proc UpdSflRecd;
    // Set on indicator based on saved SFL fields
    if SF_ACT_H = 'N';
        sfInAct = *on;
    endif;
    update SFL;
    sfInAct = *off;
    write DUMMY; // Supposed to help restore SFL display
End-Proc UpdSflRecd;

//=== ProcessSearchCriteria ====================================
// Examine the data entered in the search fields and build an
// SQL statement.
// Success:
//    NewSearchCriteria is set off
//    SQL Cursor is open
// Failure:
//    NewSearchCriteria is left on
//    Error message is sent to the msg sufile
//    Cursor is postioned at the field in error

Dcl-Proc ProcessSearchCriteria;
    // Reset switches
    NewSearchCriteria = *off;
    // Save entered values.  (Never change screen fields.)
    LastSearchCriteria = SearchCriteria;
    CloseCursor();
    // Build SQL cursor host variables. Using host variables
    // protects against SQL injection attacks.
    wkName =  %trim(SC_NAME) + '%' ;
    wkCity = %trim(SC_CITY) + '%';
    if SC_STATE = ' '; // All states
        wkStateLow = ' ';
        wkStateHigh = 'ZZ';
    else;
        if %len(%trim(SC_STATE)) <> 2;
            NewSearchCriteria=*on;
            SflMsgSnt = ClrMsgPgmQ(PgmName);
            SflMsgSnt = SndSflMsg('DEM0007');
        endif;
        wkStateLow = SC_STATE;
        wkStateHigh = SC_STATE;
    endif;
    If scIncActInc = *off;  // Include just actives
        wkActiveLow = 'Y';
        wkActiveHigh = 'Y';
    else; 
        wkActiveLow = ' ';
        wkActiveHigh = 'Z';
    endif;
    // Open the Cursor
    if NewSearchCriteria = *off;
        exec sql open ItemCur 
            using :wkName,:wkCity, 
            :wkStateLow, :wkStateHigh, 
            :wkActiveLow,:wkActiveHigh;
        if SQLSTT  <> SQLSUCCESS;
            SQLProblem('Open ItemCur');
        endif;
        CursorOpen = *on;
    endif;
End-Proc ProcessSearchCriteria ;

//=== SetCursorPostion ========================================
// If Invalid Option, position screen cursor on first error,
// else postion cursor on the last valid option.
Dcl-Proc SetCursorPosition;
    if OptError = *off;
        SC_CSR_RCD=SflRRN;
    endif;
End-Proc SetCursorPosition;

//=== BldFKeyText =============================================
// Build the Function key text for the bottom of the screen.
Dcl-Proc BldFkeyText;
    //=== Text for function keys ==============================
    dcl-c F3TEXT 'F3=Exit';
    dcl-c F4TEXT 'F4=Prompt+';
    dcl-c F5TEXT 'F5=Reset';
    dcl-c F6TEXT 'F6=Add';
    dcl-c F12TEXT 'F12=Cancel';
    dcl-s F9Text char(25);

    SFT_KEYS=' ';
    SFT_KEYS = CatB(SFT_KEYS : F3TEXT);
    SFT_KEYS = CatB(SFT_KEYS : F4TEXT);
    SFT_KEYS = CatB(SFT_KEYS : F5TEXT);
    if pParmType = 'M';
        SFT_KEYS = CatB(SFT_KEYS : F6TEXT);
        Maint_OK = *on;
    endif;
    if scIncActInc = *on;
        F9Text = 'F9=Exclude Inactive';
    else;
        F9Text = 'F9=Include Inactive';
    endif;
    SFT_KEYS = CatB(SFT_KEYS : F9Text);
    SFT_KEYS = CatB(SFT_KEYS : F12TEXT);
End-Proc BldFkeyText ;

//=== CloseDownPgm ============================================
// Things to do before we issue a return to the caller
Dcl-Proc CloseDownPgm;
    CloseCursor();
    close PMTCUSTD;
    CustDsp(); // Close Window display file.
End-Proc CloseDownPgm;

//=== Init ====================================================
// Must be executed each time program is entered, because F12
// and Enter key leave with LR off.
Dcl-Proc Init;
    dcl-pi *n;
        pParmType char(1);
        pCustID like(CUSTID);     
    end-pi;

    //=== Options Text ========================================
    dcl-c OPT1TEXT '1=Select';
    dcl-c OPT2TEXT '2=Edit';
    dcl-c OPT5TEXT '5=Display';
    //=== Screen Header Text===================================
    dcl-s HdrInq like(sh_funct) inz('Inquiry');
    dcl-s HdrSelect like(sh_funct) inz('Selection');
    dcl-s HdrMaint like(sh_funct) inz('Maintenance');
    dcl-s HdrBad like(sh_funct) inz('--> Bad Parm 1 <--');

    Quit_Pgm = *off;
    MSGPGMQ = PgmName;
    SH_PGM = PgmName;
    SH_FUNCT = CenterStr(HdrBad);
    if not %open(PMTCUSTD);
        open PMTCUSTD;
    endif;
    // Clear fields left over from previous F12.
    reset LastSearchCriteria;
    reset SearchCriteria;
    scIncActInc = *off;
    Maint_OK = *off;

    // Put cursor in first field if inquiry
    if pParmType = 'I';
        SC_NAME_PC = *ON;
        SH_FUNCT = CenterStr(HdrInq);
    endif;

    // Build options string.
    // If we have a field to return customer number and we
    // are doing selection, set 1=Select option.
    clear SC_OPTIONS;

    Opt1_OK = *off;
    If pParmType = 'S' and %parms > 1;
        SC_OPTIONS = OPT1TEXT;
        Opt1_OK = *on;
        SH_FUNCT = CenterStr(HdrSelect);
    endif;

    if pParmType = 'M';
        SC_OPTIONS = CatB(SC_OPTIONS : OPT2TEXT);
        SH_FUNCT = CenterStr(HdrMaint);
    endif;
    SC_OPTIONS = CatB(SC_OPTIONS : OPT5TEXT);
End-Proc Init;

//=============================================================
// ===  S u b  P r o c e d u r e s ============================
//=============================================================


//=== CatB ====================================================
// Concatenates a string to another string with a blank between.
// If the target string is all blank to start with it will not
// end up with a leading blank.
dcl-proc CatB;
    dcl-pi CatB varchar(79);
        ToStr varchar(79) value;
        AddStr varchar(79) value;
    end-pi;
    if ToStr = ' ';
        return AddStr;
    else;
        return %trimr(ToStr) + ' ' + AddStr;
    endif;
end-proc CatB;

//=== FetchNextData ===========================================
// Fetch the next row from the cursor
// Returns:        End of data Indicator:
//                   *ON   No more data, nothing returned
//                   *OFF  Data returned
//------------------------------------------------------------
dcl-proc FetchNextData;
    dcl-pi FetchNextData ind;
        TheRecd likeds(CustMast);
    end-pi;
// Local fields
    dcl-s wkEof ind inz(*off);

    exec sql fetch ItemCur into
                             :TheRecd.NAME,
                             :TheRecd.CITY,
                             :TheRecd.STATE,
                             :TheRecd.ZIP,
                             :TheRecd.ACTIVE,
                             :TheRecd.CUSTID
                        ;
    select;
        when SQLSTT = SQLSUCCESS;
            wkEof = *off;
        when SQLSTT = SQLNOMOREDATA;
            wkEof = *on;
        Other;
            SQLProblem('Fetch ITEMCUR');
    endsl;

    RETURN wkEof;

end-proc FetchNextData;

//=== ReadByKey ===============================================
// Read the record by key into the specified data record
// using the key passed in.
dcl-proc ReadByKey;
    dcl-pi ReadByKey;
        TheKey like(custid);
        TheRecd likeds(CustMast);
    end-pi;
    exec sql select
                         NAME,
                         CITY,
                         STATE,
                         ZIP,
                         ACTIVE,
                         CUSTID
                into
                         :TheRecd.NAME,
                         :TheRecd.CITY,
                         :TheRecd.STATE,
                         :TheRecd.ZIP,
                         :TheRecd.ACTIVE,
                         :TheRecd.CUSTID
                from     CUSTMAST
                where    CUSTID = :TheKey
    ;
end-proc ReadByKey;

//=== BuildSFLRecd ============================================
// Builds a SFL record from the specified data record
dcl-proc BuildSflRecd;
    dcl-pi BuildSflRecd;
        CustRecd likeds(CustMast);
    end-pi;
    SF_NAME = CustRecd.NAME;
    SF_CITY = CustRecd.CITY;
    SF_STATE = CustRecd.STATE;
    SF_ZIP = CustRecd.ZIP;
      // Save Id in case we need it for 5=Display
    SF_CUST_H = CustRecd.CUSTID;
      // Change color if record is inactive
    if CustRecd.ACTIVE = 'N';
        sfInAct = *on;
    else;
        sfInAct= *off;
    endif;
      // Save Active status in case we update subfile
    SF_ACT_H = CustRecd.ACTIVE;
end-proc BuildSflRecd;

//=== CloseCursor =============================================
// Closes the SQL Cursor if open
dcl-proc CloseCursor;
    dcl-pi CloseCursor end-pi;
// Local fields
    if CursorOpen = *on;
        exec sql close ItemCur;
        if SQLSTT <> SQLSUCCESS;
            SQLProblem('Close ITEMCUR');
        endif;
        CursorOpen = *off;
    endif;
    RETURN;
end-proc CloseCursor;

//=== SndSflMsg ===============================================
// Send a message to the Error Subfile
// Returns:        *ON
// Parameter:      ErrMsgId => Msg Id to Send
// Parameter:      ErrMsgData => Optional Error Message Data
// Parameter:      ErrMsgFile => Optional Error Message File
//                 Defaults to CUSTMSGF
       //------------------------------------------------------------
dcl-proc SndSflMsg;
    dcl-pi SndSflMsg ind;
        ErrMsgId char(7) const;
        ErrMsgData char(80) const options(*nopass:*varsize);
        ErrMsgFile char(10) const options(*nopass);
    end-pi;

// Local fields
    dcl-s retField ind;
    dcl-s wkMsgId char(7);
    dcl-s wkMsgFile char(10);
    dcl-s wkMsgData varchar(512);

    if %parms >2;
        wkMsgFile = ErrMsgFile;
    else;
        wkMsgFile = 'CUSTMSGF';
    ENDIF;
    if %parms > 1;
        wkMsgData = ErrMsgData;
    else;
        wkMsgData = ' ';
    ENDIF;
    wkMsgId = ErrMsgId;
    SNDMSGPGMQ(PgmName:
             wkMsgId:
             wkMsgFile:
             wkMsgData);

    retField = *on;
    RETURN retField;

end-proc SndSflMsg;

//=== SflClear ================================================
// Clears the Subfile
dcl-proc SflClear;
    dcl-pi SflClear end-pi;
    clear SflRRN;
    clear RcdsInSfl;
    scSflClr = *ON;
    write SFLCTL;
    scSflClr = *OFF;
    return;
end-proc SflClear;