vwr/mnt/v-cmplst.w

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
   2 &ANALYZE-RESUME
   3 /* Connected Databases
   4           ttpl             PROGRESS
   5 */
   6 &Scoped-define WINDOW-NAME CURRENT-WINDOW
   7 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS V-table-Win
   8 /*------------------------------------------------------------------------
   9   File:
  10   Description:
  11 ------------------------------------------------------------------------*/
  12 CREATE WIDGET-POOL.
  13 /* ***************************  Definitions  ************************** */
  14
  15 DEF VAR user-name AS CHAR NO-UNDO.
  16 {inc/username.i "user-name"}
  17
  18 /* _UIB-CODE-BLOCK-END */
  19 &ANALYZE-RESUME
  20
  21
  22 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  23
  24 /* ********************  Preprocessor Definitions  ******************** */
  25
  26 &Scoped-define PROCEDURE-TYPE SmartViewer
  27
  28 &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target
  29
  30 /* Name of first Frame and/or Browse and/or first Query                 */
  31 &Scoped-define FRAME-NAME F-Main
  32
  33 /* External Tables                                                      */
  34 &Scoped-define EXTERNAL-TABLES RP
  35 &Scoped-define FIRST-EXTERNAL-TABLE RP
  36
  37
  38 /* Need to scope the external tables to this procedure                  */
  39 DEFINE QUERY external_tables FOR RP.
  40 /* Standard List Definitions                                            */
  41 &Scoped-Define ENABLED-FIELDS RP.Char1 RP.Int1 RP.Char2 RP.Log2 RP.Log1
  42 &Scoped-define FIELD-PAIRS~
  43  ~{&FP1}Int1 ~{&FP2}Int1 ~{&FP3}
  44 &Scoped-define ENABLED-TABLES RP
  45 &Scoped-define FIRST-ENABLED-TABLE RP
  46 &Scoped-Define ENABLED-OBJECTS RECT-27 cmb_Client btn_ok
  47 &Scoped-Define DISPLAYED-FIELDS RP.Char1 RP.Int1 RP.Char2 RP.Log2 RP.Log1
  48 &Scoped-Define DISPLAYED-OBJECTS fil_Company cmb_Client
  49
  50 /* Custom List Definitions                                              */
  51 /* ADM-CREATE-FIELDS,ADM-ASSIGN-FIELDS,List-3,List-4,List-5,List-6      */
  52
  53 /* _UIB-PREPROCESSOR-BLOCK-END */
  54 &ANALYZE-RESUME
  55
  56
  57
  58 /* ***********************  Control Definitions  ********************** */
  59
  60
  61 /* Definitions of the field level widgets                               */
  62 DEFINE BUTTON btn_ok DEFAULT
  63      LABEL "&OK"
  64      SIZE 9.72 BY 1.
  65
  66 DEFINE VARIABLE cmb_Client AS CHARACTER FORMAT "X(256)"
  67      VIEW-AS COMBO-BOX INNER-LINES 15
  68      LIST-ITEMS "Item 1"
  69      SIZE 41.14 BY 1 NO-UNDO.
  70
  71 DEFINE VARIABLE fil_Company AS CHARACTER FORMAT "X(256)":U
  72      VIEW-AS FILL-IN
  73      SIZE 35.43 BY 1.05 NO-UNDO.
  74
  75 DEFINE RECTANGLE RECT-27
  76      EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
  77      SIZE 60 BY 11.2.
  78
  79
  80 /* ************************  Frame Definitions  *********************** */
  81
  82 DEFINE FRAME F-Main
  83      RP.Char1 AT ROW 2.4 COL 3.86 NO-LABEL
  84           VIEW-AS RADIO-SET VERTICAL
  85           RADIO-BUTTONS
  86                     "Company Name", "Name":U,
  87 "Company Code", "Code":U,
  88 "Hierarchy from", "Hierarchy":U
  89           SIZE 13.72 BY 2.4
  90      RP.Int1 AT ROW 3.8 COL 17.29 COLON-ALIGNED HELP
  91           "" NO-LABEL FORMAT ">>999"
  92           VIEW-AS FILL-IN
  93           SIZE 5.72 BY 1.05
  94      fil_Company AT ROW 3.8 COL 23 COLON-ALIGNED NO-LABEL
  95      RP.Char2 AT ROW 6.4 COL 3.86 HELP
  96           "" NO-LABEL
  97           VIEW-AS RADIO-SET VERTICAL
  98           RADIO-BUTTONS
  99                     "All Clients/Owners", "All":U,
 100 "One Client/Owner", "OneClient":U
 101           SIZE 15.43 BY 1.6
 102      cmb_Client AT ROW 7.2 COL 17.29 COLON-ALIGNED NO-LABEL
 103      RP.Log2 AT ROW 9.2 COL 4.43
 104           LABEL "Active companies only"
 105           VIEW-AS TOGGLE-BOX
 106           SIZE 18.29 BY 1
 107      RP.Log1 AT ROW 10.8 COL 4.43
 108           LABEL "Print Preview"
 109           VIEW-AS TOGGLE-BOX
 110           SIZE 11.72 BY 1
 111      btn_ok AT ROW 11 COL 50.72
 112      RECT-27 AT ROW 1 COL 1
 113      "Sort by:" VIEW-AS TEXT
 114           SIZE 6.29 BY 1 AT ROW 1.4 COL 2.14
 115     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
 116          SIDE-LABELS NO-UNDERLINE THREE-D
 117          AT COL 1 ROW 1 SCROLLABLE
 118          FONT 10
 119          DEFAULT-BUTTON btn_ok.
 120
 121
 122 /* *********************** Procedure Settings ************************ */
 123
 124 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 125 /* Settings for THIS-PROCEDURE
 126    Type: SmartViewer
 127    External Tables: TTPL.RP
 128    Allow: Basic,DB-Fields
 129    Frames: 1
 130    Add Fields to: EXTERNAL-TABLES
 131    Other Settings: PERSISTENT-ONLY COMPILE
 132  */
 133
 134 /* This procedure should always be RUN PERSISTENT.  Report the error,  */
 135 /* then cleanup and return.                                            */
 136 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
 137   MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT."
 138           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 139   RETURN.
 140 END.
 141
 142 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 143
 144 /* *************************  Create Window  ************************** */
 145
 146 &ANALYZE-SUSPEND _CREATE-WINDOW
 147 /* DESIGN Window definition (used by the UIB)
 148   CREATE WINDOW V-table-Win ASSIGN
 149          HEIGHT             = 12.2
 150          WIDTH              = 70.43.
 151 /* END WINDOW DEFINITION */
 152                                                                         */
 153 &ANALYZE-RESUME
 154
 155
 156 /* ***************  Runtime Attributes and UIB Settings  ************** */
 157
 158 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 159 /* SETTINGS FOR WINDOW V-table-Win
 160   VISIBLE,,RUN-PERSISTENT                                               */
 161 /* SETTINGS FOR FRAME F-Main
 162    NOT-VISIBLE Size-to-Fit                                              */
 163 ASSIGN
 164        FRAME F-Main:SCROLLABLE       = FALSE
 165        FRAME F-Main:HIDDEN           = TRUE.
 166
 167 /* SETTINGS FOR RADIO-SET RP.Char2 IN FRAME F-Main
 168    EXP-HELP                                                             */
 169 /* SETTINGS FOR FILL-IN fil_Company IN FRAME F-Main
 170    NO-ENABLE                                                            */
 171 /* SETTINGS FOR FILL-IN RP.Int1 IN FRAME F-Main
 172    EXP-LABEL EXP-FORMAT EXP-HELP                                        */
 173 /* SETTINGS FOR TOGGLE-BOX RP.Log1 IN FRAME F-Main
 174    EXP-LABEL                                                            */
 175 /* SETTINGS FOR TOGGLE-BOX RP.Log2 IN FRAME F-Main
 176    EXP-LABEL                                                            */
 177 /* _RUN-TIME-ATTRIBUTES-END */
 178 &ANALYZE-RESUME
 179
 180
 181 /* Setting information for Queries and Browse Widgets fields            */
 182
 183 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
 184 /* Query rebuild information for FRAME F-Main
 185      _Options          = "NO-LOCK"
 186      _Query            is NOT OPENED
 187 */  /* FRAME F-Main */
 188 &ANALYZE-RESUME
 189
 190
 191
 192
 193 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB V-table-Win
 194 /* ************************* Included-Libraries *********************** */
 195
 196 {src/adm/method/viewer.i}
 197 {inc/method/m-mntvwr.i}
 198
 199 /* _UIB-CODE-BLOCK-END */
 200 &ANALYZE-RESUME
 201
 202
 203
 204
 205 /* ************************  Control Triggers  ************************ */
 206
 207 &Scoped-define SELF-NAME btn_ok
 208 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_ok V-table-Win
 209 ON CHOOSE OF btn_ok IN FRAME F-Main /* OK */
 210 DO:
 211   DISABLE {&SELF-NAME}.
 212   RUN run-report.
 213   ENABLE {&SELF-NAME}.
 214 END.
 215
 216 /* _UIB-CODE-BLOCK-END */
 217 &ANALYZE-RESUME
 218
 219
 220 &Scoped-define SELF-NAME RP.Char1
 221 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL RP.Char1 V-table-Win
 222 ON VALUE-CHANGED OF RP.Char1 IN FRAME F-Main /* Char1 */
 223 DO:
 224   RUN enable-appropriate-fields.
 225 END.
 226
 227 /* _UIB-CODE-BLOCK-END */
 228 &ANALYZE-RESUME
 229
 230
 231 &Scoped-define SELF-NAME RP.Char2
 232 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL RP.Char2 V-table-Win
 233 ON VALUE-CHANGED OF RP.Char2 IN FRAME F-Main /* Char2 */
 234 DO:
 235   RUN enable-appropriate-fields.
 236 END.
 237
 238 /* _UIB-CODE-BLOCK-END */
 239 &ANALYZE-RESUME
 240
 241
 242 &Scoped-define SELF-NAME cmb_Client
 243 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL cmb_Client V-table-Win
 244 ON U1 OF cmb_Client IN FRAME F-Main
 245 DO:
 246   {inc/selcmb/scclient1.i "RP" "Char3"}
 247 END.
 248
 249 /* _UIB-CODE-BLOCK-END */
 250 &ANALYZE-RESUME
 251
 252
 253 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL cmb_Client V-table-Win
 254 ON U2 OF cmb_Client IN FRAME F-Main
 255 DO:
 256   {inc/selcmb/scclient2.i "RP" "Char3"}
 257 END.
 258
 259 /* _UIB-CODE-BLOCK-END */
 260 &ANALYZE-RESUME
 261
 262
 263 &Scoped-define SELF-NAME RP.Int1
 264 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL RP.Int1 V-table-Win
 265 ON LEAVE OF RP.Int1 IN FRAME F-Main /* Int1 */
 266 DO:
 267 DO WITH FRAME {&FRAME-NAME}:
 268   FIND Company WHERE Company.CompanyCode = INT(SELF:SCREEN-VALUE) NO-LOCK NO-ERROR.
 269   IF AVAILABLE(Company) THEN DO:
 270     fil_Company = Company.LegalName.
 271     DISPLAY fil_Company.
 272   END.
 273 END.
 274 END.
 275
 276 /* _UIB-CODE-BLOCK-END */
 277 &ANALYZE-RESUME
 278
 279
 280 &UNDEFINE SELF-NAME
 281
 282 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK V-table-Win
 283
 284
 285 /* ***************************  Main Block  *************************** */
 286
 287 /* _UIB-CODE-BLOCK-END */
 288 &ANALYZE-RESUME
 289
 290
 291 /* **********************  Internal Procedures  *********************** */
 292
 293 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available V-table-Win _ADM-ROW-AVAILABLE
 294 PROCEDURE adm-row-available :
 295 /*------------------------------------------------------------------------------
 296   Purpose:     Dispatched to this procedure when the Record-
 297                Source has a new row available.  This procedure
 298                tries to get the new row (or foriegn keys) from
 299                the Record-Source and process it.
 300   Parameters:  <none>
 301 ------------------------------------------------------------------------------*/
 302
 303   /* Define variables needed by this internal procedure.             */
 304   {src/adm/template/row-head.i}
 305
 306   /* Create a list of all the tables that we need to get.            */
 307   {src/adm/template/row-list.i "RP"}
 308
 309   /* Get the record ROWID's from the RECORD-SOURCE.                  */
 310   {src/adm/template/row-get.i}
 311
 312   /* FIND each record specified by the RECORD-SOURCE.                */
 313   {src/adm/template/row-find.i "RP"}
 314
 315   /* Process the newly available records (i.e. display fields,
 316      open queries, and/or pass records on to any RECORD-TARGETS).    */
 317   {src/adm/template/row-end.i}
 318
 319 END PROCEDURE.
 320
 321 /* _UIB-CODE-BLOCK-END */
 322 &ANALYZE-RESUME
 323
 324
 325 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI V-table-Win _DEFAULT-DISABLE
 326 PROCEDURE disable_UI :
 327 /*------------------------------------------------------------------------------
 328   Purpose:     DISABLE the User Interface
 329   Parameters:  <none>
 330   Notes:       Here we clean-up the user-interface by deleting
 331                dynamic widgets we have created and/or hide
 332                frames.  This procedure is usually called when
 333                we are ready to "clean-up" after running.
 334 ------------------------------------------------------------------------------*/
 335   /* Hide all frames. */
 336   HIDE FRAME F-Main.
 337   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 338 END PROCEDURE.
 339
 340 /* _UIB-CODE-BLOCK-END */
 341 &ANALYZE-RESUME
 342
 343
 344 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable-appropriate-fields V-table-Win
 345 PROCEDURE enable-appropriate-fields :
 346 /*------------------------------------------------------------------------------
 347   Purpose:
 348 ------------------------------------------------------------------------------*/
 349 DO WITH FRAME {&FRAME-NAME}:
 350   IF INPUT RP.Char1 = "Hierarchy" THEN
 351     VIEW RP.Int1 fil_Company.
 352   ELSE
 353     HIDE RP.Int1 fil_Company.
 354
 355   IF INPUT RP.Char2 = "OneClient" THEN
 356     VIEW cmb_Client.
 357   ELSE
 358     HIDE cmb_Client.
 359 END.
 360 END PROCEDURE.
 361
 362 /* _UIB-CODE-BLOCK-END */
 363 &ANALYZE-RESUME
 364
 365
 366 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-initialize V-table-Win
 367 PROCEDURE inst-initialize :
 368 /*------------------------------------------------------------------------------
 369   Purpose:
 370   Parameters:  <none>
 371   Notes:
 372 ------------------------------------------------------------------------------*/
 373
 374 &SCOP REPORT-ID "Company Listing"
 375
 376   FIND RP WHERE
 377     RP.UserName = user-name AND
 378     RP.ReportID = {&REPORT-ID} NO-ERROR.
 379
 380   IF NOT AVAILABLE RP THEN
 381   DO WITH FRAME {&FRAME-NAME}:
 382
 383     CREATE RP.
 384     ASSIGN
 385       RP.ReportID = {&REPORT-ID}
 386       RP.UserName = user-name
 387       RP.Log1     = Yes.
 388   END.
 389
 390   RUN dispatch( 'enable-fields':U ).
 391   RUN dispatch( 'display-fields':U ).
 392   APPLY 'LEAVE':U TO RP.Int1.
 393   RUN enable-appropriate-fields.
 394
 395 END PROCEDURE.
 396
 397 /* _UIB-CODE-BLOCK-END */
 398 &ANALYZE-RESUME
 399
 400
 401 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pre-destroy V-table-Win
 402 PROCEDURE pre-destroy :
 403 /*------------------------------------------------------------------------------
 404   Purpose:
 405   Parameters:  <none>
 406   Notes:
 407 ------------------------------------------------------------------------------*/
 408
 409   RUN check-modified( "CLEAR" ).
 410
 411 END PROCEDURE.
 412
 413 /* _UIB-CODE-BLOCK-END */
 414 &ANALYZE-RESUME
 415
 416
 417 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE run-report V-table-Win
 418 PROCEDURE run-report :
 419 /*------------------------------------------------------------------------------
 420   Purpose:
 421 ------------------------------------------------------------------------------*/
 422
 423   DEF VAR report-options AS CHAR NO-UNDO.
 424
 425   RUN verify-report.
 426   IF RETURN-VALUE = "FAIL" THEN RETURN.
 427
 428   RUN dispatch( 'update-record':U ).
 429
 430   report-options = "Sort," + RP.Char1 + "," + STRING(RP.Int1)
 431                  + (IF RP.Log1 THEN "~nPreview,Yes" ELSE "")
 432                  + (IF RP.Log2 THEN "~nActiveOnly,Yes" ELSE "")
 433                  + (IF RP.Char2 = "OneClient" THEN "~n" + RP.Char2 + "," + RP.Char3 ELSE "") .
 434
 435   IF RP.Log1 THEN DO:
 436     RUN notify( 'set-busy, CONTAINER-SOURCE':U ).
 437     RUN process/report/cmplistg.p ( report-options ).
 438     RUN notify( 'set-idle, CONTAINER-SOURCE':U ).
 439   END.
 440   ELSE DO:
 441     RUN make-bq-entry IN sys-mgr( "process/report/cmplistg.p", report-options, ?, ?).
 442   END.
 443
 444 END PROCEDURE.
 445
 446 /* _UIB-CODE-BLOCK-END */
 447 &ANALYZE-RESUME
 448
 449
 450 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records V-table-Win _ADM-SEND-RECORDS
 451 PROCEDURE send-records :
 452 /*------------------------------------------------------------------------------
 453   Purpose:     Send record ROWID's for all tables used by
 454                this file.
 455   Parameters:  see template/snd-head.i
 456 ------------------------------------------------------------------------------*/
 457
 458   /* Define variables needed by this internal procedure.               */
 459   {src/adm/template/snd-head.i}
 460
 461   /* For each requested table, put it's ROWID in the output list.      */
 462   {src/adm/template/snd-list.i "RP"}
 463
 464   /* Deal with any unexpected table requests before closing.           */
 465   {src/adm/template/snd-end.i}
 466
 467 END PROCEDURE.
 468
 469 /* _UIB-CODE-BLOCK-END */
 470 &ANALYZE-RESUME
 471
 472
 473 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed V-table-Win
 474 PROCEDURE state-changed :
 475 /* -----------------------------------------------------------
 476   Purpose:
 477   Parameters:  <none>
 478   Notes:
 479 -------------------------------------------------------------*/
 480   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE    NO-UNDO.
 481   DEFINE INPUT PARAMETER p-state      AS CHARACTER NO-UNDO.
 482
 483   CASE p-state:
 484       /* Object instance CASEs can go here to replace standard behavior
 485          or add new cases. */
 486       {src/adm/template/vstates.i}
 487   END CASE.
 488 END PROCEDURE.
 489
 490 /* _UIB-CODE-BLOCK-END */
 491 &ANALYZE-RESUME
 492
 493
 494 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE verify-report V-table-Win
 495 PROCEDURE verify-report :
 496 /*------------------------------------------------------------------------------
 497   Purpose:
 498   Parameters:  <none>
 499   Notes:
 500 ------------------------------------------------------------------------------*/
 501
 502 END PROCEDURE.
 503
 504 /* _UIB-CODE-BLOCK-END */
 505 &ANALYZE-RESUME
 506
 507