/* SHOLPARNBR -- Simple APIs to get and display basic LPAR info     */
/*                                                                  */
/*   dlpar_get_info retrieves the LPAR data structure.              */
/*                  LPAR number is converted from binary to *CHAR   */
/*   QTQCVRT        converts UTF-8 LPAR name to job CCSID           */

pgm

   dcl   &rcvvar      *char  344
   dcl   &format      *int     4     value( 1 )
   dcl   &lrcvvar     *int     4     value( 344 )
   dcl   &rc          *int     4

   dcl   &LPARid      *char    2
   dcl   &LPARname    *char  256

   dcl   &jobccsid    *dec  (  5 0 )
   dcl   &dftccsid    *dec  (  5 0 )

   dcl   &ccsid1      *int     4     value( 1208 ) /* UTF-8 */
   dcl   &st1         *int     4     value( 1 )
   dcl   &s1          *char  256
   dcl   &l1          *int     4     value( 256 )
   dcl   &ccsid2      *int     4
   dcl   &st2         *int     4     value( 2 )
   dcl   &gccasn      *int     4     value( 0 )
   dcl   &l2          *int     4     value( 256 )
   dcl   &s2          *char  256     value( ' ' )
   dcl   &l3          *int     4     value( 0 )
   dcl   &l4          *int     4     value( 0 )
   dcl   &fb          *char   12

   dcl   &LngTxt      *char  999
   dcl   &TxtLen      *int     4
   dcl   &lmsgtxt     *dec (   5 0 )


/* Get basic LPAR info...  */

   callprc     'dlpar_get_info'      ( +
                                       ( &rcvvar )          +
                                       ( &format  *BYVAL )  +
                                       ( &lrcvvar *BYVAL )  +
                                     ) +
                               rtnval( &rc )

/* Extract LPAR ID number from receiver structure...  */

   chgvar      &LPARid        %bin( &rcvvar   41 4 )


/* Extract LPAR name and convert from UTF-8... */

   chgvar      &s1            %sst( &rcvvar   89 256 )

/* Use job CCSID as target... */

   rtvjoba     ccsid( &jobccsid ) dftccsid( &dftccsid )

/* Use default CCSID if necessary... */

   if ( &jobccsid *eq 65535 )  +
      chgvar   &ccsid2        &dftccsid
   else  +
      chgvar   &ccsid2        &jobccsid


   call        QTQCVRT      ( +
                              &ccsid1      +
                              &st1         +
                              &s1          +
                              &l1          +
                              &ccsid2      +
                              &st2         +
                              &gccasn      +
                              &l2          +
                              &s2          +
                              &l3          +
                              &l4          +
                              &fb          +
                            )


/* Determine if a name was returned... */

   if ( &s2 *eq ' ' )  +
      chgvar   &LPARname      '*NONE'
   else  +
      chgvar   &LPARname      &s2


/* Display the LPAR ID and name... */

   sndpgmmsg  msg( &LPARid *bcat &LPARname )

   chgvar      &LngTxt      ( +
                              'This system is running under LPAR +
                              number' *bcat &LPARid *tcat '. The +
                              name of this LPAR is' *bcat &LPARname +
                              *tcat '.' +
                            )

/* Get length of the string to display... */

   rtvmsg      msgid( cpf9897 ) msgf( QSYS/QCPFMSG ) +
                 msgdta( &LngTxt )    +
                 msglen( &lmsgtxt )

   chgvar      &TxtLen        &lmsgtxt

/* ...and display the message... */

   call        QUILNGTX     ( +
                              &LngTxt      +
                              &TxtLen      +
                              'CPF9898'    +
                              '                    ' +
                              x'00000000'  +
                            )

   return

endpgm