Example of a Naming Convention Program

*---------------------------------------------------------------------------------------------------------------------------

* OBJECT: Build the name of a logical entity's PHYSICAL FILE, LOGICAL FILE and FORMAT

*---------------------------------------------------------------------------------------------------------------------------

*

* New version June 94: Access the file of files via the entity name

*

* Physical file name

* Logical file name

* Format name

*

* If the entity does not exist, it is created in the file of files.

* The first 2 characters of the entity name are used as a prefix.

* If this prefix is already used for another file, the program replaces it with 'QQ' and fills in the

* description with a warning in the file of files.

*

* If it does not exist, the physical file name is created from the first 6 characters of the entity name, followed

* by 'P'.

*

*---------------------------------------------------------------------------------------------------------------------------

* PARAMETERS:

*

*

*

*

*

*---------------------------------------------------------------------------------------------------------------------------------

*

RECEIVE P_ENTITY_NAM P_FILE_NAM P_FORMAT_NAM P_LOG_FIL_NAM RETURN_COD

*

* W_ENTITY_NAM = key for the FILE_VW view

W_ENTITY_NAM = *BLANK

W_ENTITY_NAM = P_ENTITY_NAM

CHAIN FILE_VW

* An I/O error is detected when reading: position the RETURN_COD to '1'

IF     *IN90 = '1'

RETURN_COD = '1'

TERMINATE

END

IF     FILE_VW EXISTS

NAM_ARR = *BLANK

MOVE_ARRAY FI_FILE_NAM NAM_ARR

*

* Retrieve physical file name

*

P_FILE_NAM = *BLANK

P_FILE_NAM = FI_FILE_NAM

*

* Search for the length

*

W_NAM_LENGTH = &STRING_LENGTH(FI_FILE_NAM)

*

* Format name

*

NAM_ARR(W_NAM_LENGTH) = 'F'

MOVE_ARRAY NAM_ARR P_FORMAT_NAM

*

IF   W_NAM_LENGTH = 10

*

* Logical file name: "L" as last character

*

P_LOG_FIL_NAM = FI_FILE_NAM

MOVE_ON_RIGHT 'L' P_LOG_FIL_NAM

ELSE

NAM_ARR(W_NAM_LENGTH) = 'L'

W_NAM_LENGTH = W_NAM_LENGTH + 1

NAM_ARR(W_NAM_LENGTH) = '1'

MOVE_ARRAY NAM_ARR P_LOG_FIL_NAM

END

ELSE

INIT_FIELDS FILE_VW

FI_ENTITY_NAM = W_ENTITY_NAM

MOVE_ON_LEFT W_ENTITY_NAM W6_2

W6 = &TRANSFORMATION(W6_2;'_';'0')

P_FILE_NAM = W6 /// 'P'

P_FORMAT_NAM = W6 /// 'F'

P_LOG_FIL_NAM = W6 /// 'L1'

FI_FILE_NAM = W6 /// 'P'

FI_CREATION_YER = *YEAR

FI_CREATION_MON = *MONTH

FI_CREATION_DAY = *DAY

* WW_PREFIX_COD = key for the PREFIX_FILE_VW view

MOVE_ON_LEFT W_ENTITY_NAM WW_PREFIX_COD

CHAIN PREFIX_FILE_VW

* An I/O error is detected when reading: position the RETURN_COD to '1'

IF   *IN90 = '1'

RETURN_COD = '1'

TERMINATE

END

IF   PREFIX_FILE_VW DOES_NOT_EXIST

FI_PREFIX_COD = WW_PREFIX_COD

FI_FILE_DES = *JOB

ELSE

FI_PREFIX_COD = 'QQ'

FI_FILE_DES = *JOB // 'Same prefix as' // F2_ENTITY_NAM

END

CREATE FILE_VW

* An I/O error is detected when writing: position the RETURN_COD to '2'

IF   *IN90 = '1'

RETURN_COD = '2'

TERMINATE

END

END