**FREE
/TITLE MNTCUSTR - Update/Display a Customer Master
//==============================================================
// A maintenance or display program for a Customer Master Recds
//
//
// Parameters
// ----------
//  1 In  Z4  Customer Id to, or 0 to add a new code
//  2 In  CL1 Function
//            E - Edit passed record
//            D - Display passed record
//            A - Add a new record
//
//    If no parms passed, close the display file and return.
//==============================================================
// Program is essentially without indicators. (Indicators are
// stil lneeded to control the display file, but all have names.)
//
// 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 screen field naming convention is used:
//     Screen Header:   Fields begin with SH_
//     Detail           Fields begin with SD_
//     Screen footer:   Fields begin with SFT_
//==============================================================
// Compilation
//    Use CRTSQLRPGI command.
//    Note that /INCLUDEs expects to find code in DEMO library,
//    not the default of QRPGLESRC. Change as needed.
//=============================================================

ctl-opt dftactgrp(*no) actgrp(*caller) option(*nodebugio: *srcstmt)
bnddir('UTIL_BND': 'ADRVAL_BND': 'SRV_BASE36') main(Main);

//=== Display File =============================================
dcl-f MTNCUSTD workstn infds(dfInfDS) indds(dfIndDS) usropn;

//=== Service Program Prototypes ===============================
/include ../Copy_Mbrs/SRV_MSG_P.RPGLE
/include ../Copy_Mbrs/SRV_STR_P.RPGLE
/include ../Copy_Mbrs/USADRVAL_P.RPGLE
/include ../Copy_Mbrs/BASE36_P.RPGLE

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

//=== USAdrVal Paramter DS ======================================
/include ../Copy_Mbrs/USADRVALDS.RPGLE
dcl-ds AdrIn  likeds (USAdrValDS);
dcl-ds AdrOut likeds (USAdrValDS);

//=== Fields read by SQL ========================================
// NOTE: Only the fields in the SQL statement are populated!
dcl-ds CUSTMAST extname('CUSTMAST') 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';

//=== 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.

//--- 01-20 are not automatically cleared after EXFMT ----------
dcl-ds dfIndDS len(99);

  //--- 21-99 are automatically cleared after EXFMT --------------
  Protect_SD_ALL ind pos(10);
  dfIndClr char(79) pos(21);
  RI_SD_ACTIVE ind pos(40);
  PC_SD_ACTIVE ind pos(41);
  RI_SD_NAME ind pos(42);
  PC_SD_NAME ind pos(43);
  RI_SD_ADDR ind pos(44);
  PC_SD_ADDR ind pos(45);
  RI_SD_CITY ind pos(46);
  PC_SD_CITY ind pos(47);
  RI_SD_STATE ind pos(48);
  PC_SD_STATE ind pos(49);
  RI_SD_ZIP ind pos(50);
  PC_SD_ZIP ind pos(51);
  RI_SD_ACCTPH ind pos(52);
  PC_SD_ACCTPH ind pos(53);
  RI_SD_ACCTMGR ind pos(54);
  PC_SD_ACCTMGR ind pos(55);
  RI_SD_CORPPH ind pos(56);
  PC_SD_CORPPH ind pos(57);
  DSP_SD_STAMP ind pos(61);
end-ds;

//=== Screen Header Text =======================================
dcl-s H2TextE like(sh_funct) inz('Change Customer');
dcl-s H2TextA like(sh_funct) inz('Add Customer');
dcl-s H2TextD like(sh_funct) inz('Displaying Customer');

//=== Text for function keys ===================================
dcl-c F3TEXT 'F3=Exit';
dcl-c F4TEXT 'F4=Prompt+';
dcl-c F5TEXT 'F5=Refresh';
dcl-c F12TEXT 'F12=Cancel';

//=== External Programs Prototypes =============================
dcl-pr PmtState extpgm('PMTSTATER');
  *n like(state); // TheState
end-pr;
//=== Global Switches ==========================================
dcl-c COWSCOMEHOME  const('0');
dcl-c DISPLAYING    const('D');
dcl-c EDITING       const('E');
dcl-c ADDING        const('A');

dcl-s SflMsgSnt     ind;
dcl-s Function      char(1);
dcl-s NoErrors      ind;

// === Global Fields ===========================================
dcl-s Orig_CHGTIME timestamp;

// === Next available customer number ==========================
dcl-s Cust_Next char(4) dtaara('CUSTNEXT');
dcl-s varCust_Next varchar(4);

//=== Program Status Data Structure ============================
dcl-ds ProgStatus PSDS;
  PgmName *PROC;
  CURR_USER char(10) pos(358); // * Current user
end-ds;

dcl-s MainProc char(10);

//==============================================================
//==============================================================
// === Program Starts Here =====================================
//==============================================================

dcl-proc Main;
  dcl-pi Main;
    pID like(custid);
    pMaintain char(1);
  end-pi;


  //=== Set SQL Options ===============================
  exec sql set option datfmt=*iso,
                    closqlcsr=*endmod,
                    commit = *NONE;

  //=== Initialization Logic ===================================
  exsr Init;

  //--- Establish window that other formats refer to ---
  write SH_HDR;

  //============================================================
  // === Main Program Loop =====================================
  //============================================================
  // Loops until logic decides to exit.
  dou (COWSCOMEHOME);
    select;
        // =======================================================
        // === DISPLAYING an existing Customer ===================
        // =======================================================
      when ( Function = DISPLAYING);
        exsr ReadRecd;
        if (SQLSTT = SQLNODATA);
          SQLProblem('Calling error 1: Code passed in does not exist.');
        endif;
        exsr FillScreenFields;
        // All Fields protected
        exsr ProtectAll;
        exsr ScreenIO;
        exsr CloseDownPgm;
        return;

        // =======================================================
        // === Updating an existing Customer =====================
        // =======================================================
      when (Function = EDITING);
        exsr ReadRecd;
        if (SQLSTT = SQLNODATA);
          SQLProblem('Calling error 2: Code passed in does not exist.');
        endif;
        exsr FillScreenFields;

        // Write/read screen until all data is valid,
        // then re-display for confirmation to update.
        dou (NoErrors);
          exsr ScreenIO;
          select;

            when (Key = F12);
              exsr CloseDownPgm;
              return;

            when (Key = F05);
              exsr ReadRecd;
              if (SQLSTT = SQLNODATA);
                // Record vanished!
                SflMsgSnt= SndSflMsg('DEM0599'); //Delete, redo search
                clear CUSTMAST;
              endif;
              NoErrors = *off;

            when (Key = F04);
              exsr F04Prompt;

            when (Key = Enter);
              exsr EditUpdData;
              if (NoErrors);
                // Re-display screen fields for confirmation
                exsr ProtectAll;
                exsr FillScreenFields;
                SflMsgSnt = SndSflMsg('DEM0000'); // Enter to update ...
                exsr ScreenIO;
                select;
                  when (Key = F12 or Key = F05);
                    // Loop again
                  when (Key = Enter);
                    exsr UpdateRecd;
                    if (NoErrors);
                      exsr CloseDownPgm; // Success! Exit program
                      return;
                    endif;
                  other;
                    SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
                    NoErrors = *off;
                endsl;
              endif;
              // Open up fields for correction of errors
              exsr UnProtectAll;

            other;
              SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
              NoErrors = *off;                  // Stay in dou NoErrors
          endsl;
        enddo;

        // =======================================================
        // === Adding a new Customer =============================
        // =======================================================
      when ( Function=ADDING);
        clear  CUSTMAST;
        //Default status to active
        ACTIVE = 'Y';
        exsr FillScreenFields;

        dou (NoErrors);
          // Write/read screen until all data is valid,
          // then re-display for confirmation to update.
          //All fields can be keyed
          exsr UnProtectAll;
          exsr ScreenIO;
          select;
            when (Key = F12);
              exsr CloseDownPgm;
              return;

            when (Key = F04);
              exsr F04Prompt;

            when (Key = F05);
              clear CUSTMAST;
              ACTIVE = 'Y';
              exsr FillScreenFields;

            when (Key = Enter);
              exsr EditAddData;
              if (NoErrors);
                // Re-display field for confirmation
                exsr ProtectAll;
                SflMsgSnt = SndSflMsg('DEM0009'); // Enter to add ...
                exsr FillScreenFields;
                exsr ScreenIO;
                select;
                  when (Key=F12);
                    exsr FillScreenFields;
                  when (Key = Enter);
                    exsr AddRecd;
                    if (NoErrors);
                      exsr CloseDownPgm;
                      return;
                    endif;
                  other;
                    SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
                    NoErrors = *off;
                endsl;
              endif;
            other;
              SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
          endsl;
        enddo;

      other;
        // =======================================================
        //=== Goofed - Should ever happen ========================
        // =======================================================
        dump(a);
        SflMsgSnt = SndSflMsg('DEM9999'); // Contact IT now ...
        return;
    endsl;

  enddo;
  exsr CloseDownPgm;     // Should never happen
  return;

  //============================================================
  //=== End of Main Program Loop ===============================
  //============================================================
  return;

  //=== ReadRecd ===============================================
  begsr ReadRecd;
    exec sql
    select
       CUSTID
      ,NAME
      ,ADDR
      ,CITY
      ,STATE
      ,ZIP
      ,CORPPHONE
      ,ACCTMGR
      ,ACCTPHONE
      ,ACTIVE
      ,CHGTIME
      ,CHGUSER
    into    :CUSTMAST
    from    CUSTMAST
    where   CUSTID = :pID
        ;
    if (SQLSTT <> SQLSUCCESS and SQLSTT <> SQLNODATA);
      SQLProblem('ReadRecd');
    endif;
    Orig_CHGTIME = CHGTIME;   // Save for update comparison
  endsr;

  //=== FillScreenFields =======================================
  begsr FillScreenFields;
    SD_CUSTID = CUSTID;
    SD_NAME = NAME;
    SD_ADDR = ADDR;
    SD_CITY = CITY;
    SD_STATE = STATE;
    SD_ZIP = ZIP;
    SD_ACTIVE = ACTIVE;
    SD_ACCTPH = ACCTPHONE;
    SD_ACCTMGR =ACCTMGR;
    SD_CORPPH = CORPPHONE;
    SD_CHGTIME = ' ';
    SD_CHGUSER = ' ';
    // Show Changed stamp info
    if (CHGUSER <> '*SYSTEM*' and CHGUSER <> ' ');
      exec sql VALUES
            varchar_format(:CHGTIME, 'YYYY-Mon-DD')
            concat ' at ' concat
            varchar_format(:CHGTIME,'HH24:MI:SS')
            into :SD_CHGTIME;
      SD_CHGUSER = CHGUSER;
      DSP_SD_STAMP = *on;
    endif;
  endsr;

  //=== F04Prompt ==============================================
  // CF04 reads the screen data. We then prompt and replace
  // anything in the state field, then we redisplay and
  // re-edit the screen data.
  // Always sets NoError to *off to force re-edit
  begsr F04Prompt;
    select;
        //  --- Prompt for State Code
      when (SD_PMT_FLD = 'SD_STATE');
        PmtState(STATE);
        SD_STATE = STATE;
        PC_SD_STATE = *ON;
        // --- Field not promptable
      other;
        //   Use F4 only in field followed by + sign
        SflMsgSnt= SndSflMsg('DEM0005');
    endsl;
    NoErrors = *off;        // DOU Loop again
  endsr;

  //=== EditUpdData ============================================
  // Edit the screen fields that can be changed on a update.
  // Give up when the first error found.
  // A valid screen field is moved to the database record.
  begsr EditUpdData;
    NoErrors = *on;

    // ACTIVE Status
    exsr Edit_SD_ACTIVE;
    if (NoErrors = *off);
      leavesr;
    endif;
    // Name
    exsr Edit_SD_NAME;
    if (NoErrors = *off);
      leavesr;
    endif;
    // // Addr
    // exsr Edit_SD_ADDR;
    // if (NoErrors = *off);
    //   leavesr;
    // endif;
    // // City
    // exsr Edit_SD_CITY;
    // if (NoErrors = *off);
    //   leavesr;
    // endif;
    // // State
    // exsr Edit_SD_STATE;
    // if (NoErrors = *off);
    //   leavesr;
    // endif;
    // // ZIP
    // exsr Edit_SD_ZIP;
    // if (NoErrors = *off);
    //   leavesr;
    // endif;

    // Account Phone
    exsr Edit_SD_ACCTPH;
    if (NoErrors = *off);
      leavesr;
    endif;
    // Account Manager
    exsr Edit_SD_ACCTMGR;
    if (NoErrors = *off);
      leavesr;
    endif;
    // Corporate Phone
    exsr Edit_SD_CORPPH;
    if (NoErrors = *off);
      leavesr;
    endif;
    // Address
    exsr Edit_Address;
    if (NoErrors = *off);
      leavesr;
    endif;
  endsr;

  //=== EditAddData ============================================
  // Edit the screen fields needed to add a record.
  // Give up when the first error found.
  // A valid screen field is moved to the database record.
  begsr EditAddData;
    // For this program. same data for edit and add.
    exsr EditUpdData;
  endsr;

  //=== Edit Address ===========================================
  begsr Edit_Address;
    clear AdrIn;
    AdrIn.Address2 = SD_ADDR;
    AdrIn.City = SD_CITY;
    AdrIn.State = SD_STATE;
    AdrIn.Zip5 = %subst(SD_ZIP :1 :5);

    AdrOut = USAdrVal(AdrIn);
    // Good address-copy from USPS data & return
    if (AdrOut.City <> ' ');
      ADDR = AdrOut.Address2;
      CITY = AdrOut.City;
      STATE = AdrOut.State;
      if (AdrOut.Zip4 <> ' ');
        ZIP = AdrOut.Zip5 + '-' + AdrOut.Zip4;
      else;
        ZIP = AdrOut.Zip5;
      endif;
      leavesr;
    endif;
    // Bad address-send USPS error message
    SflMsgSnt = SndSflMsg('DEM9898' : AdrOut.Description);
    NoErrors = *off;
    PC_SD_ADDR = *ON;
    RI_SD_ADDR = *ON;
    RI_SD_CITY = *ON;
    RI_SD_STATE= *ON;
    RI_SD_ZIP= *ON;
  endsr;

  //=== Edit_SD_ACTIVE==========================================
  begsr Edit_SD_ACTIVE;
    if (SD_ACTIVE = 'Y' or SD_ACTIVE = 'N');
      ACTIVE = SD_ACTIVE;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0501': 'Active Status');
    NoErrors = *off;
    RI_SD_ACTIVE = *on;
    PC_SD_ACTIVE = *on;
  endsr;

  //=== Edit_SD_NAME ===========================================
  begsr Edit_SD_NAME;
    if (SD_NAME <> ' ');
      NAME = SD_NAME;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Name');
    NoErrors= *off;
    RI_SD_NAME = *ON;
    PC_SD_NAME = *ON;
  endsr;

  //=== Edit_SD_ADDR ===========================================
  begsr Edit_SD_ADDR;
    if (SD_ADDR <> ' ');
      ADDR = SD_ADDR;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Address');
    NoErrors= *off;
    RI_SD_ADDR = *ON;
    PC_SD_ADDR = *ON;
  endsr;

  //=== Edit_SD_CITY ===========================================
  begsr Edit_SD_CITY;
    if (SD_CITY <> ' ');
      CITY = SD_CITY;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'City');
    NoErrors= *off;
    RI_SD_CITY = *ON;
    PC_SD_CITY = *ON;
  endsr;

  //=== Edit_SD_STATE ==========================================
  begsr Edit_SD_STATE;
    exec sql select STATE into :STATE
    from STATES
    where STATE = :SD_STATE;
    if (SQLSTT = SQLSUCCESS);
      STATE = SD_STATE;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0503');
    NoErrors= *off;
    RI_SD_STATE= *ON;
    PC_SD_STATE = *ON;
  endsr;

  //=== Edit_SD_ZIP ============================================
  begsr Edit_SD_ZIP;
    if (SD_ZIP <> ' ');
      ZIP = SD_ZIP;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'ZIP');
    NoErrors= *off;
    RI_SD_ZIP= *ON;
    PC_SD_ZIP = *ON;
  endsr;

  //=== Edit_SD_ACCTPH =========================================
  begsr Edit_SD_ACCTPH;
    if (SD_ACCTPH <> ' ');
      ACCTPHONE = SD_ACCTPH;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Account Manager Phone');
    NoErrors= *off;
    RI_SD_ACCTPH= *ON;
    PC_SD_ACCTPH = *ON;
  endsr;

  //=== Edit_SD_ACCTMGR =========================================
  begsr Edit_SD_ACCTMGR;
    if (SD_ACCTMGR <> ' ');
      ACCTMGR = SD_ACCTMGR;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Account Manager Name');
    NoErrors= *off;
    RI_SD_ACCTMGR= *ON;
    PC_SD_ACCTMGR = *ON;
  endsr;

  //=== Edit_SD_CORPPH =========================================
  begsr Edit_SD_CORPPH;
    if (SD_CORPPH <> ' ');
      CORPPHONE = SD_CORPPH;
      leavesr;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Corporate Phone');
    NoErrors= *off;
    RI_SD_CORPPH= *ON;
    PC_SD_CORPPH = *ON;
  endsr;

  //=== AddRecd ================================================
  // Insert a record into the file.
  // Returns:  NoErrors = *on if the add was successful.
  begsr AddRecd;
    NoErrors = *on;
    in *LOCK Cust_Next;
    varCust_Next = Cust_Next;
    varCust_Next = BASE36ADD(varCust_Next);
    Cust_Next = varCust_Next;
    Out Cust_Next;
    CUSTID= Cust_Next;
    CHGTIME = %timestamp();
    CHGUSER = CURR_USER;
    exec sql
    insert into CUSTMAST
    values(:CUSTMAST)
    ;
    // There is no good reason why insert should fail.
    if (SQLSTT <> SQLSUCCESS);
      SQLProblem('Insert into CUSTMAST ...');
    endif;
  endsr;

  //=== UpdateRecd =============================================
  // Updates the record with the screen data.
  // The SQL WHERE checks the last time stamp and if different,
  // doesn't update because someone else updated the record.
  // (This isn't the only way to avoid pessimistic locking.)
  // SQLERRD(3) contains the actual number of records updated
  // when the update is successful.
  begsr UpdateRecd;
    NoErrors = *on;
    exec sql
    update CUSTMAST
    SET NAME = :SD_NAME,
      ADDR = :SD_ADDR,
      CITY = :SD_CITY,
      STATE = :SD_STATE,
      ZIP = :SD_ZIP,
      CORPPHONE = :SD_CORPPH,
      ACCTMGR = :SD_ACCTMGR,
      ACCTPHONE = :SD_ACCTPH,
      ACTIVE = :SD_ACTIVE,
      CHGTIME = CURRENT TIMESTAMP,
      CHGUSER = :CURR_USER
    where CUSTID = :CUSTID
    -- and compare timestamp
        and CHGTIME = :Orig_CHGTIME;
    select;
      when (SQLSTT = SQLNODATA);            // Update Failed
        SflMsgSnt = SndSflMsg('DEM1002'); // Record changed, review.
        NoErrors = *off;
        // Show the changed data
        exsr ReadRecd;
        exsr FillScreenFields;

      when (SQLSTT =SQLROWLOCKED);          // Row locked
        SflMsgSnt = SndSflMsg('DEM1001' : SQLERRMC);
        NoErrors = *off;
      when (SQLSTT = SQLSUCCESS);

      other;
        SQLProblem('Update CUSTMAST');
    endsl;
  endsr;

  //=== ClearScreenData ========================================
  begsr ClearScreenData;
    clear DETAILS;
  endsr;

  //=== ProtectAll =============================================
  begsr ProtectAll;
    Protect_SD_ALL = *on;
  endsr;

  //=== UnProtectAll ===========================================
  begsr UnProtectAll;
    Protect_SD_ALL = *off;
  endsr;

  //=== ScreenIO ===============================================
  // Writes and Reads the screen
  begsr ScreenIO;

    write SH_HDR;
    write SFT_FKEY;

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

    exfmt DETAILS;

    // Clear most display file indicators
    clear dfIndClr;

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

  endsr;

  //=== BldFKeyText ============================================
  // Build the Function key text for the bottom of the screen.
  begsr BldFkeyText;
    SFT_KEYS=' ';
    SFT_KEYS = catB(SFT_KEYS : F4TEXT);
    SFT_KEYS = catB(SFT_KEYS : F5TEXT);
    SFT_KEYS = catB(SFT_KEYS : F12TEXT);
  endsr;

  //=== CloseDownPgm ===========================================
  // Things to do before we issue a return to the caller
  begsr CloseDownPgm;
    //  Closing the display file may cause any subfile display in
    //  the caller to blank out.
  endsr;

  //=== Init ===================================================
  // Every time initialization logic
  begsr Init;

    //--- Analyse parameters ---
    if (%parms() = 0);     // Close down
      if (%open(MTNCUSTD));
        close MTNCUSTD;
      endif;
      *inlr = *on;
      return;
    endif;

    select;
      when ( %parms() = 1);
        Function = DISPLAYING;
      when ( %parms() >= 2);
        select;
          when ( pMaintain = ADDING);
            Function = ADDING;
            SH_FUNCT = CenterStr(H2TextA);
          when (pMaintain = EDITING);
            Function = EDITING;
            SH_FUNCT = CenterStr(H2TextE);
          other;
            Function = DISPLAYING;
            SH_FUNCT = CenterStr(H2TextD);
        endsl;
      other;
        // Should never happen
    endsl;

    //--- Miscellaneous setup ---
    MainProc = %proc();
    MSGPGMQ = MainProc;
    SH_PGM = PgmName;
    clear CUSTMAST;
    clear dfIndDS;
    exsr BldFkeyText;

    //--- Open display file ---
    if (not %open(MTNCUSTD));
      open MTNCUSTD;
    endif;
  endsr;
end-proc;

//============================================================
//   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;
//=== SQLProblem ===============================================
// For those "Never should happen" SQL errors.
// Issues DUMP(A) to dump memory, then ends program by
// sending an *ESCAPE message of the supplied debugging text.
dcl-proc SQLProblem;
  dcl-pi SQLProblem;
    piSQLDebug varchar(1024) value;
  end-pi;

  //--- Local Variables ------------------------------------------
  dcl-s wkSQLDebug varchar(1024);

  wkSQLDebug = 'SQLSTT ' + SQLSTT
            + ' << Unexpected SQL Return Code: '
            + piSQLDebug;
  dump(a);
  SndEscMsg(wkSQLDebug);
  return;
end-proc;

//--------------------------------------------------------------
// Procedure name: SndSflMsg
// Purpose:        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(512) 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(MainProc:
      wkMsgId:
      wkMsgFile:
      wkMsgData);

  retField = *on;
  RETURN retField;

end-proc;
