*=================================================================================== * 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 partially free form and is compatible with version * 5.4 of the operating system and upwards as well as version 8.5.1 of RDi. *=================================================================================== h dftactgrp(*no) actgrp(*caller) usrprf(*owner) aut(*use) h bnddir('AMWSRV') option(*nodebugio) debug *=============================================================== d FILEA_B1 pr extpgm('FILEA_B1') d P likeds(P1) options(*varsize) d PL 10i 0 const *=============================================================== d FILEA_B1 pi d P likeds(P1) options(*varsize) d PL 10i 0 const *=============================================================== d PP s * *=============================================================== * Standardized Trigger Program Parameter List d P1 ds template qualified d PFName 1 10 d LibName 11 20 d MbrName 21 30 d Event 31 31 d Time 32 32 d CmtLock 33 33 d Resvd1 34 36 d CCSID 37 40b 0 d RRN 41 44b 0 d Resvd2 45 48 d OldOS 49 52b 0 d OldLen 53 56b 0 d OldNMOS 57 60b 0 d OldNMLen 61 64b 0 d NewOS 65 68b 0 d NewLen 69 72b 0 d NewNMOS 73 76b 0 d NewNMLen 77 80b 0 d Resvd3 81 96 *=============================================================== d OP s * d O e ds extname(FILEA) based(OP) qualified d NP s * d N e ds extname(FILEA) based(NP) qualified *=============================================================== * Move *DIAG and Re-Send *ESCAPE Messages d ERR03 pr d MT 1 const options(*nopass) * Move *DIAG and *ESCAPE Messages as *DIAG d ERR05 pr d MT 1 const options(*nopass) * Send *DIAG Message d ERR10 pr d MI 7 const d MF 10 const options(*omit:*nopass) d MD 128 const options(*omit:*nopass) d MT 1 const options(*nopass) * Send *ESCAPE Message d ERR11 pr d MI 7 const d MF 10 const options(*omit:*nopass) d MD 128 const options(*omit:*nopass) d MT 1 const options(*nopass) *=============================================================== d CheckLegacy pr n extproc('UTLSRV@001A') d Program 10 *=============================================================== d ERRLOGFP s * inz(%ADDR(ERRLOGFR)) d ERRLOGFR e ds extname('ERRLOGF') *=============================================================== * Write Log Record Service Procedure d ERRLOGF$ pr d ParmPointer * const d RecPointer * const d MsgData 128 const *=============================================================== d DFT pr d VAL pr d INS pr d DLT pr d UPD pr *=============================================================== d Legacy s n d Error s n inz('0') *=============================================================== /free monitor; //================================================ Legacy = CheckLegacy(PROGNM); // Set Legacy Indicator & Program Name //================================================ reset Error; PP = %addr(P); //================================================ select; //============================================ when P.Event='1'; // Insert Event NP = PP + P.NewOS; // Set New Record Pointer DFT(); INS(); VAL(); //============================================ when P.Event='2'; // Delete Event OP = PP + P.OldOS; // Set Original Record Pointer DLT(); //============================================ when P.Event='3'; // Update Event OP = PP + P.OldOS; // Set Original Record Pointer NP = PP + P.NewOS; // Set New Record Pointer DFT(); UPD(); VAL(); //============================================ endsl; //================================================ if Error and not Legacy; // At Least One Error Found for Non-Legacy ERR05(); // Percolate *DIAG and *ESCAPE Messages ERR11('ERR0035':'ERRMSGF':'FILEA_B0'); // Send *ESCAPE Message endif; // Legacy Errors are Logged at Validation, // and do not generate a final *ESCAPE Error //================================================ on-error; // Unexpected Error Condition. if Legacy; ERRMSG = 'ERR0030'; // Set Specific Error Message Number ERRLOGF$(PP:ERRLOGFP:'Unexpected'); // Log One Error Record for Legacy else; // not Legacy ERR05(); // Percolate *DIAG and *ESCAPE Messages ERR11('ERR0030':'AOFMSGF':'FILEA_B0'); // *ESCAPE Message endif; endmon; //=================================================== return; //=================================================== /end-free *=============================================================== * Set Defaults <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p DFT b *===================================================== /free //=================================================== 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-free *===================================================== p DFT e *=============================================================== * Insert <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p INS b *===================================================== /free //=================================================== monitor; //================================================ // This procedure is provided to do specific validation, defaults // or any other requirements applicable to inserts only. //================================================ on-error; ERR03(); endmon; //=================================================== /end-free *===================================================== p INS e *=============================================================== * Delete <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p DLT b *===================================================== /free //=================================================== monitor; //================================================ // This procedure is provided to do specific validation, defaults // or any other requirements applicable to deletes only. //================================================ on-error; ERR03(); endmon; //=================================================== /end-free *===================================================== p DLT e *=============================================================== * Update <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p UPD b *===================================================== /free //=================================================== monitor; //================================================ // This procedure is provided to do specific validation, defaults // or any other requirements applicable to updates only. //================================================ on-error; ERR03(); endmon; //=================================================== /end-free *===================================================== p UPD e *=============================================================== * Validations <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p VAL b *===================================================== /free //=================================================== monitor; //================================================ // This procedure provides the validation rules for the columns // in the file. It is usually called from both the "Insert" and // "Update" events. // Each error encountered turns on an error indicator and issues // a *DIAG message to the caller via the error handler service // procedure (ERR10) // // EXAMPLES // FILETP ======================================== if %check('FEIVWJMO':N.FILETP) <> 0; Error = *on; if Legacy; // Log Error Record for Legacy ERRMSG = 'ERR0014'; // Set Specific Error Message Number ERRLOGF$(PP:ERRLOGFP:'FILETP'); // Log Error Record for Legacy else; ERR10('AOF0014':'AOFMSGF':'FILETP'); // Send *DIAG Message to DBMS endif; endif; // NOMBRS ======================================== if N.NOMBRS < 0; Error = *on; if Legacy; // Log Error Record for Legacy ERRMSG = 'ERR0026'; // Set Specific Error Message Number ERRLOGF$(PP:ERRLOGFP:'FILETP'); // Log Error Record for Legacy else; ERR10('AOF0014':'AOFMSGF':'FILETP'); endif; endif; //================================================ on-error; ERR03(); endmon; //=================================================== /end-free p VAL e *===============================================================