× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



A couple of weeks ago I posted situation dealing w/database triggers.

 

I got a few responses, implemented some of the suggestions, I still have big
problems.

 

I am doing my 1st trigger program.
An interavtive program gets the record and displays it on the
screeen. When entry is made, the program then does the "update"
opcode. I am using monitor on this. This does fire my trigger. The
trigger program sends back an error message if the data was not
valid, and displays the error message on the screen. That part works
ok. I am using cpf9898 to pass my message data and using a subfile
in my interactive program to retrieve and display.

The problem is .... if you change the data to correct values or even
get a new record and try to update it ... you now get error messages
cpf5147 ... instruction sequence error and/or cpf5129 that the
trigger program sort of left something hanging. I do not know how to
handle this.

I honestly do not know which program is really the problem.

I would have included code, but it seems impossible to get it into a
readable fashion w/o typing the whole thing by hand.

Anyway, with what little you have to go on, any responses would be
appreciated.

 

Hopefully some of you can make heads or tails out of this.

 

Here goes.

 

Here is some code for the interactive program.

 

     //====================================================================/

        // Mainline                   |
/

 
//----------------------------+---------------------------------------/

        // Process screen until END requested
/

 
//====================================================================/

        Dou   *InLR;


            clear CSrec1;


            exfmt CSupdt01;


                  If *InKC or


                     *InKG;


                        *InLR = *On;


                        leave;


                  EndIf;


 


        exsr ClrMsgs;                                                 

                                                                            

       chain CSdlr# csxb00;             

              If %Found(csxb00);        

                  Mesg = Mesg_Updt;     

                  CsSmn#_B = CsSmn#;    

                  CsOsm#_B = CsOsm#;    

                                        

                  Dow  Mesg <> *Blanks; 

                                        

                  write #msgctl;        

                  exfmt CSupdt02;       

                                        

                  exsr  ClrMsgs;        

                                        

                  If *InKC or           

                     *InKG or           

                     *InKK;             

                                If *InKK;                      

                           unlock(e) CSxb00;           

                        Else;                          

                           eval *InLR = *On;           

                        EndIf;                         

                    leave;                             

                    EndIf;                             

                                                       

                 // Save new values                    

                    CsSmn#_A = CsSmn#;                 

                    CsOsm#_A = CsOsm#;                 

                                                       

                 // Do the update                      

                    Monitor;                           

                    update CSb00;                      

                    On-Error *File;        

                         ##Errcod = 1;             

                         Mesg = Mesg_See;          

                  EndMon;                          

                                                   

                  EndDo;                           

 // Customer Not found                             

                  Else;                            

                     Mesg = ' Invalid Customer ';  

                     leave;                        

                  EndIf;                           

                                                   

                  EndDo;                           

 

 

Here is some code for the trigger program.

 

     //====================================================================/

        // Mainline                   |
/

 
//----------------------------+---------------------------------------/

        // Process screen until END requested
/

 
//====================================================================/

        Dou   *InLR;


            clear CSrec1;


            exfmt CSupdt01;


                  If *InKC or


                     *InKG;


                        *InLR = *On;


                        leave;


                  EndIf;


 


        exsr ClrMsgs;                                                 

                                                                            

       chain CSdlr# csxb00;             

              If %Found(csxb00);        

                  Mesg = Mesg_Updt;     

                  CsSmn#_B = CsSmn#;    

                  CsOsm#_B = CsOsm#;    

                                        

                  Dow  Mesg <> *Blanks; 

                                        

                  write #msgctl;        

                  exfmt CSupdt02;       

                                        

                  exsr  ClrMsgs;        

                                        

                  If *InKC or           

                     *InKG or           

                     *InKK;             

                                If *InKK;                      

                           unlock(e) CSxb00;           

                        Else;                          

                           eval *InLR = *On;           

                        EndIf;                         

                    leave;                             

                    EndIf;                             

                                                       

                 // Save new values                    

                    CsSmn#_A = CsSmn#;                 

                    CsOsm#_A = CsOsm#;                 

                                                       

                 // Do the update                      

                    Monitor;                           

                    update CSb00;                      

                    On-Error *File;        

                         ##Errcod = 1;             

                         Mesg = Mesg_See;          

                  EndMon;                          

                                                   

                  EndDo;                           

 // Customer Not found                             

                  Else;                            

                     Mesg = ' Invalid Customer ';  

                     leave;                        

                  EndIf;                           

                                                   

                  EndDo;                           

 

Here is some code for the trigger program

 

*------------------------------------------------------------------------
Documentation      

 *


 * Trigger pgm for CSdelr maintenance (currently just testing)


 *  Terry N    - 05/07/2004 - New


 *


H Option(*SrcStmt)


H DftActGrp(*NO)


H ActGrp(*Caller)


H BndDir('EWAPPS')


FSMdlrI    CT   F    6        DISK


FSMdlrO    CT   F    6        DISK


 


D* Tables for testing salesmen id's


DInside           S              6S 0 Dim(10) PerRcd(1) Fromfile(SMdlrI)


DOutside          S              6S 0 Dim(10) PerRcd(1) Fromfile(SMdlrO)


 


D*------------------------------------------------------------------------
Documentation      

 


 *------------------------------------------------------------------------


 

  *    Pointers used to refer to data in the buffers


  *------------------------------------------------------------------------


 DpBefore          S               *


 DpAfter           S               *


  *------------------------------------------------------------------------


  *    Before and After data structures (change to file name needed)


  *    .... set Pointer in order to use data


  *------------------------------------------------------------------------


 DBefore         E DS                  ExtName(CSdelr)


 D                                     Prefix(B_)


 D                                     Based(pBefore)


 DAfter          E DS                  ExtName(CSdelr)


 D                                     Prefix(A_)


 D                                     Based(pAfter)


  *------------------------------------------------------------------------


  *    Trigger Constants


  *------------------------------------------------------------------------


 D@Insert          C                   '1'


 D@Delete          C                   '2'


 D@Update          C                   '3'


D@Before          C                   '2'


D@After           C                   '1'


 *------------------------------------------------------------------------


 *    Error Message constants


 *------------------------------------------------------------------------


D@Error1          C                   'Invalid Inside Salesman #'


D@Error2          C                   'Invalid Outside Salesman #'


D@Error3          C                   'Invalid Price Frt Zone'


D@Error4          C                   'Invalid Delivery Frt Zone'


 *------------------------------------------------------------------------


 *    Other work fields


 *------------------------------------------------------------------------


D  Found_I                      10I 0


D  Found_O                      10I 0


 *------------------------------------------------------------------------


 *    Trigger Buffer and Trigger Buffer Length Declarations


 *------------------------------------------------------------------------


DBufferLen        S             10I 0


DTrigBuff         DS


D  TrigFile                     10A


D  TrigLib                      10A                                         

D  TrigMbr                      10A                                         

D  TrigEvent                     1A                                         

D  TrigTime                      1A                                         

D  TrigCommit                    1A                                         

D  TrigRes1                      3A                                         

D  TrigCCSID                    10I 0                                       

D  TrigRRN                      10I 0                                       

D  TrigRes2                      4A                                         

D  TrigB4OS                     10I 0                                       

D  TrigB4Len                    10I 0                                       

D  TrigB4NBM                    10I 0                                       

D  TrigB4NBL                    10I 0                                       

D  TrigAftOS                    10I 0                                       

D  TrigAftLen                   10I 0                                       

D  TrigAftNBM                   10I 0                                       

D  TrigAftNBL                   10I 0                                       

 *------------------------------------------------------------------------  

 *    Api Declarations                                                      

 *------------------------------------------------------------------------  

D MsgId           S              7    Inz('CPF9898')


D MsgFile         S             20    Inz('QCPFMSG   *LIBL     ')


D MsgData         S             78    Inz(' ')


D MsgRplDtaLen    S             10i 0


D MsgType         S             10a   Inz('*ESCAPE')


D MsgQueue        S            276a   Inz('*')


D MsgCallStack    S             10i 0 Inz(3)
Msg Call Stack         

D MsgKey          S              4a   Inz(' ')
Msg Key                

D MsgErr          S             10i 0 Inz(0)
Msg Error              

 


D SendMsg         pr                  extpgm('QMHSNDPM')


D  msgId                         7a
Msg Id                 

D  msgFile                      20a
Msg File               

D  msgData                      78a
Msg                    

D  msgRplDtaLen                 10i 0
Msg Repl Data Len      

D  msgType                      10a
Msg Type               

D  msgQueue                    276a
Msg Queue              

D  msgCallStack                 10i 0
Msg Call Stack         

D  msgKey                        4a
Msg Key                

D MsgErr          S             10i 0 Inz(0)
Msg Error        

 


 


 D SendMsg         pr                  extpgm('QMHSNDPM')


 D  msgId                         7a
Msg Id        

 D  msgFile                      20a
Msg File      

 D  msgData                      78a
Msg           

 D  msgRplDtaLen                 10i 0
Msg Repl Data 

 D  msgType                      10a
Msg Type      

 D  msgQueue                    276a
Msg Queue     

 D  msgCallStack                 10i 0
Msg Call Stack

 D  msgKey                        4a
Msg Key       

 D  msgErr                       10i 0
Msg Error     

*------------------------------------------------------------------------


 * Input Paramaters are passed automatically when the trigger


 * fires. Passed ere the trigger buffer and trigger buffer length.


 *------------------------------------------------------------------------


C     *Entry        Plist


C                   Parm                    TrigBuff


C                   Parm                    BufferLen


 


 /Free


 
//------------------------------------------------------------------------


   // Map the data structures for the before and after images to


   // the offset location in the trigger buffer using pointers.


 
//------------------------------------------------------------------------


 


   // Set before & after values


     pBefore = %Addr(TrigBuff) + TrigB4OS;


     pAfter  = %Addr(TrigBuff) + TrigAftOS;


 


   // Test Trigger event


          If TrigEvent = @Update or


             TrigEvent = @Insert;


 


             MsgData = *Blanks;


 


   // Inside Salesman


          If A_CSsmn# <> B_CSsmn#;


             Found_I = %Lookup(A_CSsmn#:Inside);                

   // ... if not found - send back error msg                    

             If Found_I < 1;                                    

                MsgData = @Error1;                              

                exsr SendError;                                 

                A_CSsmn# = B_CSsmn#;                            

              EndIf;                                            

          EndIf;                                                

   // Outside Salesman                                          

          If A_CSosm# <> B_CSosm#;                              

             Found_O = %Lookup(A_CSosm#:Outside);               

   // ... if not found - send back error msg                    

             If Found_O < 1;                                    

                MsgData = @Error2;                              

                exsr SendError;                                 

                A_CSosm# = B_CSosm#;                            

             EndIf;                                             

           EndIf;                                               

                                                                

          EndIf; 

 


   // Go back to caller


     Return;


 


   // Send back error message


 
//====================================================================//  

         // Subroutine: SendError      |
//  

 
//----------------------------+---------------------------------------//  

         // Send escape msg back to caller
//  

 
//====================================================================//  

         begsr SendError;


             MsgId = 'CPF9898';


             MsgRplDtaLen = %Len(%Trim(MsgData));


             callp SendMsg (msgid :


                             msgFile :


                             msgData :


                             msgRplDtaLen :


                             msgType :


                             msgQueue : 

                            msgCallStack :               

                            msgKey :                     

                            msgErr);                     

        endsr;                                           

/End-Free


 


This is the cl that creates the trigger

 

/* Add triggers for CSdelr file */                                     

/*  */                                                                 

             PGM                                                       

                                                                       

             ADDPFTRG   FILE(CSDELRX) TRGTIME(*before) +               

                          TRGEVENT(*INSERT) PGM(TRGCSDELR) +           

                          ALWREPCHG(*YES)                              

                                                                       

             ADDPFTRG   FILE(CSDELRX) TRGTIME(*before) +               

                          TRGEVENT(*UPDATE) PGM(TRGCSDELR) +           

                          ALWREPCHG(*YES)                              

                                                                       

             ENDPGM                                                    

****************** End of data ****************************************

 


 



As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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.