SQLRPGLE
***************************************************************************
* *
* Program : CPYFSTPATH *
* Description : Copy Fast Path To Other Environments Screen *
* Author : *
* *
***************************************************************************
*--------------------------------------------------------------------------
* M o d i f i c a t i o n J o u r n a l
*--------------------------------------------------------------------------
* Date Name WO# Description
*--------------------------------------------------------------------------
* 06/09/2017 GXXX Copy Fast Path To Other Environments
*
*--------------------------------------------------------------------------
H Option(*NoDebugIO:*SrcStmt)
H DftActGrp(*No) ActGrp(*Caller)
FCpyFPDs CF E WorkStn
F INFDS(sc$FDS)
*--------------------------------------------------------------------*
* P R O C E D U R E P R O T O T Y P E S *
*--------------------------------------------------------------------*
D EnvSlt PR ExtPgm('ENVSLT')
D prEnv 15A
//---------------------------------------------------------------------
// File Information Data Structure For Display File
//---------------------------------------------------------------------
D sc$FDS DS
D sc$Fmt 261 270
D sc$Key 369 369
D sc$Line 370 370
D sc$Colmn 371 371
D sc$RR# 397 400B 0
* Local Data Area
D ldaDs UDS Dtaara(*Lda)
D ldaCmpName 40
D ldaBld 1
*--------------------------------------------------------------------*
* D A T A S T R U C T U R E S *
*--------------------------------------------------------------------*
* Program Status Data Structure
D stdPgmSds ESDS
*--------------------------------------------------------------------*
* D E C L A R E C O P Y B O O K *
*--------------------------------------------------------------------*
* Function Keys Constants
/COPY PRDCOMSRC/QCPYSRCILE,CO_FKEYS
*-------------------------------------------------------------------------
* Define Binary Work Fields
*-------------------------------------------------------------------------
D DS
D g$MsgPsc 9B 0 Inz(0)
D g$MsgLen 9B 0 Inz(132)
*-------------------------------------------------------------------------
* Internally Described Data Structure For Handling Errors
*-------------------------------------------------------------------------
D z$ApiErr DS
D z$ApiBytp 9B 0 Inz(64)
D z$ApiByta 9B 0 Inz(0)
D z$ApiErr# 7
D z$ApiRsrv 1
D z$ApiEDta 65
* Prototype for 'QMHRMVPM'
D QMhRmvPM PR ExtPgm('QMHRMVPM')
D g$Pgnm_ Like(psdPgm) Program Queue
D g$MsgPsc_ Like(g$MsgPsc) Pgm Stack Cntr
D g$MsgKey_ Like(g$MsgKey) Msg Key
D g$MsgRMV_ Like(g$MsgRmv) Msg To Remove
D g$ApiErr_ Like(z$ApiErr) Error Code D/S
* Prototype for 'QMHSNDPM'
D QMHSNDPM PR ExtPgm('QMHSNDPM') Send Pgm Message
D g$Msg#_ Like(g$Msg#) Message Id
D g$MsgFIL_ Like(g$MsgFil) Message File
D g$MsgDta_ Like(g$MsgDta) Message Data
D g$MsgLen_ Like(g$MsgLen) Msg Data Length
D g$MsgTYP_ Like(g$MsgTYP) Message Type
D g$Pgnm_ Like(psdPgm) Program Queue
D g$MsgPsc_ Like(g$MsgPsc) Pgm Stack Cntr
D g$MsgKey_ Like(g$MsgKey) Msg Key
D g$ApiErr_ Like(z$ApiErr) Error Code D/S
*-------------------------------------------------------------------------
* Message Fields
*-------------------------------------------------------------------------
D g$ErrCnt S 5 0
D g$Msg# S 7
D g$MsgCnt S 5 0
D g$MsgDta S 132
D g$MsgFil S 20
D g$MsgKey S 4
D g$MsgRmv S 10
D g$MsgTyp S 10
D g$Mvr S 5 0
D g$MsgID S 7
//---------------------------------------------------------------------
// Working-Storage Fields
//---------------------------------------------------------------------
D $count S 2 0 Inz(0)
D l$ever S 2 0 Inz(0)
D l$Error S 1A Inz('N')
D l$PressF6 S 1A Inz('N')
D l$PgmOrCmd S 1A Inz('')
D l$DstEnv S 10A Inz(*Blanks)
D l$DstLib S 10A Inz(*Blanks)
D l$SrcLib S 10A Inz(*Blanks)
D l$SqlStmt S 500A Inz(*Blanks)
D l$PgmName S 10A Inz(*Blanks)
D l$CmdName S 10A Inz(*Blanks)
D l$FP_exists S 35A Inz('')
D g$Control S 10 Inz(*Blanks)
D n$InizScr C Const('InizScr ')
D n$DsplScr C Const('DsplScr ')
D n$ValdScr C Const('ValdScr ')
D n$ProcKey C Const('ProcKey ')
D n$CrtFstPth C Const('CrtFstPth ')
D n$Reset C Const('Reset ')
D n$Exit C Const('Exit ')
/Free
Exec Sql
Set Option Commit = *NONE, CloSqlCsr = *ENDMOD;
g$Control = n$InizScr;
For l$ever;
l$ever = 1;
Select;
When g$Control = n$InizScr;
ExSr $InizScr;
When g$Control = n$DsplScr;
ExSr $DsplScr;
When g$Control = n$ValdScr;
ExSr $ValdScr;
When g$Control = n$CrtFstPth;
ExSr $CrtFastPath;
When g$Control = n$ProcKey;
ExSr $ProcKey;
Other;
ExSr $Exit;
EndSl;
EndFor;
//---------------------------------------------------------------------
// $InizScr - Subr To Initilize Screen
//---------------------------------------------------------------------
BegSr $InizScr;
g$Control = n$DsplScr;
// Populate screen program name
In ldaDs;
s$CmpName = ldaCmpName;
If s$CmpName ='';
s$CmpName=' Oriental Trading Company';
EndIf;
*In41 = *Off;
*In42 = *Off;
l$PressF6 = 'N';
scFastpath = '';
scSrcEnv = '';
scDesEnvs= '';
Clear g$MsgKey;
g$MsgRmv = '*ALL';
g$MsgFil = 'ILCMSGF *LIBL';
g$MsgTyp = '*INFO';
QMhRmvPM ( psdPgm : g$MsgPsc : g$MsgKey :
g$MsgRmv : z$ApiErr );
Clear g$MsgCnt;
Exec sql
Select Trim(codcd1)||' - '||Trim(codRcd) Into :scSrcEnv
From ILCCOD
Where codSys ='UTILITY' And codFil ='FASTPATH'
And codCd2 = 'Y'; //Get Src Env.
EndSr;
//---------------------------------------------------------------------
// $DsplScr - Subr To Display Screen #
//---------------------------------------------------------------------
BegSr $DsplScr;
*In99 = *On;
// Write Error Message Subfile Control Record
Write MsgCtl;
// Read/Write Screen Record
Exfmt FsPath;
// Remove Program Messages
Clear g$MsgKey;
QMhRmvPM ( psdPgm : g$MsgPsc : g$MsgKey :
g$MsgRmv : z$ApiErr );
Clear g$MsgCnt;
Select;
// If Valid Command Key Process Command Key Routine
When *In99 = *On;
g$Control = n$ProcKey;
// When *In04 = *On And #fld = 'SCSRCENV';
// callp EnvSlt(scSrcEnv);
// g$Control = n$DsplScr;
Other;
g$Control = n$ValdScr;
EndSl;
*In41 = *Off;
*In42 = *Off;
EndSr;
//---------------------------------------------------------------------
// $ValdScr - Subr To Validate Screen
//---------------------------------------------------------------------
BegSr $ValdScr;
$count = 0;
l$Error = 'N';
l$PgmOrCmd = '';
l$SrcLib = '';
scDesEnvs= '';
l$SqlStmt = '';
l$PgmName = '';
l$CmdName = '';
l$FP_exists = '';
If scSrcEnv = '';
g$MsgDta = 'Enter From Environment.';
g$Msg# = 'ERF9999';
*In41 = *On;
ExSr $SndMsg;
l$Error = 'Y';
Else;
Exec sql
Select codCd1 Into :l$SrcLib
From ILCCOD
Where codSys ='UTILITY' And codFil ='FASTPATH'
And Trim(codcd1)||' - '||Trim(codRcd) = :scSrcEnv
Fetch First 1 Row Only;
If l$SrcLib = '';
g$MsgDta = 'Invalid Environment.';
g$Msg# = 'ERF9999';
*In41 = *On;
ExSr $SndMsg;
l$Error = 'Y';
EndIf;
EndIf;
//Create the list of Destination Environments //Create Des Env List
If l$Error = 'N' And l$SrcLib <> '';
Exec sql
Declare fpCsr1 Scroll Cursor For
Select codRcd, codCd1
From ILCCOD
Where codSys ='UTILITY' And codFil ='FASTPATH'
And Trim(codcd1)||' - '||Trim(codRcd) <> :scSrcEnv;
Exec sql
Open fpCsr1;
Exec sql
Fetch Next From fpCsr1 Into :l$DstEnv, :l$DstLib;
Dow SQLCODE = 0;
scDesEnvs = %Trim(scDesEnvs) + %Trim(l$DstEnv); //Concat all Des Env
Exsr $ChkFPExists; //Chk if FP already exists
Exec sql
Fetch Next From fpCsr1 Into :l$DstEnv, :l$DstLib;
If SQLCODE = 0;
scDesEnvs = %Trim(scDesEnvs) + ', ';
EndIf;
EndDo; //End of Des Env List
Exec sql
Close fpCsr1;
If l$FP_exists <> '';
g$MsgDta = 'Fast Path ' + %Trim(scFastPath) +
' already exists in ' + %Trim(l$FP_exists) + '.';
g$Msg# = 'ERF9999';
*In42 = *On;
ExSr $SndMsg;
l$Error = 'Y';
EndIf;
EndIf;
If l$Error = 'N' And scFastPath = '';
g$MsgDta = 'Enter Fast Path.';
g$Msg# = 'ERF9999';
*In42 = *On;
ExSr $SndMsg;
l$Error = 'Y';
ElseIf l$Error = 'N' And scFastPath <> ''; //Chk if FP exists in MenPgm
l$SqlStmt = 'Select pgmPgm' +
' From ' + %Trim(l$Srclib) + '/MenPgm Where' +
' pgmFpt = ''' + %Trim(scFastPath) + '''' +
' Fetch First 1 Row Only';
Exec Sql
Declare SqlStm Statement;
Exec Sql
Prepare SqlStm From :l$SqlStmt;
Exec Sql
Declare CountCsr Scroll Cursor for SqlStm;
Exec Sql
Open CountCsr;
Exec Sql
Fetch CountCsr Into :l$PgmName;
Exec Sql
Close CountCsr;
If l$PgmName = ''; //Chk if FP exists in MenCmd
l$SqlStmt = 'Select cmdCid' +
' From ' + %Trim(l$Srclib) + '/MenCmd Where' +
' cmdFpt = ''' + %Trim(scFastPath) + '''' +
' Fetch First 1 Row Only';
Exec Sql
Declare SqlStm1 Statement;
Exec Sql
Prepare SqlStm1 From :l$SqlStmt;
Exec Sql
Declare CountCsr1 Scroll Cursor for SqlStm1;
Exec Sql
Open CountCsr1;
Exec Sql
Fetch CountCsr1 Into :l$CmdName;
Exec Sql
Close CountCsr1;
If l$CmdName = '';
g$MsgDta = 'Invalid Fast Path.';
g$Msg# = 'ERF9999';
*In42 = *On;
ExSr $SndMsg;
l$Error = 'Y';
Else;
l$PgmOrCmd = 'C';
EndIf;
Else;
l$PgmOrCmd = 'P';
EndIf;
EndIf;
If l$Error = 'N' And l$PressF6 = 'N';
g$MsgDta = 'Press F6 to Confirm.';
g$Msg# = 'ERF9999';
ExSr $SndMsg;
l$Error = 'Y';
EndIf;
If l$Error = 'Y';
g$Control = n$DsplScr; //Control
Else;
g$Control = n$CrtFstPth; //Control
EndIf;
EndSr;
//---------------------------------------------------------------------
// $ChkFPExists - Check if FastPath already exits in Destination Env.
//---------------------------------------------------------------------
BegSr $ChkFPExists;
If scFastPath <> '';
l$SqlStmt = 'Select count(*)' + //Check in Dest MenPgm
' From ' + %Trim(l$DstLib) + '/MenPgm Where' +
' pgmFpt = ''' + %Trim(scFastPath) + '''' +
' Fetch First 1 Row Only';
Exec Sql
Declare SqlStm7 Statement;
Exec Sql
Prepare SqlStm7 From :l$SqlStmt;
Exec Sql
Declare CountCsr2 Scroll Cursor for SqlStm7;
Exec Sql
Open CountCsr2;
Exec Sql
Fetch CountCsr2 Into :$count;
Exec Sql
Close CountCsr2;
If $count > 0;
l$FP_exists = %Trim(l$FP_exists) + %Trim(l$DstEnv) + ' '; //FP Already Exists
ElseIf $count = 0;
l$SqlStmt = 'Select count(*)' + //Check in Dest MenCmd
' From ' + %Trim(l$DstLib) + '/MenCmd Where' +
' cmdFpt = ''' + %Trim(scFastPath) + '''' +
' Fetch First 1 Row Only';
Exec Sql
Declare SqlStm8 Statement;
Exec Sql
Prepare SqlStm8 From :l$SqlStmt;
Exec Sql
Declare CountCsr3 Scroll Cursor for SqlStm8;
Exec Sql
Open CountCsr3;
Exec Sql
Fetch CountCsr3 Into :$count;
Exec Sql
Close CountCsr3;
If $count > 0;
l$FP_exists = %Trim(l$FP_exists) + %Trim(l$DstEnv) + ' '; //FP Already Exists
EndIf;
EndIf;
EndIf;
EndSr;
//---------------------------------------------------------------------
// $CrtFastPath - Subr To Create Fast Path
//---------------------------------------------------------------------
BegSr $CrtFastPath;
//Read the list of Destination Environments except Source Env.
Exec sql
Declare fpCsr2 Scroll Cursor For
Select codCd1
From ILCCOD
Where codSys ='UTILITY' And codFil ='FASTPATH'
And Trim(codcd1)||' - '||Trim(codRcd) <> :scSrcEnv;
Exec sql
Open fpCsr2;
Exec sql
Fetch Next From fpCsr2 Into :l$DstLib;
Dow SQLCODE = 0;
If l$PgmOrCmd = 'P'; //If it is Program
//Insert Fast path record in file MenPgm in all libs //Insert menPgm Pgm
l$SqlStmt = 'Insert Into ' + %Trim(l$DstLib) + '/menPgm' +
' Select * from ' + %Trim(l$Srclib) +
'/menPgm' + ' Where pgmFpt = ''' +
%Trim(scFastPath) + '''';
Exec Sql
Declare SqlStm2 Statement;
Exec Sql
Prepare SqlStm2 From :l$SqlStmt;
Exec Sql
Execute Immediate :l$SqlStmt;
//Insert User Authority Record into file MenAut in all libs //Insert menAut Pgm
l$SqlStmt = 'Insert Into ' + %Trim(l$DstLib) + '/menAut' +
' Select * from ' + %Trim(l$Srclib) +
'/menAut' + ' Where autPgm = ''' +
%Trim(l$PgmName) + '''';
Exec Sql
Declare SqlStm3 Statement;
Exec Sql
Prepare SqlStm3 From :l$SqlStmt;
Exec Sql
Execute Immediate :l$SqlStmt;
//Insert Menu Details Record into file MenMdt in all libs //Insert menMdt Pgm
l$SqlStmt = 'Insert Into ' + %Trim(l$DstLib) + '/menMdt' +
' Select * from ' + %Trim(l$Srclib) +
'/menMdt' + ' Where mdtPgm = ''' +
%Trim(l$PgmName) + '''';
Exec Sql
Declare SqlStm4 Statement;
Exec Sql
Prepare SqlStm4 From :l$SqlStmt;
Exec Sql
Execute Immediate :l$SqlStmt;
//End of Pgm
ElseIf l$PgmOrCmd = 'C'; //If it is Command
l$SqlStmt = 'Insert Into ' + %Trim(l$DstLib) + '/menCmd' + //Insert menCmd Cmd
' Select * from ' + %Trim(l$Srclib) +
'/menCmd' + ' Where cmdFpt = ''' +
%Trim(scFastPath) + '''';
Exec Sql
Declare SqlStm5 Statement;
Exec Sql
Prepare SqlStm5 From :l$SqlStmt;
Exec Sql
Execute Immediate :l$SqlStmt;
//Insert User Authority Record into file MenAut in all libs //Insert menAut Cmd
l$SqlStmt = 'Insert Into ' + %Trim(l$DstLib) + '/menAut' +
' Select * from ' + %Trim(l$Srclib) +
'/menAut' + ' Where autCid = ''' +
%Trim(l$CmdName) + '''';
Exec Sql
Declare SqlStm5 Statement;
Exec Sql
Prepare SqlStm5 From :l$SqlStmt;
Exec Sql
Execute Immediate :l$SqlStmt;
//Insert Menu Details Record into file MenMdt in all libs //Insert menMdt Cmd
l$SqlStmt = 'Insert Into ' + %Trim(l$DstLib) + '/menMdt' +
' Select * from ' + %Trim(l$Srclib) +
'/menMdt' + ' Where mdtCid = ''' +
%Trim(l$CmdName) + '''';
Exec Sql
Declare SqlStm6 Statement;
Exec Sql
Prepare SqlStm6 From :l$SqlStmt;
Exec Sql
Execute Immediate :l$SqlStmt;
//Read the next library to insert the fastpath
EndIf; //End of Cmd
Exec sql
Fetch Next From fpCsr2 Into :l$DstLib; //Fetch Next Env Lib
EndDo;
Exec sql
Close fsCsr2;
g$MsgDta = 'Fast Path ' + %Trim(scFastpath) + ' Created.';
g$Msg# = 'ERF9999';
ExSr $SndMsg;
g$Control = n$DsplScr;
EndSr;
//---------------------------------------------------------------------
// $ProcKey - Subr To Process Command Keys for Screen
//---------------------------------------------------------------------
BegSr $ProcKey;
Select;
// Process Cmd - 03, Exit/Terminate Program
When sc$Key = c$F03;
g$Control = n$Exit; //Exit Program
// Process Cmd - 04, Select Environment
When sc$Key = c$F04 And #fld = 'SCSRCENV';
callp EnvSlt(scSrcEnv);
g$Control = n$ValdScr;
// Process Cmd - 05, Reset Screen
When sc$Key = c$F05;
g$Control = n$InizScr; //Refresh
// Process Cmd - 06, Confirm Fast Path
When sc$Key = c$F06; //Confirm
g$Control = n$ValdScr;
l$PressF6 = 'Y';
Other;
g$Control = n$ValdScr;
EndSl;
EndSr;
*----------------------------------------------------------------*
* S U B R O U T I N E : $SndMsg - Send Messages to program queue *
*----------------------------------------------------------------*
BegSr $SndMsg;
Clear g$MsgKey;
g$ErrCnt += 1;
QMHSndPM ( g$Msg# : g$MsgFil : g$MsgDta :
g$MsgLen : g$MsgTyp : psdPgm : g$MsgPsc :
g$MsgKey : z$ApiErr );
g$MsgCnt = g$MsgCnt + 1;
EndSr;
//---------------------------------------------------------------------
// $Exit - Subr To Exit/Terminate Program
//---------------------------------------------------------------------
BegSr $Exit;
*InLr = *On;
Return;
EndSr;
/End-Free