FRM035 – Appendix
Your finished code for form iiiMntDept should appear something like the following:
FUNCTION OPTIONS(*DIRECT)
BEGIN_COM ROLE(*EXTENDS #PRIM_FORM) CLIENTHEIGHT(174) CLIENTWIDTH(500) HEIGHT(212) LEFT(416) TOP(250) WIDTH(516)
DEFINE_COM CLASS(#DEPTMENT.Visual) NAME(#DEPTMENT) DISPLAYPOSITION(1) HEIGHT(19) LEFT(16) PARENT(#COM_OWNER) TABPOSITION(1) TOP(8) USEPICKLIST(False) WIDTH(201)
DEFINE_COM CLASS(#DEPTDESC.Visual) NAME(#DEPTDESC) DISPLAYPOSITION(2) HEIGHT(19) LEFT(16) PARENT(#COM_OWNER) TABPOSITION(2) TOP(32) WIDTH(324)
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(3) HEIGHT(24) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(150) WIDTH(500)
DEFINE_COM CLASS(#STD_NUM.Visual) NAME(#STD_NUM) CAPTION('Insert') DISPLAYPOSITION(4) LEFT(16) PARENT(#COM_OWNER) TABPOSITION(4) TOP(64)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#UPDATE) CAPTION('Update') DISPLAYPOSITION(5) LEFT(389) PARENT(#COM_OWNER) TABPOSITION(5) TOP(78)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#DELETE) CAPTION('Delete') DISPLAYPOSITION(6) LEFT(389) PARENT(#COM_OWNER) TABPOSITION(6) TOP(112)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CLEAR) CAPTION('Clear') DISPLAYPOSITION(7) LEFT(168) PARENT(#COM_OWNER) TABPOSITION(7) TOP(96)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#insert) CAPTION('Insert') DISPLAYPOSITION(8) HEIGHT(26) LEFT(389) PARENT(#COM_OWNER) TABPOSITION(8) TOP(40)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#Fetch) CAPTION('Fetch') DISPLAYPOSITION(9) HEIGHT(26) LEFT(389) PARENT(#COM_OWNER) TABPOSITION(9) TOP(8)
GROUP_BY NAME(#FORMDATA) FIELDS(#DEPTMENT #DEPTDESC #STD_NUM)
DEFINE FIELD(#ANSWER) TYPE(*CHAR) LENGTH(6)
EVTROUTINE HANDLING(#COM_OWNER.Initialize)
SET COM(#COM_OWNER) CAPTION(*COMPONENT_DESC)
EXECUTE SUBROUTINE(INITFORM)
ENDROUTINE
EVTROUTINE HANDLING(#FETCH.Click)
FETCH FIELDS(#DEPTMENT #DEPTDESC) FROM_FILE(DEPTAB) WITH_KEY(#DEPTMENT)
IF_STATUS IS_NOT(*OKAY)
MESSAGE MSGTXT('Error retrieving Department')
ELSE
#DEPTMENT.Enabled #FETCH.Enabled #INSERT.Enabled := False
#UPDATE.Enabled #DELETE.Enabled := True
ENDIF
ENDROUTINE
EVTROUTINE HANDLING(#INSERT.Click)
BEGINCHECK
FILECHECK FIELD(#DEPTMENT) USING_FILE(DEPTAB) USING_KEY(#DEPTMENT) FOUND(*ERROR) NOT_FOUND(*NEXT) MSGTXT('Department Code already exists.')
VALUECHECK FIELD(#DEPTDESC) WITH_LIST(NONE END LAST) IN_LIST(*ERROR) NOT_INLIST(*NEXT) MSGTXT('This description is reserved.')
RANGECHECK FIELD(#STD_NUM) RANGE((1 10)) MSGTXT('Must be in range 1 to 10.')
CONDCHECK FIELD(#DEPTMENT) COND(#DEPTMENT.Contains( ' ' )) IF_TRUE(*ERROR) IF_FALSE(*NEXT) MSGTXT('Code cannot contain embedded blanks.')
IF COND(#DEPTMENT *EQ #DEPTDESC)
SET_ERROR FOR_FIELD(#DEPTMENT #DEPTDESC) MSGTXT('Department Code cannot be the same as Department Description.')
ENDIF
ENDCHECK
INSERT FIELDS(#FORMDATA) TO_FILE(DEPTAB)
IF_STATUS IS(*OKAY)
MESSAGE MSGTXT('Department inserted successfully')
#FORMDATA := *DEFAULT
ELSE
IF_STATUS IS(*ERROR)
MESSAGE MSGTXT('Error inserting Department')
ENDIF
ENDIF
ENDROUTINE
EVTROUTINE HANDLING(#UPDATE.Click)
UPDATE FIELDS(#FORMDATA) IN_FILE(DEPTAB)
IF_STATUS IS(*OKAY)
MESSAGE MSGTXT('Department updated successfully')
EXECUTE SUBROUTINE(INITFORM)
ELSE
IF_STATUS IS(*NORECORD)
MESSAGE MSGTXT('Department not found')
ELSE
IF_STATUS IS(*ERROR)
MESSAGE MSGTXT('Error updating Department')
ENDIF
ENDIF
ENDIF
ENDROUTINE
EVTROUTINE HANDLING(#DELETE.Click)
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(YESNOCANCEL NO QUESTION *COMPONENT 'Are your sure you want to delete?') TO_GET(#ANSWER)
IF COND(#ANSWER = YES)
DELETE FROM_FILE(DEPTAB)
IF_STATUS IS(*OKAY)
MESSAGE MSGTXT('Department deleted successfully')
EXECUTE SUBROUTINE(INITFORM)
ELSE
IF_STATUS IS(*NORECORD)
MESSAGE MSGTXT('Department not found')
ELSE
IF_STATUS IS(*ERROR)
MESSAGE MSGTXT('Error deleting Department')
ENDIF
ENDIF
ENDIF
ENDIF
ENDROUTINE
EVTROUTINE HANDLING(#CLEAR.Click)
EXECUTE SUBROUTINE(INITFORM)
ENDROUTINE
SUBROUTINE NAME(INITFORM)
#FORMDATA := *DEFAULT
#UPDATE.Enabled #DELETE.Enabled := False
#DEPTMENT.Enabled #FETCH.Enabled #INSERT.Enabled := True
ENDROUTINE
END_COM