SET208S

LANSA

SET208S
* =======================================================
* Process ........: SET_208
* Function .......: SET208S
* Description ....: Handle salary adjustments
*
* This function is called by SET208H to handle the
* processing of an employee salary updates that has been
* received in MS-Excel document SET208S.XLS
*
* Disclaimer: The following material is supplied as
* sample material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* =======================================================
Function Options(*DIRECT *HEAVYUSAGE)
*
* Other locally defined fields
*
Define Field(#ROW) Reffld(#STD_NUM) Desc('Speadsheet Cell Row to be retrieved')
Define Field(#COLN) Reffld(#STD_NUM) Desc('Speadsheet Cell Column to be retrieved')
Define Field(#COLNP1) Reffld(#STD_NUM) Desc('Speadsheet Cell Column + 1')
Define Field(#DISCARDA) Reffld(#STD_TEXT) Desc('Alpha value that can be be discarded')
Define Field(#DISCARDN) Reffld(#STD_NUM) Desc('Numeric value that can be be discarded')
Define Field(#SEPERATOR) Type(*CHAR) Length(070) Desc('Message separator')
Use Builtin(FILLSTRING) With_Args('=') To_Get(#SEPERATOR)
*
* Clear any messages hanging around
*
Use Builtin(CLR_MESSAGES)
*
*
* Process the spread sheet values up to 19 rows down
* the sheet and up to 10 number-salary pairs across
* the sheet. Start at row 2 as row 1 is used for
* heading details
*
Begin_Loop Using(#ROW) From(2) To(20)
Begin_Loop Using(#COLN) To(19) Step(0000002)
Change Field(#COLNP1) To('#COLN + 1')
*
* Set the employee number (#EMPNO) and the
* salary value (#SALARY) to null / zero values
*
Change Field(#EMPNO #SALARY) To(*NULL)
*
* Now extract column "n" of the current row as
* an alphanumeric value into field #EMPNO
*
Execute Subroutine(GET_CELL) With_Parms(#ROW #COLN #EMPNO #DISCARDN)
*
* Then extract column "n+1" of the current row as
* a numeric value into field #SALARY
*
Execute Subroutine(GET_CELL) With_Parms(#ROW #COLNP1 #DISCARDA #SALARY)
*
* If nothing was extracted then there is nothing to do
*
If_Null Field(#EMPNO #SALARY)
*
Else
*
* Issue a message to separate this from the others
*
Execute Subroutine(MESSAGE) With_Parms(#SEPERATOR *BLANKS *BLANKS)
*
* Uppercase the employee number
*
Use Builtin(UPPERCASE) With_Args(#EMPNO) To_Get(#EMPNO)
*
* and then attempt to update the salary
*
Update Fields(#SALARY) In_File(PSLMST) With_Key(#EMPNO) Io_Error(*NEXT) Val_Error(*NEXT) Issue_Msg(*YES)
*
* Handle success or failure with different messages.
* Note that a failure will probably result in repository
* messages being issued as well (eg: salary >= 0)
*
If_Status Is(*OKAY)
Execute Subroutine(MESSAGE) With_Parms('Salary of' #EMPNO 'successfully updated.')
Else
Execute Subroutine(MESSAGE) With_Parms('*** Attempt to update salary of' #EMPNO 'failed. See previous messages ***')
Endif
Endif
*
End_Loop
End_Loop
*
* Finished
*
Return
* =====================================================
* Get_Alpha : Locate an alphanumeric value
* =====================================================
Subroutine Name(GET_CELL) Parms((#CELL_ROW *RECEIVED) (#CELL_COL *RECEIVED) #S_208AVAL #S_208NVAL)
Define Field(#CELL_IDN) Type(*CHAR) Length(012) Default(CELL_0000000)
Define Field(#CELL_ROW) Length(007) Decimals(0) Reffld(#DATE) Edit_Code(4) Default(0) To_Overlay(#CELL_IDN 006)
Define Field(#CELL_COL) Reffld(#STD_NUM)
Change Field(#S_208OPER) To(LOCATE)
Change Field(#S_208NAME) To(#CELL_IDN)
Change Field(#S_208INST) To(#CELL_COL)
Exchange Fields(#S_208OPER #S_208NAME #S_208INST)
Call Process(*DIRECT) Function(SET208L)
Endroutine
* =====================================================
* MESSAGE : Dynamically build a text message
* =====================================================
Subroutine Name(MESSAGE) Parms((#TEXT01 *RECEIVED) (#TEXT02 *RECEIVED) (#TEXT03 *RECEIVED))
Define Field(#TEXT01) Reffld(#S_208MSG)
Define Field(#TEXT02) Reffld(#TEXT01)
Define Field(#TEXT03) Reffld(#TEXT01)
Use Builtin(BCONCAT) With_Args(#TEXT01 #TEXT02 #TEXT03) To_Get(#S_208MSG)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#S_208MSG)
Endroutine