Unconfigured Ad Widget

Collapse

Announcement

Collapse
No announcement yet.

Trigger mystery?

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Guest's Avatar
    Guest replied
    Trigger mystery?

    Hi, I am having a problem with triggers. Question is I cannot see the New Buffer when trigger fires. I read your solution and comapre it with my program as well.but so far no sucesses. Can you please help ? Trigger fires Before Update operation. I am on V5R1M0. Here is the program and DDS. Thanks in advance. PROCESS OPTIONS. IDENTIFICATION DIVISION. PROGRAM-ID. UPDTRG. AUTHOR. ALEX JAYASUNDARA. DATE-WRITTEN. MAY 2004. DATE-COMPILED. COPY C82PROP OF QS36SRC. ************************************************** ************* * Update Trigger for ATMTRANS * * ~~~~~~~~~~~~~~~~~~~~~~~~ * ************************************************** ************* ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-AS400. OBJECT-COMPUTER. IBM-AS400. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT ACC-FILE ASSIGN TO DATABASE-ACCTS ORGANIZATION IS INDEXED ACCESS MODE IS RANDOM RECORD KEY IS ACCTN STATUS IS STATUS-ERR1. SPAS400 * SELECT ATM-FILE ASSIGN TO DATABASE-ATMS ORGANIZATION IS INDEXED ACCESS MODE IS RANDOM RECORD KEY IS ATMN STATUS IS STATUS-ERR2. SPAS400 * DATA DIVISION. FILE SECTION. * FD ACC-FILE LABEL RECORD IS STANDARD. 01 ACC-REC. COPY DDS-ALL-FORMATS OF ACCTS. * FD ATM-FILE LABEL RECORD IS STANDARD. 01 ATM-REC. COPY DDSR-ALL-FORMATS OF ATMS. * WORKING-STORAGE SECTION. 01 STATUS-ERR1 PIC X(2) VALUE SPACES. 01 STATUS-ERR2 PIC X(2) VALUE SPACES. * 01 INPUT-RECORD. COPY DDSR-ALL-FORMATS OF ATMTRANS. * COPY DDS-TRANS OF ATMTRANS. 01 OFFSET-NEW-REC PIC 9(8) BINARY. 01 OFFSET-OLD-REC PIC 9(8) BINARY. 01 NUMBERS-1. 05 NUM-1 PIC 9(10) VALUE 0. 05 NUM-2 PIC 9(10) VALUE 0. 05 NUM-3 PIC 9(10) VALUE 0. 01 FEEDBACK-STUFF PIC X(500) VALUE SPACES. ************************************************** ************* * Message for signalling any Trigger Error * ************************************************** ************* 01 SNDPGMMSG-PARMS. 05 SND-MSG-ID PIC X(7) VALUE "TRG9999". 05 SND-MSG-FILE PIC X(20) VALUE "TRGMSGF TRIGTEST ". 05 SND-MSG-DATA PIC X(25) VALUE "Trigger Error ". 05 SND-MSG-LEN PIC 9(8) BINARY VALUE 25. 05 SND-MSG-TYPE PIC X(10) VALUE "*ESCAPE ". 05 SND-PGM-QUEUE PIC X(10) VALUE "* ". 05 SND-PGM-STACK-CNT PIC 9(8) BINARY VALUE 1. 05 SND-MSG-KEY PIC X(4) VALUE " ". 05 SND-ERROR-CODE. 15 PROVIDED PIC 9(8) BINARY VALUE 66. 15 AVAILABLE PIC 9(8) BINARY VALUE 0. 15 RTN-MSG-ID PIC X(7) VALUE " ". 15 FILLER PIC X(1) VALUE " ". 15 RTN-DATA PIC X(50) VALUE " ". * LINKAGE SECTION. 01 PARM-1-AREA. 05 FILE-NAME PIC X(10). 05 LIB-NAME PIC X(10). 05 MEM-NAME PIC X(10). 05 TRG-EVENT PIC X. 05 TRG-TIME PIC X. 05 CMT-LCK-LVL PIC X. 05 FILLER PIC X(3). 05 DATA-AREA-CCSID PIC 9(8) BINARY. 05 FILLER PIC X(8). 05 DATA-OFFSET. 15 OLD-REC-OFF PIC 9(8) BINARY. 15 OLD-REC-LEN PIC 9(8) BINARY. 15 OLD-REC-NULL-MAP PIC 9(8) BINARY. 15 OLD-REC-NULL-LEN PIC 9(8) BINARY. 15 NEW-REC-OFF PIC 9(8) BINARY. 15 NEW-REC-LEN PIC 9(8) BINARY. 15 NEW-REC-NULL-MAP PIC 9(8) BINARY. 15 NEW-REC-NULL-LEN PIC 9(8) BINARY. 15 FILLER PIC X(16). 05 RECORD-JUNK. 15 OLD-REC PIC X(18). 15 OLD-NULL-MAP PIC X(4). 15 NEW-REC PIC X(18). 15 NEW-NULL-MAP PIC X(4). 01 PARM-2-AREA. 05 TRGBUFL PIC X(2). * * PROCEDURE DIVISION USING PARM-1-AREA, PARM-2-AREA. MAIN-PROGRAM-SECTION. 0000-MAIN-PROGRAM. DISPLAY 'TRIGGER HAS STARTED'. DISPLAY 'TRIGGER EVENT ', TRG-EVENT. DISPLAY 'TRIGGER TIME ', TRG-TIME. DISPLAY 'COMMIT LEVEL ', CMT-LCK-LVL. DISPLAY 'OLD REC ', OLD-REC. DISPLAY 'NEW REC ', NEW-REC. OPEN I-O ATM-FILE. DISPLAY 'ATM FILE OPENED ', STATUS-ERR2. OPEN I-O ACC-FILE. DISPLAY 'ACC FILE OPENED ', STATUS-ERR1. MOVE 0 TO BAL. ************************************************** ************* * Setup the offset pointer. * * Has to add 1 because it starts from 0. * ************************************************** ************* ADD 1 TO NEW-REC-OFF GIVING OFFSET-NEW-REC. ADD 1 TO OLD-REC-OFF GIVING OFFSET-OLD-REC. ************************************************** ************* * Copy new record to INPUT-RECORD. * ************************************************** ************* UNSTRING PARM-1-AREA INTO INPUT-RECORD WITH POINTER OFFSET-NEW-REC. DISPLAY 'UNSTRING COMPLETED'. ************************************************** ************* * Read ACCTS record * ************************************************** ************* DISPLAY 'ABOUT TO READ ACCT.'. MOVE ACCTID TO ACCTN. DISPLAY 'ACCTN =', ACCTN. READ ACC-FILE INVALID KEY PERFORM 9999-ABEND NOT INVALID KEY PERFORM 5000-ADJUST-ACCOUNT. DISPLAY 'ACCT WAS READ. '. ************************************************** ************* * Read ATMS Records * ************************************************** ************* DISPLAY 'ABOUT TO READ ATM '. MOVE ATMID TO ATMN. DISPLAY 'ATMID =', ATMN. READ ATM-FILE INVALID KEY PERFORM 9999-ABEND NOT INVALID KEY PERFORM 6000-ADJUST-ATM-BAL. DISPLAY 'ATM WAS READ. '. 5000-ADJUST-ACCOUNT. IF TCODE = "W" THEN IF (BAL < AMOUNT) THEN PERFORM 9500-NOT-ENOUGH-IN-ACCT ELSE SUBTRACT AMOUNT FROM BAL REWRITE ACC-REC INVALID KEY PERFORM 9999-ABEND ELSE IF TCODE = "D" THEN ADD AMOUNT TO BAL REWRITE ACC-REC INVALID KEY PERFORM 9999-ABEND ELSE DISPLAY "TRANSACTION CODE ERROR, CODE IS: ", TCODE. 6000-ADJUST-ATM-BAL. IF TCODE = "W" THEN IF (ATMAMT < AMOUNT) THEN PERFORM 9600-NOT-ENOUGH-IN-ATM ELSE SUBTRACT AMOUNT FROM ATMAMT REWRITE ATM-REC INVALID KEY PERFORM 9999-ABEND ELSE IF TCODE = "D" THEN ADD AMOUNT TO ATMAMT REWRITE ATM-REC INVALID KEY PERFORM 9999-ABEND ELSE DISPLAY "TRANSACTION CODE ERROR, CODE IS: ", TCODE. 9500-NOT-ENOUGH-IN-ACCT. DISPLAY "NOT ENOUGH MONEY IN ACCOUNT". CLOSE ATM-FILE. CLOSE ACC-FILE. PERFORM 9999-SIGNAL-ESCAPE. 9600-NOT-ENOUGH-IN-ATM. DISPLAY "NOT ENOUGH MONEY IN ATM". CLOSE ATM-FILE. CLOSE ACC-FILE. PERFORM 9999-SIGNAL-ESCAPE. 9999-ABEND. DISPLAY "INVALID KEY :", ATMN, "ATM STAT : ", STATUS-ERR1 "ACCT STAT : ", STATUS-ERR2. CLOSE ATM-FILE. CLOSE ACC-FILE. PERFORM 9999-SIGNAL-ESCAPE. 9999-SIGNAL-ESCAPE. CALL "QMHSNDPM" USING SND-MSG-ID, SND-MSG-FILE, SND-MSG-DATA, SND-MSG-LEN, SND-MSG-TYPE, SND-PGM-QUEUE, SND-PGM-STACK-CNT, SND-MSG-KEY, SND-ERROR-CODE. DDS * ATM Transactions (ATMTRANS) UNIQUE R ATMTRANR ATMID 5A COLHDG('ATM ID') ACCTID 5A COLHDG('Account #') TCODE 1A COLHDG('Txn Code') AMOUNT 7S 2 COLHDG('Txn Amount') K ATMID K ACCTID * ATM Record(ATMS) UNIQUE R ATMREC ATMN 5A COLHDG('ATM Number') LOCAT 2A COLHDG('ATM Location') ATMAMT 7S 2 COLHDG('Cash in ATM') K ATMN * Accounting Records(ACCTS) UNIQUE R ATMREC ACCTN 5A COLHDG('Account #') BAL 7S 2 COLHDG('Acct Balance') ACCTSTAT 1A COLHDG('Acct Status') K ACCTN

    Leave a comment:


  • Guest's Avatar
    Guest replied
    Trigger mystery?

    Thanks to you Jim and Barbara! I've found out that I messed-up the length of the NULL MAP.

    Leave a comment:


  • Guest's Avatar
    Guest replied
    Trigger mystery?

    Barbara, you are right we should not hard code the old and new record locations into our COBOL programs. Most of our trigger programs do this. The programmers who setup the triggers were not familiar with pointers and how to use the set command to add an offset to a pointer.

    Leave a comment:


  • Guest's Avatar
    Guest replied
    Trigger mystery?

    Do you have the locations of the old and new buffers hardcoded in your program? You should be using the offsets in the trigger buffer header to locate them. href="http://publib.boulder.ibm.com:80/cgi-bin/bookmgr/BOOKS/qb3auc02/3.8.5.2">C OBOL trigger program example

    Leave a comment:


  • Guest's Avatar
    Guest replied
    Trigger mystery?

    It looks to me that you have the null map as part of the record. Each record is followed by a null map. The null map has a flag for each field to allow you to test if a field in the record is null. A null field will contain blanks in the record area so you get this null map. In our cobol trigger programs we define something like this: LINKAGE SECTION. COPY TRGBUFFER. 03 OLD-RECORD. COPY DDS-ALL-FORMATS OF MSO1 ALIAS. 03 OLD-NULL-MAP PIC X(134). 03 NEW-RECORD. COPY DDS-ALL-FORMATS OF MSO1 ALIAS. 03 NEW-NULL-MAP PIC X(134). 01 TRIGGER-BUFFER-LENGTH PIC 9(8) USAGE IS BINARY. PROCEDURE DIVISION USING TRIGGER-BUFFER TRIGGER-BUFFER-LENGTH. The record in this file contains 134 fields. As a result, there are 134 null flags after each record.

    Leave a comment:


  • Guest's Avatar
    Guest started a topic Trigger mystery?

    Trigger mystery?

    Hi! Can anyone please help me with this? Trigger specs: Trigger time . . . . . . . . . . . . . : *AFTER Trigger event . . . . . . . . . . . . . : *UPDATE Allow repeated change . . . . . . . . . : *NO Trigger condition . . . . . . . . . . . : *CHANGE Program Name . . . . . . . . . . . . . : PGM TRGPGM Library . . . . . . . . . . . . . . . : LIB MYLIB * Trigger program is written in COBOL. This trigger when activated writes the OLD and NEW snaphots of the changed record into an audit file. My problem is - The NEW value for a changed field in the record is blanked out. I've checked my program several times and I still don't have a clue what's causing it... Please help. For added reference I am attaching a text file with the picture of the OLD and NEW record right after the trigger program fires-off.... Thanks in advance.
Working...
X