Hi Joel,
Here is an older example which I tried back in 2005. It was never used in
production, but it worked for me.
Regards
Roman
Functionality:
--------------
If a user inserts a record in the given table, then the trigger-program
creates SMS message and sends it to a given telephone number.
Add Trigger to the file:
------------------------
ADDPFTRG FILE(IBPDDB/EMPPAYPF)
TRGTIME(*BEFORE)
TRGEVENT(*INSERT)
PGM(IBPDPGM/RMTRIGGER)
Remove all triggers from PF:
----------------------------
RMVPFTRG FILE(IBPDDB/EMPPAYPF)
Compile the program:
--------------------
CRTBNDCBL PGM(IBPDPGM/RMTRIGGER)
SRCFILE(RM/RMTRIGGER) SRCMBR(RMTRIGGER)
OPTION(*SOURCE *APOST) DBGVIEW(*SOURCE) ACTGRP(*CALLER)
Program Source:
---------------
PROCESS OPTIONS
IDENTIFICATION DIVISION.
**********************
PROGRAM-ID. RMTRIGGER.
***********************
* Version V1R0 *
***********************
AUTHOR. ROMANAPS.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 JOBA-AREA.
03 BYTES-RTN PIC 9(8) BINARY VALUE 0.
03 BYTES-AVAIL PIC 9(8) BINARY VALUE 0.
03 JOBNAME PIC X(10).
03 USERNAME PIC X(10).
03 JOBNUMBER PIC X(6).
03 INTERNALJID PIC X(16).
03 JOBSTATUS PIC X(10).
03 JOBTYPE PIC X(1).
*=================================================*
* These are the parameters for the API QUSRJOBI *
* to get job attributes - we need the USERID *
*=================================================*
01 RTV-JOBA.
03 RTV-JOB-VAR PIC X(61).
03 RTV-JOB-LEN PIC 9(8) BINARY VALUE 61.
03 RTV-JOB-FMT PIC X(8) VALUE 'JOBI0400'.
03 RTV-JOB-NAME PIC X(26) VALUE '*'.
03 RTV-JOB-ID PIC X(16) VALUE ' '.
*==================================================*
* This is the area to receive the record image *
*==================================================*
01 EMPPAYPF-RECORD-AREA.
* COPY DDS-ALL-FORMATS OF EMPPAYPF.
05 EMPPAYPF-RECORD PIC X(49).
05 EMPPAYPF REDEFINES EMPPAYPF-RECORD.
06 EMPLOYEENO PIC S9(9) COMP-3.
06 STORENO PIC S9(4) COMP-3.
06 FIRSTNAME PIC X(15).
06 MINITIAL PIC X(1).
06 LASTNAME PIC X(15).
06 DEPARTMENT PIC S9(3) COMP-3.
06 HOURLYRATE PIC S9(3)V9(2) COMP-3.
06 HRSWORKED PIC S9(2)V9(1) COMP-3.
06 SALES PIC S9(5) COMP-3.
01 CL-COMMAND-CALL.
* Variable contains CL-command
05 CL-CMD PIC X(500) VALUE SPACE.
* Variable contains length of CL-command
05 PACK-VAL PIC S9(10)V9(5) COMP-3 VALUE ZERO.
01 WORK-FIELDS.
05 THE-STRING PIC X(500).
05 STRING-LENGTH PIC 9(3) COMP.
05 SMS-MSG PIC X(256).
05 RRN-DSP PIC 9(8).
05 EMPLOYEENO-DSP PIC 9(9).
05 STORENO-DSP PIC 9(4).
LINKAGE SECTION.
*================================================*
* PARM 1 = Trigger Buffer *
* PARM 2 = Trigger Length *
*================================================*
01 PARM-1.
03 FILE-NAME PIC X(10).
03 LIB-NAME PIC X(10).
03 MEM-NAME PIC X(10).
03 TRG-EVENT PIC X.
03 TRG-TIME PIC X.
03 CMT-LCK-LVL PIC X.
03 FILLER PIC X(3).
03 DATA-AREA-CCSID PIC 9(8) BINARY.
03 RRN PIC 9(8) BINARY.
03 FILLER PIC X(4).
03 DATA-OFFSET.
05 OLD-REC-OFF PIC 9(8) BINARY.
05 OLD-REC-LEN PIC 9(8) BINARY.
05 OLD-REC-NULL-MAP PIC 9(8) BINARY.
05 OLD-REC-NULL-LEN PIC 9(8) BINARY.
05 NEW-REC-OFF PIC 9(8) BINARY.
05 NEW-REC-LEN PIC 9(8) BINARY.
05 NEW-REC-NULL-MAP PIC 9(8) BINARY.
05 NEW-REC-NULL-LEN PIC 9(8) BINARY.
05 FILLER PIC X(16).
03 RECORD-JUNK.
05 OLD-RECORD PIC X(49).
05 OLD-NULL-MAP PIC X(9).
05 FILLER PIC X(22)
05 NEW-RECORD PIC X(49).
05 NEW-NULL-MAP PIC X(9).
01 PARM-2.
03 TRGBUF-LEN PIC X(2).
**********************************************************
PROCEDURE DIVISION USING PARM-1, PARM-2.
MAIN-PROGRAM SECTION.
START-SECTION.
PERFORM RETRIEVE-JOB-ATTRIBUTES.
INITIALIZE EMPPAYPF-RECORD.
INITIALIZE EMPPAYPF.
MOVE NEW-RECORD TO EMPPAYPF-RECORD.
PERFORM SEND-SMS.
GOBACK.
RETRIEVE-JOB-ATTRIBUTES.
*=======================================================*
* Call API to get the job attributes - USERID *
* and move the receiving contents to working storage *
*=======================================================*
CALL 'QUSRJOBI' USING RTV-JOB-VAR,
RTV-JOB-LEN,
RTV-JOB-FMT,
2426813 RTV-JOB-NAME,
RTV-JOB-ID.
MOVE RTV-JOB-VAR TO JOBA-AREA.
COMPUTE-LENGTH-OF-THE-STRING.
* determine length of THE-STRING
IF THE-STRING NOT = SPACES THEN
PERFORM VARYING STRING-LENGTH FROM 500 BY -1
UNTIL THE-STRING(STRING-LENGTH:1) NOT = SPACE
CONTINUE
END-PERFORM
ELSE
MOVE 0 TO STRING-LENGTH
END-IF.
EXECUTE-COMMAND.
CALL 'QCMDEXC' USING CL-CMD PACK-VAL.
SEND-SMS.
MOVE RRN TO RRN-DSP.
MOVE EMPLOYEENO TO EMPLOYEENO-DSP.
STRING 'The user ' DELIMITED BY SIZE
USERNAME DELIMITED BY SPACE
' inserted in the table ' DELIMITED BY SIZE
LIB-NAME DELIMITED BY SPACE
'/' DELIMITED BY SPACE
FILE-NAME DELIMITED BY SPACE
' new record with RRN=' DELIMITED BY SIZE
RRN-DSP DELIMITED BY SPACE
' EMPLOYEENO=' DELIMITED BY SIZE
EMPLOYEENO-DSP DELIMITED BY SPACE
' FIRSTNAME=' DELIMITED BY SIZE
FIRSTNAME DELIMITED BY SPACE
' LASTNAME=' DELIMITED BY SIZE
LASTNAME DELIMITED BY SPACE
INTO SMS-MSG.
STRING "SENDSMS SMS('" DELIMITED BY SIZE
SMS-MSG DELIMITED BY SIZE
"') TELNRLIST('+421903123456')" DELIMITED BY SIZE
INTO CL-CMD.
MOVE CL-CMD TO THE-STRING.
PERFORM COMPUTE-LENGTH-OF-THE-STRING.
MOVE STRING-LENGTH TO PACK-VAL.
PERFORM EXECUTE-COMMAND.
From:
"Stone, Joel" <Joel.Stone@xxxxxxxxxx>
To:
"cobol400-l@xxxxxxxxxxxx" <cobol400-l@xxxxxxxxxxxx>
Date:
11.06.2012 22:47
Subject:
[COBOL400-L] cobol/400 trigger program
Sent by:
cobol400-l-bounces@xxxxxxxxxxxx
Do you have a COBOL trigger buffer layout that you can share?
Also an example of using a trigger pgm with copy books for the data file
mapping?
Thanks!
______________________________________________________________________
This outbound email has been scanned for all viruses by the MessageLabs
Skyscan service.
For more information please visit
http://www.symanteccloud.com
______________________________________________________________________
midrange.com
