News Stay informed about the latest enterprise technology news and product updates.

Allow users to see why they are locked -- Code

Allow users to see why they are locked -- Code

 	
      *--------------------------------------------------------------(BEGIN)----P_S_DSPLOC
      *------------------------------------------------------------------------*
      * Prototype For Procedure Dsp_Lock : display detailled Locking Info      *
      *------------------------------------------------------------------------*
     D  Dsp_lock       PR             1                                         Return Result
      *                                                                         0 - OK
      *                                                                         1 - Locking Not Found
      *                                                                         9 - Process Failure
     d                               10    CONST                                File name  (I)
     d                               10i 0 CONST                                RRN Number (I)
     d                               58    CONST                                Message    (I)

      *------------------------------------------------------------------------*
      * Used Variables                                                         *
      *------------------------------------------------------------------------*
      * IOFBDS
     d feebk_Lock      ds
     d  rrn_lock             397    400b 0

      *Parms
     d  File_lck       s             10
     d  Rrn_lck        s             10i 0
     d  Msg_lck        s             58    INZ('RECORD IS ALREADY LOCKED BY')
      * Return Value
     d  Ret_Dsp_Lock   s              1                                         Returned Value
      *--------------------------------------------------------------(END)------P_S_DSPLOC
      *--------------------------------------------------------------(BEGIN)----DSPLOCFM
     A*%%TS  SD  19931026  105559  TS_EDP_93   REL-V2R2M0  5738-PW1
     A*%%EC
     A                                      DSPSIZ(24 80 *DS3)
     A                                      CHGINPDFT
     A                                      MSGLOC(24)
     A                                      PRINT
     A                                      INDARA
     A                                      CA03(03 'DETAIL')
     A          R DSPLOC01
     A*%%TS  SD  19931026  105559  TS_EDP_93   REL-V2R2M0  5738-PW1
     A                                      ASSUME
     A                                      OVERLAY
     A                                      PROTECT
     A                                      PUTOVR
     A                                      OVRDTA
     A                                  5 12'._________________________________-
     A                                      ___________________________.'
     A                                      COLOR(BLU)
     A                                  6 12']'
     A                                      COLOR(BLU)
     A                                  6 73']'
     A                                      COLOR(BLU)
     A                                 18 12']'
     A                                      COLOR(BLU)
     A                                 18 73']'
     A                                      COLOR(BLU)
     A                                 19 12']__Enter__________________________-
     A                                      ___________F3/Detail_______]'
     A                                      COLOR(BLU)
     A                                 18 14'                                  -
     A                                                              '
     A                                  7 12']'
     A                                      COLOR(BLU)
     A                                  9 12']'
     A                                      COLOR(BLU)
     A                                  6 14'DSPLOC'
     A                                      DSPATR(HI)
     A                                  6 55DATE
     A                                      EDTCDE(Y)
     A                                  6 64TIME
     A                                  7 73']'
     A                                      COLOR(BLU)
     A                                  9 73']'
     A                                      COLOR(BLU)
     A            E1MSG         58   O  9 14DSPATR(RI)
     A                                  8 12'+----------------------------------
     A                                      ---------------------------+'
     A                                      COLOR(BLU)
     A                                 10 12'+----------------------------------
     A                                      ---------------------------+'
     A                                      COLOR(BLU)
     A                                  6 21'                                 '
     A                                 11 12']'
     A                                      COLOR(BLU)
     A                                 12 12']'
     A                                      COLOR(BLU)
     A                                 13 12']'
     A                                      COLOR(BLU)
     A                                 14 12']'
     A                                      COLOR(BLU)
     A                                 11 73']'
     A                                      COLOR(BLU)
     A                                 11 14'JOB.....:'
     A                                      DSPATR(HI)
     A                                 12 14'USER....:'
     A                                      DSPATR(HI)
     A                                 15 12']'
     A                                      COLOR(BLU)
     A                                 16 12']'
     A                                      COLOR(BLU)
     A                                 13 14'Number..:'
     A N20                                  DSPATR(ND)
     A                                 14 14'Status..:'
     A N20                                  DSPATR(ND)
     A                                 15 14'Lock....:'
     A N20                                  DSPATR(ND)
     A                                 17 12']'
     A                                      COLOR(BLU)
     A                                 17 14'RRN.....:'
     A N20                                  DSPATR(ND)
     A                                 12 73']'
     A                                      COLOR(BLU)
     A                                 13 73']'
     A                                      COLOR(BLU)
     A                                 14 73']'
     A                                      COLOR(BLU)
     A                                 15 73']'
     A                                      COLOR(BLU)
     A                                 16 73']'
     A                                      COLOR(BLU)
     A                                 17 73']'
     A                                      COLOR(BLU)
     A            E1JOB         10A  O 11 24DSPATR(HI)
     A            E1USER        10A  O 12 24DSPATR(HI)
     A            E1NUMB         9A  O 13 24
     A N20                                  DSPATR(ND)
     A            E1STAT        10A  O 14 24
     A N20                                  DSPATR(ND)
     A            E1LOCK        10A  O 15 24
     A N20                                  DSPATR(ND)
     A            E1RRN         11A  O 17 24
     A N20                                  DSPATR(ND)
     A                                 16 14'File....:'
     A N20                                  DSPATR(ND)
     A            E1FILE        10A  O 16 24
     A N20                                  DSPATR(ND)
     A            E1LJOB        37A  O 11 35
     A            E1LUSE        37A  O 12 35
     A                                 13 34'                                  -
     A                                          '
     A                                 14 35'                                  -
     A                                         '
     A                                 15 35'                                  -
     A                                         '
     A                                 16 35'                                  -
     A                                         '
     A                                 17 36'                                  -
     A                                        '
     A                                  7 14'             * JOB RECORD LOCK INF-
     A                                      ORMATION *              '
     A                                      DSPATR(HI)
      *--------------------------------------------------------------(END)------DSPLOCFM
      *--------------------------------------------------------------(BEGIN)----S_DSPLOC
     hnomain
      *****************************************************************
      * SRVPGM  : yes                                                 *
      * Module  : yes                                                 *
      * Module  : ASRGEN/S_DSPLOC   (RPGLE)                           *
      *                                                               *
      *   LOCKING MANAGEMENT SERVICE PROGRAM                          *
      *                                                               *
      *                                                               *
      * Use SRVPGM         : None                                     *
      * Binding Directory  : None                                     *
      *                                                               *
      *****************************************************************
      * V 04/2002 : Accept Logical Filename as Input parm             *
      *****************************************************************
     FS_DSPLOCFMCF   E             WORKSTN USROPN                               /Screen,  manualy open

     D/COPY P_S_DSPLOC                                                          Proto fo S_DSPLOC

     d*--------------------------------------
     d* Global variables
     d*--------------------------------------
     d rrn11x          ds
     d rrn11                         11s 0

     D errcod          ds
     D  bytpro                       10i 0 INZ(256)                             Bytes provided for Error
     D  bytava                       10i 0                                      Bytes available (0=no error)
     D  msgid                         7                                         Exception id
     D  rsrv1                         1                                         Reserved
     D  msgdta                      240                                         Exception data


      * User spaces created in qtemp
     D usrspc          DS
     D  usr1                         10    INZ('S_DSPLOC  ')
     D  usr2                         10    INZ('QTEMP     ')
     D format          s              8
     D p_Usrspc        s               *
     D spc_attr        s             10
     D spc_size        s             10i 0
     D spc_init        s              1    inz(x'00')
     D spc_aut         s             10    inz('*ALL')
     D spc_text        s             50    inz('Used by S_DSPLOC')
     D spc_replace     s             10    inz('*YES')


     D Filename        DS                                                       Qualified File Name
     D  File_                        10                                          File    name (from parm)
     D  Library_                     10    INZ('*LIBL     ')                     Library Name
     D Member_         s             10    INZ('*FIRST    ')                     Member  Name

     d dsin_size       s             10i 0                                      Length receiver
     d DEVD0100_Size   s             10i 0                                      Length receiver
     d USRI0300_Size   s             10i 0                                      Length receiver
     d MBRD0300_Size   s             10i 0                                      Length receiver

     d RRCD0100        ds                  based(p_Dsin)                        Receiver for QDBRRCDL
     D  AVAJOB                       10i 0                                      Jobs Available
     D  RETJOB                       10i 0                                      Jobs Returned
     D  OFFJOB                       10i 0                                      Offset to Job Information
     D  SIZJOB                       10i 0                                      Size of Info for each job

     d DEVD0100        ds                                                       Receiver for QDCRDEVD
     d  RETBYT_D                     10i 0                                      Returned Bytes
     d  AVABYT_D                     10i 0                                      Available Bytes
     d  DATRTV_D                      7                                         Retrieve Date
     d  TIMRTV_D                      6                                         Retrieve Time
     d  Dev_Name                     10                                         Device Name
     d  Dev_Category                 10                                         Device category
     d  Dev_Onl_Ipl                  10                                         Device OnLine At Ipl
     d  Dev_Descr                    50                                         Device Description
     d  Dev_Rsrv                      3                                         Reserved

     d USRI0300        ds                                                       Receiver For QSYRUSRI
     d  RETBYT_U                     10i 0                                      Returned Bytes
     d  AVABYT_U                     10i 0                                      Available Bytes
     d  Usprf                        10                                         User Profile Name
     d  Usr_Descr            199    248                                         User Description

     d MBRD0300        ds                  based(p_Mbrd)                        Receiver For QUSRMBRD
     d  RETBYT_Mbr                   10i 0                                      Returned Bytes
     d  AVABYT_Mbr                   10i 0                                      Available Bytes
     d  Mbr_file_name                10                                         Database File name
     d  Mbr_libr_name                10                                         Database File Library Name
     d  Mbr_member                   10                                         Member  Name
     d  Mbr_lf_pf            137    137                                         Logical(1)/Physical(0) file
     d  Mbr_Nbr_bo_PF        157    160i 0                                      Nbr Based on PF members

     d  Mbr_bo_FLE     ds           112    based(p_bofle)                       Based on File List 1St Entry
     d   Mbr_bo_pf                   10    overlay(Mbr_bo_Fle)                  Based-on PF name
     d   Mbr_bo_lib                  10    overlay(Mbr_bo_fle:*next)            Based-on PF library name
     d   Mbr_bo_mbr                  10    overlay(Mbr_bo_fle:*next)            Based-on PF member  name

     D dsdata          ds                  based(p_Data)
     D  pjob                         10                                         Job  Name
     D  pusr                         10                                         Job  User Name
     D  pnbr                          6                                         Job  Number
     D  plock_stat                    1                                         Lock Status(0/Held 1/wait)
     D  plock_type                    1                                         Lock Type  (0/read 1/update)
     D  prrn                         10i 0                                      RRn  Locked

     D  HELD           c                   const('0')
     D  update         c                   const('1')
     D  Physical       c                   const('0')
     D  Logical        c                   const('1')

     D  Override       s              1    inz('1')
     D  Find_mbr       s              1    inz('0')
     D  rrn_           s             10i 0

     ***************************************************************************
     ** Dsp_lock : Display Detailled Locking Info                              *
     ***************************************************************************
     p Dsp_lock        B                   EXPORT
     d Dsp_lock        PI             1                                         Return Result
      *                                                                         0 - Ok
      *                                                                         1 - Locking Not Found
      *                                                                         9 - Process Failure
     d File_in                       10    CONST                                     Filename (PF or LF)
     d Rrn_in                        10i 0 CONST                                Rrn Locked
     d msg_in                        58    CONST                                     Message for the user


     d   Return_code   s              1    inz('1')                             No lock found
     ***********************************************************************************************
      *
      * Receive parms
      *
     c                   eval      rrn_     = rrn_in
     c                   eval      file_    = file_in
     c                   eval      msg_user = Msg_in

      *
      * Retrieve File Type (PF,LF) and Based-On File 1st list entry
      *
      *
      *   Set receiver Length to 496 (MBRD0300 is MBRD0200 + 1st Based-on file list entry)
      *
     c                   eval      MBRD0300_Size = 384 + 112                    MBRD0200 + 1st BOFLE
     c                   alloc     MBRD0300_Size p_Mbrd
      *
      *   Retrieve Member Description
      *
     c                   call (e)  'QUSRMBRD'                                   Retrive Member Description
     c                   parm                    MBRD0300                       Receiver variable      (I)
     c                   parm                    MBRD0300_size                  Receiver size          (I)
     c                   parm      'MBRD0300'    format                         Format Name            (I)
     c                   parm                    Filename                       Qualified Filename     (I)
     c                   parm      '*FIRST'      Member_                        Member Name            (I)
     c                   parm                    Override                       Override Proces(1=yes) (I)
     c                   parm                    ERRCOD                         Error code             (I/O)
     c                   parm                    Find_mbr                       Find Mbr Proces(0=Dft) (I)

     c                   if        bytava <> 0 or %error                        (B10) Error ....
     c                   eval       return_code = '9'
     c                   goto      exit
     c                   endif                                                  (E10)

      *
      * If File Type is Physical, that's ok
      * If File Type is Logical, Replace Filename by physical filename of 1st BOFLE
      *
     c                   if        Mbr_lf_pf   = logical                        (B10)
     c                   eval        p_bofle   = p_mbrd + 384                   Addr  1st Based-on Pf mbr
     c                   eval        file_     = Mbr_bo_pf                      Pf name
     c                   eval        Library_  = Mbr_bo_lib                     Pf Library Name
     c                   eval        member_   = Mbr_bo_mbr                     Pf member name
     c                   endif                                                  (E10)
     c
     c                   dealloc                 p_mbrd

      *
      * Set receiver Length to 16 (Information Returned DS)
      *
     c                   eval      dsin_size = %size(RRCD0100)
     c                   alloc     dsin_size     p_Dsin

      *
      * Retrieve Bytes Required fo API QDBRRCDL (for this run)
      *
     c                   call (e)  'QDBRRCDL'                                   Retrieve Record Locks
     c                   parm                    RRCD0100
     c                   parm                    Dsin_size
     c                   parm      'RRCD0100'    format
     c                   parm                    Filename
     c                   parm                    Member_
     c                   parm                    rrn_
     c                   parm                    ERRCOD


     c                   if        bytava <> 0 or %error                        (B10) Error ....
     c                   eval       return_code = '9'
     c                   goto      exit
     c                   endif                                                  (E10)

      *
      * Compute Spaces required  ((Available Job * Size 1 job) + offset to Job Info)
      *
     c                   eval      dsin_size = (avajob * sizjob) + offjob
     c                   eval      Spc_size  = Dsin_size + 124                  124 bytes for USRSPC INFO
     c                   dealloc                 p_Dsin
      *
      * Create User Space to get Results from QDBRRCDL
      *
     C                   CALL (e)  'QUSCRTUS'                                   Create USer Space S_DSPLOC
     c                   parm                    Usrspc
     C                   parm                    spc_ATTR
     C                   parm                    SPC_SIZE                       !!!!!
     C                   parm                    SPC_INIT
     C                   parm                    SPC_AUT
     C                   parm                    SPC_TEXT
     C                   parm                    SPC_REPLACE
     C                   parm                    ERRCOD

     c                   if        bytava <> 0 or %error                        (B10) Error ....
     c                   eval       return_code = '9'
     c                   goto      exit
     c                   endif                                                  (E10)

      *
      * Retrieve User Space Address   (p_Usrspc)
      *
     C                   CALL (e)  'QUSPTRUS'
     C                   parm                    usrspc
     C                   parm                    p_Usrspc
     C                   parm                    ERRCOD


     c                   if        bytava <> 0 or %error                        (B10) Error ....
     c                   eval       return_code = '9'
     c                   goto      exit
     c                   endif                                                  (E10)


      *
      * Initialize Address of receiver variable for QDBRRCDL ( RRCD0100)
      *
     C                   eval      p_Dsin  = p_Usrspc

      *
      * Retrieve Record Locks
      *
     c                   call (e)  'QDBRRCDL'                                   Retrieve Record Locks
     c                   parm                    RRCD0100                       Receiver variable     (I)
     c                   parm                    dsin_size                      Receiver Size         (I)
     c                   parm      'RRCD0100'    format                         Format Name           (I)
     c                   parm                    Filename                       Qualified Filename    (I)
     c                   parm                    Member_                        Member Name           (I)
     c                   parm                    rrn_                           Relative record Number(I)
     c                   parm                    ERRCOD                         Error Code            (I/O)
     c
     c                   if        bytava <> 0 or %error                        (B10) Error ....
     c                   eval       return_code = '9'
     c                   goto      exit
     c                   endif                                                  (E10)
      *
      * Data Address p_Data is Receiver Address + Offset Job
      *
     C                   eval      p_Data  = p_Dsin  + OFFJOB
      * Scan Locked Info
      *
     C
     C                   do        retjob                                       (b10)
      *
      * Until The job Holding the record for Update is found
      *
     C                   if        plock_stat <> HELD or Plock_type <> update   (b20)
     C                   EVAL      p_Data  =  p_Data + SIZjob
     C                   iter
     C                   else                                                   (x20)
      *
      * Open Display File
      *
     c                   open      S_DSPLOCFM
     c                   eval      *in20 = *off                                 No Detail
      *
      * Retrieve the device name
      *
     c                   eval      DEVD0100_Size = %size(DEVD0100)

     c                   call (e)  'QDCRDEVD'                                   Retrieve Device Description
     c                   parm                    DEVD0100
     c                   parm                    DEVD0100_Size
     c                   parm      'DEVD0100'    format
     c                   parm                    Pjob
     c                   parm                    ERRCOD

     c                   if        bytava <> 0 or %error                        (B30) Error ....
     c                   eval       return_code = '9'
     c                   goto      exit
     c                   endif                                                  (E30)

     c                   if        retbyt_D > 0                                 (b30)
     c                   movel     Dev_Descr     Ljob
     c                   else                                                   (X30)
     c                   eval      Ljob        = *BLANK
     c                   endif                                                  (E30)
      *
      * Retrieve the User   name
      *
     c                   eval      USRI0300_Size = %size(USRI0300)

     c                   call (e)  'QSYRUSRI'                                   Retrieve User   Description
     c                   parm                    USRI0300
     c                   parm                    USRI0300_Size
     c                   parm      'USRI0300'    format
     c                   parm                    Pusr
     c                   parm                    ERRCOD

     c                   if        bytava <> 0 or %error                        (B30) Error ....
     c                   eval       return_code = '9'
     c                   goto      exit
     c                   endif                                                  (E30)

     c                   if        retbyt_U > 0                                 (b30)
     c                   movel     Usr_Descr     Lusr
     c                   else                                                   (X30)
     c                   eval      Lusr        = *BLANK
     c                   endif                                                  (E30)
      *
      * Setup additional Info
      *
     c                   eval      Lstat = 'HELD      '
     c                   eval      Llock = 'UPDATE    '
     c                   eval      RRN11 = RRN_
     c                   eval      return_code = '0'
      *
      * Display results
      *

     C     scr1          tag
     C                   EXFMT     DSPLOC01
      *
      * F3/Exit
      *
     C                   if        *in03                                        (b30)
     C                   goto      exit
     C                   endif                                                  (e30)
      *
      * F10/Toggle Display Detailled Info or not
      *
     C                   IF        *in10                                        (b30)
     C                   eval       *in20 = not *in20
     C                   endif                                                  (e30)


     c                   goto      scr1

     C                   endif                                                  (e20)
     C                   ENDDO                                                  (e10)

     c     exit          tag
      *
      * Close Opened File
      *
     c                   if        %open(S_DSPLOCFM)
     c                   Close     S_DSPLOCFM
     c                   endif

     c                   return    (Return_code)

     P                 E
      *--------------------------------------------------------------(END)------S_DSPLOC

Dig Deeper on iSeries programming commands

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close