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