diff --git a/.vscode/actions.json b/.vscode/actions.json index d91b84a..82e8c22 100644 --- a/.vscode/actions.json +++ b/.vscode/actions.json @@ -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", diff --git a/makefile b/makefile index 6d6ce1b..7954024 100644 --- a/makefile +++ b/makefile @@ -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 diff --git a/qddssrc/nemp.dspf b/qddssrc/nemp.dspf new file mode 100644 index 0000000..6869516 --- /dev/null +++ b/qddssrc/nemp.dspf @@ -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) \ No newline at end of file diff --git a/qrpglesrc/depts.pgm.sqlrpgle b/qrpglesrc/depts.pgm.sqlrpgle index 985925a..9fb01d0 100755 --- a/qrpglesrc/depts.pgm.sqlrpgle +++ b/qrpglesrc/depts.pgm.sqlrpgle @@ -141,6 +141,8 @@ When (SelVal = '5'); //DSPLY @XID; Employees(XID); + When (SelVal = '8'); + // Insert new employee screen Endsl; If (XSEL <> *Blank); diff --git a/qrpglesrc/newemp.pgm.sqlrpgle b/qrpglesrc/newemp.pgm.sqlrpgle new file mode 100644 index 0000000..49d681d --- /dev/null +++ b/qrpglesrc/newemp.pgm.sqlrpgle @@ -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; \ No newline at end of file