This sample program is written in the REXX programming language.
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
1 /*********************************************************************/
2 /* A sample program which updates the salaries for those employees */
3 /* whose current commission total is greater than or equal to the */
4 /* value of COMMISSION. The salaries of those who qualify are */
5 /* increased by the value of PERCENTAGE, retroactive to RAISE_DATE. */
6 /* A report is generated and dumped to the display which shows the */
7 /* projects which these employees have contributed to, ordered by */
8 /* project number and employee ID. A second report shows each */
9 /* project having an end date occurring after RAISE DATE (i.e. is */
10 /* potentially affected by the retroactive raises) with its total */
11 /* salary expenses and a count of employees who contributed to the */
12 /* project. */
13 /*********************************************************************/
14
15
16 /* Initialize RC variable */
17 RC = 0
18
19 /* Initialize HV for program usage */
20 COMMISSION = 2000.00;
21 PERCENTAGE = 1.04;
22 RAISE_DATE = '1982-06-01';
23 WORK_DAYS = 253;
24
25 /* Create the output file to dump the 2 reports. Perform an OVRDBF */
26 /* to allow us to use the SAY REXX command to write to the output */
27 /* file. */
28 ADDRESS '*COMMAND',
29 'DLTF FILE(CORPDATA/REPORTFILE)'
30 ADDRESS '*COMMAND',
31 'CRTPF FILE(CORPDATA/REPORTFILE) RCDLEN(80)'
32 ADDRESS '*COMMAND',
33 'OVRDBF FILE(STDOUT) TOFILE(CORPDATA/REPORTFILE) MBR(REPORTFILE)'
34
35 /* Update the selected employee's salaries by the new percentage. */
36 /* If an error occurs during the update, ROLLBACK the changes. */
37 3SIGNAL ON ERROR
38 ERRLOC = 'UPDATE_ERROR'
39 UPDATE_STMT = 'UPDATE CORPDATA/EMPLOYEE ',
40 'SET SALARY = SALARY * ? ',
41 'WHERE COMM >= ? '
42 EXECSQL,
43 'PREPARE S1 FROM :UPDATE_STMT'
44 4EXECSQL,
45 'EXECUTE S1 USING :PERCENTAGE,',
46 ' :COMMISSION '
47 /* Commit changes */
48 5EXECSQL,
49 'COMMIT'
50 ERRLOC = 'REPORT_ERROR'
51
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 52 /* Report the updated statistics for each project supported by one */ 53 /* of the selected employees. */ 54 55 /* Write out the header for Report 1 */ 56 SAY ' ' 57 SAY ' ' 58 SAY ' ' 59 SAY ' REPORT OF PROJECTS AFFECTED BY EMPLOYEE RAISES' 60 SAY ' ' 61 SAY 'PROJECT EMPID EMPLOYEE NAME SALARY' 62 SAY '------- ----- ------------- ------' 63 SAY ' ' 64 65 SELECT_STMT = 'SELECT DISTINCT PROJNO, EMPPROJACT.EMPNO, ', 66 ' LASTNAME||'', ''||FIRSTNME, SALARY ', 67 'FROM CORPDATA/EMPPROJACT, CORPDATA/EMPLOYEE ', 68 'WHERE EMPPROJACT.EMPNO = EMPLOYEE.EMPNO AND ', 69 ' COMM >= ? ', 70 'ORDER BY PROJNO, EMPNO ' 71 EXECSQL, 72 'PREPARE S2 FROM :SELECT_STMT' 73 6EXECSQL, 74 'DECLARE C1 CURSOR FOR S2' 75 7EXECSQL, 76 'OPEN C1 USING :COMMISSION' 77 78 /* Handle the FETCH errors and warnings inline */ 79 SIGNAL OFF ERROR 80 81 /* Fetch all of the rows */ 82 DO UNTIL (SQLCODE <> 0) 83 9EXECSQL, 84 'FETCH C1 INTO :RPT1.PROJNO, :RPT1.EMPNO,', 85 ' :RPT1.NAME, :RPT1.SALARY ' 86 87 /* Process any errors that may have occurred. Continue so that */ 88 /* we close the cursor for any warnings. */ 89 IF SQLCODE < 0 THEN 90 SIGNAL ERROR 91 92 /* Stop the loop when we hit the EOF. Don't try to print out the */ 93 /* fetched values. */ 94 8IF SQLCODE = 100 THEN 95 LEAVE 96 97 /* Print out the fetched row */ 98 SAY RPT1.PROJNO ' ' RPT1.EMPNO ' ' RPT1.NAME ' ' RPT1.SALARY 99 END; 100 101 10EXECSQL, 102 'CLOSE C1' 103 ..+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 104 /* For all projects ending at a date later than 'raise_date' */ 105 /* (i.e. those projects potentially affected by the salary raises) */ 106 /* generate a report containing the project number, project name */ 107 /* the count of employees participating in the project and the */ 108 /* total salary cost of the project. */ 109
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 110 /* Write out the header for Report 2 */ 111 SAY ' ' 112 SAY ' ' 113 SAY ' ' 114 SAY ' ACCUMULATED STATISTICS BY PROJECT' 115 SAY ' ' 116 SAY 'PROJECT PROJECT NAME NUMBER OF TOTAL' 117 SAY 'NUMBER EMPLOYEES COST' 118 SAY '------- ------------ --------- -----' 119 SAY ' ' 120 121 122 /* Go to the common error handler */ 123 SIGNAL ON ERROR 124 125 SELECT_STMT = 'SELECT EMPPROJACT.PROJNO, PROJNAME, COUNT(*), ', 126 ' SUM( (DAYS(EMENDATE) - DAYS(EMSTDATE)) * EMPTIME * ', 127 ' DECIMAL(( SALARY / ? ),8,2) ) ', 128 'FROM CORPDATA/EMPPROJACT, CORPDATA/PROJECT, CORPDATA/EMPLOYEE', 129 'WHERE EMPPROJACT.PROJNO = PROJECT.PROJNO AND ', 130 ' EMPPROJACT.EMPNO = EMPLOYEE.EMPNO AND ', 131 ' PRENDATE > ? ', 132 'GROUP BY EMPPROJACT.PROJNO, PROJNAME ', 133 'ORDER BY 1 ' 134 EXECSQL, 135 'PREPARE S3 FROM :SELECT_STMT' 136 11EXECSQL, 137 'DECLARE C2 CURSOR FOR S3' 138 EXECSQL, 139 'OPEN C2 USING :WORK_DAYS, :RAISE_DATE' 140 141 /* Handle the FETCH errors and warnings inline */ 142 SIGNAL OFF ERROR 143 144 /* Fetch all of the rows */ 145 DO UNTIL (SQLCODE <> 0) 146 12EXECSQL, 147 'FETCH C2 INTO :RPT2.PROJNO, :RPT2.PROJNAME, ', 148 ' :RPT2.EMPCOUNT, :RPT2.TOTAL_COST ' 149 150 /* Process any errors that may have occurred. Continue so that */ 151 /* we close the cursor for any warnings. */ 152 IF SQLCODE < 0 THEN 153 SIGNAL ERROR 154 155 /* Stop the loop when we hit the EOF. Don't try to print out the */ 156 /* fetched values. */ 157 IF SQLCODE = 100 THEN 158 LEAVE 159 160 /* Print out the fetched row */ 161 SAY RPT2.PROJNO ' ' RPT2.PROJNAME ' ' , 162 RPT2.EMPCOUNT ' ' RPT2.TOTAL_COST 163 END; 164 165 EXECSQL, 166 'CLOSE C2' 167
168 /* Delete the OVRDBF so that we will continue writing to the output */ 169 /* display. */ 170 ADDRESS '*COMMAND', 171 'DLTOVR FILE(STDOUT)' 172 173 /* Leave procedure with a successful or warning RC */ 174 EXIT RC 175 176 177 /* Error occurred while updating the table or generating the */ 178 /* reports. If the error occurred on the UPDATE, rollback all of */ 179 /* the changes. If it occurred on the report generation, display the */ 180 /* REXX RC variable and the SQLCODE and exit the procedure. */ 181 ERROR: 182 183 13SIGNAL OFF ERROR 184 185 /* Determine the error location */ 186 SELECT 187 /* When the error occurred on the UPDATE statement */ 188 WHEN ERRLOC = 'UPDATE_ERROR' THEN 190 DO 191 SAY '*** ERROR Occurred while updating table.', 192 'SQLCODE = ' SQLCODE 193 14EXECSQL, 194 'ROLLBACK' 195 END 196 /* When the error occurred during the report generation */ 197 WHEN ERRLOC = 'REPORT_ERROR' THEN 198 SAY '*** ERROR Occurred while generating reports. ', 199 'SQLCODE = ' SQLCODE 200 OTHERWISE 201 SAY '*** Application procedure logic error occurred ' 202 END 203 204 /* Delete the OVRDBF so that we will continue writing to the */ 205 /* output display. */ 206 ADDRESS '*COMMAND', 207 'DLTOVR FILE(STDOUT)' 208 209 /* Return the error RC received from SQL. */ 210 EXIT RC 211 * * * * * E N D O F S O U R C E * * * * *