Form VL_SAM134 : Dynamic Tier Management Configuration
Name: VL_SAM134
Description: The following RDMLX form is used to configure a logical tiers management scheme and access to the associated physical systems that it is implemented on.
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM FORMPOSITION(ScreenCenter) HEIGHT(444) LAYOUTMANAGER(#ATLM_1) LEFT(135) TOP(152) WIDTH(745);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_1) DISPLAYPOSITION(1) HEIGHT(395) LAYOUTMANAGER(#ATLM_2) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(201);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Left) MANAGE(#PANL_1) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_2) DISPLAYPOSITION(2) HEIGHT(395) LAYOUTMANAGER(#ATLM_3) LEFT(201) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(536);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Center) MANAGE(#PANL_2) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONVER(Spread);
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(3) HEIGHT(22) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(395) WIDTH(737);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Bottom) MANAGE(#STBR_1) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_1) CAPTION('Available Systems') DISPLAYPOSITION(1) HEIGHT(395) LAYOUTMANAGER(#ATLM_4) LEFT(0) PARENT(#PANL_1) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(201);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Center) MANAGE(#GPBX_1) PARENT(#ATLM_2);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_1) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_3);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_2) CAPTION('System Details') DISPLAYPOSITION(1) HEIGHT(395) LEFT(0) PARENT(#PANL_2) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(536);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#GPBX_2) PARENT(#ATLM_3);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_4);
DEFINE_COM CLASS(#PRIM_LTBX) NAME(#VIEW_TIER) DISPLAYPOSITION(1) HEIGHT(366) LEFT(4) PARENT(#GPBX_1) POPUPMENU(#PMNU_1) TABPOSITION(1) TOP(13) WIDTH(193);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_6) ATTACHMENT(Center) MANAGE(#VIEW_TIER) PARENT(#ATLM_4);
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_1) PARENT(#VIEW_TIER) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_2) DISPLAYPOSITION(1) PARENT(#VIEW_TIER) SOURCE(#STD_TEXTS) WIDTH(20) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_NAME) CHARACTERCASE(Upper) DISPLAYPOSITION(1) HEIGHT(18) HINT('The Symbolic System Name (SSN) to be assigned ') LEFT(80) MAXLENGTH(10) PARENT(#GPBX_2) TABPOSITION(1) TOP(24) VISUALSTYLE(#VS_NORM) WIDTH(109);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_DESC) DISPLAYPOSITION(2) HEIGHT(18) LEFT(80) MAXLENGTH(30) PARENT(#GPBX_2) TABPOSITION(2) TOP(52) VISUALSTYLE(#VS_NORM) WIDTH(202);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_1) CAPTION('System Name') DISPLAYPOSITION(4) HEIGHT(16) PARENT(#GPBX_2) TABPOSITION(8) TABSTOP(False) TOP(24) WIDTH(68);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_2) CAPTION('Description') DISPLAYPOSITION(3) HEIGHT(16) LEFT(13) PARENT(#GPBX_2) TABPOSITION(7) TABSTOP(False) TOP(52) WIDTH(61);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_3) CAPTION('System Type ') DISPLAYPOSITION(5) HEIGHT(70) LEFT(296) PARENT(#GPBX_2) TABPOSITION(3) TABSTOP(False) TOP(16) WIDTH(225);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_2) DIRECTION(TopToBottom) FLOWOPERATION(Decrease) SPACING(2) SPACINGITEMS(2);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_2) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VTIER_WIN) CAPTION('Windows Client ') DISPLAYPOSITION(1) HEIGHT(12) LEFT(16) PARENT(#GPBX_3) TABPOSITION(1) TOP(13);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_3) MANAGE(#VTIER_WIN) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VTIER_AS400) CAPTION('AS/400 Server') DISPLAYPOSITION(2) HEIGHT(17) LEFT(16) PARENT(#GPBX_3) TABPOSITION(2) TOP(27) WIDTH(112);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_4) MANAGE(#VTIER_AS400) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_5) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VTIER_OTHER) CAPTION('Other Server (eg: NT)') DISPLAYPOSITION(3) HEIGHT(14) LEFT(16) PARENT(#GPBX_3) TABPOSITION(3) TOP(48) WIDTH(129);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_6) MANAGE(#VTIER_OTHER) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_4) CAPTION('Connect to this System using these Details') DISPLAYPOSITION(6) HEIGHT(260) LEFT(8) PARENT(#GPBX_2) TABPOSITION(4) TABSTOP(False) TOP(93) WIDTH(229);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_5) CAPTION('When Executing Applications on this System ') DISPLAYPOSITION(7) HEIGHT(260) LEFT(238) PARENT(#GPBX_2) TABPOSITION(5) TABSTOP(False) TOP(92) WIDTH(288);
;
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_NETN) DISPLAYPOSITION(6) HEIGHT(18) HINT('The Partner or Network LU name of the system as assigned in the LANSA Communications Adminstrator') LEFT(104) MAXLENGTH(30) PARENT(#GPBX_4) TABPOSITION(1) TOP(24) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_9) CAPTION('Network Name') DISPLAYPOSITION(13) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(17) TABSTOP(False) TOP(24) WIDTH(84);
;
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_USER) DISPLAYPOSITION(7) HEIGHT(18) HINT('The user profile to be used to gain access to the operating system on this system. Case may be important. ') LEFT(104) MAXLENGTH(10) PARENT(#GPBX_4) TABPOSITION(2) TOP(46) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_3) CAPTION('OS User') DISPLAYPOSITION(14) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(16) TABSTOP(False) TOP(48) WIDTH(68);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_PASW) DISPLAYPOSITION(4) HEIGHT(18) HINT('The password for the user profile to be used to gain access to the operating system on this system. Case may be important') LEFT(104) MAXLENGTH(10) PARENT(#GPBX_4) PASSWORDCHAR('*') TABPOSITION(3) TOP(70) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_4) CAPTION('OS Password') DISPLAYPOSITION(11) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(14) TABSTOP(False) TOP(70) WIDTH(68);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VDBMS_USER) DISPLAYPOSITION(5) HEIGHT(18) HINT('The user profile to be used to gain access to any DBMS on the system. Case may be important.') LEFT(104) MAXLENGTH(10) PARENT(#GPBX_4) TABPOSITION(4) TOP(94) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_5) CAPTION('DBMS User') DISPLAYPOSITION(12) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(15) TABSTOP(False) TOP(94) WIDTH(68);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VDBMS_PASW) DISPLAYPOSITION(3) HEIGHT(18) HINT('The passwword of the user profile to be used to gain access to any DBMS on the system. Case may be important.') LEFT(104) MAXLENGTH(10) PARENT(#GPBX_4) PASSWORDCHAR('*') TABPOSITION(5) TOP(118) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_6) CAPTION('DBMS Password') DISPLAYPOSITION(10) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(13) TABSTOP(False) TOP(118) WIDTH(84);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VDBMS_TYPE) CHARACTERCASE(Upper) DISPLAYPOSITION(2) HEIGHT(18) HINT('The DBMS type (eg: SQLANYWHERE, ODBCORACLE, etc)') LEFT(104) MAXLENGTH(20) PARENT(#GPBX_4) TABPOSITION(6) TOP(142) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_7) CAPTION('DBMS Type') DISPLAYPOSITION(9) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(12) TABSTOP(False) TOP(142) WIDTH(84);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VDBMS_NAME) DISPLAYPOSITION(1) HEIGHT(18) HINT('The DBMS name (eg: LX_LANSA)') LEFT(104) MAXLENGTH(20) PARENT(#GPBX_4) TABPOSITION(7) TOP(166) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_8) CAPTION('DBMS Name') DISPLAYPOSITION(8) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(11) TABSTOP(False) TOP(166) WIDTH(84);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VTIER_LOCK) CAPTION('Divert Locks') DISPLAYPOSITION(17) HEIGHT(14) LEFT(104) PARENT(#GPBX_4) TABPOSITION(8) TOP(192) WIDTH(111);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VTIER_DBCS) CAPTION('DBCS Server') DISPLAYPOSITION(16) HEIGHT(14) LEFT(104) PARENT(#GPBX_4) TABPOSITION(10) TOP(236) WIDTH(110);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VTIER_COMM) CAPTION('Commitment Control') DISPLAYPOSITION(15) HEIGHT(14) LEFT(104) PARENT(#GPBX_4) TABPOSITION(9) TOP(212) WIDTH(114);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_6) CAPTION('The APPL Tier is handled by ') DISPLAYPOSITION(4) HEIGHT(41) LEFT(16) PARENT(#GPBX_5) TABPOSITION(1) TABSTOP(False) TOP(24) WIDTH(257);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#APPL_LIST) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(1) LEFT(8) PARENT(#GPBX_6) TABPOSITION(1) TOP(15) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(241);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_1) PARENT(#APPL_LIST) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_2) DISPLAYPOSITION(1) PARENT(#APPL_LIST) SOURCE(#STD_TEXTS) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_7) CAPTION('The DATA Tier is handled by') DISPLAYPOSITION(3) HEIGHT(41) LEFT(16) PARENT(#GPBX_5) TABPOSITION(2) TABSTOP(False) TOP(83) WIDTH(257);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#DATA_LIST) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(1) LEFT(8) PARENT(#GPBX_7) TABPOSITION(1) TOP(15) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(241);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_3) PARENT(#DATA_LIST) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_4) DISPLAYPOSITION(1) PARENT(#DATA_LIST) SOURCE(#STD_TEXTS) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_8) CAPTION('The PRINT Tier is handled by') DISPLAYPOSITION(2) HEIGHT(41) LEFT(16) PARENT(#GPBX_5) TABPOSITION(3) TABSTOP(False) TOP(142) WIDTH(257);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#PRNT_LIST) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(1) LEFT(8) PARENT(#GPBX_8) TABPOSITION(1) TOP(16) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(241);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_5) PARENT(#PRNT_LIST) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_6) DISPLAYPOSITION(1) PARENT(#PRNT_LIST) SOURCE(#STD_TEXTS) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_9) CAPTION('The BATCH Tier is handled by') DISPLAYPOSITION(1) HEIGHT(41) LEFT(16) PARENT(#GPBX_5) TABPOSITION(4) TABSTOP(False) TOP(200) WIDTH(257);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#BTCH_LIST) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(1) LEFT(8) PARENT(#GPBX_9) TABPOSITION(1) TOP(14) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(241);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_7) PARENT(#BTCH_LIST) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_8) DISPLAYPOSITION(1) PARENT(#BTCH_LIST) SOURCE(#STD_TEXTS) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_PMNU) NAME(#PMNU_1);
DEFINE_COM CLASS(#PRIM_MITM) NAME(#MITM_DELETE) CAPTION('Delete') DISPLAYPOSITION(1) PARENT(#PMNU_1);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_ADMIN) CAPTION('Communications Administrator ') DISPLAYPOSITION(8) LEFT(364) PARENT(#GPBX_2) TABPOSITION(6) TOP(360) WIDTH(160);
;
;
* Local globally scopde definitions;
;
Define #Tier_File RefFld(#SysVar$av);
Define #BRetCode *char 2 Desc('Return Code');
;
* ============================;
* Create instance of this form ;
* ============================;
;
EVTROUTINE handling(#com_owner.CreateInstance);
Define #Password *char 14 default(TIEREXAMPLE);
* Create the tiered file name. Note the use of a password;
* which means that it is stored in encypted form. If you change ;
* the password then you should also change it in VSAM130 and;
* delete any existing TierData.Dat file because it will have been;
* saved with a different password and thus be unusable with ;
* a new password. ;
Use Tconcat (*Part_Dir 'TierData.Dat') (#Tier_File) ;
Use Tconcat (#Tier_File ';PASSWORD(' #PASSWORD ')') (#Tier_File) ;
Execute RstTiers;
ENDROUTINE;
;
* ================================;
* Initialize Instance of this form ;
* ================================;
;
EVTROUTINE handling(#com_owner.Initialize);
Execute LoadList (*Blanks);
ENDROUTINE;
;
* ================================;
* Form Closing;
* ================================;
;
EVTROUTINE handling(#com_owner.Closing);
Execute SavTiers;
ENDROUTINE;
;
* ================================;
* Add / update details of a tier ;
* ================================;
;
SubRoutine PutTier ;
Define #Tier_Name RefFld(#Std_Obj) Default(*Blanks);
Define #Save_Name RefFld(#Tier_Name) ;
Define #Tier_Desc RefFld(#Std_TextS) default('Tier');
Define #Tier_Type RefFld(#Std_CodeS) default(C) ;
Define #Tier_NetN RefFld(#Std_Texts) default(*blanks) ;
Define #Tier_User Reffld(#Std_obj) default(QOTHPRDOWN);
Define #Tier_Pasw Reffld(#Std_obj) default(*Blanks);
Define #Tier_DBCS RefFld(#Std_Codes) default(N);
Define #Tier_Comm RefFld(#Std_Codes) default(N);
Define #Tier_Lock RefFld(#Std_Codes) default(Y);
Define #DBMS_User RefFld(#Std_Obj) default(DBA);
Define #DBMS_Pasw RefFld(#Std_Obj) default(SQL);
Define #DBMS_Name RefFld(#Std_Texts) default(LX_LANSA);
Define #DBMS_Type RefFld(#Std_Texts) default(SQLANYWHERE);
Define #Use_APPL RefFld(#Std_Obj) default(*Blanks);
Define #Use_DATA RefFld(#Std_Obj) default(*Blanks);
Define #Use_BATCH RefFld(#Std_Obj) default(*Blanks);
Define #Use_PRINT RefFld(#Std_Obj) default(*Blanks);
;
GROUP_BY NAME(#XG_TIERS) FIELDS(#TIER_NAME #TIER_DESC #TIER_TYPE #Tier_NETN #TIER_USER #TIER_PASW #Tier_dbcs #TIER_COMM #TIER_LOCK #DBMS_USER #DBMS_PASW #DBMS_NAME #DBMS_TYPE #USE_APPL #USE_DATA #USE_BATCH #USE_PRINT);
Define #Tier_TotL RefFld(#Std_Num);
Def_List #Tiers (#XG_TIERS) Type(*working) entrys(1000) Counter(#Tier_Totl);
Def_List #SaveTiers (#XG_TIERS) Type(*working) entrys(1);
;
* Save existing details;
;
Inz_list #saveTiers 1;
;
* Now see if the tier already exists;
;
Change #Save_Name #Tier_Name;
;
Loc_Entry #Tiers Where('#Tier_Name = #Save_Name');
;
* If it exists, update it else create a new tier ;
;
If_Status *Okay;
Get_Entry 1 #SaveTiers;
Upd_Entry #Tiers;
Else;
Get_Entry 1 #SaveTiers;
Add_Entry #Tiers;
Endif;
;
EndRoutine;
;
* ================================;
* Get a tier ;
* ================================;
;
SubRoutine GetTier ;
;
Change #Save_Name #Tier_Name;
;
Loc_Entry #Tiers where('#Tier_Name = #Save_Name');
;
if_Status *okay;
;
Set #VTier_Name Value(#Tier_Name);
Set #VTier_Desc Value(#Tier_Desc);
Set (#VTier_WIN #VTier_AS400 #VTier_OTHER) ButtonChecked(False);
;
Case #Tier_Type;
When '= C';
Set #VTier_WIN ButtonChecked(True);
Set #VTier_NetN Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_User Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_Pasw Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_User Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Pasw Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Type Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Name Value(*blanks) Enabled(false) VisualStyle(#VS_NOREAD);
Set #VTier_Lock ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_Comm ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_DBCS ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
When '= A';
Set #VTier_AS400 ButtonChecked(True);
Set #VTier_NetN Value(#Tier_NetN) Enabled(True) VisualStyle(#VS_NORM);
Set #VTier_User Value(#Tier_User) Enabled(True) VisualStyle(#VS_NORM);
Set #VTier_Pasw Value(#Tier_Pasw) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_User Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Pasw Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Type Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Name Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
If '#Tier_Lock = Y';
Set #VTier_Lock ButtonState(Checked) Enabled(True) VisualStyle(#VS_NORM);
else;
Set #VTier_Lock ButtonState(Unchecked) Enabled(True) VisualStyle(#VS_NORM);
Endif;
If '#Tier_Comm = Y';
Set #VTier_Comm ButtonState(Checked) Enabled(True) VisualStyle(#VS_NORM) ;
else;
Set #VTier_Comm ButtonState(Unchecked) Enabled(True) VisualStyle(#VS_NORM) ;
Endif;
If '#Tier_DBCS = Y';
Set #VTier_DBCS ButtonState(Checked) Enabled(True) VisualStyle(#VS_NORM) ;
else;
Set #VTier_DBCS ButtonState(Unchecked) Enabled(True) VisualStyle(#VS_NORM) ;
Endif;
When '= O';
Set #VTier_OTHER ButtonChecked(True);
Set #VTier_NetN Value(#Tier_NetN) Enabled(True) VisualStyle(#VS_NORM);
Set #VTier_User Value(#Tier_User) Enabled(True) VisualStyle(#VS_NORM);
Set #VTier_Pasw Value(#Tier_Pasw) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_User Value(#DBMS_User) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_Pasw Value(#DBMS_Pasw) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_Type Value(#DBMS_Type) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_Name Value(#DBMS_Name) Enabled(True) VisualStyle(#VS_NORM);
If '#Tier_Lock = Y';
Set #VTier_Lock ButtonState(Checked) Enabled(True) VisualStyle(#VS_NORM) ;
else;
Set #VTier_Lock ButtonState(Unchecked) Enabled(True) VisualStyle(#VS_NORM);
Endif;
Set #VTier_Comm ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_DBCS ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
Endcase;
;
* Now fill all the drop down ;
;
Define #xxxx RefFld(#Std_Num);
Define #Use_Name RefFld(#Tier_Name);
Define #Use_Desc RefFld(#Tier_Desc);
Define #Use_Type RefFld(#Tier_Type);
Define #Use_Self RefFld(#Std_Codes) ;
;
Inz_list #SaveTiers 1;
;
Clr_List #APPL_List ;
Clr_List #DATA_List ;
Clr_List #PRNT_List ;
Clr_List #BTCH_List ;
Change #Use_Self N ;
;
Begin_Loop from(1) to(#Tier_Totl) Using(#xxxx);
;
Get_Entry #XXXX #Tiers ;
;
Change #Use_name #Tier_Name;
Change #Use_Desc #Tier_Desc ;
Change #Use_Type #Tier_Type ;
;
Get_Entry 1 #SaveTiers;
;
If '#Use_Type *ne C';
;
if '#Tier_Type = A';
Execute AddTier (*blanks '''This System Itself''');
Change #Use_Self Y ;
Leave;
else;
if '#Tier_Name = #Use_Name';
Execute AddTier (*blanks '''This System Itself''') ;
Change #Use_Self Y ;
Else;
Execute AddTier (#Use_Name #Use_Desc) ;
Endif;
endif;
;
Endif;
;
End_Loop;
;
if '#Use_Self = N';
Execute AddTier (*blanks '''This System Itself''');
Endif;
;
;
Endif;
;
EndRoutine;
;
* ================================;
* Delete a tier ;
* ================================;
;
SubRoutine DltTier ;
;
Change #Save_Name #Tier_Name;
;
Loc_Entry #Tiers where('#Tier_Name = #Save_Name');
;
If_Status *Okay;
Dlt_Entry *Current #Tiers;
Endif;
;
EndRoutine;
;
* ================================;
* Save tiers ;
* ================================;
;
Subroutine SavTiers;
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#TIERS #TIER_FILE T) TO_GET(#BRETCODE);
EndRoutine;
;
* ================================;
* Restore tiers;
* ================================;
;
Subroutine RstTiers;
Clr_list #Tiers;
USE BUILTIN(TRANSFORM_FILE) WITH_ARGS(#TIERS #TIER_FILE T) TO_GET(#BRETCODE);
If '#BRetCode = ER';
Use Clr_Messages;
* Define default client;
Change #XG_Tiers *Default ;
Change #Tier_name DFTCLIENT;
Change #Tier_Desc '''Default Client System''';
Change #Tier_Type C;
Execute PutTier ;
* Define default AS/400 tier;
Change #XG_Tiers *Default ;
Change #Tier_name DFTAS400;
Change #Tier_Desc '''Default AS/400 Server System''';
Change #Tier_Type A;
Execute PutTier ;
* Define default Other tier;
Change #XG_Tiers *Default ;
Change #Tier_name DFTOTHER;
Change #Tier_Desc '''Default Other Server System''';
Change #Tier_Type O;
Execute PutTier ;
Endif;
EndRoutine;
;
* ================================;
* Load List;
* ================================;
;
Subroutine LoadList ((#SEL_Name *received)) ;
Define #SEL_Name RefFld(#Tier_Name);
Define #SEL_Item RefFld(#Std_Num);
Define #SEL_Count RefFld(#Std_Num);
;
Change (#SEL_Item #SEL_Count) 0;
Inz_list #SaveTiers 1;
Clr_list #View_Tier;
SelectList #Tiers;
Change #SEL_Count '#SEL_Count + 1';
Change #Std_Obj #Tier_Name;
Change #Std_Texts #Tier_Desc;
Add_Entry #View_Tier;
if '( (#Tier_Name = #SEL_Name) *or (#SEL_Name = *blanks) ) *and (#SEL_Item = 0)';
Change #SEL_Item #SEL_Count ;
Endif;
EndSelect;
;
If '#SEL_Item > 0';
Get_Entry #SEL_Item #View_Tier;
If_Status *okay;
Set #View_Tier.CurrentItem Focus(True) Selected(True);
Endif;
Endif;
;
Get_Entry 1 #SaveTiers;
;
EndRoutine;
;
* ================================;
* Tier selected from tier list ;
* ================================;
;
EVTROUTINE HANDLING(#VIEW_TIER.ItemGotSelection) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Change #Tier_Name #Std_Obj;
Execute GetTier;
ENDROUTINE;
;
* ================================;
* Logical tier manipulation ;
* ================================;
;
Subroutine AddTier ((#Std_OBJ *received)(#Std_Texts *received));
Define #List_Enab *char 1 default(Y);
Change #List_Enab N;
Add_Entry #APPL_List ;
if '#STD_OBJ = #Use_APPL';
Set #APPL_List.CurrentItem Focus(True) ;
Endif;
Add_Entry #DATA_List ;
if '#STD_OBJ = #Use_DATA';
Set #DATA_List.CurrentItem Focus(True) ;
Endif;
Add_Entry #PRNT_List ;
if '#STD_OBJ = #Use_PRINT';
Set #PRNT_List.CurrentItem Focus(True) ;
Endif;
Add_Entry #BTCH_List ;
if '#STD_OBJ = #Use_BATCH';
Set #BTCH_List.CurrentItem Focus(True) ;
Endif;
Change #List_Enab Y;
EndRoutine;
;
Evtroutine Handling(#APPL_List.ItemGotFocus);
if '#List_Enab = Y';
Change #Tier_Name #VTier_Name.Value;
Change #Use_APPL #Std_Obj;
Execute PutTier;
Endif;
EndRoutine;
;
Evtroutine Handling(#DATA_List.ItemGotFocus);
if '#List_Enab = Y';
Change #Tier_Name #VTier_Name.Value;
Change #Use_DATA #Std_Obj;
Execute PutTier;
Endif;
EndRoutine;
;
Evtroutine Handling(#PRNT_List.ItemGotFocus);
if '#List_Enab = Y';
Change #Tier_Name #VTier_Name.Value;
Change #Use_PRINT #Std_Obj;
Execute PutTier;
Endif;
EndRoutine;
;
Evtroutine Handling(#BTCH_List.ItemGotFocus);
if '#List_Enab = Y';
Change #Tier_Name #VTier_Name.Value;
Change #Use_BATCH #Std_Obj;
Execute PutTier;
Endif;
EndRoutine;
;
* ================================;
* Tier Named changed;
* ================================;
;
EVTROUTINE HANDLING(#VTIER_Name.LostFocus) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
;
Change #Tier_Name #VTier_Name.Value;
;
if_null #Tier_Name;
Message 'A name is required for a tier';
Invoke #VTier_Name.SetFocus ;
else;
Change #Save_Name #Tier_Name ;
LOC_ENTRY IN_LIST(#TIERS) WHERE('#Tier_Name = #Save_Name') RET_ENTRY(*NO);
if_Status is_not(*okay);
Change #Tier_Name #Save_Name ;
Change #Tier_Desc '''New Tier'';
Set #VTier_Desc Value(#Tier_Desc);
Execute PutTier;
Execute LoadList (#Tier_Name);
Endif;
Endif;
;
EndRoutine;
;
* ================================;
* Tier Details Changed;
* ================================;
;
EVTROUTINE HANDLING(#VTIER_DESC.Changed);
Change #Tier_Name #VTier_Name.Value;
Change #Tier_Desc #VTier_Desc.Value;
Execute PutTier;
Execute LoadList (#Tier_Name);
ENDROUTINE;
;
EVTROUTINE HANDLING(#VTIER_NetN.Changed #VTIER_User.Changed #VTIER_Pasw.Changed #VDBMS_User.Changed #VDBMS_Pasw.Changed #VDBMS_Type.Changed #VDBMS_Name.Changed) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Change #Tier_Name #VTier_Name.Value;
Change #Tier_NetN #VTier_NetN.Value;
Change #Tier_User #VTier_User.Value;
Change #Tier_Pasw #VTier_Pasw.Value;
Change #DBMS_User #VDBMS_User.Value;
Change #DBMS_Pasw #VDBMS_Pasw.Value;
Change #DBMS_Type #VDBMS_Type.Value;
Change #DBMS_Name #VDBMS_Name.Value;
Execute PutTier;
ENDROUTINE;
;
EVTROUTINE HANDLING(#VTIER_WIN.Click #VTIER_AS400.Click #VTIER_OTHER.Click) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Change #Tier_Name #VTier_Name.Value;
If '#VTIER_WIN.ButtonChecked = True';
Change #Tier_Type C ;
Endif;
If '#VTIER_AS400.ButtonChecked = True';
Change #Tier_Type A ;
Endif;
If '#VTIER_OTHER.ButtonChecked = True';
Change #Tier_Type O ;
Endif;
Execute PutTier;
Execute GetTier;
ENDROUTINE;
;
EVTROUTINE HANDLING(#VTIER_Comm.Click #VTIER_DBCS.Click #VTIER_Lock.Click) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Change #Tier_Name #VTier_Name.Value;
Change (#Tier_Lock #Tier_DBCS #Tier_Comm) N;
If '#VTIER_Lock.ButtonState = Checked';
Change #Tier_Lock Y ;
Endif;
If '#VTIER_DBCS.ButtonState = Checked';
Change #Tier_DBCS Y ;
Endif;
If '#VTIER_Comm.ButtonState = Checked';
Change #Tier_Comm Y ;
Endif;
Execute PutTier;
ENDROUTINE;
;
* ================================;
* Delete of Tier Requested;
* ================================;
;
EVTROUTINE HANDLING(#MITM_Delete.Click) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Execute DltTier;
Execute SavTiers;
Execute RstTiers;
Execute LoadList ( *Blanks );
ENDROUTINE;
;
* ==================================;
* Start LANSA Communications Administrator;
* ==================================;
;
EVTROUTINE HANDLING(#BTN_ADMIN.Click);
Use Ov_System_Service ( Start LCOADM32 ) (#BRetCode) ;
if '#BRetCode *ne OK';
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK ERROR *COMPONENT 'Adminstrator (LCOADM32.EXE) could not be started');
endif;
ENDROUTINE;
;
END_COM;
Name: VL_SAM134
Description: The following RDMLX form is used to configure a logical tiers management scheme and access to the associated physical systems that it is implemented on.
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM FORMPOSITION(ScreenCenter) HEIGHT(444) LAYOUTMANAGER(#ATLM_1) LEFT(135) TOP(152) WIDTH(745);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_1) DISPLAYPOSITION(1) HEIGHT(395) LAYOUTMANAGER(#ATLM_2) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(201);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Left) MANAGE(#PANL_1) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_2) DISPLAYPOSITION(2) HEIGHT(395) LAYOUTMANAGER(#ATLM_3) LEFT(201) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(536);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Center) MANAGE(#PANL_2) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONVER(Spread);
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(3) HEIGHT(22) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(395) WIDTH(737);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Bottom) MANAGE(#STBR_1) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_1) CAPTION('Available Systems') DISPLAYPOSITION(1) HEIGHT(395) LAYOUTMANAGER(#ATLM_4) LEFT(0) PARENT(#PANL_1) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(201);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Center) MANAGE(#GPBX_1) PARENT(#ATLM_2);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_1) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_3);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_2) CAPTION('System Details') DISPLAYPOSITION(1) HEIGHT(395) LEFT(0) PARENT(#PANL_2) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(536);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#GPBX_2) PARENT(#ATLM_3);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_4);
DEFINE_COM CLASS(#PRIM_LTBX) NAME(#VIEW_TIER) DISPLAYPOSITION(1) HEIGHT(366) LEFT(4) PARENT(#GPBX_1) POPUPMENU(#PMNU_1) TABPOSITION(1) TOP(13) WIDTH(193);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_6) ATTACHMENT(Center) MANAGE(#VIEW_TIER) PARENT(#ATLM_4);
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_1) PARENT(#VIEW_TIER) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_2) DISPLAYPOSITION(1) PARENT(#VIEW_TIER) SOURCE(#STD_TEXTS) WIDTH(20) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_NAME) CHARACTERCASE(Upper) DISPLAYPOSITION(1) HEIGHT(18) HINT('The Symbolic System Name (SSN) to be assigned ') LEFT(80) MAXLENGTH(10) PARENT(#GPBX_2) TABPOSITION(1) TOP(24) VISUALSTYLE(#VS_NORM) WIDTH(109);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_DESC) DISPLAYPOSITION(2) HEIGHT(18) LEFT(80) MAXLENGTH(30) PARENT(#GPBX_2) TABPOSITION(2) TOP(52) VISUALSTYLE(#VS_NORM) WIDTH(202);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_1) CAPTION('System Name') DISPLAYPOSITION(4) HEIGHT(16) PARENT(#GPBX_2) TABPOSITION(8) TABSTOP(False) TOP(24) WIDTH(68);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_2) CAPTION('Description') DISPLAYPOSITION(3) HEIGHT(16) LEFT(13) PARENT(#GPBX_2) TABPOSITION(7) TABSTOP(False) TOP(52) WIDTH(61);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_3) CAPTION('System Type ') DISPLAYPOSITION(5) HEIGHT(70) LEFT(296) PARENT(#GPBX_2) TABPOSITION(3) TABSTOP(False) TOP(16) WIDTH(225);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_2) DIRECTION(TopToBottom) FLOWOPERATION(Decrease) SPACING(2) SPACINGITEMS(2);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_2) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VTIER_WIN) CAPTION('Windows Client ') DISPLAYPOSITION(1) HEIGHT(12) LEFT(16) PARENT(#GPBX_3) TABPOSITION(1) TOP(13);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_3) MANAGE(#VTIER_WIN) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VTIER_AS400) CAPTION('AS/400 Server') DISPLAYPOSITION(2) HEIGHT(17) LEFT(16) PARENT(#GPBX_3) TABPOSITION(2) TOP(27) WIDTH(112);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_4) MANAGE(#VTIER_AS400) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_5) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VTIER_OTHER) CAPTION('Other Server (eg: NT)') DISPLAYPOSITION(3) HEIGHT(14) LEFT(16) PARENT(#GPBX_3) TABPOSITION(3) TOP(48) WIDTH(129);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_6) MANAGE(#VTIER_OTHER) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_4) CAPTION('Connect to this System using these Details') DISPLAYPOSITION(6) HEIGHT(260) LEFT(8) PARENT(#GPBX_2) TABPOSITION(4) TABSTOP(False) TOP(93) WIDTH(229);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_5) CAPTION('When Executing Applications on this System ') DISPLAYPOSITION(7) HEIGHT(260) LEFT(238) PARENT(#GPBX_2) TABPOSITION(5) TABSTOP(False) TOP(92) WIDTH(288);
;
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_NETN) DISPLAYPOSITION(6) HEIGHT(18) HINT('The Partner or Network LU name of the system as assigned in the LANSA Communications Adminstrator') LEFT(104) MAXLENGTH(30) PARENT(#GPBX_4) TABPOSITION(1) TOP(24) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_9) CAPTION('Network Name') DISPLAYPOSITION(13) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(17) TABSTOP(False) TOP(24) WIDTH(84);
;
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_USER) DISPLAYPOSITION(7) HEIGHT(18) HINT('The user profile to be used to gain access to the operating system on this system. Case may be important. ') LEFT(104) MAXLENGTH(10) PARENT(#GPBX_4) TABPOSITION(2) TOP(46) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_3) CAPTION('OS User') DISPLAYPOSITION(14) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(16) TABSTOP(False) TOP(48) WIDTH(68);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VTIER_PASW) DISPLAYPOSITION(4) HEIGHT(18) HINT('The password for the user profile to be used to gain access to the operating system on this system. Case may be important') LEFT(104) MAXLENGTH(10) PARENT(#GPBX_4) PASSWORDCHAR('*') TABPOSITION(3) TOP(70) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_4) CAPTION('OS Password') DISPLAYPOSITION(11) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(14) TABSTOP(False) TOP(70) WIDTH(68);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VDBMS_USER) DISPLAYPOSITION(5) HEIGHT(18) HINT('The user profile to be used to gain access to any DBMS on the system. Case may be important.') LEFT(104) MAXLENGTH(10) PARENT(#GPBX_4) TABPOSITION(4) TOP(94) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_5) CAPTION('DBMS User') DISPLAYPOSITION(12) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(15) TABSTOP(False) TOP(94) WIDTH(68);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VDBMS_PASW) DISPLAYPOSITION(3) HEIGHT(18) HINT('The passwword of the user profile to be used to gain access to any DBMS on the system. Case may be important.') LEFT(104) MAXLENGTH(10) PARENT(#GPBX_4) PASSWORDCHAR('*') TABPOSITION(5) TOP(118) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_6) CAPTION('DBMS Password') DISPLAYPOSITION(10) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(13) TABSTOP(False) TOP(118) WIDTH(84);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VDBMS_TYPE) CHARACTERCASE(Upper) DISPLAYPOSITION(2) HEIGHT(18) HINT('The DBMS type (eg: SQLANYWHERE, ODBCORACLE, etc)') LEFT(104) MAXLENGTH(20) PARENT(#GPBX_4) TABPOSITION(6) TOP(142) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_7) CAPTION('DBMS Type') DISPLAYPOSITION(9) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(12) TABSTOP(False) TOP(142) WIDTH(84);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VDBMS_NAME) DISPLAYPOSITION(1) HEIGHT(18) HINT('The DBMS name (eg: LX_LANSA)') LEFT(104) MAXLENGTH(20) PARENT(#GPBX_4) TABPOSITION(7) TOP(166) VISUALSTYLE(#VS_NORM) WIDTH(113);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_8) CAPTION('DBMS Name') DISPLAYPOSITION(8) HEIGHT(15) LEFT(13) PARENT(#GPBX_4) TABPOSITION(11) TABSTOP(False) TOP(166) WIDTH(84);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VTIER_LOCK) CAPTION('Divert Locks') DISPLAYPOSITION(17) HEIGHT(14) LEFT(104) PARENT(#GPBX_4) TABPOSITION(8) TOP(192) WIDTH(111);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VTIER_DBCS) CAPTION('DBCS Server') DISPLAYPOSITION(16) HEIGHT(14) LEFT(104) PARENT(#GPBX_4) TABPOSITION(10) TOP(236) WIDTH(110);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VTIER_COMM) CAPTION('Commitment Control') DISPLAYPOSITION(15) HEIGHT(14) LEFT(104) PARENT(#GPBX_4) TABPOSITION(9) TOP(212) WIDTH(114);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_6) CAPTION('The APPL Tier is handled by ') DISPLAYPOSITION(4) HEIGHT(41) LEFT(16) PARENT(#GPBX_5) TABPOSITION(1) TABSTOP(False) TOP(24) WIDTH(257);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#APPL_LIST) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(1) LEFT(8) PARENT(#GPBX_6) TABPOSITION(1) TOP(15) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(241);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_1) PARENT(#APPL_LIST) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_2) DISPLAYPOSITION(1) PARENT(#APPL_LIST) SOURCE(#STD_TEXTS) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_7) CAPTION('The DATA Tier is handled by') DISPLAYPOSITION(3) HEIGHT(41) LEFT(16) PARENT(#GPBX_5) TABPOSITION(2) TABSTOP(False) TOP(83) WIDTH(257);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#DATA_LIST) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(1) LEFT(8) PARENT(#GPBX_7) TABPOSITION(1) TOP(15) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(241);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_3) PARENT(#DATA_LIST) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_4) DISPLAYPOSITION(1) PARENT(#DATA_LIST) SOURCE(#STD_TEXTS) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_8) CAPTION('The PRINT Tier is handled by') DISPLAYPOSITION(2) HEIGHT(41) LEFT(16) PARENT(#GPBX_5) TABPOSITION(3) TABSTOP(False) TOP(142) WIDTH(257);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#PRNT_LIST) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(1) LEFT(8) PARENT(#GPBX_8) TABPOSITION(1) TOP(16) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(241);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_5) PARENT(#PRNT_LIST) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_6) DISPLAYPOSITION(1) PARENT(#PRNT_LIST) SOURCE(#STD_TEXTS) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_9) CAPTION('The BATCH Tier is handled by') DISPLAYPOSITION(1) HEIGHT(41) LEFT(16) PARENT(#GPBX_5) TABPOSITION(4) TABSTOP(False) TOP(200) WIDTH(257);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#BTCH_LIST) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(1) LEFT(8) PARENT(#GPBX_9) TABPOSITION(1) TOP(14) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(241);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_7) PARENT(#BTCH_LIST) SOURCE(#STD_OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_8) DISPLAYPOSITION(1) PARENT(#BTCH_LIST) SOURCE(#STD_TEXTS) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_PMNU) NAME(#PMNU_1);
DEFINE_COM CLASS(#PRIM_MITM) NAME(#MITM_DELETE) CAPTION('Delete') DISPLAYPOSITION(1) PARENT(#PMNU_1);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_ADMIN) CAPTION('Communications Administrator ') DISPLAYPOSITION(8) LEFT(364) PARENT(#GPBX_2) TABPOSITION(6) TOP(360) WIDTH(160);
;
;
* Local globally scopde definitions;
;
Define #Tier_File RefFld(#SysVar$av);
Define #BRetCode *char 2 Desc('Return Code');
;
* ============================;
* Create instance of this form ;
* ============================;
;
EVTROUTINE handling(#com_owner.CreateInstance);
Define #Password *char 14 default(TIEREXAMPLE);
* Create the tiered file name. Note the use of a password;
* which means that it is stored in encypted form. If you change ;
* the password then you should also change it in VSAM130 and;
* delete any existing TierData.Dat file because it will have been;
* saved with a different password and thus be unusable with ;
* a new password. ;
Use Tconcat (*Part_Dir 'TierData.Dat') (#Tier_File) ;
Use Tconcat (#Tier_File ';PASSWORD(' #PASSWORD ')') (#Tier_File) ;
Execute RstTiers;
ENDROUTINE;
;
* ================================;
* Initialize Instance of this form ;
* ================================;
;
EVTROUTINE handling(#com_owner.Initialize);
Execute LoadList (*Blanks);
ENDROUTINE;
;
* ================================;
* Form Closing;
* ================================;
;
EVTROUTINE handling(#com_owner.Closing);
Execute SavTiers;
ENDROUTINE;
;
* ================================;
* Add / update details of a tier ;
* ================================;
;
SubRoutine PutTier ;
Define #Tier_Name RefFld(#Std_Obj) Default(*Blanks);
Define #Save_Name RefFld(#Tier_Name) ;
Define #Tier_Desc RefFld(#Std_TextS) default('Tier');
Define #Tier_Type RefFld(#Std_CodeS) default(C) ;
Define #Tier_NetN RefFld(#Std_Texts) default(*blanks) ;
Define #Tier_User Reffld(#Std_obj) default(QOTHPRDOWN);
Define #Tier_Pasw Reffld(#Std_obj) default(*Blanks);
Define #Tier_DBCS RefFld(#Std_Codes) default(N);
Define #Tier_Comm RefFld(#Std_Codes) default(N);
Define #Tier_Lock RefFld(#Std_Codes) default(Y);
Define #DBMS_User RefFld(#Std_Obj) default(DBA);
Define #DBMS_Pasw RefFld(#Std_Obj) default(SQL);
Define #DBMS_Name RefFld(#Std_Texts) default(LX_LANSA);
Define #DBMS_Type RefFld(#Std_Texts) default(SQLANYWHERE);
Define #Use_APPL RefFld(#Std_Obj) default(*Blanks);
Define #Use_DATA RefFld(#Std_Obj) default(*Blanks);
Define #Use_BATCH RefFld(#Std_Obj) default(*Blanks);
Define #Use_PRINT RefFld(#Std_Obj) default(*Blanks);
;
GROUP_BY NAME(#XG_TIERS) FIELDS(#TIER_NAME #TIER_DESC #TIER_TYPE #Tier_NETN #TIER_USER #TIER_PASW #Tier_dbcs #TIER_COMM #TIER_LOCK #DBMS_USER #DBMS_PASW #DBMS_NAME #DBMS_TYPE #USE_APPL #USE_DATA #USE_BATCH #USE_PRINT);
Define #Tier_TotL RefFld(#Std_Num);
Def_List #Tiers (#XG_TIERS) Type(*working) entrys(1000) Counter(#Tier_Totl);
Def_List #SaveTiers (#XG_TIERS) Type(*working) entrys(1);
;
* Save existing details;
;
Inz_list #saveTiers 1;
;
* Now see if the tier already exists;
;
Change #Save_Name #Tier_Name;
;
Loc_Entry #Tiers Where('#Tier_Name = #Save_Name');
;
* If it exists, update it else create a new tier ;
;
If_Status *Okay;
Get_Entry 1 #SaveTiers;
Upd_Entry #Tiers;
Else;
Get_Entry 1 #SaveTiers;
Add_Entry #Tiers;
Endif;
;
EndRoutine;
;
* ================================;
* Get a tier ;
* ================================;
;
SubRoutine GetTier ;
;
Change #Save_Name #Tier_Name;
;
Loc_Entry #Tiers where('#Tier_Name = #Save_Name');
;
if_Status *okay;
;
Set #VTier_Name Value(#Tier_Name);
Set #VTier_Desc Value(#Tier_Desc);
Set (#VTier_WIN #VTier_AS400 #VTier_OTHER) ButtonChecked(False);
;
Case #Tier_Type;
When '= C';
Set #VTier_WIN ButtonChecked(True);
Set #VTier_NetN Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_User Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_Pasw Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_User Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Pasw Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Type Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Name Value(*blanks) Enabled(false) VisualStyle(#VS_NOREAD);
Set #VTier_Lock ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_Comm ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_DBCS ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
When '= A';
Set #VTier_AS400 ButtonChecked(True);
Set #VTier_NetN Value(#Tier_NetN) Enabled(True) VisualStyle(#VS_NORM);
Set #VTier_User Value(#Tier_User) Enabled(True) VisualStyle(#VS_NORM);
Set #VTier_Pasw Value(#Tier_Pasw) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_User Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Pasw Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Type Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VDBMS_Name Value(*blanks) Enabled(False) VisualStyle(#VS_NOREAD);
If '#Tier_Lock = Y';
Set #VTier_Lock ButtonState(Checked) Enabled(True) VisualStyle(#VS_NORM);
else;
Set #VTier_Lock ButtonState(Unchecked) Enabled(True) VisualStyle(#VS_NORM);
Endif;
If '#Tier_Comm = Y';
Set #VTier_Comm ButtonState(Checked) Enabled(True) VisualStyle(#VS_NORM) ;
else;
Set #VTier_Comm ButtonState(Unchecked) Enabled(True) VisualStyle(#VS_NORM) ;
Endif;
If '#Tier_DBCS = Y';
Set #VTier_DBCS ButtonState(Checked) Enabled(True) VisualStyle(#VS_NORM) ;
else;
Set #VTier_DBCS ButtonState(Unchecked) Enabled(True) VisualStyle(#VS_NORM) ;
Endif;
When '= O';
Set #VTier_OTHER ButtonChecked(True);
Set #VTier_NetN Value(#Tier_NetN) Enabled(True) VisualStyle(#VS_NORM);
Set #VTier_User Value(#Tier_User) Enabled(True) VisualStyle(#VS_NORM);
Set #VTier_Pasw Value(#Tier_Pasw) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_User Value(#DBMS_User) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_Pasw Value(#DBMS_Pasw) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_Type Value(#DBMS_Type) Enabled(True) VisualStyle(#VS_NORM);
Set #VDBMS_Name Value(#DBMS_Name) Enabled(True) VisualStyle(#VS_NORM);
If '#Tier_Lock = Y';
Set #VTier_Lock ButtonState(Checked) Enabled(True) VisualStyle(#VS_NORM) ;
else;
Set #VTier_Lock ButtonState(Unchecked) Enabled(True) VisualStyle(#VS_NORM);
Endif;
Set #VTier_Comm ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
Set #VTier_DBCS ButtonState(Unchecked) Enabled(False) VisualStyle(#VS_NOREAD);
Endcase;
;
* Now fill all the drop down ;
;
Define #xxxx RefFld(#Std_Num);
Define #Use_Name RefFld(#Tier_Name);
Define #Use_Desc RefFld(#Tier_Desc);
Define #Use_Type RefFld(#Tier_Type);
Define #Use_Self RefFld(#Std_Codes) ;
;
Inz_list #SaveTiers 1;
;
Clr_List #APPL_List ;
Clr_List #DATA_List ;
Clr_List #PRNT_List ;
Clr_List #BTCH_List ;
Change #Use_Self N ;
;
Begin_Loop from(1) to(#Tier_Totl) Using(#xxxx);
;
Get_Entry #XXXX #Tiers ;
;
Change #Use_name #Tier_Name;
Change #Use_Desc #Tier_Desc ;
Change #Use_Type #Tier_Type ;
;
Get_Entry 1 #SaveTiers;
;
If '#Use_Type *ne C';
;
if '#Tier_Type = A';
Execute AddTier (*blanks '''This System Itself''');
Change #Use_Self Y ;
Leave;
else;
if '#Tier_Name = #Use_Name';
Execute AddTier (*blanks '''This System Itself''') ;
Change #Use_Self Y ;
Else;
Execute AddTier (#Use_Name #Use_Desc) ;
Endif;
endif;
;
Endif;
;
End_Loop;
;
if '#Use_Self = N';
Execute AddTier (*blanks '''This System Itself''');
Endif;
;
;
Endif;
;
EndRoutine;
;
* ================================;
* Delete a tier ;
* ================================;
;
SubRoutine DltTier ;
;
Change #Save_Name #Tier_Name;
;
Loc_Entry #Tiers where('#Tier_Name = #Save_Name');
;
If_Status *Okay;
Dlt_Entry *Current #Tiers;
Endif;
;
EndRoutine;
;
* ================================;
* Save tiers ;
* ================================;
;
Subroutine SavTiers;
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#TIERS #TIER_FILE T) TO_GET(#BRETCODE);
EndRoutine;
;
* ================================;
* Restore tiers;
* ================================;
;
Subroutine RstTiers;
Clr_list #Tiers;
USE BUILTIN(TRANSFORM_FILE) WITH_ARGS(#TIERS #TIER_FILE T) TO_GET(#BRETCODE);
If '#BRetCode = ER';
Use Clr_Messages;
* Define default client;
Change #XG_Tiers *Default ;
Change #Tier_name DFTCLIENT;
Change #Tier_Desc '''Default Client System''';
Change #Tier_Type C;
Execute PutTier ;
* Define default AS/400 tier;
Change #XG_Tiers *Default ;
Change #Tier_name DFTAS400;
Change #Tier_Desc '''Default AS/400 Server System''';
Change #Tier_Type A;
Execute PutTier ;
* Define default Other tier;
Change #XG_Tiers *Default ;
Change #Tier_name DFTOTHER;
Change #Tier_Desc '''Default Other Server System''';
Change #Tier_Type O;
Execute PutTier ;
Endif;
EndRoutine;
;
* ================================;
* Load List;
* ================================;
;
Subroutine LoadList ((#SEL_Name *received)) ;
Define #SEL_Name RefFld(#Tier_Name);
Define #SEL_Item RefFld(#Std_Num);
Define #SEL_Count RefFld(#Std_Num);
;
Change (#SEL_Item #SEL_Count) 0;
Inz_list #SaveTiers 1;
Clr_list #View_Tier;
SelectList #Tiers;
Change #SEL_Count '#SEL_Count + 1';
Change #Std_Obj #Tier_Name;
Change #Std_Texts #Tier_Desc;
Add_Entry #View_Tier;
if '( (#Tier_Name = #SEL_Name) *or (#SEL_Name = *blanks) ) *and (#SEL_Item = 0)';
Change #SEL_Item #SEL_Count ;
Endif;
EndSelect;
;
If '#SEL_Item > 0';
Get_Entry #SEL_Item #View_Tier;
If_Status *okay;
Set #View_Tier.CurrentItem Focus(True) Selected(True);
Endif;
Endif;
;
Get_Entry 1 #SaveTiers;
;
EndRoutine;
;
* ================================;
* Tier selected from tier list ;
* ================================;
;
EVTROUTINE HANDLING(#VIEW_TIER.ItemGotSelection) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Change #Tier_Name #Std_Obj;
Execute GetTier;
ENDROUTINE;
;
* ================================;
* Logical tier manipulation ;
* ================================;
;
Subroutine AddTier ((#Std_OBJ *received)(#Std_Texts *received));
Define #List_Enab *char 1 default(Y);
Change #List_Enab N;
Add_Entry #APPL_List ;
if '#STD_OBJ = #Use_APPL';
Set #APPL_List.CurrentItem Focus(True) ;
Endif;
Add_Entry #DATA_List ;
if '#STD_OBJ = #Use_DATA';
Set #DATA_List.CurrentItem Focus(True) ;
Endif;
Add_Entry #PRNT_List ;
if '#STD_OBJ = #Use_PRINT';
Set #PRNT_List.CurrentItem Focus(True) ;
Endif;
Add_Entry #BTCH_List ;
if '#STD_OBJ = #Use_BATCH';
Set #BTCH_List.CurrentItem Focus(True) ;
Endif;
Change #List_Enab Y;
EndRoutine;
;
Evtroutine Handling(#APPL_List.ItemGotFocus);
if '#List_Enab = Y';
Change #Tier_Name #VTier_Name.Value;
Change #Use_APPL #Std_Obj;
Execute PutTier;
Endif;
EndRoutine;
;
Evtroutine Handling(#DATA_List.ItemGotFocus);
if '#List_Enab = Y';
Change #Tier_Name #VTier_Name.Value;
Change #Use_DATA #Std_Obj;
Execute PutTier;
Endif;
EndRoutine;
;
Evtroutine Handling(#PRNT_List.ItemGotFocus);
if '#List_Enab = Y';
Change #Tier_Name #VTier_Name.Value;
Change #Use_PRINT #Std_Obj;
Execute PutTier;
Endif;
EndRoutine;
;
Evtroutine Handling(#BTCH_List.ItemGotFocus);
if '#List_Enab = Y';
Change #Tier_Name #VTier_Name.Value;
Change #Use_BATCH #Std_Obj;
Execute PutTier;
Endif;
EndRoutine;
;
* ================================;
* Tier Named changed;
* ================================;
;
EVTROUTINE HANDLING(#VTIER_Name.LostFocus) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
;
Change #Tier_Name #VTier_Name.Value;
;
if_null #Tier_Name;
Message 'A name is required for a tier';
Invoke #VTier_Name.SetFocus ;
else;
Change #Save_Name #Tier_Name ;
LOC_ENTRY IN_LIST(#TIERS) WHERE('#Tier_Name = #Save_Name') RET_ENTRY(*NO);
if_Status is_not(*okay);
Change #Tier_Name #Save_Name ;
Change #Tier_Desc '''New Tier'';
Set #VTier_Desc Value(#Tier_Desc);
Execute PutTier;
Execute LoadList (#Tier_Name);
Endif;
Endif;
;
EndRoutine;
;
* ================================;
* Tier Details Changed;
* ================================;
;
EVTROUTINE HANDLING(#VTIER_DESC.Changed);
Change #Tier_Name #VTier_Name.Value;
Change #Tier_Desc #VTier_Desc.Value;
Execute PutTier;
Execute LoadList (#Tier_Name);
ENDROUTINE;
;
EVTROUTINE HANDLING(#VTIER_NetN.Changed #VTIER_User.Changed #VTIER_Pasw.Changed #VDBMS_User.Changed #VDBMS_Pasw.Changed #VDBMS_Type.Changed #VDBMS_Name.Changed) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Change #Tier_Name #VTier_Name.Value;
Change #Tier_NetN #VTier_NetN.Value;
Change #Tier_User #VTier_User.Value;
Change #Tier_Pasw #VTier_Pasw.Value;
Change #DBMS_User #VDBMS_User.Value;
Change #DBMS_Pasw #VDBMS_Pasw.Value;
Change #DBMS_Type #VDBMS_Type.Value;
Change #DBMS_Name #VDBMS_Name.Value;
Execute PutTier;
ENDROUTINE;
;
EVTROUTINE HANDLING(#VTIER_WIN.Click #VTIER_AS400.Click #VTIER_OTHER.Click) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Change #Tier_Name #VTier_Name.Value;
If '#VTIER_WIN.ButtonChecked = True';
Change #Tier_Type C ;
Endif;
If '#VTIER_AS400.ButtonChecked = True';
Change #Tier_Type A ;
Endif;
If '#VTIER_OTHER.ButtonChecked = True';
Change #Tier_Type O ;
Endif;
Execute PutTier;
Execute GetTier;
ENDROUTINE;
;
EVTROUTINE HANDLING(#VTIER_Comm.Click #VTIER_DBCS.Click #VTIER_Lock.Click) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Change #Tier_Name #VTier_Name.Value;
Change (#Tier_Lock #Tier_DBCS #Tier_Comm) N;
If '#VTIER_Lock.ButtonState = Checked';
Change #Tier_Lock Y ;
Endif;
If '#VTIER_DBCS.ButtonState = Checked';
Change #Tier_DBCS Y ;
Endif;
If '#VTIER_Comm.ButtonState = Checked';
Change #Tier_Comm Y ;
Endif;
Execute PutTier;
ENDROUTINE;
;
* ================================;
* Delete of Tier Requested;
* ================================;
;
EVTROUTINE HANDLING(#MITM_Delete.Click) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
Execute DltTier;
Execute SavTiers;
Execute RstTiers;
Execute LoadList ( *Blanks );
ENDROUTINE;
;
* ==================================;
* Start LANSA Communications Administrator;
* ==================================;
;
EVTROUTINE HANDLING(#BTN_ADMIN.Click);
Use Ov_System_Service ( Start LCOADM32 ) (#BRetCode) ;
if '#BRetCode *ne OK';
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK ERROR *COMPONENT 'Adminstrator (LCOADM32.EXE) could not be started');
endif;
ENDROUTINE;
;
END_COM;