** CBL.CTL(SSGHU)      *** L=003 --- 2016/03/04 10:57:49 (L05)
*
*  Routine to issue IMS GHU (Get Unique and Hold) on a named
*  IMS database segment using SEARCH  <field_name> = <key_value>.
*  SSCHKEQU and SSGHUEQU equates are a pre-requisite.
*

==IMSGHUK==       * Get unique database segment.
*
* Read a data base segment using SEG and SEARCH key field.
* Key is provided via another input source and saved in chkky.
*
  @iseg                      = ghusg     stopaft=1 * Input position.
  pos chksg, chksg+chksg_L-1 = segname   stopaft=1 * Get segment name.
  pos chkfl, chkfl+chkfl_L-1 = fieldname stopaft=1 * Get key feild name

  GHU dbdname  dbd#   ims   into @iseg      \
         seg=chksg    search=chkfl  EQ  chkky_L at chkky

  if pos status  = 'GE'        * "Not found" status code for GHU?
    then retcode = 4           * Set RC=4
    then goto IMSGHUK_message  * Output a bad status message.

  if pos status  = '  '        * Blank status code for GHU?
    then goto IMSGHUK_end      * All ok so leave sub-routine.
    else retcode = 12          * Set RC=12
    then goto IMSGHUK_message  * Output a bad status message.


 =IMSGHUK_message=
** We have a bad (non-blank) status code...

  pos chker, chker+chker_L-1 = \
        'GHU KEY   ERR911:  Bad status code (  ) from GHU '
  pos chker+36 =  2       at status   !@pr = chker+49
  pos @pr      =  'DBD='              !@pr = @pr+04
  pos @pr      =  dbdname             !@pr = @pr+08
  pos @pr      =  ' SEG='             !@pr = @pr+05
  pos @pr      =  chksg_L at chksg    !@pr = @pr+chksg_L
  pos @pr      =  '  SEARCH '         !@pr = @pr+09
  pos @pr      =  chkfl_L at chkfl    !@pr = @pr+chkfl_L
  pos @pr      =  ' EQ "'             !@pr = @pr+05
  pos @pr      =  chkky_L at chkky    !@pr = @pr+chkky_L
  pos @pr      =  '"'                 !@pr = @pr+01

  print from  pos chker,  @pr-01   type=s
  space

 =IMSGHUK_end=
  return