Sign in

docs Examples

MTNCUSTR

MTNCUSTR

**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.
//=============================================================
// 12/2023 Convert to totally **FREE
// 02/2024 Change CUSTID to character for alpha-numeric keys
//=============================================================
ctl-opt dftactgrp(*no) actgrp(*caller) option(*nodebugio: *srcstmt)
  bnddir('UTIL_BND':'SRV_BASE36') ;

// === Program parameters ====================================
dcl-pi *n;
    pID like(custid);
    pMaintain char(1);
end-pi;

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

//=== Named hexadecimal constants for function keys ============
/INCLUDE ../Copy_Mbrs/AIDBYTES.RPGLE
//=== Fields read by SQL ========================================
// NOTE: Only the fields in the SQL statement are populated!
dcl-ds CUSTMAST_ds 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');
//=== External Programs Prototypes =============================
dcl-pr PmtState extpgm('PMTSTATER');
    *n like(state); // TheState
end-pr;
//=== Global Switches ==========================================
dcl-s SflMsgSnt ind;
dcl-c COWSCOMEHOME const('0');
dcl-s Function char(1);
dcl-c DISPLAYING const('D');
dcl-c EDITING const('E');
dcl-c ADDING const('A');
dcl-s NoErrors ind;
// === Global Fields ===========================================
dcl-s Orig_CHGTIME timestamp;
//=== Work Fields ==============================================
dcl-s wkInt int(10);
dcl-s wkMsgText varchar(256);
// === Next available customer number ==========================
// CUSTNEXT        ds                  dtaara(CUSTNEXT)
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 =====================================
//==============================================================

//=== Set SQL Options ===============================
exec sql set option datfmt=*iso,
                   closqlcsr=*endmod,
                   commit = *NONE;
//=== 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;
//=== Misc Initialization ====================================
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;
            ReadRecd();
            if SQLSTT = SQLNODATA;
                SQLProblem('Calling error 1: Function parm passed does not exist.');
            endif;
            FillScreenFields();
            // All Fields protected
            ProtectAll();
            ScreenIO();
            CloseDownPgm();
            return;
   // =======================================================
   // === Updating an existing Customer =====================
   // =======================================================
        when Function = EDITING;
            ReadRecd();
            if SQLSTT = SQLNODATA;
                SQLProblem('Calling error 2: Function parm passed does not exist.');
            endif;
            FillScreenFields();
            // Write/read screen until all data is valid,
            // then re-display for confirmation to update.
            dou NoErrors;
                ScreenIO();
                select;
                    when Key = F12;
                        CloseDownPgm();
                        return;
                    when Key = F05;
                        ReadRecd();
                        if SQLSTT = SQLNODATA;
                        // Record vanished!
                            SflMsgSnt= SndSflMsg('DEM0599'); //Delete, redo search
                            clear CUSTMAST_ds;
                        endif;
                        NoErrors = *off;
                    when Key = F04;
                        F04Prompt();
                    when Key = Enter;
                        EditUpdData();
                        if NoErrors;
                            // Re-display screen fields for confirmation
                            ProtectAll();
                            FillScreenFields();
                            SflMsgSnt = SndSflMsg('DEM0000'); // Enter to update ...
                            ScreenIO();
                            select;
                                when Key = F12 or Key = F05;
                                // Loop again
                                when Key = Enter;
                                    UpdateRecd();
                                    if NoErrors;
                                        CloseDownPgm(); // Success! Exit program
                                        return;
                                    endif;
                                other;
                                    SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
                                    NoErrors = *off;
                            endsl;
                        endif;  // If NoErrors
                        // Open up fields for correction of errors
                        UnProtectAll();
                    other;
                        SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
                        NoErrors = *off;                  // Stay in dou NoErrors
                endsl;
            enddo; // DOU NoErrors
   // =======================================================
   // === Adding a new Customer =============================
   // =======================================================
        when  Function=ADDING;
            clear  CUSTMAST_ds;
     //Default status to active
            ACTIVE = 'Y';
            FillScreenFields();
            dou NoErrors;
           // Write/read screen until all data is valid,
           // then re-display for confirmation to update.
           // All fields can be keyed
                UnProtectAll();
                ScreenIO();
                select;
                    when Key = F12;
                        CloseDownPgm();
                        return;
                    when Key = F04;
                        F04Prompt();
                    when Key = F05;
                        clear CUSTMAST_ds;
                        ACTIVE = 'Y';
                        FillScreenFields();
                    when Key = Enter;
                        EditAddData();
                        if NoErrors;
                            // Re-display field for confirmation
                            ProtectAll();
                            SflMsgSnt = SndSflMsg('DEM0009'); // Enter to add ...
                            FillScreenFields();
                            ScreenIO();
                            select;
                                when Key=F12;
                                    FillScreenFields();
                                when Key = Enter;
                                    AddRecd();
                                    if NoErrors;
                                        CloseDownPgm();
                                        return;
                                    endif;
                                other;
                                    SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
                                    NoErrors = *off;
                            endsl;
                        endif; // if NoErrors
                    other;
                        SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
                endsl;
            enddo; // DOU NoErrors
        other;
   // =======================================================
   //=== Goofed - Should ever happen ========================
   // =======================================================
            dump(a);
            SflMsgSnt = SndSflMsg('DEM9999'); // Contact IT now ...
            return;
    endsl;
enddo;  // DOU CoswComeHome
CloseDownPgm();     // Should never happen
return;
//============================================================
//=== End of Main Program Loop ===============================
//============================================================
return;

//=== ReadRecd ===============================================
Dcl-Proc ReadRecd;
    exec sql
select
     CUSTID
    ,NAME
    ,ADDR
    ,CITY
    ,STATE
    ,ZIP
    ,CORPPHONE
    ,ACCTMGR
    ,ACCTPHONE
    ,ACTIVE
    ,CHGTIME
    ,CHGUSER
into       :CUSTMAST_ds
from      CUSTMAST
where      CUSTID = :pID
       ;
    if SQLSTT <> SQLSUCCESS and SQLSTT <> SQLNODATA;
        SQLProblem('ReadRecd');
    endif;
    Orig_CHGTIME = CHGTIME;   // Save for update comparison
End-Proc;
//=== FillScreenFields =======================================
Dcl-Proc 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;
End-Proc;
//=== 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
Dcl-Proc 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
End-Proc;
//=== 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.
Dcl-Proc EditUpdData;
    NoErrors = *on;
// ACTIVE Status
    Edit_SD_ACTIVE();
    if NoErrors = *off;
        return;
    endif;
// Name
    Edit_SD_NAME();
    if NoErrors = *off;
        return;
    endif;
// Addr
    Edit_SD_ADDR();
    if NoErrors = *off;
        return;
    endif;
// City
    Edit_SD_CITY();
    if NoErrors = *off;
        return;
    endif;
// State
    Edit_SD_STATE();
    if NoErrors = *off;
        return;
    endif;
// ZIP
    Edit_SD_ZIP();
    if NoErrors = *off;
        return;
    endif;
// Account Phone
    Edit_SD_ACCTPH();
    if NoErrors = *off;
        return;
    endif;
// Account Manager
    Edit_SD_ACCTMGR();
    if NoErrors = *off;
        return;
    endif;
// Corporate Phone
    Edit_SD_CORPPH();
    if NoErrors = *off;
        return;
    endif;
End-Proc;
//=== 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.
Dcl-Proc EditAddData;
   // For this program. same data for edit and add.
    EditUpdData();
End-Proc;
//=== Edit_SD_ACTIVE==========================================
Dcl-Proc Edit_SD_ACTIVE;
    if SD_ACTIVE = 'Y' or SD_ACTIVE = 'N';
        ACTIVE = SD_ACTIVE;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0501': 'Active Status');
    NoErrors = *off;
    RI_SD_ACTIVE = *on;
    PC_SD_ACTIVE = *on;
End-Proc;
//=== Edit_SD_NAME ===========================================
Dcl-Proc Edit_SD_NAME;
    if SD_NAME <> ' ';
        NAME = SD_NAME;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Name');
    NoErrors= *off;
    RI_SD_NAME = *ON;
    PC_SD_NAME = *ON;
End-Proc;
//=== Edit_SD_ADDR ===========================================
Dcl-Proc Edit_SD_ADDR;
    if SD_ADDR <> ' ';
        ADDR = SD_ADDR;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Address');
    NoErrors= *off;
    RI_SD_ADDR = *ON;
    PC_SD_ADDR = *ON;
End-Proc;
//=== Edit_SD_CITY ===========================================
Dcl-Proc Edit_SD_CITY;
    if SD_CITY <> ' ';
        CITY = SD_CITY;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'City');
    NoErrors= *off;
    RI_SD_CITY = *ON;
    PC_SD_CITY = *ON;
End-Proc;
//=== Edit_SD_STATE ==========================================
Dcl-Proc Edit_SD_STATE;
    exec sql select STATE into :STATE
   from STATES
   where STATE = :SD_STATE;
    if SQLSTT = SQLSUCCESS;
        STATE = SD_STATE;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0503');
    NoErrors= *off;
    RI_SD_STATE= *ON;
    PC_SD_STATE = *ON;
End-Proc;
//=== Edit_SD_ZIP ============================================
Dcl-Proc Edit_SD_ZIP;
    if SD_ZIP <> ' ';
        ZIP = SD_ZIP;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'ZIP');
    NoErrors= *off;
    RI_SD_ZIP= *ON;
    PC_SD_ZIP = *ON;
End-Proc;
//=== Edit_SD_ACCTPH =========================================
Dcl-Proc Edit_SD_ACCTPH;
    if SD_ACCTPH <> ' ';
        ACCTPHONE = SD_ACCTPH;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Account Manager Phone');
    NoErrors= *off;
    RI_SD_ACCTPH= *ON;
    PC_SD_ACCTPH = *ON;
End-Proc;
//=== Edit_SD_ACCTMGR =========================================
Dcl-Proc Edit_SD_ACCTMGR;
    if SD_ACCTMGR <> ' ';
        ACCTMGR = SD_ACCTMGR;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Account Manager Name');
    NoErrors= *off;
    RI_SD_ACCTMGR= *ON;
    PC_SD_ACCTMGR = *ON;
End-Proc;
//=== Edit_SD_CORPPH =========================================
Dcl-Proc Edit_SD_CORPPH;
    if SD_CORPPH <> ' ';
        CORPPHONE = SD_CORPPH;
        return;
    endif;
    SflMsgSnt = SndSflMsg('DEM0502': 'Corporate Phone');
    NoErrors= *off;
    RI_SD_CORPPH= *ON;
    PC_SD_CORPPH = *ON;
End-Proc;
//=== AddRecd ================================================
// Insert a record into the file.
// Returns:  NoErrors = *on if the add was successful.
Dcl-Proc 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_ds)
   ;
 // There is no good reason why insert should fail.
    if SQLSTT <> SQLSUCCESS;
        SQLProblem('Insert into CUSTMAST ...');
    endif;
End-Proc;
//=== 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.
Dcl-Proc 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;
            SflMsgSnt = SndSflMsg('DEM1002'); // Record changed, review.
            NoErrors = *off;
       // Show the changed data
            ReadRecd();
            FillScreenFields();
        when SQLSTT =SQLROWLOCKED;          // Row locked
            SflMsgSnt = SndSflMsg('DEM1001' : SQLERRMC);
            NoErrors = *off;
        when SQLSTT = SQLSUCCESS;
        other;
            SQLProblem('Update CUSTMAST');
    endsl;
End-Proc;
//=== ClearScreenData ========================================
Dcl-Proc ClearScreenData;
    clear DETAILS;
End-Proc;
//=== ProtectAll =============================================
Dcl-Proc ProtectAll;
    Protect_SD_ALL = *on;
End-Proc;
//=== UnProtectAll ===========================================
Dcl-Proc UnProtectAll;
    Protect_SD_ALL = *off;
End-Proc;
//=== 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;
    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;
End-Proc;
//=== 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=Refresh';
    dcl-c F12TEXT 'F12=Cancel';
    SFT_KEYS=' ';
    SFT_KEYS = catB(SFT_KEYS : F4TEXT);
    SFT_KEYS = catB(SFT_KEYS : F5TEXT);
    SFT_KEYS = catB(SFT_KEYS : F12TEXT);
End-Proc;
//=== CloseDownPgm ===========================================
// Things to do before we issue a return to the caller
Dcl-Proc CloseDownPgm;
//  Closing the display file may cause any subfile display in
//  the caller to blank out.
End-Proc;
//=== Init ===================================================
// Every time initialization logic
Dcl-Proc Init;

//--- Miscellaneous setup ---
    // MainProc = %proc();
    MainProc = PgmName;
    MSGPGMQ = MainProc;
    SH_PGM = PgmName;
    clear CUSTMAST_ds;
    clear dfIndDS;
    BldFkeyText();
//--- Open display file ---
    if not %open(MTNCUSTD);
        open MTNCUSTD;
    endif;
end-proc;
// 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(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(MainProc:
     wkMsgId:
     wkMsgFile:
     wkMsgData);
    retField = *on;
    RETURN retField;
end-proc;