|
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-2025 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.