|
If this is a choice program then I will be better off with a SUBFILE but I'm not going that route. I will do away with the DYNAMIC file retrieval. thanks to all who contribute. Dare ----- Original Message ----- From: "David Morris" <David.Morris@plumcreek.com> To: <rpg400-l@midrange.com> Sent: Friday, July 19, 2002 1:28 PM Subject: Re: Programming Command - CMD > Here is something to look at while Bob is bailing: > > FSOCLL001 IF E K DISK RENAME(SCL000:SCL001) > > F* Classes > > F* SOCLP000 by CLCLS > > > D*************************************************************************** ******************* > D CmdInf DS > > D Cmd 10A > > D CmdKwd 10A > > D ChcTyp 1A > > D RtnChcTxt DS > > D ClsCnt 5U 0 > > D ClsChc 1998A > > D ClsLenAlp DS > > D ClsLen 5U 0 > > > C*************************************************************************** ******************* > C *ENTRY PLIST > > C PARM CmdInf > Command info > C PARM RtnChcTxt > Choice field > C* > > C* Process each command separately > > C* > > C SELECT > > C WHEN Cmd = 'CRTOBJ' Or > > C Cmd = 'UPDOBJCAT' > > C EXSR SubCRTOBJ > > C WHEN Cmd = 'WRKOBJCAT' > > C EXSR SubWRKOBJCAT > > C WHEN Cmd = 'RLDOBJCAT' > > C EXSR SubRLDOBJCAT > > C ENDSL > Cmd > C* > > C MOVE *ON *INLR > > C RETURN > > > C*************************************************************************** ******************* > C* CRTOBJ command > > > C*************************************************************************** ******************* > C SubCRTOBJ BEGSR > > C* > > C* Choice text > > C* > > C IF ChcTyp = 'C' > > C EVAL RtnChcTxt = *BLANKS > > C READ SOCLL001 > 01 > C DOW *IN01 = *OFF > > C IF %LEN(%TRIM(RtnChcTxt) + ', ' + > CLCLS) > 27 > C EVAL RtnChcTxt = %TRIMR(RtnChcTxt) + > '...' > C LEAVE > > C ENDIF > > C IF CLSOT = 'Y' > > C IF RtnChcTxt <> *BLANKS > > C EVAL RtnChcTxt = %TRIMR(RtnChcTxt) + ', ' > + CLCLS > C ELSE > > C EVAL RtnChcTxt = CLCLS > > C ENDIF > ChcTxt<>*BLANKS > C ENDIF > CLSOT='Y' > C READ SOCLL001 > 01 > C ENDDO > > C* > > C* Choices list > > C* > > C ELSE > > C EVAL ClsCnt = 0 > > C EVAL ClsChc = *BLANKS > > C READ SOCLL001 > 01 > C DOW *IN01 = *OFF > > C IF CLSOT = 'Y' > > C EVAL ClsCnt = ClsCnt + 1 > > C EVAL ClsLen = %LEN(%TRIMR(CLCLS)) > > C EVAL ClsChc = %TRIMR(ClsChc) + ClsLenAlp > + CLCLS > C ENDIF > CLSOT='Y' > C READ SOCLL001 > 01 > C ENDDO > > C ENDIF > ChcTyp='C' > C* > > C ENDSR > > > C*************************************************************************** ******************* > C* WRKOBJCAT command > > > C*************************************************************************** ******************* > C SubWRKOBJCAT BEGSR > > C* > > C* Choice text > > C* > > C IF ChcTyp = 'C' > > C EVAL RtnChcTxt = '*ALL, *PROMPT' > > C READ SOCLL001 > 01 > C DOW *IN01 = *OFF > > C IF %LEN(%TRIM(RtnChcTxt) + ', ' + > CLCLS) > 27 > C EVAL RtnChcTxt = %TRIMR(RtnChcTxt) + > '...' > C LEAVE > > C ENDIF > > C IF RtnChcTxt <> *BLANKS > > C EVAL RtnChcTxt = %TRIMR(RtnChcTxt) + ', ' > + CLCLS > C ELSE > > C EVAL RtnChcTxt = CLCLS > > C ENDIF > ChcTxt<>*BLANKS > C READ SOCLL001 > 01 > C ENDDO > > > C*************************************************************************** ******************* > C* WRKOBJCAT command > > > C*************************************************************************** ******************* > C SubWRKOBJCAT BEGSR > > C* > > C* Choice text > > C* > > C IF ChcTyp = 'C' > > C EVAL RtnChcTxt = '*ALL, *PROMPT' > > C READ SOCLL001 > 01 > C DOW *IN01 = *OFF > > C IF %LEN(%TRIM(RtnChcTxt) + ', ' + > CLCLS) > 27 > C EVAL RtnChcTxt = %TRIMR(RtnChcTxt) + > '...' > C LEAVE > > C ENDIF > > C IF RtnChcTxt <> *BLANKS > > C EVAL RtnChcTxt = %TRIMR(RtnChcTxt) + ', ' > + CLCLS > C ELSE > > C EVAL RtnChcTxt = CLCLS > > C ENDIF > ChcTxt<>*BLANKS > C READ SOCLL001 > 01 > C ENDDO > > > C*************************************************************************** ******************* > > C* RLDOBJCAT command > > > C*************************************************************************** ******************* > > C SubRLDOBJCAT BEGSR > > C* > > C* Choice text > > C* > > C IF ChcTyp = 'C' > > C EVAL RtnChcTxt = '*ALL' > > C READ SOCLL001 > 01 > C DOW *IN01 = *OFF > > C IF %LEN(%TRIM(RtnChcTxt) + ', ' + > CLCLS) > 27 > C EVAL RtnChcTxt = %TRIMR(RtnChcTxt) + > '...' > C LEAVE > > C ENDIF > > C IF CLSOT = 'Y' > > C IF RtnChcTxt <> *BLANKS > > C EVAL RtnChcTxt = %TRIMR(RtnChcTxt) + ', ' > + CLCLS > C ELSE > > C EVAL RtnChcTxt = CLCLS > > C ENDIF > ChcTxt<>*BLANKS > C ENDIF > CLSOT='Y' > C READ SOCLL001 > 01 > C ENDDO > > C* > > C* Choices list > > C* > > C ELSE > > C EVAL ClsCnt = 0 > > C EVAL ClsChc = *BLANKS > > C EVAL ClsLen = 4 > > C EVAL ClsChc = %TRIMR(ClsChc) + ClsLenAlp > + '*ALL' > C EVAL ClsCnt = ClsCnt + 1 > > C READ SOCLL001 > 01 > C DOW *IN01 = *OFF > > C IF CLSOT = 'Y' > > C EVAL ClsCnt = ClsCnt + 1 > > C EVAL ClsLen = %LEN(%TRIMR(CLCLS)) > > C EVAL ClsChc = %TRIMR(ClsChc) + ClsLenAlp > + CLCLS > C ENDIF > CLSOT='Y' > C READ SOCLL001 > 01 > C ENDDO > > C ENDIF > ChcTyp='C' > C* > > C ENDSR > > I could also supply a CL choice program if you would like (it is > simpler). If you > need to create more than one of these, I would pull the data retrieval > from the > list building. > > David Morris > > >>> oludare@ix.netcom.com 07/19/02 10:04AM >>> > Bob I will hang around for your findings, meanwhile I look at getting > that > book. > _______________________________________________ > This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list > To post a message email: RPG400-L@midrange.com > To subscribe, unsubscribe, or change list options, > visit: http://lists.midrange.com/cgi-bin/listinfo/rpg400-l > or email: RPG400-L-request@midrange.com > 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.
midrange.com
