|
midrange.com
Hello all, I have a trigger question that I hope someone can help me with. I
have an update trigger on a file and need to interagate the first 10 bytes
of the entry parm to see what file caused me to be in this trigger program.
The problem is the second update from the same application the entry parm1
passed to the trigger has all zeros in the first 10 bytes and appears the
next 4 bytes are over written as well. I,ve debugged the trigger pgm and
after my logic is completed and before returning I checked the entry parm1.
after the first update its fine at the time the Return is issued. In
actuality I really have a generic program that is on the trigger and the
entry parms are flowing through. This allows me to makes changes to the
actual trigger pgm w/o getting an exclusive lock on the file (we are 24/7 ),
it also allows me to call or not call the actual datbase updating program
based on the before and after image of the file that cause the firing of the
trigger. I got the same results with or without the front end program so I
omitted it for simplicity sake.
The following is the code. Can Anyone
Help??? TIA
Basically I am updating a Contract summary file based on some operation
against the contract file.
Fscpcontsm uf a e k disk
*
*
d Ptr s *
d Ptr_B4 s *
*
d Data e ds extname(scpcont) based(Ptr)
d Data_B4 e ds extname(scpcont) based(Ptr_B4)
d prefix(B4_)
*
dEntryParm1 ds
d @fileName 10
d @filelib 10
d @filembr 10
d Insupdflg 1
d filler2 17
dBfrRecOff 9B 0
dBfrRecLen 9B 0
dfiller3 8
dAftRecOff 9B 0
dAftRecLen 9B 0
d EntryArray 1 32767 dim(32767)
dEntryParm2 ds
*
d QtyZero 9 0
d QtyTot 9 0
*--------------------------------------------------------------------*
c *entry plist
c parm EntryParm1
c parm EntryParm2
*
c eval Ptr = %addr(EntryArray(AftRecOff + 1))
c eval Ptr_B4 = %addr(EntryArray(BfrRecOff + 1))
c If @filename = 'SCPCONT'
* - - - - - - - - - - - - -
* Select for trigger Events
* - - - - - - - - - - - - -
c Select
* - - - - - - - - - - - - - -
* This is an Insert Condition
* - - - - - - - - - - - - - -
c when Insupdflg = '1'
*- - - - - - - - - - - - - - - - - - - - - - - - - - -
* Retrieve Summary Record of Contract code of B4 Image
*- - - - - - - - - - - - - - - - - - - - - - - - - - -
c If Cnsta = 'A' or Cnsta = 'B' or Cnsta = 'P'
*
c Eval SMccode = B4_ccode
c SMccode Chain Contsmfm
*
c If cbamt = *zeros
c Eval Qtyzero = 1
c Else
c Eval Qtyzero = 0
c Endif
*
c If %found(Scpcontsm)
c Eval SMtotqty = SMtotqty + 1
c Eval SMtotqtz = SMtotqtz + Qtyzero
c Update Contsmfm
c Else
c Eval SMtotqty = 1
c Eval SMtotqtz = Qtyzero
c Write Contsmfm
c Endif
%found(Scpcontsm)
*
c Endif
Active Status
*- - - - - - - - - - - - - -
* This is a Delete Condition
*- - - - - - - - - - - - - -
c when Insupdflg = '2'
*
c If B4_Cnsta = 'A' or B4_Cnsta = 'B' or
c B4_Cnsta = 'P'
*
c Eval SMccode = B4_ccode
c SMccode Chain Contsmfm
*
c If B4_cbamt = *zeros
c Eval Qtyzero = 1
c Else
c Eval Qtyzero = 0
c Endif
*
c If %found(Scpcontsm)
c Eval SMtotqty = SMtotqty + 1
c Eval SMtotqtz = SMtotqtz + Qtyzero
c Update Contsmfm
c Endif
*
c Endif
Status = Active
* - - - - - - - - - - - - - -
* This is an Update Condition
* - - - - - - - - - - - - - -
c when Insupdflg = '3'
*
c If (B4_Cnsta = 'A' or B4_Cnsta = 'B' or
c B4_Cnsta = 'P') and
c (Cnsta = 'D' or Cnsta = 'C') or
c (B4_Cnsta = 'C' or B4_Cnsta = 'D') and
c (Cnsta = 'A' or Cnsta = 'P' or Cnsta='
*- - - - - - - - - - - - - - - - - - - - - - - - - - -
* Retrieve Summary Record of Contract code of B4 Image
*- - - - - - - - - - - - - - - - - - - - - - - - - - -
c Eval SMccode = B4_ccode
c SMccode Chain Contsmfm
*
c If B4_cbamt = *zeros
c Eval Qtyzero = 1
c Else
c Eval Qtyzero = 0
c Endif
*
c If Cnsta = 'D' or Cnsta = 'C'
c Eval Qtyzero = Qtyzero * -1
c Eval QtyTot = -1
c Else
c Eval QtyTot = 1
c Endif
*
c If %found(Scpcontsm)
c Eval SMtotqty = SMtotqty + Qtytot
c Eval SMtotqtz = SMtotqtz + Qtyzero
c Update Contsmfm
c Else
c Eval SMtotqty = Qtytot
c Eval SMtotqtz = Qtyzero
c Write Contsmfm
c Endif
%found(Scpcontsm)
*
c Endif
@filename = 'SCPCONT'
c Endif
Status changed
*
c endsl
Insupdflg select
* - - - - - - - - - - - - - - - - - - - - -
c Eomod Tag
c Eval *inlr = *on
c Return
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
