|
midrange.com
Here is the source code for our utility used to help the maintenance of
caracter data area.
Notes:
- all comments are in french, but I have translated what the user sees (the
command prompt)
- the command assume that the external DS has the same name as the data area
with the letters "DS" appended at the end. But this can be overriden when
typing the command.
- I have put in comment the command FWRPGMMSG in the CLP to avoid having to
post it
- This utility uses DFU to present the content of the data area and to update
it using a temporary member
Feel free to use it.
================== CMD EDTDTAARA =========================
/* *%%%* Instuctions pour compilation */
/* *%%% CRTCMD */
/* *%%% CMD(%LIBO/%OBJ) */
/* *%%% PGM(*LIBL/GEI0006C) */
/* *%%% SRCFILE(%LIBS/%FIC) */
/* *%%% SRCMBR(%MBR) */
/* *%%%& */
/*===================================================================*/
/* AUTEUR . : Denis Robitaille */
/* DATE . . : 97/03/27 */
/* */
/* DESCRIPTION: Maj de data area */
/* */
/* */
/* MODIFICATION */
/* ----------------------------------------------------------------- */
/* XXXXXXXXXXXXXXXXXXXX 99/99/99 XXX... */
/* */
/*===================================================================*/
CMD PROMPT('Edit data area')
PARM KWD(DTAARA) TYPE(Q1) CHOICE('Name') +
PROMPT('Data area')
Q1: QUAL TYPE(*NAME) LEN(10) MIN(1) CHOICE('Name')
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) PROMPT('Library')
PARM KWD(DS) TYPE(*CHAR) LEN(10) DFT(*AUTO) +
SPCVAL((*AUTO)) PROMPT('Name of external DS')
======================= CLP GEI0006C =====================================
/* *%%%* Instruction pour compilation--------------------+ */
/* *%%% CRTBNDCL */
/* *%%% PGM(%LIBO/%OBJ) */
/* *%%% SRCFILE(%LIBS/%FIC) */
/* *%%% SRCMBR(%MBR) */
/* *%%% DFTACTGRP(*NO) */
/* *%%% ACTGRP(*CALLER) */
/* *%%% DBGVIEW(*LIST) */
/* *%%%& */
/*===================================================================*/
/* AUTEUR . . : Denis robitaille */
/* DATE . . . : 97/03/27 */
/* COMMANDE . : edtdtaara */
/* */
/* DESCRIPTION: MAJ de data area */
/* */
/* */
/* MODIFICATION */
/* ----------------------------------------------------------------- */
/*===================================================================*/
PGM PARM(&DTAARAQ &DTAARADS)
DCL VAR(&DTAARAQ) TYPE(*CHAR) LEN(20)
DCL VAR(&DTAARA) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&WRKF) TYPE(*CHAR) LEN(10) VALUE(GEI0006T)
DCL VAR(&WRKM) TYPE(*CHAR) LEN(10)
DCL VAR(&WRKMN) TYPE(*DEC) LEN(9 0)
DCL VAR(&WRKMNA) TYPE(*CHAR) LEN(9)
DCL VAR(&DTAARADS) TYPE(*CHAR) LEN(10)
DCL VAR(&V2000) TYPE(*CHAR) LEN(2000)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
DCL VAR(&LIBL) TYPE(*CHAR) LEN(10) VALUE('*LIBL')
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERREUR))
/* separe la librairi et le data area */
CHGVAR VAR(&DTAARA) VALUE(%SST(&DTAARAQ 1 10))
CHGVAR VAR(&LIB) VALUE(%SST(&DTAARAQ 11 10))
IF COND(&LIB *EQ *LIBL) THEN(RTVOBJD +
OBJ(&DTAARA) OBJTYPE(*DTAARA) RTNLIB(&LIB))
RTVJOBA TYPE(&TYPE)
/* determine le nom du DS externe */
IF COND(&DTAARADS *EQ *AUTO) THEN(CHGVAR +
VAR(&DTAARADS) VALUE(&DTAARA *TCAT 'DS'))
/* Allouer le fichier 'DS' pour éviter écrasement */
ALLOC: ALCOBJ OBJ((&DTAARADS *FILE *EXCL)) WAIT(20)
MONMSG MSGID(CPF1002) EXEC(DO)
/* Si c'est un travail interactif */
IF COND(&TYPE *EQ '1') THEN(SNDPGMMSG +
MSGID(GE00002) MSGF(GEMSG) +
MSGDTA(&DTAARADS *CAT &LIBL) TOPGMQ(*EXT) +
MSGTYPE(*STATUS))
/* Si c'est un travail en lot */
ELSE CMD(SNDUSRMSG MSGID(GE00002) MSGF(GEMSG) +
MSGDTA(&DTAARADS *CAT &LIBL) +
MSGTYPE(*INFO) TOUSR(*SYSOPR))
GOTO CMDLBL(ALLOC)
ENDDO
/* determine le nom du membre du fichier de travail+cree+override */
CHGVAR VAR(&WRKMN) VALUE(1)
CHGVAR VAR(&WRKMNA) VALUE(&WRKMN)
CHGVAR VAR(&WRKM) VALUE('M' *TCAT &WRKMNA)
B1: ADDPFM FILE(&WRKF) MBR(&WRKM)
MONMSG MSGID(CPF5812 CPF7306) EXEC(DO)
CHGVAR VAR(&WRKMN) VALUE(&WRKMN + 1)
CHGVAR VAR(&WRKMNA) VALUE(&WRKMN)
CHGVAR VAR(&WRKM) VALUE('M' *TCAT &WRKMNA)
GOTO CMDLBL(B1)
ENDDO
OVRDBF FILE(&WRKF) MBR(&WRKM)
/* extrait les info du data area */
RTVDTAARA DTAARA(&LIB/&DTAARA) RTNVAR(&V2000)
/* transfert les info dans le fichier de travail */
CALL PGM(GEI0006R) PARM(&V2000 '1')
/* transfert le fichier de travail dans le DS externe */
CPYF FROMFILE(&WRKF) TOFILE(&DTAARADS) +
MBROPT(*REPLACE) FMTOPT(*NOCHK)
/* m a j des donnees dans le DS */
UPDDTA FILE(&DTAARADS)
/* transfert du DS au fichier de travail */
CPYF FROMFILE(&DTAARADS) TOFILE(&WRKF) +
MBROPT(*REPLACE) FMTOPT(*NOCHK)
/* transfert du fichier de travail vers la variables */
CALL PGM(GEI0006R) PARM(&V2000 '2')
/* m a j du data area */
CHGDTAARA DTAARA(&LIB/&DTAARA) VALUE(&V2000)
GOTO CMDLBL(FINPGM)
/*-------------------------------------------------------------------*/
/* Gestion des erreurs */
/*-------------------------------------------------------------------*/
ERREUR:
DLCOBJ OBJ((&DTAARADS *FILE *EXCL))
MONMSG MSGID(CPF0000)
DLTOVR FILE(&WRKF)
MONMSG MSGID(CPF0000)
RMVM FILE(&WRKF) MBR(&WRKM)
MONMSG MSGID(CPF0000)
RCLRSC
MONMSG MSGID(CPF0000)
/* FWDPGMMSG */
MONMSG MSGID(CPF0000)
RETURN
/*-------------------------------------------------------------------*/
/* Fin du programme */
/*-------------------------------------------------------------------*/
FINPGM:
DLCOBJ OBJ((&DTAARADS *FILE *EXCL))
DLTOVR FILE(&WRKF)
RMVM FILE(&WRKF) MBR(&WRKM)
RCLRSC
MONMSG MSGID(CPF0000)
ENDPGM
=========================== RPG GEI0006R =========================
*%%%* Instruction pour compilation -------------------+
*%%% CRTBNDRPG
*%%% PGM(%LIBO/%OBJ)
*%%% SRCFILE(%LIBS/%FIC)
*%%% SRCMBR(%MBR)
*%%% DFTACTGRP(*NO)
*%%% ACTGRP(*CALLER)
*%%%&
****************************************************************
*
* AUTEUR . . : Denis Robitaille
* DATE . . . : 97/03/27
*
* DESCRIPTION : Transfert des donnee entre le fichier de travail
* et une variable
*
*
* USAGE SOMMAIRE DES INDICATEURS
* ------------------------------
* 55 Utilitaire
*
* MODIFICATIONS
* -------------
*
***************************************************************
fgei0006t uf a e disk
d@v2000 s 2000a
d@12 s 1a
c *entry plist
c parm @v2000
c parm @12
c if @12 = '1'
c eval b2000 = @v2000
c write rgei0006
c else
c 1 chain gei0006t 55
c if not *in55
c eval @v2000 = b2000
c endif
c endif
c eval *inlr = *on
======================= extract from MSGF GEMSG ======================
GE00002 File &1 of &2 is being used... verify
========================================================================
Denis Robitaille
Directeur services technique TI
819 363 6130
SUPPORT
Jour (EST) Daytime : 819-363-6134
En-dehors des heures (EST) After hour : 819-363-6158
Network Status : 819-363-6157
>>> steve.raby@xxxxxx 2005-07-26 09:46:11 >>>
I would be very interested Denis
TIA
Steve
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx]On Behalf Of Denis Robitaille
Sent: 26 July 2005 15:40
To: rpg400-l@xxxxxxxxxxxx
Subject: RE: CHGDTAARA packed field
We have a lot of data area like this: Caracter data area with several subfield
containing different kind of information. What we did to overcome the kind of
problem presented here is the following:
- create an external DS (a physical file) that defines the structure of the
data area
- create a utility program that uses this external DS to provide a facility to
update the data area
this way, we have no issue with packed, zone, caracter... We also never make
mistake like using the wrong offset for a subfield.
If some are interested, I can post the source of this utility. It is made of: 1
command, 1 CLP, 1 RPG and a message file
Denis Robitaille
Directeur services technique TI
819 363 6130
SUPPORT
Jour (EST) Daytime : 819-363-6134
En-dehors des heures (EST) After hour : 819-363-6158
Network Status : 819-363-6157
>>> steve.raby@xxxxxx 2005-07-26 09:13:57 >>>
Hello Chaps,
Nope that didn't work, this is what the live one looks like,
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 'AMBISPRD 9902U34274AMB N J ?J32101 '
50 ' éh Scholing . . . . . . . . . . . . . . . . . V'
100 'oertaal. . . . . . . VO2max. . . . . . . . . . . .'
150 ' . . . . . . .111 N '
200 ' '
250 ' '
300 ' '
350 ' '
400 ' '
and this is the test after that change,
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 'AMBISLNP 9902SUP01 N J00000000100 & '
50 ' (1) . . . . . . . . . (2) . . . . . . . . . ('
100 '3) . . . . . . . . . (4) . . . . . . . . . (5) . .'
150 ' . . . . . . .111 N '
200 ' '
250 ' '
300 ' '
350 ' '
400 ' '
The field starts in position 33, I cannot change the data area as it is part of
a package so I just need that little bit changed.
Steve
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx]On Behalf Of Jonathan Mason
Sent: 26 July 2005 14:32
To: 'RPG programming on the AS400 / iSeries'
Subject: RE: CHGDTAARA packed field
Hi Steve
I was going to say the same thing as Paul, but he beat me to it :-)
All the best
Jonathan
www.astradyne-uk.com
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Paul Tuohy
Sent: 26 July 2005 13:23
To: RPG programming on the AS400 / iSeries
Subject: Re: CHGDTAARA packed field
Hi Steve,
get the boot ready :-)
The data area is a character data area so the VALUE needs to be a
character
field.
Try -
PGM
DCL VAR(&NUM) TYPE(*DEC) LEN(9 0) +
VALUE(1)
DCL VAR(&NUMCHAR) TYPE(*CHAR) LEN(9)
CHGVAR &NUMCHAR &NUM
CHGDTAARA DTAARA(AMBISDATA (33 9)) VALUE(&NUMCHAR)
ENDPGM
HTH
Paul
----- Original Message -----
From: "Raby, Steve (GE Advanced Materials, consultant)"
<steve.raby@xxxxxx>
To: "RPG programming on the AS400 / iSeries" <rpg400-l@xxxxxxxxxxxx>
Sent: Tuesday, July 26, 2005 12:59 PM
Subject: RE: CHGDTAARA packed field
> Hello Jonathan
>
> I just want to change the value to one, I tried just CHGDTAARA from a
command line, then I put it in a CL,
>
>
> PGM
> DCL VAR(&NUM) TYPE(*DEC) LEN(9 0) +
> VALUE(1)
> CHGDTAARA DTAARA(AMBISDATA (33 9)) VALUE(&NUM)
> ENDPGM
>
> And I get this,
>
>
> Message ID . . . . . . : CPA0701
> Date sent . . . . . . : 05/07/26 Time sent . . . . . . :
13:54:06
>
> Message . . . . : CPF1019 received by CHGDTAARA at 500. (C D I R)
>
> Cause . . . . . : Control language (CL) program CHGDTAARA in
library
> AMBISLNP detected an error at statement number 500. Message text
for
CPF1019
> is: VALUE parameter not correct.
> Recovery . . . : This inquiry message can be avoided by changing
the
>
> the dump looks like;
>
> 5722SS1 V5R2M0 020719 CL Program
Dump
> Job name . . . . . . . . : SWRDV027D1 User name . . . . . . . . :
SUPPORT
> Program name . . . . . . : CHGDTAARA Library . . . . . . . . . :
AMBISLNP
> Messages
> Message Message
From
> Time ID Sev Type Text
Program
> 135406 00 CMD 500 - CHGDTAARA
DTAA
QCADRV
> RA(AMBISDATA (33
9)) VA
> LUE(1)
> 135406 CPF1019 40 ESC VALUE parameter not
cor
QWCCCHVC
> rect.
> 135406 CPF9999 40 ESC Function check.
CPF1019
QMHUNMSG
> unmonitored by
CHGDTAA
> RA at statement
500, in
> struction X'000F'.
> Variables
> Variable Type Length Value
Valu
>
*...+....1....+....2....+ * .
> &NUM *DEC 9 0 1
>
>
> Do I need to put it into Hex or something? I am probably going to kick
myself when I find out what I am doing wrong aren't I?
>
> Steve
>
>
> -----Original Message-----
> From: rpg400-l-bounces@xxxxxxxxxxxx
> [mailto:rpg400-l-bounces@xxxxxxxxxxxx]On Behalf Of Jonathan Mason
> Sent: 26 July 2005 13:48
> To: 'RPG programming on the AS400 / iSeries'
> Subject: RE: CHGDTAARA packed field
>
>
> Hi Steve
>
> What error messages are you getting? How are you trying to change it?
> Can you provide code samples?
>
> All the best
>
> Jonathan
> www.astradyne-uk.com
>
>
> -----Original Message-----
> From: rpg400-l-bounces@xxxxxxxxxxxx
> [mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Raby, Steve (GE
> Advanced Materials, consultant)
> Sent: 26 July 2005 11:55
> To: RPG programming on the AS400 / iSeries
> Subject: CHGDTAARA packed field
>
> Hello All,
>
> I have a data area with a 9,0 packed field in that I am trying to
> change, just a one off. I just keep getting error messages, how do I
> change that?
>
> TIA
>
> Steve
>
>
>
> --
> This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing
> list
> To post a message email: RPG400-L@xxxxxxxxxxxx
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
> or email: RPG400-L-request@xxxxxxxxxxxx
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/rpg400-l.
>
>
>
> --
> This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing
list
> To post a message email: RPG400-L@xxxxxxxxxxxx
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
> or email: RPG400-L-request@xxxxxxxxxxxx
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/rpg400-l.
>
>
> --
> This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing
list
> To post a message email: RPG400-L@xxxxxxxxxxxx
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
> or email: RPG400-L-request@xxxxxxxxxxxx
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/rpg400-l.
>
>
As an Amazon Associate we earn from qualifying purchases.
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.
