ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

Qdbrrcdl

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    Qdbrrcdl

    Hi
    I tried this API but whenever I am executing program that time it is giving me
    error message in Errorcode parameter
    CPF32470SPCUSN GLTUTLRSR SPCUSN 
    CPF3247 - Record number &4 does not exist in member &3.
    I took help from Iseries information center in Relative record number parameter
    I am sending 0 so that it should search for every record in the file.

    This is statement in the Iseries information center
    0
    Record lock information for all records in the member should be returned.

    Please help me.
    Tags: None
  • #2
    Re: Qdbrrcdl

    Give this a try and let me know.



    Code:
    FTable1    UF   E           K DISK    InfDs( T1InfDs )
F                                     UsrOpn

 * File information data structure
D T1InfDs         DS
D  T1FileName       *File
D  T1Opcode         *Opcode

 * Mnemonics
D FStsOK          C                   Const(    0 )
D FStsNoKey       C                   Const(   12 )
D FStsRcdLckOth   C                   Const( 1218 )
D FStsRcdLckSame  C                   Const( 1299 )
D False           C                   Const( '0'  )
D JlLckStsHeld    C                   Const( '0'  )
D JlLckStsWait    C                   Const( '1'  )
D JlLckTypRead    C                   Const( '0'  )
D JlLckTypUpdate  C                   Const( '1'  )

 * Program variables 
D SlcColKey       S                   Like( ColPK  )
D LckStsText      S              6A
D LckTypText      S              6A
D Msg             S             52A
D LckLib          S             10A
D LckFile         S             10A
D LckMbr          S             10A
D LckRrn          S             11P 0
D LckQualJob      S             28A
D LckSameJob      S              1A
D LckDeadlock     S              1A
D QualFileName    S             20A   
D ListMbrName     S             10A   
D ListRrn         S             10U 0
D JobEntryBase    S               * 
D JobCnt          S             10U 0 

 * Constant arguments
D JobListLenV     C                   Const( %Size( JobList ) )
 * Info Center's documented format name of RRCD0100 is incorrect
D ApiFmtNameV     C                   Const( 'RCDL0200' )

 **-- API Prototype: Get list of jobs for record lock --------------**
D RtvRcdLck       PR                  Extpgm( 'QDBRRCDL' )
D  RlJobList                          Like( JobList )
D  RlJobListLen                 10I 0 Const
D  RlApiFmtName                  8A   Const
D  RlQulFileName                20A   Const
D  RlMbrName                    10A   Const
D  RlRrn                        10U 0 Const
D  RlErrRtn                           Like( ApiError )
 **-- Job list data structure    ---------------------------**
D JobList         DS
D  JlJobsAvl                    10I 0
D  JlJobsRtn                    10I 0
D  JlJobOff                     10I 0
D  JlJobSize                    10I 0
 * Should be multiple of JlJobSize (32) 
D  JlJobDta                   3200A
 **-- Job entry data structure   ---------------------------**
D JobEntry        DS                  Based( JobEntryAdr )
D  JeJobName                    10A
D  JeUserName                   10A
D  JeJobNNbr                     6A
D  JeLockSts                     1A
D  JeLockType                    1A
D  JeRrn                        10U 0
 **-- API error data structure   ---------------------------**
D ApiError        DS
D  AeBytePrv                    10I 0 Inz( %Size( ApiError ) )
D  AeByteAvl                    10I 0
D  AeMsgId                       7A
D                                1A
D  AeMsgDta                    128A

 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 *    Main block
C                   Open  (E) Table1
C                   Eval      SlcColKey = 1
C     SlcColKey     Chain (E) Table1
C                   Select
C                     When    %Status( Table1 ) = FStsOK
C                       ExSr  ProcessRcd
C                     When    %Status( Table1 ) = FStsNoKey
C                       ExSr  NoRcdFnd
C                     Other
C                       ExSr  IOErr
C                   EndSl 
C                   Close (E) Table1
C                   Return
 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C     ProcessRcd    BegSr
C                   EndSr
 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C     NoRcdFnd      BegSr
C                   EndSr
 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C     IOErr         BegSr
C                   Eval      Msg = 'I/O error: '
C                                 + %Char( %Status( Table1 ) )
C                                 + ' on '       
C                                 + %Trim( T1Opcode )
C                                 + ' for ' 
C                                 + %Trim( T1FileName ) 
C                                 + ' file.' 
C     Msg           Dsply (E)

C                   If        %Status( Table1 ) = FStsRcdLckOth  Or
C                             %Status( Table1 ) = FStsRcdLckSame
C                    ExSr     RtvLckMsg
C                    If       LckRrn > 0
C                     ExSr    GetJobList
C                    EndIf
C                   EndIf
C                   EndSr
 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C     RtvLckMsg     BegSr
C                   Call      'RTVLCKMSG'
C                   Parm                    LckLib     
C                   Parm                    LckFile    
C                   Parm                    LckMbr     
C                   Parm                    LckRrn     
C                   Parm                    LckQualJob 
C                   Parm                    LckSameJob
C                   Parm                    LckDeadlock
C                   EndSr
 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C     GetJobList    BegSr
C                   Eval      QualFileName = LckFile + LckLib
C                   Eval      ListMbrName  = LckMbr
C                   Eval      ListRrn      = LckRrn
C                   Eval      JlJobsRtn    = 0

C                   CallP     RtvRcdLck(
C                               JobList
C                             : JobListLenV
C                             : ApiFmtNameV
C                             : QualFileName
C                             : ListMbrName     
C                             : ListRrn         
C                             : ApiError )

C                   If        AeByteAvl > 0
C                     Eval    Msg = 'API Excp: ' + AeMsgId
C     Msg             Dsply(E)
C                     LeaveSr
C                   EndIf

C                   Eval      JobCnt       = 0
C                   Eval      JobEntryBase = %Addr( JobList ) +
C                                               JlJobOff

C                   DoW       JobCnt < JlJobsRtn
C                    Eval     JobEntryAdr = JobEntryBase +
C                                             ( JobCnt * JlJobSize )

C                    Select
C                     When    JeLockSts = JlLckStsHeld
C                       Eval  LckStsText = 'holds'
C                     When    JeLockSts = JlLckStsWait
C                       Eval  LckStsText = 'awaits'
C                     Other
C                       Eval  LckStsText = JeLockSts
C                    EndSl 

C                    Select
C                     When    JeLockType = JlLckTypRead
C                       Eval  LckTypText = 'Read'
C                     When    JeLockType = JlLckTypUpdate
C                       Eval  LckTypText = 'Update'
C                     Other
C                       Eval  LckTypText = JeLockType
C                    EndSl 

C                    Eval     Msg = %Trim( JeJobName )
C                                 + '/'       
C                                 + %Trim( JeUserName )
C                                 + '/' 
C                                 + %Trim( JeJobNNbr )
C                                 + ' '
C                                 + %Trim( LckStsText )
C                                 + ' ' 
C                                 + %Trim( LckTypText )
C                                 + ' lock on RRN '
C                                 + %Char( JeRrn )
C                                 + '.' 
C     Msg            Dsply (E)
C                    Eval     JobCnt = JobCnt + 1
C                   EndDo
C                   EndSr
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com
    • Likes 1

    Comment

    • #3
      Re: Qdbrrcdl

      Thanks Jamie
      I got the error in my code.
      Thanks again.

      Regards,
      Ravi

      Comment

      • #4
        Hi Jamie,
        how must be the source-code for RtvRcdLck?
        I thought that was a Api.
        Regards

        Comment

        Previous template Next
        Working...
        X