× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Here's a CL method.

/* OS Version
/**/
/* QSZRTVPR:                                                (V2R3M0)
/**/

             PGM        PARM(&VERSION)

             DCL        VAR(&VERSION) TYPE(*CHAR) LEN(6)

             DCL        VAR(&RCV) TYPE(*CHAR) LEN(256)
             DCL        VAR(&RCVLEN) TYPE(*CHAR) LEN(4) /* BIN4! */
             DCL        VAR(&FMTNAM) TYPE(*CHAR) LEN(8)
             DCL        VAR(&ERROR) TYPE(*CHAR) LEN(256)
             DCL        VAR(&ERRORLEN) TYPE(*DEC) LEN(10 0)
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(200)
             DCL        VAR(&INF) TYPE(*CHAR) LEN(27)

/* -----------------------------------------------------------------------/*
*/
             DCL        VAR(&ERRORSW   ) TYPE(*LGL )
             MONMSG     MSGID(CPF0000 MCH0000) EXEC(GOTO +
                          CMDLBL(GLOBALERR))
/* -----------------------------------------------------------------------/*
*/
/* api exist? (data areas can be changed, use api if possible!)
/**/
             CHKOBJ     OBJ(QSYS/QSZRTVPR) OBJTYPE(*PGM) AUT(*USE)
             MONMSG     MSGID(CPF0000) EXEC(DO)

             RTVDTAARA  DTAARA(QSYS/Q5738SS1 (1 6)) RTNVAR(&VERSION)
             MONMSG     MSGID(CPF0000) EXEC(DO)

             RTVDTAARA  DTAARA(QSS1MRI (1 6)) RTNVAR(&VERSION)
             MONMSG     MSGID(CPF0000) EXEC(CHGVAR VAR(&VERSION) +
                          VALUE(V0R0M0))
             ENDDO

             SNDPGMMSG  MSG(&VERSION) MSGTYPE(*COMP)

             RETURN

             ENDDO
/* ------------------------------------------------------------------------
/**/

             CHGVAR     VAR(%BIN(&RCVLEN 1 4)) VALUE(256)
             CHGVAR     VAR(%BIN(&ERROR 1 4)) VALUE(256)
             CHGVAR     VAR(%BIN(&ERROR 5 4)) VALUE(0)

             CHGVAR     VAR(&FMTNAM) VALUE('PRDR0100')
             CHGVAR     VAR(%SST(&INF 1 7)) VALUE('*OPSYS ')
             CHGVAR     VAR(%SST(&INF 8 6)) VALUE('*CUR  ')
             CHGVAR     VAR(%SST(&INF 14 4)) VALUE('0000')
             CHGVAR     VAR(%SST(&INF 18 10)) VALUE('*CODE     ')

             CALL       PGM(QSZRTVPR) PARM(&RCV &RCVLEN &FMTNAM &INF +
                          &ERROR)
 /* error conditions?
/**/
             CHGVAR     VAR(&ERRORLEN) VALUE(%BIN(&ERROR 5 4))
             IF         COND(&ERRORLEN *GT 9) THEN(DO)
             CHGVAR     VAR(&MSGID) VALUE(%SST(&ERROR 9 7))
             CHGVAR     VAR(&ERRORLEN) VALUE(&ERRORLEN - 15)
             IF         COND(&ERRORLEN *LE 200) THEN(DO)
             CHGVAR     VAR(&MSGDTA) VALUE(%SST(&ERROR 17 &ERRORLEN))
             ENDDO
             ELSE       CMD(DO)
             CHGVAR     VAR(&MSGDTA) VALUE(%SST(&ERROR 17 200))
             ENDDO
             SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
                          MSGTYPE(*ESCAPE)
             ENDDO

             CHGVAR     VAR(&VERSION) VALUE(%SST(&RCV 20 6))

             SNDPGMMSG  MSG(&VERSION) MSGTYPE(*COMP)

             RETURN
/* ------------------------------------------------------------------- /**/
 GLOBALERR:
             IF         COND(&ERRORSW) THEN(SNDPGMMSG MSGID(CPF9999) +
                          MSGF(QCPFMSG) MSGTYPE(*ESCAPE)) /**/
             CHGVAR     VAR(&ERRORSW) VALUE('1')
             ENDPGM

----- Original Message -----
From: "Bruce Jin" <brucej@MRC-PRODUCTIVITY.COM>
To: <RPG400-L@midrange.com>
Sent: Thursday, May 03, 2001 1:46 PM
Subject: Can I retrieve OS version in RPG or CL?


> How can I decide my AS400 is V4R4 or V5R1 or whatever in RPG or CL?
>
> Thanks.
> Bruce


+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.