modern rpg
Ctl-Opt DftActGrp(*No) ActGrp(*Caller) Option(*SrcStmt: *NoDebugIO);
//=====================================================================/
// Program: Modern RPG /
//---------------------------------------------------------------------/
//=====================================================================/
//---------------------------------------------------------------------/
// File Declaration /
//---------------------------------------------------------------------/
Dcl-F TESTFILE Disk Usage(*Input);
Dcl-F FILER03 Disk Usage(*Input) Keyed Rename(FMTRCD:RECP);
Dcl-F SETUPFILE Disk Usage(*Input) Keyed;
Dcl-F FILEU01 Disk Usage(*update:*output) keyed;
//---------------------------------------------------------------------/
// Vaiable Declaration /
//---------------------------------------------------------------------/
Dcl-S Num char(11);
Dcl-S CountNbr int(10) inz(0);
Dcl-S Count char(10);
Dcl-S Num1 packed(11);
Dcl-S Type char(1);
Dcl-s Profile char(9) inz('MASTER ');
Dcl-s Type char(5) inz('OK ');
Dcl-s Num char(11) inz('NUMBER ');
Dcl-s Type1 char(4) inz('TYPE');
Dcl-s SysDate1 packed(7);
//---------------------------------------------------------------------/
// Data Structure Declaration /
//---------------------------------------------------------------------/
// Data Structure
Dcl-DS DS_Name;
C Char(9) Pos(1);
G Char(15) Pos(25);
A Char(15) Pos(10);
End-DS;
dcl-ds KeyDS likerec(FILEU01REC:*key);
// Data Structure
DCL-DS *N PSDS;
PgmName Char(10) Pos(1);
UserName Char(10) Pos(254);
SysDate Zoned(6) Pos(276);
SysTime Zoned(6) Pos(282);
END-DS;
//---------------------------------------------------------------------/
// Entry Parameters /
//---------------------------------------------------------------------/
Dcl-PI *N;
pMode Char(1);
pCount Char(10);
End-PI;
//---------------------------------------------------------------------/
// Main line /
//---------------------------------------------------------------------/
SysDate1 = %DEC(%DATE(SYSDATE:*MDY):*CYMD) ;
// Get Setup values
Exsr GetSetUpValues;
Setll *Start TESTFILE;
Read TESTFILE;
Dow Not %Eof(TESTFILE);
DS_Name = TESTFILE;
If pMode = 'A';
Exsr WriteFile;
ElseIf pMode = 'U' and DateValid ='Y';
Exsr UpdateFile;
EndIf;
Else;
Leave;
EndIf;
Read TESTFILE;
Enddo;
Exsr UpdateSetupFile;
Eval pCount = %char(CountN);
*Inlr = *On;
Return ;
//---------------------------------------------------------------------/
// Subroutine - Get values from Setup /
//---------------------------------------------------------------------/
Begsr GetSetUpValues;
// Get Setup Number
Chain ('A':Profile:Type1:Num1) SETUPFILE;
If %Found( SETUPFILE );
Num = FLDNBR;
else;
Num = '200000000';
Endif;
// Get Setup Date and Validate setup date for numeric
Chain ('A':Profile:Type1:Date) SETUPFILE;
If %found( SETUPFILE );
Monitor;
SetupDate = %Dec(%Subst(FLDDAT:1:7):7:0);
Test(DE) *CYMD SetupDate;
If %Error();
DateValid = 'N';
Else;
DateValid = 'Y';
EndIf;
On-Error;
EndMon;
EndIf;
Endsr;
//---------------------------------------------------------------------/
// Subroutine - Write File Record /
//---------------------------------------------------------------------/
Begsr WriteFile;
// Audit Fields
EVAL ADDUSR = UserName ;
EVAL ADDDAT = SYSDAT7;
EVAL ADDTIM = SysTime ;
EVAL ADDPGM = PgmName ;
// Change fields
EVAL CHGUSR = UserName ;
EVAL CHGDAT = SYSDAT7;
EVAL CHGTIM = SysTime ;
EVAL CHGPGM = PgmName ;
Exsr ChkRecord;
write FILEU01;
// Increment Number by 1 to update the next record
Num1 = %dec(Num:11:1) +1 ;
Num = %char(Num1);
CountN = CountN + 1;
Endsr;
//---------------------------------------------------------------------/
// Subroutine - Update File record with latest number /
//---------------------------------------------------------------------/
Begsr UpdateSetUpFIle;
Setll (Profile:Type:Num) FILEU01;
If %equal(FILEU01);
Read FILEU01;
DOW not %EOF( FILEU01 );
If (FLDSTS= 'A' and FLDNBR = 'NUMBER');
Eval FLDNBR = Num;
Eval CHGUSR = UserName ;
Eval CHGDAT = SYSDAT7;
Eval CHGTIM = SysTime ;
Eval CHGPGM = PgmName ;
update FILEU01 ;
ENDIF;
reade (Profile:Type:Num) FILEU01;
Enddo;
Endif;
Endsr;