//=================================================================================== // Trigger program for FILEA //=================================================================================== // MIT License // Copyright (c) 2016 TEMBO Technology Labs (Pty) Ltd. // Author: Tommy Atkins - Chief Development Officer // // Permission is hereby granted, free of charge, to any person obtaining a copy of this // software and associated documentation files (the "Software"), to deal in the Software // without restriction, including without limitation the rights to use, copy, modify, // merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit // persons to whom the Software is furnished to do so, subject to the following conditions: // // The above copyright notice and this permission notice shall be included in all copies // or substantial portions of the Software. // ================================================================================== // THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, // INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR // PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE // FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR // OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER // DEALINGS IN THE SOFTWARE. // ================================================================================== // This source code is written in fully free form and is compatible with version // 7.2 of the operating system (and upwards) as well as version 9.3 (and upwards) of RDi. //=================================================================================== ctl-opt dftactgrp(*no) actgrp(*caller) usrprf(*owner) aut(*use); ctl-opt bnddir('AMWSRV') option(*nodebugio:*srcstmt) debug; //=============================================================== dcl-pr FILEA_B0 extpgm; ParmList likeds(Parm) options(*varsize); ParmLen int(10) const; end-pr; //=============================================================== dcl-pi FILEA_B0; P likeds(Parm) options(*varsize); PL int(10) const; end-pi; //=============================================================== dcl-s ParmPointer pointer; //=============================================================== // Standardized Trigger Program Parameter List dcl-ds Parm template qualified; PFName char(10) Pos(1); LibName char(10) Pos(11); MbrName char(10) Pos(21); Event char(1) Pos(31); Time char(1) Pos(32); CmtLock char(1) Pos(33); Resvd1 char(3) Pos(34); CCSID int(10) Pos(37); RRN int(10) Pos(41); *n char(4) Pos(45); OldOS int(10) Pos(49); OldLen int(10) Pos(53); OldNMOS int(10) Pos(57); OldNMLen int(10) Pos(61); NewOS int(10) Pos(65); NewLen int(10) Pos(69); NewNMOS int(10) Pos(73); NewNMLen int(10) Pos(77); Resvd3 char(16) Pos(81); end-ds; //=============================================================== dcl-s OrigPtr pointer; dcl-ds O extname('FILEA') based(OrigPtr) qualified; end-ds; dcl-s NewPtr pointer; dcl-ds N extname('FILEA') based(NewPtr) qualified; end-ds; //=============================================================== // Move *DIAG and Re-Send *ESCAPE Messages dcl-pr ERR03; MT char(1) const options(*nopass); end-pr; // Move *DIAG and *ESCAPE Messages as *DIAG dcl-pr ERR05; MT char(1) const options(*nopass); end-pr; // Send *DIAG Message dcl-pr ERR10; MI char(7) const; MF char(10) const options(*omit:*nopass); MD char(128) const options(*omit:*nopass); MT char(1) const options(*nopass); end-pr; // Send *ESCAPE Message dcl-pr ERR11; MI char(7) const; MF char(10) const options(*omit:*nopass); MD char(128) const options(*omit:*nopass); MT char(1) const options(*nopass); end-pr; //=============================================================== dcl-pr CheckLegacy ind extproc('UTLSRV@001A'); Program char(10); end-pr; //============================================================== dcl-s ERRLOGFP pointer inz(%addr(ERRLOGFR)); dcl-ds ERRLOGFR extname('ERRLOGF'); end-ds; //============================================================== // Write Log Record Service Procedure dcl-pr ERRLOGF$; ParmPointer pointer const; RecPointer pointer const; MsgData char(128) const; end-pr; //============================================================== dcl-s Legacy ind; dcl-s Error ind inz('0'); //============================================================== monitor; // Set Legacy Indicator & Program Name =========== Legacy = CheckLegacy(PROGNM); //================================================ reset Error; ParmPointer = %addr(P); //================================================ select; // Insert Event ============================== when P.Event='1'; // Set New Record Pointer NewPtr = ParmPointer + P.NewOS; DFT(); INS(); VAL(); // Delete Event ============================== when P.Event='2'; // Set Original Record Pointer OrigPtr = ParmPointer + P.OldOS; DLT(); // Update Event ============================== when P.Event='3'; // Set Original Record Pointer OrigPtr = ParmPointer + P.OldOS; // Set New Record Pointer NewPtr = ParmPointer + P.NewOS; DFT(); UPD(); VAL(); //============================================ endsl; //================================================ // Legacy Errors are Logged at Validation time, // and do not generate a final *ESCAPE Error //================================================ // At Least One Error Found for Non-Legacy //================================================ if Error and not Legacy; // Percolate *DIAG and *ESCAPE Messages ERR05(); // Send *ESCAPE Message ERR11('ERR0035':'ERRMSGF':'FILEA_B0'); endif; //================================================ // Unexpected Error Condition. on-error; if Legacy; // Set Specific Error Message Number ERRMSG = 'ERR0030'; // Log One Error Record for Legacy ERRLOGF$(ParmPointer:ERRLOGFP:'Unexpected'); else; // not Legacy // Percolate *DIAG and *ESCAPE Messages ERR05(); // *ESCAPE Message ERR11('ERR0030':'AOFMSGF':'FILEA_B0'); endif; endmon; //=================================================== return; //============================================================= // Set Defaults <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< //============================================================= dcl-proc DFT; //=================================================== monitor; //================================================ // This procedure is used to check for and provide any necessary // default values to fields/columns not correctly provided // by the application code. // EXAMPLE // JRNNME ======================================== if N.JRNNME = *blank; N.JRNNME = '*NONE'; endif; //================================================ on-error; ERR03(); endmon; //=================================================== end-proc; //============================================================= // Insert <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< //============================================================= dcl-proc INS; //=================================================== monitor; //================================================ // This procedure is provided to do specific validation, defaults // or any other requirements applicable to inserts only. //================================================ on-error; ERR03(); endmon; //=================================================== end-proc; //============================================================= // Delete <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< //============================================================= dcl-proc DLT; //=================================================== monitor; //================================================ // This procedure is provided to do specific validation, defaults // or any other requirements applicable to deletes only. //================================================ on-error; ERR03(); endmon; //=================================================== end-proc; //============================================================= // Update <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< //============================================================= dcl-proc UPD; //=================================================== monitor; //================================================ // This procedure is provided to do specific validation, defaults // or any other requirements applicable to updates only. //================================================ on-error; ERR03(); endmon; //=================================================== end-proc; //============================================================= // Validations <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< //============================================================= dcl-proc VAL; //=================================================== monitor; //================================================ // This procedure provides the validation rules for the columns // in the file. It is usually called from both the "Insert" and // "Update" events. //================================================ // IF NOT LEGACY // Each error encountered turns on the error indicator and // issues a *DIAG message to the caller via the error handler // service procedure (ERR10) //================================================ // IF LEGACY // Each error encountered logs an error message to the ERRLOGF file // and returns, but still indicates an error has occurred. //================================================ // EXAMPLES // FILETP ======================================== if %check('FEIVWJMO':N.FILETP) <> 0; Error = *on; if Legacy; // Error for "Legacy" Program // Set Specific Error Message Number // Log Error Record to ERRLOGF ERRMSG = 'ERR0014'; ERRLOGF$(ParmPointer:ERRLOGFP:'FILETP'); else; // Send *DIAG Message to DBMS ERR10('AOF0014':'AOFMSGF':'FILETP'); endif; endif; // NOMBRS ======================================== if N.NOMBRS < 0; Error = *on; if Legacy; ERRMSG = 'ERR0026'; ERRLOGF$(ParmPointer:ERRLOGFP:'FILETP'); else; ERR10('AOF0014':'AOFMSGF':'FILETP'); endif; endif; //================================================ on-error; ERR03(); endmon; //=================================================== end-proc; *===============================================================