vwr/sel/b-selpsn.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 B-table-Win
   8 /*------------------------------------------------------------------------
   9 ------------------------------------------------------------------------*/
  10
  11 CREATE WIDGET-POOL.
  12
  13 /* ***************************  Definitions  ************************** */
  14
  15 {inc/topic/tpperson.i}
  16 DEF VAR FullName     AS CHAR NO-UNDO.
  17 DEF VAR type-list    AS CHAR NO-UNDO.
  18 DEF VAR filter-value AS CHAR NO-UNDO.
  19 DEF VAR contact-type AS CHAR NO-UNDO.
  20
  21 &SCOPED-DEFINE FILTER-PHRASE TRUE
  22
  23 {inc/ofc-this.i}
  24 {inc/ofc-set.i "Contacts-Staff" "staff-contact-type"}
  25 IF NOT AVAILABLE(OfficeSetting) THEN staff-contact-type = "SF".
  26
  27 /* _UIB-CODE-BLOCK-END */
  28 &ANALYZE-RESUME
  29
  30
  31 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  32
  33 /* ********************  Preprocessor Definitions  ******************** */
  34
  35 &Scoped-define PROCEDURE-TYPE SmartBrowser
  36
  37 &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target
  38
  39 /* Name of first Frame and/or Browse and/or first Query                 */
  40 &Scoped-define FRAME-NAME F-Main
  41 &Scoped-define BROWSE-NAME br_table
  42
  43 /* Internal Tables (found by Frame, Query & Browse Queries)             */
  44 &Scoped-define INTERNAL-TABLES Contact Person
  45
  46 /* Define KEY-PHRASE in case it is used by any query. */
  47 &Scoped-define KEY-PHRASE TRUE
  48
  49 /* Definitions for BROWSE br_table                                      */
  50 &Scoped-define FIELDS-IN-QUERY-br_table ~
  51 Person.FirstName + ' ' + Person.LastName @ FullName Person.Company ~
  52 Person.Preferred
  53 &Scoped-define ENABLED-FIELDS-IN-QUERY-br_table
  54 &Scoped-define FIELD-PAIRS-IN-QUERY-br_table
  55 &Scoped-define OPEN-QUERY-br_table OPEN QUERY br_table FOR EACH Contact WHERE ~{&KEY-PHRASE} ~
  56       AND Contact.ContactType = contact-type NO-LOCK, ~
  57       FIRST Person OF Contact NO-LOCK ~
  58     ~{&SORTBY-PHRASE}.
  59 &Scoped-define TABLES-IN-QUERY-br_table Contact Person
  60 &Scoped-define FIRST-TABLE-IN-QUERY-br_table Contact
  61
  62
  63 /* Definitions for FRAME F-Main                                         */
  64
  65 /* Standard List Definitions                                            */
  66 &Scoped-Define ENABLED-OBJECTS br_table
  67
  68 /* Custom List Definitions                                              */
  69 /* List-1,List-2,List-3,List-4,List-5,List-6                            */
  70
  71 /* _UIB-PREPROCESSOR-BLOCK-END */
  72 &ANALYZE-RESUME
  73
  74
  75 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Foreign Keys" B-table-Win _INLINE
  76 /* Actions: ? adm/support/keyedit.w ? ? ? */
  77 /* STRUCTURED-DATA
  78 <KEY-OBJECT>
  79 &BROWSE-NAME
  80 </KEY-OBJECT>
  81 <FOREIGN-KEYS>
  82 PersonCode||y|TTPL.Contact.PersonCode
  83 </FOREIGN-KEYS>
  84 <EXECUTING-CODE>
  85 **************************
  86 * Set attributes related to FOREIGN KEYS
  87 */
  88 RUN set-attribute-list (
  89     'Keys-Accepted = ,
  90      Keys-Supplied = "PersonCode"':U).
  91
  92 /* Tell the ADM to use the OPEN-QUERY-CASES. */
  93 &Scoped-define OPEN-QUERY-CASES RUN dispatch ('open-query-cases':U).
  94 /**************************
  95 </EXECUTING-CODE> */
  96 /* _UIB-CODE-BLOCK-END */
  97 &ANALYZE-RESUME
  98
  99 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Advanced Query Options" B-table-Win _INLINE
 100 /* Actions: ? adm/support/advqedit.w ? ? ? */
 101 /* STRUCTURED-DATA
 102 <KEY-OBJECT>
 103 &BROWSE-NAME
 104 </KEY-OBJECT>
 105 <SORTBY-OPTIONS>
 106 Company Name|||TTPL.Person.Company|yes
 107 Last Name|y||TTPL.Person.LastName|yes
 108 </SORTBY-OPTIONS>
 109 <SORTBY-RUN-CODE>
 110 ************************
 111 * Set attributes related to SORTBY-OPTIONS */
 112 RUN set-attribute-list (
 113     'SortBy-Options = "Company Name,Last Name",
 114      Sort-Case = Last Name':U).
 115
 116 /* Tell the ADM to use the OPEN-QUERY-CASES. */
 117 &Scoped-define OPEN-QUERY-CASES RUN dispatch ('open-query-cases':U).
 118
 119 /* This SmartObject is a valid SortBy-Target. */
 120 &IF '{&user-supported-links}':U ne '':U &THEN
 121   &Scoped-define user-supported-links {&user-supported-links},SortBy-Target
 122 &ELSE
 123   &Scoped-define user-supported-links SortBy-Target
 124 &ENDIF
 125
 126 /************************
 127 </SORTBY-RUN-CODE>
 128 <FILTER-ATTRIBUTES>
 129 </FILTER-ATTRIBUTES> */
 130
 131 /* _UIB-CODE-BLOCK-END */
 132 &ANALYZE-RESUME
 133
 134
 135 /* ***********************  Control Definitions  ********************** */
 136
 137
 138 /* Definitions of the field level widgets                               */
 139 /* Query definitions                                                    */
 140 &ANALYZE-SUSPEND
 141 DEFINE QUERY br_table FOR
 142       Contact,
 143       Person SCROLLING.
 144 &ANALYZE-RESUME
 145
 146 /* Browse definitions                                                   */
 147 DEFINE BROWSE br_table
 148 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS br_table B-table-Win _STRUCTURED
 149   QUERY br_table NO-LOCK DISPLAY
 150       Person.FirstName + ' ' + Person.LastName @ FullName COLUMN-LABEL "Full Name" FORMAT "X(25)"
 151       Person.Company FORMAT "X(60)"
 152       Person.Preferred FORMAT "X(20)"
 153 /* _UIB-CODE-BLOCK-END */
 154 &ANALYZE-RESUME
 155     WITH NO-ASSIGN SEPARATORS SIZE 80.57 BY 14.8
 156          BGCOLOR 15 .
 157
 158
 159 /* ************************  Frame Definitions  *********************** */
 160
 161 DEFINE FRAME F-Main
 162      br_table AT ROW 1 COL 1
 163     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
 164          SIDE-LABELS NO-UNDERLINE THREE-D
 165          AT COL 1 ROW 1 SCROLLABLE
 166          FGCOLOR 0 .
 167
 168
 169 /* *********************** Procedure Settings ************************ */
 170
 171 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 172 /* Settings for THIS-PROCEDURE
 173    Type: SmartBrowser
 174    Allow: Basic,Browse
 175    Frames: 1
 176    Add Fields to: EXTERNAL-TABLES
 177    Other Settings: PERSISTENT-ONLY COMPILE
 178  */
 179
 180 /* This procedure should always be RUN PERSISTENT.  Report the error,  */
 181 /* then cleanup and return.                                            */
 182 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
 183   MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT."
 184           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 185   RETURN.
 186 END.
 187
 188 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 189
 190 /* *************************  Create Window  ************************** */
 191
 192 &ANALYZE-SUSPEND _CREATE-WINDOW
 193 /* DESIGN Window definition (used by the UIB)
 194   CREATE WINDOW B-table-Win ASSIGN
 195          HEIGHT             = 15.4
 196          WIDTH              = 83.29.
 197 /* END WINDOW DEFINITION */
 198                                                                         */
 199 &ANALYZE-RESUME
 200
 201
 202 /* ***************  Runtime Attributes and UIB Settings  ************** */
 203
 204 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 205 /* SETTINGS FOR WINDOW B-table-Win
 206   NOT-VISIBLE,,RUN-PERSISTENT                                           */
 207 /* SETTINGS FOR FRAME F-Main
 208    NOT-VISIBLE Size-to-Fit                                              */
 209 /* BROWSE-TAB br_table 1 F-Main */
 210 ASSIGN
 211        FRAME F-Main:SCROLLABLE       = FALSE
 212        FRAME F-Main:HIDDEN           = TRUE.
 213
 214 /* _RUN-TIME-ATTRIBUTES-END */
 215 &ANALYZE-RESUME
 216
 217
 218 /* Setting information for Queries and Browse Widgets fields            */
 219
 220 &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE br_table
 221 /* Query rebuild information for BROWSE br_table
 222      _TblList          = "TTPL.Contact,TTPL.Person OF TTPL.Contact"
 223      _Options          = "NO-LOCK KEY-PHRASE SORTBY-PHRASE"
 224      _TblOptList       = ", FIRST"
 225      _Where[1]         = "Contact.ContactType = contact-type"
 226      _FldNameList[1]   > "_<CALC>"
 227 "Person.FirstName + ' ' + Person.LastName @ FullName" "Full Name" "X(25)" ? ? ? ? ? ? ? no ?
 228      _FldNameList[2]   > TTPL.Person.Company
 229 "Person.Company" ? "X(60)" "character" ? ? ? ? ? ? no ?
 230      _FldNameList[3]   > TTPL.Person.Preferred
 231 "Person.Preferred" ? "X(20)" "character" ? ? ? ? ? ? no ?
 232      _Query            is NOT OPENED
 233 */  /* BROWSE br_table */
 234 &ANALYZE-RESUME
 235
 236 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
 237 /* Query rebuild information for FRAME F-Main
 238      _Options          = "NO-LOCK"
 239      _Query            is NOT OPENED
 240 */  /* FRAME F-Main */
 241 &ANALYZE-RESUME
 242
 243
 244
 245
 246 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB B-table-Win
 247 /* ************************* Included-Libraries *********************** */
 248
 249 {src/adm/method/browser.i}
 250 {inc/method/m-selvwr.i}
 251
 252 /* _UIB-CODE-BLOCK-END */
 253 &ANALYZE-RESUME
 254
 255
 256
 257
 258 /* ************************  Control Triggers  ************************ */
 259
 260 &Scoped-define BROWSE-NAME br_table
 261 &Scoped-define SELF-NAME br_table
 262 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
 263 ON ROW-ENTRY OF br_table IN FRAME F-Main
 264 DO:
 265   /* This code displays initial values for newly added or copied rows. */
 266   {src/adm/template/brsentry.i}
 267 END.
 268
 269 /* _UIB-CODE-BLOCK-END */
 270 &ANALYZE-RESUME
 271
 272
 273 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
 274 ON ROW-LEAVE OF br_table IN FRAME F-Main
 275 DO:
 276     /* Do not disable this code or no updates will take place except
 277      by pressing the Save button on an Update SmartPanel. */
 278    {src/adm/template/brsleave.i}
 279 END.
 280
 281 /* _UIB-CODE-BLOCK-END */
 282 &ANALYZE-RESUME
 283
 284
 285 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
 286 ON VALUE-CHANGED OF br_table IN FRAME F-Main
 287 DO:
 288   /* This ADM trigger code must be preserved in order to notify other
 289      objects when the browser's current row changes. */
 290   {src/adm/template/brschnge.i}
 291
 292 END.
 293
 294 /* _UIB-CODE-BLOCK-END */
 295 &ANALYZE-RESUME
 296
 297
 298 &UNDEFINE SELF-NAME
 299
 300 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK B-table-Win
 301
 302
 303 /* ***************************  Main Block  *************************** */
 304
 305 &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
 306 RUN dispatch IN THIS-PROCEDURE ('initialize':U).
 307 &ENDIF
 308
 309 RUN set-attribute-list ( 'SortBy-Case = Last name, SortBy-Options = Company name|Last name':U ).
 310
 311 type-list = "".
 312 FOR EACH ContactType NO-LOCK:
 313   type-list = type-list + IF type-list = "" THEN "" ELSE "|".
 314   type-list = type-list + STRING( ContactType.ContactType, "X(4)") + " - " + TRIM( ContactType.Description).
 315 END.
 316
 317 RUN set-attribute-list ( 'FilterBy-Style = Combo-Box':U).
 318 RUN set-attribute-list ( 'FilterBy-Options = ':U + type-list).
 319 /* RUN set-attribute-list ( 'Filter-Value = ':U ). */
 320
 321 /* _UIB-CODE-BLOCK-END */
 322 &ANALYZE-RESUME
 323
 324
 325 /* **********************  Internal Procedures  *********************** */
 326
 327 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-open-query-cases B-table-Win adm/support/_adm-opn.p
 328 PROCEDURE adm-open-query-cases :
 329 /*------------------------------------------------------------------------------
 330   Purpose:     Opens different cases of the query based on attributes
 331                such as the 'Key-Name', or 'SortBy-Case'
 332   Parameters:  <none>
 333 ------------------------------------------------------------------------------*/
 334
 335   /* No Foreign keys are accepted by this SmartObject. */
 336
 337   RUN get-attribute ('SortBy-Case':U).
 338   CASE RETURN-VALUE:
 339     WHEN 'Company Name':U THEN DO:
 340       &Scope SORTBY-PHRASE BY Person.Company
 341       {&OPEN-QUERY-{&BROWSE-NAME}}
 342     END.
 343     WHEN 'Last Name':U THEN DO:
 344       &Scope SORTBY-PHRASE BY Person.LastName
 345       {&OPEN-QUERY-{&BROWSE-NAME}}
 346     END.
 347     OTHERWISE DO:
 348       &Undefine SORTBY-PHRASE
 349       {&OPEN-QUERY-{&BROWSE-NAME}}
 350     END. /* OTHERWISE...*/
 351   END CASE.
 352
 353 END PROCEDURE.
 354
 355 /* _UIB-CODE-BLOCK-END */
 356 &ANALYZE-RESUME
 357
 358
 359 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available B-table-Win _ADM-ROW-AVAILABLE
 360 PROCEDURE adm-row-available :
 361 /*------------------------------------------------------------------------------
 362   Purpose:     Dispatched to this procedure when the Record-
 363                Source has a new row available.  This procedure
 364                tries to get the new row (or foriegn keys) from
 365                the Record-Source and process it.
 366   Parameters:  <none>
 367 ------------------------------------------------------------------------------*/
 368
 369   /* Define variables needed by this internal procedure.             */
 370   {src/adm/template/row-head.i}
 371
 372   /* Process the newly available records (i.e. display fields,
 373      open queries, and/or pass records on to any RECORD-TARGETS).    */
 374   {src/adm/template/row-end.i}
 375
 376 END PROCEDURE.
 377
 378 /* _UIB-CODE-BLOCK-END */
 379 &ANALYZE-RESUME
 380
 381
 382 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI B-table-Win _DEFAULT-DISABLE
 383 PROCEDURE disable_UI :
 384 /*------------------------------------------------------------------------------
 385   Purpose:     DISABLE the User Interface
 386   Parameters:  <none>
 387   Notes:       Here we clean-up the user-interface by deleting
 388                dynamic widgets we have created and/or hide
 389                frames.  This procedure is usually called when
 390                we are ready to "clean-up" after running.
 391 ------------------------------------------------------------------------------*/
 392   /* Hide all frames. */
 393   HIDE FRAME F-Main.
 394   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 395 END PROCEDURE.
 396
 397 /* _UIB-CODE-BLOCK-END */
 398 &ANALYZE-RESUME
 399
 400
 401 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-open-query-cases B-table-Win
 402 PROCEDURE local-open-query-cases :
 403 /*------------------------------------------------------------------------------
 404   Purpose:     Override standard ADM method
 405   Notes:
 406 ------------------------------------------------------------------------------*/
 407
 408   /* No Foreign keys are accepted by this SmartObject. */
 409
 410   &Scope TABLE-PHRASE FOR EACH Contact WHERE ~
 411     Contact.ContactType = contact-type NO-LOCK, ~
 412     FIRST Person OF Contact NO-LOCK
 413
 414   RUN notify( 'set-busy,container-source':U ).
 415   RUN get-attribute ('SortBy-Case':U).
 416   CASE RETURN-VALUE:
 417     WHEN 'Company Name':U THEN DO:
 418       &Scope SORTBY-PHRASE BY Person.Company
 419       &Scope FILTER-PHRASE Person.Company BEGINS filter-value
 420       OPEN QUERY {&BROWSE-NAME} {&TABLE-PHRASE} WHERE {&FILTER-PHRASE} {&SORTBY-PHRASE}.
 421     END.
 422     WHEN 'Last Name':U THEN DO:
 423       &Scope SORTBY-PHRASE BY Person.LastName
 424       &Scope FILTER-PHRASE Person.LastName BEGINS filter-value
 425       OPEN QUERY {&BROWSE-NAME} {&TABLE-PHRASE} WHERE {&FILTER-PHRASE} {&SORTBY-PHRASE}.
 426     END.
 427     OTHERWISE DO:
 428       &Undefine SORTBY-PHRASE
 429       &Scope    FILTER-PHRASE TRUE
 430       OPEN QUERY {&BROWSE-NAME} {&TABLE-PHRASE} WHERE {&FILTER-PHRASE} {&SORTBY-PHRASE}.
 431     END.
 432   END CASE.
 433   RUN notify( 'set-idle,container-source':U ).
 434
 435 END PROCEDURE.
 436
 437 /* _UIB-CODE-BLOCK-END */
 438 &ANALYZE-RESUME
 439
 440
 441 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-key B-table-Win adm/support/_key-snd.p
 442 PROCEDURE send-key :
 443 /*------------------------------------------------------------------------------
 444   Purpose:     Sends a requested KEY value back to the calling
 445                SmartObject.
 446   Parameters:  <see adm/template/sndkytop.i>
 447 ------------------------------------------------------------------------------*/
 448
 449   /* Define variables needed by this internal procedure.             */
 450   {src/adm/template/sndkytop.i}
 451
 452   /* Return the key value associated with each key case.             */
 453   {src/adm/template/sndkycas.i "PersonCode" "Contact" "PersonCode"}
 454
 455   /* Close the CASE statement and end the procedure.                 */
 456   {src/adm/template/sndkyend.i}
 457
 458 END PROCEDURE.
 459
 460 /* _UIB-CODE-BLOCK-END */
 461 &ANALYZE-RESUME
 462
 463
 464 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records B-table-Win _ADM-SEND-RECORDS
 465 PROCEDURE send-records :
 466 /*------------------------------------------------------------------------------
 467   Purpose:     Send record ROWID's for all tables used by
 468                this file.
 469   Parameters:  see template/snd-head.i
 470 ------------------------------------------------------------------------------*/
 471
 472   /* Define variables needed by this internal procedure.               */
 473   {src/adm/template/snd-head.i}
 474
 475   /* For each requested table, put it's ROWID in the output list.      */
 476   {src/adm/template/snd-list.i "Contact"}
 477   {src/adm/template/snd-list.i "Person"}
 478
 479   /* Deal with any unexpected table requests before closing.           */
 480   {src/adm/template/snd-end.i}
 481
 482 END PROCEDURE.
 483
 484 /* _UIB-CODE-BLOCK-END */
 485 &ANALYZE-RESUME
 486
 487
 488 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed B-table-Win
 489 PROCEDURE state-changed :
 490 /* -----------------------------------------------------------
 491   Purpose:
 492   Parameters:  <none>
 493   Notes:
 494 -------------------------------------------------------------*/
 495   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE    NO-UNDO.
 496   DEFINE INPUT PARAMETER p-state      AS CHARACTER NO-UNDO.
 497
 498   CASE p-state:
 499       /* Object instance CASEs can go here to replace standard behavior
 500          or add new cases. */
 501       {src/adm/template/bstates.i}
 502   END CASE.
 503 END PROCEDURE.
 504
 505 /* _UIB-CODE-BLOCK-END */
 506 &ANALYZE-RESUME
 507
 508
 509 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-Filter-Value B-table-Win
 510 PROCEDURE use-Filter-Value :
 511 /*------------------------------------------------------------------------------
 512   Purpose:
 513 ------------------------------------------------------------------------------*/
 514 DEF INPUT PARAMETER new-filter-value AS CHAR NO-UNDO.
 515
 516   filter-value = new-filter-value.
 517
 518 END PROCEDURE.
 519
 520 /* _UIB-CODE-BLOCK-END */
 521 &ANALYZE-RESUME
 522
 523
 524 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-FilterBy-Case B-table-Win
 525 PROCEDURE use-FilterBy-Case :
 526 /*------------------------------------------------------------------------------
 527   Purpose:
 528 ------------------------------------------------------------------------------*/
 529 DEF INPUT PARAMETER new-case AS CHAR NO-UNDO.
 530
 531   contact-type = TRIM( SUBSTR( new-case, 1, 4 ) ).
 532   IF contact-type = "SF" THEN contact-type = staff-contact-type.
 533
 534 END PROCEDURE.
 535
 536 /* _UIB-CODE-BLOCK-END */
 537 &ANALYZE-RESUME
 538
 539