1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
4 /*--------------------------------------------------------------------------
5 ------------------------------------------------------------------------*/
7 DEF INPUT PARAMETER report-options
AS CHAR NO-UNDO.
9 DEF VAR preview
AS LOGICAL NO-UNDO INITIAL No.
10 DEF VAR group-list
AS CHAR NO-UNDO INITIAL "".
11 DEF VAR max-depth
AS INT NO-UNDO INITIAL 4.
12 DEF VAR menu-user
AS CHAR NO-UNDO INITIAL "".
15 DEF VAR menu-depth
AS INT NO-UNDO INITIAL 0.
18 DEF VAR user-name
AS CHAR NO-UNDO.
19 {inc
/username.i
"user-name"}
20 DEF VAR timeStamp
AS CHAR FORMAT "X(44)" NO-UNDO.
21 timeStamp
= STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
24 /* $History
: menulist.p $
26 * ***************** Version
5 *****************
27 * User
: Andrew Date
: 22/12/97 Time
: 14:49
28 * Updated in $
/PROCESS/REPORT
29 * Should only check in a couple of items
- let's see
!
31 * ***************** Version
4 *****************
32 * User
: Andrew Date
: 22/12/97 Time
: 9:44
33 * Updated in $
/PROCESS/REPORT
34 * Testing new SS version
36 * ***************** Version
3 *****************
37 * User
: Andrew Date
: 19/12/97 Time
: 10:46
38 * Updated in $
/PROCESS/REPORT
39 * Sending an update to OZ and to Auckland
41 * ***************** Version
2 *****************
42 * User
: Andrew Date
: 15/10/97 Time
: 9:37
43 * Updated in $
/PROCESS/REPORT
44 * Sending out another update
46 * ***************** Version
1 *****************
47 * User
: Andrew Date
: 21/07/97 Time
: 0:08
48 * Created in $
/PROCESS/REPORT
51 /* _UIB-CODE-BLOCK-END
*/
55 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
57 /* ******************** Preprocessor Definitions
******************** */
59 &Scoped-define PROCEDURE-TYPE Procedure
63 /* _UIB-PREPROCESSOR-BLOCK-END
*/
67 /* ************************ Function Prototypes
********************** */
69 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD include-group Procedure
70 FUNCTION include-group
RETURNS LOGICAL
71 ( INPUT grp
AS CHAR ) FORWARD.
73 /* _UIB-CODE-BLOCK-END
*/
77 /* *********************** Procedure Settings
************************ */
79 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
80 /* Settings for
THIS-PROCEDURE
84 Add Fields to
: Neither
85 Other Settings
: CODE-ONLY
COMPILE
87 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
89 /* ************************* Create Window
************************** */
91 &ANALYZE-SUSPEND _CREATE-WINDOW
92 /* DESIGN Window definition
(used by the UIB
)
93 CREATE WINDOW Procedure
ASSIGN
96 /* END WINDOW DEFINITION
*/
102 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
103 /* ************************* Included-Libraries
*********************** */
105 {inc
/method
/m-txtrep.i
}
107 /* _UIB-CODE-BLOCK-END
*/
112 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
115 /* *************************** Main Block
*************************** */
117 OUTPUT TO VALUE(txtrep-print-file
) KEEP-MESSAGES PAGE-SIZE 0.
119 RUN pclrep-start
( preview
, "reset,portrait,tm,2,a4,lm,6,courier,cpi,18,lpi,9").
121 RUN show-menus
( "Main Menu" ).
127 /* _UIB-CODE-BLOCK-END
*/
131 /* ********************** Internal Procedures
*********************** */
133 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
134 PROCEDURE inst-page-footer
:
135 /*------------------------------------------------------------------------------
136 Purpose
: Print any page footer
137 ------------------------------------------------------------------------------*/
139 RUN pclrep-line
( "univers,Point,7,bold,Proportional",
140 SPC
( IF INDEX( ENTRY( 1, pclrep-font-text
, pclrep-delimiter
), "landscape") > 0 THEN 100 ELSE 40 )
141 + "Page " + STRING(pclrep-page-number
)).
145 /* _UIB-CODE-BLOCK-END
*/
149 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
150 PROCEDURE inst-page-header
:
151 /*------------------------------------------------------------------------------
152 Purpose
: Print any page header
153 ------------------------------------------------------------------------------*/
155 RUN pclrep-line
( "univers,Point,7,bold,Proportional", TimeStamp
).
156 RUN pclrep-line
( "univers,Point,12,bold,Proportional",
157 FILL( " ", 45 ) + "Structured Menu Listing"
158 + (IF group-list
= "" THEN " - All User Groups" ELSE "")
159 + (IF menu-user
<> "" THEN " - User: " + menu-user
ELSE "") ).
161 IF menu-user
= "" AND group-list
<> "" THEN
162 RUN pclrep-line
( "univers,Point,10,normal,Proportional", group-list
).
164 RUN pclrep-line
( "", "").
165 RUN pclrep-line
( "courier,Fixed,cpi,18,lpi,9,Bold",
166 STRING( "Menu or Program", "X(61)" ) + "Description" ).
171 /* _UIB-CODE-BLOCK-END
*/
175 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
176 PROCEDURE parse-parameters
:
177 /*------------------------------------------------------------------------------
178 Purpose
: Decode the command-line parameters
179 ------------------------------------------------------------------------------*/
180 DEF VAR i
AS INT NO-UNDO.
181 DEF VAR token
AS CHAR NO-UNDO.
183 {inc
/showopts.i
"report-options"}
185 DO i
= 1 TO NUM-ENTRIES( report-options
, "~n" ):
186 token
= ENTRY( i
, report-options
, "~n" ).
187 CASE( ENTRY( 1, token
) ):
188 WHEN "Preview" THEN preview
= Yes.
189 WHEN "Groups" THEN group-list
= SUBSTRING( token
, INDEX(token
,",") + 1).
190 WHEN "Depth" THEN max-depth
= INT( ENTRY(2,token
) ).
191 WHEN "User" THEN menu-user
= ENTRY(2,token
).
197 /* _UIB-CODE-BLOCK-END
*/
201 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE show-menus Procedure
202 PROCEDURE show-menus
:
203 /*------------------------------------------------------------------------------
205 ------------------------------------------------------------------------------*/
206 DEF INPUT PARAMETER menu-name
AS CHAR NO-UNDO.
208 DEF VAR this-menu
AS CHAR NO-UNDO INITIAL "".
209 DEF VAR valid-group
AS LOGI
INITIAL No
NO-UNDO.
211 DEF BUFFER OtherMenu
FOR UsrGroupMenu.
212 DEF BUFFER OtherMenuItem
FOR UsrGroupMenuItem.
213 DEF BUFFER LN
FOR LinkNode.
214 DEF BUFFER PL
FOR ProgramLink.
216 FOR EACH UsrGroupMenu
NO-LOCK WHERE UsrGroupMenu.MenuName
= menu-name
:
217 IF include-group
( UsrGroupMenu.GroupName
) THEN DO:
222 IF NOT valid-group
THEN RETURN.
224 RUN pclrep-line
( "Times,Proportional,Point,14,Bold", "").
225 RUN pclrep-line
( "Times,Proportional,Point,11,Bold", SPC
(menu-depth
* 3)
228 IF menu-depth
> max-depth
THEN DO:
229 RUN pclrep-line
( "Times,Proportional,Point,11,Bold", SPC
(menu-depth
* 3)
230 + " ---> Probable loop: exceeded maximum depth" ).
234 menu-depth
= menu-depth
+ 1.
236 FOR EACH UsrGroupMenu
NO-LOCK WHERE UsrGroupMenu.MenuName
= menu-name
:
237 IF NOT include-group
( UsrGroupMenu.GroupName
) THEN NEXT.
238 FOR EACH UsrGroupMenuItem
NO-LOCK OF UsrGroupMenu
,
239 FIRST ProgramLink
OF UsrGroupMenuItem
:
240 IF LOOKUP( STRING(UsrGroupMenuItem.LinkCode
), this-menu
) > 0 THEN NEXT.
241 this-menu
= this-menu
+ STRING(UsrGroupMenuItem.LinkCode
) + ",".
242 RUN pclrep-line
( "courier,Fixed,cpi,18,lpi,9",
243 STRING( SPC
(menu-depth
* 3) + UsrGroupMenuItem.ButtonLabel
, "X(60)")
244 + Programlink.Description
).
249 FOR EACH OtherMenu
NO-LOCK WHERE OtherMenu.MenuName
= menu-name
:
250 IF NOT include-group
( OtherMenu.GroupName
) THEN NEXT.
251 FOR EACH OtherMenuItem
NO-LOCK OF OtherMenu
,
252 FIRST PL
OF OtherMenuItem
WHERE PL.LinkType
<> "MSG",
253 FIRST LN
WHERE LN.NodeCode
= PL.Target
:
254 IF LOOKUP( STRING(OtherMenuItem.LinkCode
), this-menu
) > 0 THEN NEXT.
255 this-menu
= this-menu
+ STRING(OtherMenuItem.LinkCode
) + ",".
256 RUN show-menus
( LN.Description
).
260 menu-depth
= menu-depth
- 1.
264 /* _UIB-CODE-BLOCK-END
*/
268 /* ************************ Function Implementations
***************** */
270 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION include-group Procedure
271 FUNCTION include-group
RETURNS LOGICAL
272 ( INPUT grp
AS CHAR ) :
273 /*------------------------------------------------------------------------------
276 ------------------------------------------------------------------------------*/
277 IF group-list
= "" THEN RETURN Yes.
279 RETURN (LOOKUP(grp
, group-list
) > 0).
283 /* _UIB-CODE-BLOCK-END
*/