
4359 FAGP995 IP E K DISK 05/09/09 4301 D* 05/03/21 4310 D G_First S N 05/09/06 4321 D G_Sql S 1024A INZ 05/09/06 4324 13266D G_CMDNAM S 150A 09/08/12 4325 13266D G_CMDLEN S 15P 5 09/08/13 4326 13266D* 09/08/12 4327 13226D QCMDEXC PR EXTPGM('QCMDEXC') 09/08/12 4328 13266D CMD 150A 09/08/13 4329 13266D CMDLEN 15P 5 09/08/13 4330 13266D* 09/08/13 4331 13226D AG995C PR EXTPGM('AG995C') 09/08/13 4332 13266D AG995D PR EXTPGM('AG995D') 09/08/13 4333 13266D* 09/08/13 4334 D* Int value for Chars 05/08/19 5304 I* 05/07/29 5305 IFMFILFLD 05/07/29 5306 13226I* FLFILE L1 09/08/11 5307 13226I FLBATNO L1 09/08/11 5308 13226I FLFILE L2 09/08/11 5310 C**================================================================** 05/07/29 5311 C* PARAMETER LIST * 05/07/29 5312 C**================================================================** 05/07/29 5313 C* 05/07/29 5400 C**================================================================** 04/04/16 5500 C* MAIN PROGRAM * 04/04/16 5600 C**================================================================** 04/04/16 7200 C* 04/04/16 7201 /free 05/07/29 7202 13266 // If level break L1 on FLBATNO is on 09/08/11 7203 13266 if *inl1; 09/08/11 7204 13266 // Clear File AGP995C 09/08/13 7206 13266 G_CMDNAM = 'CLRPFM AGP995C'; 09/08/12 7208 13266 G_CMDLEN = 14; 09/08/13 7210 13266 CALLP QCMDEXC(G_CMDNAM : G_CMDLEN); 09/08/13 7211 13266 09/08/13 7212 13266 // Call AG995C 09/08/13 7213 13266 CALLP AG995C(); 09/08/13 7216 13266 09/08/13 7217 13266 // Clear File AGP995D 09/08/13 7218 13266 G_CMDNAM = 'CLRPFM AGP995D'; 09/08/12 7219 13266 G_CMDLEN = 14; 09/08/13 7221 13266 CALLP QCMDEXC(G_CMDNAM : G_CMDLEN); 09/08/13 7222 13266 09/08/13 7223 13266 // Call AG995C 09/08/13 7224 13266 CALLP AG995D(); 09/08/13 7225 13266 endif; 09/08/13 7226 13266 09/08/13 7229 // init vars at detail level break 05/07/29 7231 13266 if *inl2; 09/08/11 7232 G_First = *off; 05/09/06 7233 G_Sql = 'Update ' + %trim(FLFILE) + ' set' ; 05/09/06 7234 endif; 05/07/29 7235 // build sql 05/07/29 7236 if G_First = *on; 05/09/06 7237 G_Sql = %trim(G_Sql) + ','; 05/09/06 7238 endif; 05/09/06 7241 13266 09/08/13 7242 13266 // Process character fields 09/08/13 7243 13266 if FLFLDT = 'C'; 09/08/13 7244 13266 if FLSENC <> ' ' ; 09/08/13 7245 13266 G_Sql = %trim(G_Sql) + ' ' + %trim(FLFLD) + 09/08/13 7246 13266 ' = fnScrmble(' + %trim(FLFLD) + ', ' + 09/08/13 7247 13266 %trim(FLSENC) + ')'; 09/08/13 7248 13266 else; 09/08/13 7249 13266 G_Sql = %trim(G_Sql) + ' ' + %trim(FLFLD) + 09/08/13 7250 13266 ' = fnScrmble(' + %trim(FLFLD) + ', 0)'; 09/08/13 7251 13266 endif; 09/08/13 7252 13266 endif; 09/08/13 7253 13266 09/08/13 7254 13266 // Process numeric fields 09/08/13 7255 13266 if FLFLDT = 'N'; 09/08/13 7256 13266 if FLSENC <> ' '; 09/08/13 7257 13266 G_Sql = %trim(G_Sql) + ' ' + %trim(FLFLD) + 09/08/13 7258 13266 ' = fnScrmbleN(' + %trim(FLFLD) + ', ' + 09/08/13 7259 13266 %trim(FLSENC) + ')'; 09/08/17 7261 13266 else; 09/08/13 7262 13266 G_Sql = %trim(G_Sql) + ' ' + %trim(FLFLD) + 09/08/13 7263 13266 ' = fnScrmbleN(' + %trim(FLFLD) + ', 0)'; 09/08/17 7265 13266 endif; 09/08/13 7266 13266 endif; 09/08/13 7267 G_First = *on; 05/09/06 7268 /end-free 05/07/29 7269 C* 05/07/29 7270 13266C*L1 EXSR SRExcUpd 09/08/11 7271 13266CL2 EXSR SRExcUpd 09/08/11 7272 CLR EXSR SRLastRec 05/09/09 12001 C************************************************************************** 05/07/29 12002 C* SrExcUpd - Execute Update SQL 05/07/29 12003 C************************************************************************** 05/07/29 12004 C SrExcUpd BEGSR 05/07/29 12005 C* 05/07/29 12100 C/Exec SQL 05/07/29 12200 C+ Prepare DynUpdStm From :G_Sql 05/09/06 12300 C/End-Exec 05/07/29 12400 C/Exec SQL 05/07/29 12500 C+ Execute DynUpdStm 05/07/29 12600 C/End-Exec 05/07/29 12700 C* 05/07/29 12800 C ENDSR 05/07/29 12900 C************************************************************************** 05/09/09 13000 C* *INZSR - Initialization 05/09/09 13100 C************************************************************************** 05/09/09 13200 C *INZSR BEGSR 05/09/09 13300 C* 05/09/09 13400 C/Exec SQL 05/09/09 13501 13226C+ create function fnScrmble(char(100), decimal(10,0)) 09/08/13 13502 13226C+ returns char(100) 09/08/13 13503 C+ language rpgle 05/09/09 13504 C+ external name AG995A 05/09/09 13505 C+ deterministic 05/09/09 13506 C+ no sql 05/09/09 13507 C+ no external action 05/09/09 13508 C+ parameter style SQL 05/09/09 13509 C+ allow parallel 05/09/09 13600 C/End-Exec 05/09/09 14000 C* 05/09/09 14001 13226C/Exec SQL 09/08/12 14003 13226C+ create function fnScrmbleN(decimal(15,5), decimal(10,0)) 09/08/17 14004 13226C+ returns decimal(15,5) 09/08/13 14005 13226C+ language rpgle 09/08/12 14006 13226C+ external name AG995B 09/08/12 14007 13226C+ deterministic 09/08/12 14008 13226C+ no sql 09/08/12 14009 13226C+ no external action 09/08/12 14010 13226C+ parameter style SQL 09/08/12 14011 13226C+ allow parallel 09/08/12 14012 13226C/End-Exec 09/08/12 14013 C* 09/08/11 14100 C ENDSR 05/09/09 14101 C************************************************************************** 05/09/09 14102 C* SRLastRec - At Last Record 05/09/09 14103 C************************************************************************** 05/09/09 14104 C SRLastRec BEGSR 05/09/09 14200 C/Exec SQL 05/09/09 14300 C+ drop function fnScrmble 05/09/09 14400 C/End-Exec 05/09/09 14500 C* 05/09/09 14501 13226C/Exec SQL 09/08/12 14502 13226C+ drop function fnscrmbleN 09/08/12 14503 13226C/End-Exec 09/08/12 14600 C ENDSR 05/09/09 * * * * E N D O F S O U R C E * * * *


FAGP995 IP E K DISK
D*
D G_First S N
D G_Sql S 1024A INZ
D G_CMDNAM S 150A
D G_CMDLEN S 15P 5
D*
D QCMDEXC PR EXTPGM('QCMDEXC')
D CMD 150A
D CMDLEN 15P 5
D*
D AG995C PR EXTPGM('AG995C')
D AG995D PR EXTPGM('AG995D')
D*
D* Int value for Chars
I*
IFMFILFLD
I* FLFILE L1
I FLBATNO L1
I FLFILE L2
C**================================================================**
C* PARAMETER LIST *
C**================================================================**
C*
C**================================================================**
C* MAIN PROGRAM *
C**================================================================**
C*
/free
// If level break L1 on FLBATNO is on
if *inl1;
// Clear File AGP995C
G_CMDNAM = 'CLRPFM AGP995C';
G_CMDLEN = 14;
CALLP QCMDEXC(G_CMDNAM : G_CMDLEN);
// Call AG995C
CALLP AG995C();
// Clear File AGP995D
G_CMDNAM = 'CLRPFM AGP995D';
G_CMDLEN = 14;
CALLP QCMDEXC(G_CMDNAM : G_CMDLEN);
// Call AG995C
CALLP AG995D();
endif;
// init vars at detail level break
if *inl2;
G_First = *off;
G_Sql = 'Update ' + %trim(FLFILE) + ' set' ;
endif;
// build sql
if G_First = *on;
G_Sql = %trim(G_Sql) + ',';
endif;
// Process character fields
if FLFLDT = 'C';
if FLSENC <> ' ' ;
G_Sql = %trim(G_Sql) + ' ' + %trim(FLFLD) +
' = fnScrmble(' + %trim(FLFLD) + ', ' +
%trim(FLSENC) + ')';
else;
G_Sql = %trim(G_Sql) + ' ' + %trim(FLFLD) +
' = fnScrmble(' + %trim(FLFLD) + ', 0)';
endif;
endif;
// Process numeric fields
if FLFLDT = 'N';
if FLSENC <> ' ';
G_Sql = %trim(G_Sql) + ' ' + %trim(FLFLD) +
' = fnScrmbleN(' + %trim(FLFLD) + ', ' +
%trim(FLSENC) + ')';
else;
G_Sql = %trim(G_Sql) + ' ' + %trim(FLFLD) +
' = fnScrmbleN(' + %trim(FLFLD) + ', 0)';
endif;
endif;
G_First = *on;
/end-free
C*
C*L1 EXSR SRExcUpd
CL2 EXSR SRExcUpd
CLR EXSR SRLastRec
C**************************************************************************
C* SrExcUpd - Execute Update SQL
C**************************************************************************
C SrExcUpd BEGSR
C*
C/Exec SQL
C+ Prepare DynUpdStm From :G_Sql
C/End-Exec
C/Exec SQL
C+ Execute DynUpdStm
C/End-Exec
C*
C ENDSR
C**************************************************************************
C* *INZSR - Initialization
C**************************************************************************
C *INZSR BEGSR
C*
C/Exec SQL
C+ create function fnScrmble(char(100), decimal(10,0))
C+ returns char(100)
C+ language rpgle
C+ external name AG995A
C+ deterministic
C+ no sql
C+ no external action
C+ parameter style SQL
C+ allow parallel
C/End-Exec
C*
C/Exec SQL
C+ create function fnScrmbleN(decimal(15,5), decimal(10,0))
C+ returns decimal(15,5)
C+ language rpgle
C+ external name AG995B
C+ deterministic
C+ no sql
C+ no external action
C+ parameter style SQL
C+ allow parallel
C/End-Exec
C*
C ENDSR
C**************************************************************************
C* SRLastRec - At Last Record
C**************************************************************************
C SRLastRec BEGSR
C/Exec SQL
C+ drop function fnScrmble
C/End-Exec
C*
C/Exec SQL
C+ drop function fnscrmbleN
C/End-Exec
C ENDSR
* * * * E N D O F S O U R C E * * * *
