From 97efcdacc9c36cf9d50e219185c087fb7f2a9668 Mon Sep 17 00:00:00 2001 From: Andrew McMillan Date: Wed, 27 Aug 2008 17:10:11 +1200 Subject: [PATCH] Company.Parent is not specific enough now. --- process/report/cmplistg.p | 521 ++++++++++++++++++++++++---------------------- 1 file changed, 270 insertions(+), 251 deletions(-) diff --git a/process/report/cmplistg.p b/process/report/cmplistg.p index ef43ee8..1d0455f 100644 --- a/process/report/cmplistg.p +++ b/process/report/cmplistg.p @@ -1,251 +1,270 @@ -&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 -&ANALYZE-RESUME -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure -/*-------------------------------------------------------------------------- - Company Listing Report - ------------------------------------------------------------------------*/ -DEF INPUT PARAMETER report-options AS CHAR NO-UNDO. - -DEF VAR sort-by AS CHAR NO-UNDO INIT "Code". -DEF VAR hierarchy-root AS INT NO-UNDO. -DEF VAR one-client AS CHAR NO-UNDO INIT ?. -DEF VAR preview AS LOGI NO-UNDO INIT No. -DEF VAR active-only AS LOGI NO-UNDO INIT No. -RUN parse-parameters. - -DEF VAR user-name AS CHAR NO-UNDO. -DEF VAR timeStamp AS CHAR FORMAT "X(44)" NO-UNDO. - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - -&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK - -/* ******************** Preprocessor Definitions ******************** */ - -&Scoped-define PROCEDURE-TYPE Procedure - - - -/* _UIB-PREPROCESSOR-BLOCK-END */ -&ANALYZE-RESUME - - - -/* *********************** Procedure Settings ************************ */ - -&ANALYZE-SUSPEND _PROCEDURE-SETTINGS -/* Settings for THIS-PROCEDURE - Type: Procedure - Allow: - Frames: 0 - Add Fields to: Neither - Other Settings: CODE-ONLY COMPILE - */ -&ANALYZE-RESUME _END-PROCEDURE-SETTINGS - -/* ************************* Create Window ************************** */ - -&ANALYZE-SUSPEND _CREATE-WINDOW -/* DESIGN Window definition (used by the UIB) - CREATE WINDOW Procedure ASSIGN - HEIGHT = .21 - WIDTH = 36.14. -/* END WINDOW DEFINITION */ - */ -&ANALYZE-RESUME - - - -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure -/* ************************* Included-Libraries *********************** */ - -{inc/method/m-txtrep.i} - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - - -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure - - -/* *************************** Main Block *************************** */ -{inc/username.i "user-name"} -timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name. - -OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0. - -RUN pclrep-start( preview, "reset,portrait,tm,2,a4,lm,6,courier,cpi,18,lpi,9"). - -RUN company-listing. - -OUTPUT CLOSE. - -RUN pclrep-finish. - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - -/* ********************** Internal Procedures *********************** */ - -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE company-hierarchy Procedure -PROCEDURE company-hierarchy : -/*------------------------------------------------------------------------------ - Purpose: -------------------------------------------------------------------------------*/ -DEF INPUT PARAMETER current-depth AS INT NO-UNDO. -DEF INPUT PARAMETER root-company AS INT NO-UNDO. - -DEF VAR i AS INT NO-UNDO INIT 0. - FIND Company WHERE Company.CompanyCode = root-company NO-LOCK NO-ERROR. - IF NOT AVAILABLE(Company) THEN RETURN. - RUN each-company(current-depth). - IF RETURN-VALUE = "Printed" THEN i = i + 1. - -DEF BUFFER Child FOR Company. -DEF VAR j AS INT NO-UNDO INIT 0. - FOR EACH Child WHERE Child.ParentCode = root-company NO-LOCK: -/* MESSAGE Child.CompanyCode Child.LegalName . */ - RUN company-hierarchy( current-depth + 1, Child.CompanyCode ). - j = j + INT(RETURN-VALUE). - END. - IF j > 0 THEN - RUN pclrep-line( ?, ?). - - RETURN STRING(i). - -END PROCEDURE. - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE company-listing Procedure -PROCEDURE company-listing : -/*------------------------------------------------------------------------------ - Purpose: -------------------------------------------------------------------------------*/ -DEF VAR current-level AS INT NO-UNDO INIT 0. - - CASE sort-by: - WHEN "Code" THEN - FOR EACH Company NO-LOCK: - RUN each-company(current-level). - END. - WHEN "Name" THEN - FOR EACH Company NO-LOCK BY Company.LegalName: - RUN each-company(current-level). - END. - WHEN "Hierarchy" THEN - RUN company-hierarchy( current-level, hierarchy-root ). - END CASE. -END PROCEDURE. - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-company Procedure -PROCEDURE each-company : -/*------------------------------------------------------------------------------ - Purpose: -------------------------------------------------------------------------------*/ -DEF INPUT PARAMETER depth AS INT NO-UNDO. - - IF active-only AND NOT Company.Active THEN RETURN "Not printed". - - RUN pclrep-line( "courier,Fixed,cpi,18,lpi,9,Normal", - FILL( " ", depth ) + - STRING( Company.CompanyCode, ">>999" ) + SPC( 2 ) + - STRING( Company.ShortName, "X(12)" ) + SPC( 2 ) + - STRING( Company.LegalName, "X(80)" ) - + (IF sort-by <> "Hierarchy" AND Company.Parent <> ? THEN - SPC( 2 ) + STRING( Company.Parent, ">>999" ) - ELSE "") - ). - - RETURN "Printed". - -END PROCEDURE. - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure -PROCEDURE inst-page-footer : -/*------------------------------------------------------------------------------ - Purpose: Print any page footer -------------------------------------------------------------------------------*/ - -END PROCEDURE. - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure -PROCEDURE inst-page-header : -/*------------------------------------------------------------------------------ - Purpose: Print any page header -------------------------------------------------------------------------------*/ - - RUN pclrep-line( "univers,Point,7,Proportional,Bold", TimeStamp). - RUN pclrep-line( "univers,Point,12,Proportional,Bold", - FILL( " ", 45) + "Company Listing by " + sort-by ). - RUN pclrep-line( "", ""). - RUN pclrep-line( "courier,Fixed,cpi,18,lpi,9,Bold", - STRING( "Code", "X(5)" ) + SPC( 2 ) + - STRING( "Short Name", "X(12)" ) + SPC( 2 ) + - STRING( "Legal Name", "X(80)" ) - + (IF sort-by <> "Hierarchy" THEN - SPC(2) + STRING( "Parent", "X(6)" ) - ELSE "" ) - ). - RUN pclrep-line( "", ""). - -END PROCEDURE. - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - -&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure -PROCEDURE parse-parameters : -/*------------------------------------------------------------------------------ - Purpose: -------------------------------------------------------------------------------*/ -DEF VAR i AS INT NO-UNDO. -DEF VAR token AS CHAR NO-UNDO. - -{inc/showopts.i "report-options"} - - DO i = 1 TO NUM-ENTRIES( report-options, "~n" ): - token = ENTRY( i, report-options, "~n" ). - - CASE ENTRY( 1, token ): - - WHEN "Sort" THEN ASSIGN - sort-by = ENTRY( 2,token ) - hierarchy-root = INT( ENTRY(3,token) ). - - WHEN "Preview" THEN preview = Yes. - - WHEN "ActiveOnly" THEN active-only = Yes. - - WHEN "OneClient" THEN ASSIGN - one-client = ENTRY( 2, token ). - - END CASE. - - END. - -END PROCEDURE. - -/* _UIB-CODE-BLOCK-END */ -&ANALYZE-RESUME - - +&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 +&ANALYZE-RESUME +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure +/*-------------------------------------------------------------------------- + Company Listing Report + ------------------------------------------------------------------------*/ +DEF INPUT PARAMETER report-options AS CHAR NO-UNDO. + +DEF VAR sort-by AS CHAR NO-UNDO INIT "Code". +DEF VAR hierarchy-root AS INT NO-UNDO. +DEF VAR one-client AS CHAR NO-UNDO INIT ?. +DEF VAR preview AS LOGI NO-UNDO INIT No. +DEF VAR active-only AS LOGI NO-UNDO INIT No. +RUN parse-parameters. + +DEF VAR user-name AS CHAR NO-UNDO. +DEF VAR timeStamp AS CHAR FORMAT "X(44)" NO-UNDO. + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + + +&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK + +/* ******************** Preprocessor Definitions ******************** */ + +&Scoped-define PROCEDURE-TYPE Procedure +&Scoped-define DB-AWARE no + + + +/* _UIB-PREPROCESSOR-BLOCK-END */ +&ANALYZE-RESUME + + + +/* *********************** Procedure Settings ************************ */ + +&ANALYZE-SUSPEND _PROCEDURE-SETTINGS +/* Settings for THIS-PROCEDURE + Type: Procedure + Allow: + Frames: 0 + Add Fields to: Neither + Other Settings: CODE-ONLY COMPILE + */ +&ANALYZE-RESUME _END-PROCEDURE-SETTINGS + +/* ************************* Create Window ************************** */ + +&ANALYZE-SUSPEND _CREATE-WINDOW +/* DESIGN Window definition (used by the UIB) + CREATE WINDOW Procedure ASSIGN + HEIGHT = .2 + WIDTH = 36.14. +/* END WINDOW DEFINITION */ + */ +&ANALYZE-RESUME + +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure +/* ************************* Included-Libraries *********************** */ + +{inc/method/m-txtrep.i} + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + + + + + +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure + + +/* *************************** Main Block *************************** */ +{inc/username.i "user-name"} +timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name. + +OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0. + +RUN pclrep-start( preview, "reset,portrait,tm,2,a4,lm,6,courier,cpi,18,lpi,9"). + +RUN company-listing. + +OUTPUT CLOSE. + +RUN pclrep-finish. + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + + +/* ********************** Internal Procedures *********************** */ + +&IF DEFINED(EXCLUDE-company-hierarchy) = 0 &THEN + +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE company-hierarchy Procedure +PROCEDURE company-hierarchy : +/*------------------------------------------------------------------------------ + Purpose: +------------------------------------------------------------------------------*/ +DEF INPUT PARAMETER current-depth AS INT NO-UNDO. +DEF INPUT PARAMETER root-company AS INT NO-UNDO. + +DEF VAR i AS INT NO-UNDO INIT 0. + FIND Company WHERE Company.CompanyCode = root-company NO-LOCK NO-ERROR. + IF NOT AVAILABLE(Company) THEN RETURN. + RUN each-company(current-depth). + IF RETURN-VALUE = "Printed" THEN i = i + 1. + +DEF BUFFER Child FOR Company. +DEF VAR j AS INT NO-UNDO INIT 0. + FOR EACH Child WHERE Child.ParentCode = root-company NO-LOCK: +/* MESSAGE Child.CompanyCode Child.LegalName . */ + RUN company-hierarchy( current-depth + 1, Child.CompanyCode ). + j = j + INT(RETURN-VALUE). + END. + IF j > 0 THEN + RUN pclrep-line( ?, ?). + + RETURN STRING(i). + +END PROCEDURE. + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + +&ENDIF + +&IF DEFINED(EXCLUDE-company-listing) = 0 &THEN + +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE company-listing Procedure +PROCEDURE company-listing : +/*------------------------------------------------------------------------------ + Purpose: +------------------------------------------------------------------------------*/ +DEF VAR current-level AS INT NO-UNDO INIT 0. + + CASE sort-by: + WHEN "Code" THEN + FOR EACH Company NO-LOCK: + RUN each-company(current-level). + END. + WHEN "Name" THEN + FOR EACH Company NO-LOCK BY Company.LegalName: + RUN each-company(current-level). + END. + WHEN "Hierarchy" THEN + RUN company-hierarchy( current-level, hierarchy-root ). + END CASE. +END PROCEDURE. + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + +&ENDIF + +&IF DEFINED(EXCLUDE-each-company) = 0 &THEN + +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-company Procedure +PROCEDURE each-company : +/*------------------------------------------------------------------------------ + Purpose: +------------------------------------------------------------------------------*/ +DEF INPUT PARAMETER depth AS INT NO-UNDO. + + IF active-only AND NOT Company.Active THEN RETURN "Not printed". + + RUN pclrep-line( "courier,Fixed,cpi,18,lpi,9,Normal", + FILL( " ", depth ) + + STRING( Company.CompanyCode, ">>999" ) + SPC( 2 ) + + STRING( Company.ShortName, "X(12)" ) + SPC( 2 ) + + STRING( Company.LegalName, "X(80)" ) + + (IF sort-by <> "Hierarchy" AND Company.ParentCode <> ? THEN + SPC( 2 ) + STRING( Company.ParentCode, ">>999" ) + ELSE "") + ). + + RETURN "Printed". + +END PROCEDURE. + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + +&ENDIF + +&IF DEFINED(EXCLUDE-inst-page-footer) = 0 &THEN + +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure +PROCEDURE inst-page-footer : +/*------------------------------------------------------------------------------ + Purpose: Print any page footer +------------------------------------------------------------------------------*/ + +END PROCEDURE. + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + +&ENDIF + +&IF DEFINED(EXCLUDE-inst-page-header) = 0 &THEN + +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure +PROCEDURE inst-page-header : +/*------------------------------------------------------------------------------ + Purpose: Print any page header +------------------------------------------------------------------------------*/ + + RUN pclrep-line( "univers,Point,7,Proportional,Bold", TimeStamp). + RUN pclrep-line( "univers,Point,12,Proportional,Bold", + FILL( " ", 45) + "Company Listing by " + sort-by ). + RUN pclrep-line( "", ""). + RUN pclrep-line( "courier,Fixed,cpi,18,lpi,9,Bold", + STRING( "Code", "X(5)" ) + SPC( 2 ) + + STRING( "Short Name", "X(12)" ) + SPC( 2 ) + + STRING( "Legal Name", "X(80)" ) + + (IF sort-by <> "Hierarchy" THEN + SPC(2) + STRING( "Parent", "X(6)" ) + ELSE "" ) + ). + RUN pclrep-line( "", ""). + +END PROCEDURE. + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + +&ENDIF + +&IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN + +&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure +PROCEDURE parse-parameters : +/*------------------------------------------------------------------------------ + Purpose: +------------------------------------------------------------------------------*/ +DEF VAR i AS INT NO-UNDO. +DEF VAR token AS CHAR NO-UNDO. + +{inc/showopts.i "report-options"} + + DO i = 1 TO NUM-ENTRIES( report-options, "~n" ): + token = ENTRY( i, report-options, "~n" ). + + CASE ENTRY( 1, token ): + + WHEN "Sort" THEN ASSIGN + sort-by = ENTRY( 2,token ) + hierarchy-root = INT( ENTRY(3,token) ). + + WHEN "Preview" THEN preview = Yes. + + WHEN "ActiveOnly" THEN active-only = Yes. + + WHEN "OneClient" THEN ASSIGN + one-client = ENTRY( 2, token ). + + END CASE. + + END. + +END PROCEDURE. + +/* _UIB-CODE-BLOCK-END */ +&ANALYZE-RESUME + +&ENDIF + -- 2.11.4.GIT