Function SET013B: Maintain DC@A07

LANSA

Function SET013B: Maintain DC@A07
* =======================================================
* Process ........: SET_013
* Function .......: SET013B
* Created on .....: 03/03/00 at 13:00:02
* Description ....: Maintain DC@A07
* Full Description: The purpose of this function is to
* maintain system definition data area DC@A07
*
* 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.
*
* Minimum LANSA release: 8.0
*
* =======================================================
* Function control options
Function Options(*DIRECT)
*
* Group and field definitions
*
*
Define Field(#S_013PFER) Type(*CHAR) Length(010) Desc('User defined program/file error handler')
Define Field(#S_013PRMT) Type(*CHAR) Length(010) Desc('User defined prompt key message handler')
Define Field(#S_013IMP) Type(*CHAR) Length(010) Desc('Import user exit program')
Define Field(#S_013ENV) Type(*CHAR) Length(010) Desc('LANSA environment setup user exit pgm')
Define Field(#S_013SBM) Type(*CHAR) Length(010) Desc('SUBMIT user exit program')
Define Field(#S_013TGTR) Type(*CHAR) Length(008) Desc('Target Release *N/*CURRENT/*PRV/VxRyMz')
*
Define Field(#S_013TGT1) Type(*CHAR) Length(001) To_Overlay(#S_013TGTR 001)
Define Field(#S_013TGT2) Type(*CHAR) Length(007) To_Overlay(#S_013TGTR 002)
*
Define Field(#S_013THR) Type(*CHAR) Length(001) Desc('Retain task tracking history')
Define Field(#S_013TTP1) Type(*CHAR) Length(002) Desc('Prefix for system wide tasks (optional)')
Define Field(#S_013TTP2) Type(*CHAR) Length(002) Desc('Prefix for user tasks (optional)')
Define Field(#S_013TTP3) Type(*CHAR) Length(002) Desc('Prefix for task per task (optional)')
Define Field(#S_013TTU1) Type(*CHAR) Length(001) Desc('Unlock after check in (system) Y/N')
Define Field(#S_013TTU2) Type(*CHAR) Length(001) Desc('Unlock after check in (user) Y/N')
Define Field(#S_013TTU3) Type(*CHAR) Length(001) Desc('Unlock after check in (task) Y/N')
* =======================================================
* Program Mainline : DC@A07
* =======================================================
*
Function Options(*DIRECT)
*
Def_Cond Name(*AS400) Cond('*CPUTYPE = AS400')
If Cond(*AS400)
* backup the original DC@A07 in save file S_013SAV2
* the partition data library
Message Msgtxt('Backup of DC@A07 in save file S_013SAV2 in your partition data library')
Exec_Os400 Command('CALL SETCRTSAVF PARM(#S_LBPRTDT S_013SAV2 ''Backup of DC@A07'')') If_Error(*NEXT)
Exec_Os400 Command('SAVOBJ OBJ(DC@A07) LIB(#S_LBSYSPG) DEV(*SAVF) SAVF(#S_LBPRTDT/S_013SAV2) CLEAR(*ALL) SAVACT(*SYNCLIB)')
Else
Message Msgtxt('Not available on PC')
Menu
Endif
*
Begin_Loop
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 1 10) To_Get(#S_013PFER)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 011 10) To_Get(#S_013PRMT)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 601 10) To_Get(#S_013IMP)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 611 10) To_Get(#S_013ENV)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 621 10) To_Get(#S_013SBM)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 631 08) To_Get(#S_013TGTR)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 639 01) To_Get(#S_013THR)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 640 02) To_Get(#S_013TTP1)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 642 02) To_Get(#S_013TTP2)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 644 02) To_Get(#S_013TTP3)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 646 01) To_Get(#S_013TTU1)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 647 01) To_Get(#S_013TTU2)
Use Builtin(GET_CHAR_AREA) With_Args('DC@A07' '*LIBL' 'N' 648 01) To_Get(#S_013TTU3)
Message Msgtxt('WARNING this program DOES NOT do any validation before update!!!!')
D01: Display Fields((#S_013PFER *IN) (#S_013PRMT *IN) (#S_013IMP *IN) (#S_013ENV *IN) (#S_013SBM *IN) (#S_013TGTR *IN) (#S_013THR *IN) (#S_013TTP1 *IN) (#S_013TTP2 *IN) (#S_013TTP3 *IN) (#S_013TTU1 *IN) (#S_013TTU2 *IN) (#S_013TTU3 *IN)) Identify(*DESC) Prompt_Key(*NO)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013PFER 'DC@A07' '*LIBL' 'Y' 001 10)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013PRMT 'DC@A07' '*LIBL' 'Y' 011 10)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013IMP 'DC@A07' '*LIBL' 'Y' 601 10)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013ENV 'DC@A07' '*LIBL' 'Y' 611 10)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013SBM 'DC@A07' '*LIBL' 'Y' 621 10)
* Split into two strings to avoid *N
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013TGT1 'DC@A07' '*LIBL' 'Y' 631 01)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013TGT2 'DC@A07' '*LIBL' 'Y' 632 07)
*
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013THR 'DC@A07' '*LIBL' 'Y' 639 01)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013TTP1 'DC@A07' '*LIBL' 'Y' 640 02)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013TTP2 'DC@A07' '*LIBL' 'Y' 642 02)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013TTP3 'DC@A07' '*LIBL' 'Y' 644 02)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013TTU1 'DC@A07' '*LIBL' 'Y' 646 01)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013TTU2 'DC@A07' '*LIBL' 'Y' 647 01)
Use Builtin(PUT_CHAR_AREA) With_Args(#S_013TTU3 'DC@A07' '*LIBL' 'Y' 648 01)
Message Msgtxt('DC@A07 was successfully updated')
End_Loop