FMTGM IF E K DISK USROPN D************************( Sof Coded Field )************************** D NullTypPtr S * D TypeBin4 S 9B 0 BASED (NullTypPtr ) D TypeChr S 1A BASED (NullTypPtr ) D TypeSysNam S 10A BASED (NullTypPtr ) D TypePtr S * BASED (NullTypPtr ) D @pgm S 21A Program Name D************************( Local Variables )************************** DC_MsgHdr C CONST('Trigger program ') DC_MsgGood C CONST(' Completed Normally') DC_MsgBad C CONST(' Ended in Error') DC_MsgFile C 'Trigger Master File Not Found' D************************( Data Structures )************************** DPARM2 DS D TgLength 1 4B 0 D/COPY QRPGSRC,TPARM1 D*************************( Buffer Variables)************************** D TgBufLen S Like( TypeBin4 ) D TgBfrPtr S Like( TypePtr ) D TgAftPtr S Like( TypePtr ) D TgBufSiz C Const( %Size( TgBufChr ) ) ***************************************************** * OUTPUT PARAMETERS FOR QMHSNDPM ***************************************************** D ERROR DS D PROVID 1 4B 0 D AVAIL 5 8B 0 D RTNMSG 9 15 D MSGD DS D MSGLEN 1 4B 0 D PGMSTK 5 8B 0 C********************************************************************** *--- ** Compare the Triggered file and execute Call if needed *--- C MTGM_Key SETLL RMTGM C MTGM_Key READE RMTGM 60 C* C DOW *IN60 = *OFF C IF (TGTIME = TgTrgTime ) C AND (TGEVNT = TgTrgEvt ) C AND (TGDLCD = *BLANK ) C Eval @pgm = %trim(TGPLIB) + '/' + C %trim(tgpnm) C CALL @pgm 90 C PARM TgBufDS C PARM Parm2 C* C EVAL MSGDTA = C_MsgHdr + TGPNM C IF *IN90 = *ON C EVAL MSGDTA = %Trim(MSGDTA) + C_MsgBad C ELSE C EVAL MSGDTA = %Trim(MSGDTA) + C_MsgGood C ENDIF C EXSR #LogMsg C* C ENDIF C* C MTGM_Key READE RMTGM 60 C ENDDO * * Turn on LR to Exit C CLOSE MTGM 90 C EVAL *INLR=*ON * ----------------------------------------------------------------- C #LogMsg BEGSR * C MOVEL(P) 'CPF9898' MSGID C MOVEL(P) 'QSYS' LIB 10 C MOVEL(P) 'QCPFMSG' ID 10 C ID CAT(P) LIB MSGF C EVAL MSGLEN = %Size(MSGDTA) C MOVEL(P) '*INFO' MSGTYP C MOVEL(P) '*' MSGQUE C* Updated in Source -- MoveL(P) 'TEST MSG' MSGDTA C Z-ADD 1 PGMSTK C MOVE ' ' MSGKEY C Z-ADD 0 PROVID C Z-ADD 0 AVAIL C CALL 'QMHSNDPM' PLIST1 * C ENDSR * ------------------------------------------------ C *INZSR BEGSR * Entry Parameter C *ENTRY PLIST C PARM TgBufDS C PARM PARM2 * * Trigger master file key list C MTGM_Key KLIST C KFLD TgLib C KFLD TgFile * C OPEN MTGM 90 C IF *IN90 = *ON C EVAL MSGDTA = C_MsgFile C EXSR #LogMsg C EVAL *INLR = *ON C RETURN C ENDIF ************************************************** * PARAMETERS NEEDED TO SIGNAL AN EXCEPTION INSIDE * TRIGGERS ************************************************** C PLIST1 PLIST C PARM MSGID 7 C PARM MSGF 20 C PARM MSGDTA 60 C PARM MSGLEN C PARM MSGTYP 10 C PARM MSGQUE 10 C PARM PGMSTK C PARM MSGKEY 4 C PARM ERROR C* C ENDSR The TPARM1 copy F* Trigger Buffer DataStructure F* D********************************************************************* * DTgBufDS DS D TgFile LIKE(TypeSysNam) D TgLib LIKE(TypeSysNam) D TgMbr LIKE(TypeSysNam) D TgTrgEvt LIKE(TypeChr) D TgTrgTime LIKE(TypeChr) D TgCmtLvl LIKE(TypeChr) D TgReserve1 3A D TgCCSId LIKE(TypeBin4) D TgReserve2 8A D TgBOffset LIKE(TypeBin4) D TgBLen LIKE(TypeBin4) D TgBNullOff LIKE(TypeBin4) D TgBNullLen LIKE(TypeBin4) D TgAOffset LIKE(TypeBin4) D TgALen LIKE(TypeBin4) D TgANullOff LIKE(TypeBin4) D TgANullLen LIKE(TypeBin4) D TgBufChr 1 32767A D TgBufAry 1A Overlay( TgBufChr ) D DIM ( %Size( TgBufChr ) ) D********************************************************************* The top of a handler program. D*******************( Soft Coded Trigger Fields )******************** D NullTypPtr S * D TypeBin4 S 9B 0 BASED (NullTypPtr ) D TypeChr S 1A BASED (NullTypPtr ) D TypeSysNam S 10A BASED (NullTypPtr ) D TypePtr S * BASED (NullTypPtr ) D************************( Data Structures )************************* D/COPY QRPGSRC,TPARM1 *MCTL E DS DPARM2 DS D TgLength 1 4B 0 D*************************( Variables )************************** D TgBufLen S Like( TypeBin4 ) D TgBfrPtr S Like( TypePtr ) D TgAftPtr S Like( TypePtr ) D TgBufSiz C Const( %Size( TgBufChr ) ) D********************************************************************** D B_MPATDS E DS ExtName( MPAT ) D Prefix ( B_ ) D Based ( TgBfrPtr ) D A_MPATDS E DS ExtName( MPAT ) D Prefix ( A_ ) D Based ( TgAftPtr ) D********************************************************************** *--- ** Exit: If they don't have Clinitec NxtGen Activated. *--- C IF CTNXTG <> 'Y' C EVAL *INLR=*ON C RETURN C ENDIF *--- ** Retrieve Record Buffers *--- C EVAL TgBfrPtr = %Addr(TgBufAry(TgBOffset + 1)) C EVAL TgAftPtr = %Addr(TgBufAry(TgAOffset + 1)) *--- ** Compare the selected fields and execute Call if needed *--- C EVAL *IN10 = *OFF C EVAL *IN10 = *IN10 OR (A_PTPLN <> B_PTPLN) C EVAL *IN10 = *IN10 OR (A_PTPFN <> B_PTPFN)