Skip to content

Commit

Permalink
Merge pull request #31 from IBM/feature/new_emp
Browse files Browse the repository at this point in the history
Program to create new employee
  • Loading branch information
worksofliam authored Jan 23, 2024
2 parents cbccd82 + 9378b6e commit e506ead
Show file tree
Hide file tree
Showing 5 changed files with 249 additions and 1 deletion.
9 changes: 9 additions & 0 deletions .vscode/actions.json
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,15 @@
"RPGLE"
]
},
{
"name": "Create SQLRPGLE Program",
"command": "CRTSQLRPGI OBJ(&CURLIB/&NAME) SRCSTMF('&RELATIVEPATH') OPTION(*EVENTF) DBGVIEW(*SOURCE) CLOSQLCSR(*ENDMOD) CVTCCSID(*JOB) COMPILEOPT('TGTCCSID(*JOB)') RPGPPOPT(*LVL2)",
"deployFirst": true,
"environment": "ile",
"extensions": [
"SQLRPGLE"
]
},
{
"name": "Call program",
"command": "CALL &CURLIB/&NAME",
Expand Down
3 changes: 2 additions & 1 deletion makefile
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,8 @@ all: depts.pgm.sqlrpgle employees.pgm.sqlrpgle mypgm.pgm.rpgle

## Targets

depts.pgm.sqlrpgle: depts.dspf department.table
depts.pgm.sqlrpgle: depts.dspf department.table newemp.pgm.sqlrpgle
newemp.pgm.sqlrpgle: nemp.dspf
employees.pgm.sqlrpgle: emps.dspf employee.table
mypgm.pgm.rpgle: constants.rpgleinc

Expand Down
50 changes: 50 additions & 0 deletions qddssrc/nemp.dspf
Original file line number Diff line number Diff line change
@@ -0,0 +1,50 @@
A INDARA
A CA12(12)
A R DETAIL
A 6 10'ID'
A DSPATR(HI)
A DSPATR(UL)
A XID 6A O 6 14

A 7 7'First'
A DSPATR(UL)
A COLOR(WHT)
A XFIRST 12A B 7 14

A 8 5'Initial'
A DSPATR(UL)
A COLOR(WHT)
A XINIT 1A B 8 14

A 9 8'Last'
A DSPATR(UL)
A COLOR(WHT)
A XLAST 15A B 9 14

A 10 2'Department'
A DSPATR(UL)
A COLOR(WHT)
A XDEPT 3A B 10 14

A 11 9'Job'
A DSPATR(UL)
A COLOR(WHT)
A XJOB 8A B 11 14

A 12 6'Salary'
A DSPATR(UL)
A COLOR(WHT)
A XSAL 10A B 12 14

A 13 8'Phone'
A DSPATR(UL)
A COLOR(WHT)
A XTEL 4A B 13 14

A XERR 50A O 15 14COLOR(RED)
A R HEADER_FMT
A OVERLAY
A 3 06'F12=Back Enter=Create'
A COLOR(BLU)
A 2 33'New Employee'
A DSPATR(UL)
2 changes: 2 additions & 0 deletions qrpglesrc/depts.pgm.sqlrpgle
Original file line number Diff line number Diff line change
Expand Up @@ -141,6 +141,8 @@
When (SelVal = '5');
//DSPLY @XID;
Employees(XID);
When (SelVal = '8');
// Insert new employee screen
Endsl;

If (XSEL <> *Blank);
Expand Down
186 changes: 186 additions & 0 deletions qrpglesrc/newemp.pgm.sqlrpgle
Original file line number Diff line number Diff line change
@@ -0,0 +1,186 @@
**free

ctl-opt dftactgrp(*no);

// TODO: need a way to let the parent program pass in a department id

// ---------------------------------------------------------------*

/INCLUDE 'qrpgleref/constants.rpgleinc'

// ---------------------------------------------------------------*

Dcl-F nemp WORKSTN IndDS(WkStnInd) InfDS(fileinfo);

Dcl-S Exit Ind Inz(*Off);

Dcl-DS WkStnInd;
ProcessSCF Ind Pos(21);
ReprintScf Ind Pos(22);
Error Ind Pos(25);
PageDown Ind Pos(30);
PageUp Ind Pos(31);
SflEnd Ind Pos(40);
SflBegin Ind Pos(41);
NoRecord Ind Pos(60);
SflDspCtl Ind Pos(85);
SflClr Ind Pos(75);
SflDsp Ind Pos(95);
End-DS;

Dcl-DS FILEINFO;
FUNKEY Char(1) Pos(369);
End-DS;

Dcl-Ds Employee ExtName('EMPLOYEE') Alias Qualified;
End-Ds;

Dcl-s autoEmpId char(6);
dcl-s currentError like(XERR);

autoEmpId = getNewEmpId();

if (autoEmpId = '');
XERR = 'Unable to automatically generate an new ID.';
else;
XID = autoEmpId;
Endif;

Dow (NOT Exit);

Write HEADER_FMT;
Exfmt DETAIL;

currentError = GetError();

if (FUNKEY = F12);
Exit = *On;

elseif (currentError = '');
// TODO: handle insert and exit

if (HandleInsert());
Exit = *on;
else;
XERR = 'Unable to create employee.';
endif;

else;
XERR = currentError;
endif;

Enddo;

return;

Dcl-Proc HandleInsert;
Dcl-Pi *N ind End-Pi;

Dcl-ds newEmp LikeDS(Employee);

newEmp.EMPNO = XID;
newEmp.FIRSTNME = XFIRST;
newEmp.MIDINIT = XINIT;
newEmp.LASTNAME = XLAST;
newEmp.WORKDEPT = XDEPT;
newEmp.JOB = XJOB;
newEmp.HIREDATE = %Date;
newEmp.PHONENO = XTEL;

// We don't actually care about these fields.
newEmp.BIRTHDATE = %Date;
newEmp.EDLEVEL = 0;
newEmp.BONUS = 0;
newEmp.COMM = 0;

// We can assume it is safe here as we should
// have already validated it is a number.
newEmp.SALARY = %dec(XSAL: 9: 2);

EXEC SQL
insert into employee
values (:newEmp)
with nc;

return (sqlstate = '00000');
End-Proc;

Dcl-Proc GetError;
Dcl-Pi *N Like(XERR) End-Pi;
dcl-s salaryNumber like(Employee.SALARY);
dcl-s phoneNumber int(5);

if (XFIRST = '');
return 'First name cannot be blank';
endif;

if (XINIT = '');
return 'Middle initial cannot be blank';
endif;

if (XLAST = '');
return 'Last name cannot be blank';
endif;

if (XDEPT = '');
return 'Department cannot be blank';
endif;

if (XJOB = '');
return 'Phone number cannot be blank';
endif;

if (XSAL = '');
return 'Salary cannot be blank';
else;
// Validate it is a number
monitor;
salaryNumber = %dec(XSAL: 9: 2);
on-error;
return 'Salary must be a number';
endmon;
endif;

if (XTEL = '');
return 'Phone cannot be blank';
else;
// Validate it is a number
monitor;
phoneNumber = %int(XTEL);
on-error;
return 'Phone must be a number';
endmon;
endif;

return '';
End-Proc;

///
// This is needed because empid is not
// auto incremement or auto generating.
// Returns blank if error.
///
Dcl-Proc getNewEmpId;
Dcl-Pi *N Char(6) End-Pi;

dcl-s result char(6);
dcl-s asChar varchar(6);
dcl-s startI int(5);
Dcl-s highestEmpId int(10);

result = '000000';

EXEC SQL
select max(int(empno))
into :highestEmpId
from employee;

if (sqlstate = '00000');
asChar = %Char(highestEmpId+100);
startI = 7 - %len(asChar);
%subst(result : startI) = asChar;
Return result;
endif;

return '';
End-Proc;

0 comments on commit e506ead

Please sign in to comment.