vwr/mnt/v-vchap2.w

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI ADM1
   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 ------------------------------------------------------------------------*/
  10
  11 CREATE WIDGET-POOL.
  12
  13 /* ***************************  Definitions  ************************** */
  14
  15 DEF VAR loc_Creditor AS CHAR FORMAT "X(27)" LABEL "Creditor" NO-UNDO.
  16 DEF VAR loc_Total       AS DEC  FORMAT "->>,>>>,>>9.99" LABEL "Total" NO-UNDO.
  17 DEF VAR user-name AS CHAR NO-UNDO.
  18
  19 DEF VAR break-1 AS CHAR FORMAT "X" LABEL "" INIT "" NO-UNDO.
  20 DEF VAR break-2 AS CHAR FORMAT "X" LABEL "" INIT "" NO-UNDO.
  21 DEF VAR break-3 AS CHAR FORMAT "X" LABEL "" INIT "" NO-UNDO.
  22
  23 DEF VAR h-msg        AS HANDLE NO-UNDO.
  24
  25 DEF VAR gst-applies AS LOGI NO-UNDO.
  26 DEF VAR gst-in-ecode           AS INT NO-UNDO.
  27 DEF VAR sundry-creditors-ecode AS INT NO-UNDO.
  28
  29 DEF NEW SHARED TEMP-TABLE company-gst
  30          FIELD company_id LIKE Company.CompanyCode
  31          FIELD tax_amount  LIKE NewAcctTrans.Amount
  32          INDEX company_id IS PRIMARY company_id ASCENDING.
  33
  34 {inc/ofc-this.i}
  35 {inc/ofc-acct.i "CREDITORS" "sundry-creditors"}
  36 sundry-creditors-ecode = OfficeControlAccount.EntityCode.
  37 {inc/ofc-acct.i "GST-IN" "gst-in"}
  38 gst-applies = AVAILABLE OfficeControlAccount.
  39 gst-in-ecode = OfficeControlAccount.EntityCode.
  40 {inc/ofc-acct.i "DEBTORS" "sundry-debtors"}
  41
  42 {inc/ofc-set-l.i "Voucher-Trans-Due-Date" "use-due-dates"}
  43 {inc/ofc-set.i "Voucher-Transaction-Date" "voucher-transaction-date"}
  44 IF NOT AVAILABLE(OfficeSetting) THEN voucher-transaction-date = "Invoice/Due-10".
  45
  46 {inc/ofc-set-l.i "Voucher-LinesIncludeGST" "lines-include-gst"}
  47 IF NOT AVAILABLE(OfficeSetting) THEN lines-include-gst = No.
  48
  49 {inc/ofc-set-l.i "GST-Multi-Company"  "GST-Multi-Company" }
  50 {inc/ofc-set.i "GST-Rate"  "gst-rate" }
  51
  52 /* Each creditor has attributed balances for each ledger (c.f. George Group) */
  53 {inc/ofc-set-l.i "Multi-Ledger-Creditors" "multi-ledger-creditors"}
  54
  55
  56 {inc/entity.i}
  57
  58 /* _UIB-CODE-BLOCK-END */
  59 &ANALYZE-RESUME
  60
  61
  62 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  63
  64 /* ********************  Preprocessor Definitions  ******************** */
  65
  66 &Scoped-define PROCEDURE-TYPE SmartViewer
  67 &Scoped-define DB-AWARE no
  68
  69 &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target
  70
  71 /* Name of first Frame and/or Browse and/or first Query                 */
  72 &Scoped-define FRAME-NAME F-Main
  73 &Scoped-define BROWSE-NAME BROWSE-3
  74
  75 /* Internal Tables (found by Frame, Query & Browse Queries)             */
  76 &Scoped-define INTERNAL-TABLES Voucher Creditor VoucherLine
  77
  78 /* Definitions for BROWSE BROWSE-3                                      */
  79 &Scoped-define FIELDS-IN-QUERY-BROWSE-3 Voucher.VoucherSeq ~
  80 break-1 @ break-1 Voucher.Date Voucher.CreditorCode Creditor.Name ~
  81 Voucher.Description break-2 @ break-2 Voucher.PaymentStyle ~
  82 break-3 @ break-3 Voucher.GoodsValue + Voucher.TaxValue @ loc_Total
  83 &Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-3
  84 &Scoped-define QUERY-STRING-BROWSE-3 FOR EACH Voucher ~
  85       WHERE Voucher.VoucherStatus = "U" ~
  86  AND (MyVouchers = NO OR Voucher.LastModifiedUser = user-name)  NO-LOCK, ~
  87       EACH Creditor OF Voucher NO-LOCK, ~
  88       FIRST VoucherLine OF Voucher NO-LOCK ~
  89     BY Voucher.VoucherSeq DESCENDING
  90 &Scoped-define OPEN-QUERY-BROWSE-3 OPEN QUERY BROWSE-3 FOR EACH Voucher ~
  91       WHERE Voucher.VoucherStatus = "U" ~
  92  AND (MyVouchers = NO OR Voucher.LastModifiedUser = user-name)  NO-LOCK, ~
  93       EACH Creditor OF Voucher NO-LOCK, ~
  94       FIRST VoucherLine OF Voucher NO-LOCK ~
  95     BY Voucher.VoucherSeq DESCENDING.
  96 &Scoped-define TABLES-IN-QUERY-BROWSE-3 Voucher Creditor VoucherLine
  97 &Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-3 Voucher
  98 &Scoped-define SECOND-TABLE-IN-QUERY-BROWSE-3 Creditor
  99 &Scoped-define THIRD-TABLE-IN-QUERY-BROWSE-3 VoucherLine
 100
 101
 102 /* Definitions for FRAME F-Main                                         */
 103 &Scoped-define OPEN-BROWSERS-IN-QUERY-F-Main ~
 104     ~{&OPEN-QUERY-BROWSE-3}
 105
 106 /* Standard List Definitions                                            */
 107 &Scoped-Define ENABLED-OBJECTS BROWSE-3 btn_SelectAll btn_cancel MyVouchers ~
 108 RECT-21
 109 &Scoped-Define DISPLAYED-OBJECTS MyVouchers
 110
 111 /* Custom List Definitions                                              */
 112 /* ADM-CREATE-FIELDS,ADM-ASSIGN-FIELDS,List-3,List-4,List-5,List-6      */
 113
 114 /* _UIB-PREPROCESSOR-BLOCK-END */
 115 &ANALYZE-RESUME
 116
 117
 118 /* ************************  Function Prototypes ********************** */
 119
 120 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-trn-date V-table-Win
 121 FUNCTION get-trn-date RETURNS DATE
 122   ( OUTPUT m-code AS INT )  FORWARD.
 123
 124 /* _UIB-CODE-BLOCK-END */
 125 &ANALYZE-RESUME
 126
 127 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD validate-creditor-ledger V-table-Win
 128 FUNCTION validate-creditor-ledger RETURNS INTEGER
 129   ( /* parameter-definitions */ )  FORWARD.
 130
 131 /* _UIB-CODE-BLOCK-END */
 132 &ANALYZE-RESUME
 133
 134
 135 /* ***********************  Control Definitions  ********************** */
 136
 137
 138 /* Definitions of the field level widgets                               */
 139 DEFINE BUTTON btn_approve
 140      LABEL "&Approve"
 141      SIZE 10 BY 1.05
 142      FONT 9.
 143
 144 DEFINE BUTTON btn_cancel
 145      LABEL "&Cancel"
 146      SIZE 10 BY 1.05
 147      FONT 9.
 148
 149 DEFINE BUTTON btn_SelectAll
 150      LABEL "&Select All"
 151      SIZE 11.43 BY 1.05.
 152
 153 DEFINE RECTANGLE RECT-21
 154      EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
 155      SIZE 105.72 BY 17.
 156
 157 DEFINE VARIABLE MyVouchers AS LOGICAL INITIAL no
 158      LABEL "Show My Vouchers Only"
 159      VIEW-AS TOGGLE-BOX
 160      SIZE 20 BY .8 NO-UNDO.
 161
 162 /* Query definitions                                                    */
 163 &ANALYZE-SUSPEND
 164 DEFINE QUERY BROWSE-3 FOR
 165       Voucher,
 166       Creditor,
 167       VoucherLine SCROLLING.
 168 &ANALYZE-RESUME
 169
 170 /* Browse definitions                                                   */
 171 DEFINE BROWSE BROWSE-3
 172 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS BROWSE-3 V-table-Win _STRUCTURED
 173   QUERY BROWSE-3 NO-LOCK DISPLAY
 174       Voucher.VoucherSeq COLUMN-LABEL "Voucher" FORMAT ">>>>>>9":U
 175       break-1 @ break-1 FORMAT "X":U
 176       Voucher.Date COLUMN-LABEL "Invoice Date" FORMAT "99/99/9999":U
 177       Voucher.CreditorCode COLUMN-LABEL "Creditor" FORMAT "99999":U
 178       Creditor.Name FORMAT "X(30)":U
 179       Voucher.Description FORMAT "X(50)":U
 180       break-2 @ break-2 FORMAT "X":U
 181       Voucher.PaymentStyle FORMAT "X(4)":U
 182       break-3 @ break-3 FORMAT "X":U
 183       Voucher.GoodsValue + Voucher.TaxValue @ loc_Total
 184 /* _UIB-CODE-BLOCK-END */
 185 &ANALYZE-RESUME
 186     WITH NO-ROW-MARKERS SEPARATORS MULTIPLE SIZE 104.57 BY 14.9
 187          FONT 10.
 188
 189
 190 /* ************************  Frame Definitions  *********************** */
 191
 192 DEFINE FRAME F-Main
 193      BROWSE-3 AT ROW 2.2 COL 1.57
 194      btn_SelectAll AT ROW 17.2 COL 1.57
 195      btn_approve AT ROW 17.2 COL 85
 196      btn_cancel AT ROW 17.2 COL 96.43
 197      MyVouchers AT ROW 17.25 COL 15
 198      RECT-21 AT ROW 1.4 COL 1
 199      "Voucher Approval" VIEW-AS TEXT
 200           SIZE 20.57 BY 1 AT ROW 1 COL 2.72
 201           FONT 13
 202     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
 203          SIDE-LABELS NO-UNDERLINE THREE-D
 204          AT COL 1 ROW 1 SCROLLABLE
 205          FONT 10.
 206
 207
 208 /* *********************** Procedure Settings ************************ */
 209
 210 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 211 /* Settings for THIS-PROCEDURE
 212    Type: SmartViewer
 213    Allow: Basic,DB-Fields
 214    Frames: 1
 215    Add Fields to: EXTERNAL-TABLES
 216    Other Settings: PERSISTENT-ONLY COMPILE
 217  */
 218
 219 /* This procedure should always be RUN PERSISTENT.  Report the error,  */
 220 /* then cleanup and return.                                            */
 221 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
 222   MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
 223           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 224   RETURN.
 225 END.
 226
 227 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 228
 229 /* *************************  Create Window  ************************** */
 230
 231 &ANALYZE-SUSPEND _CREATE-WINDOW
 232 /* DESIGN Window definition (used by the UIB)
 233   CREATE WINDOW V-table-Win ASSIGN
 234          HEIGHT             = 18.8
 235          WIDTH              = 108.
 236 /* END WINDOW DEFINITION */
 237                                                                         */
 238 &ANALYZE-RESUME
 239
 240 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB V-table-Win
 241 /* ************************* Included-Libraries *********************** */
 242
 243 {src/adm/method/viewer.i}
 244 {inc/method/m-mntvwr.i}
 245
 246 /* _UIB-CODE-BLOCK-END */
 247 &ANALYZE-RESUME
 248
 249
 250
 251
 252 /* ***********  Runtime Attributes and AppBuilder Settings  *********** */
 253
 254 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 255 /* SETTINGS FOR WINDOW V-table-Win
 256   VISIBLE,,RUN-PERSISTENT                                               */
 257 /* SETTINGS FOR FRAME F-Main
 258    NOT-VISIBLE Size-to-Fit                                              */
 259 /* BROWSE-TAB BROWSE-3 1 F-Main */
 260 ASSIGN
 261        FRAME F-Main:SCROLLABLE       = FALSE
 262        FRAME F-Main:HIDDEN           = TRUE.
 263
 264 /* SETTINGS FOR BUTTON btn_approve IN FRAME F-Main
 265    NO-ENABLE                                                            */
 266 /* _RUN-TIME-ATTRIBUTES-END */
 267 &ANALYZE-RESUME
 268
 269
 270 /* Setting information for Queries and Browse Widgets fields            */
 271
 272 &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE BROWSE-3
 273 /* Query rebuild information for BROWSE BROWSE-3
 274      _TblList          = "ttpl.Voucher,ttpl.Creditor OF ttpl.Voucher,ttpl.VoucherLine OF ttpl.Voucher"
 275      _Options          = "NO-LOCK"
 276      _TblOptList       = ",, FIRST"
 277      _OrdList          = "ttpl.Voucher.VoucherSeq|no"
 278      _Where[1]         = "Voucher.VoucherStatus = ""U""
 279  AND (MyVouchers = NO OR Voucher.LastModifiedUser = user-name) "
 280      _JoinCode[2]      = "Invoice.EntityType = 'T'
 281   AND
 282 Invoice.EntityCode = Tenant.TenantCode"
 283      _FldNameList[1]   > ttpl.Voucher.VoucherSeq
 284 "Voucher.VoucherSeq" "Voucher" ">>>>>>9" "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
 285      _FldNameList[2]   > "_<CALC>"
 286 "break-1 @ break-1" ? "X" ? ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
 287      _FldNameList[3]   > ttpl.Voucher.Date
 288 "Voucher.Date" "Invoice Date" ? "date" ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
 289      _FldNameList[4]   > ttpl.Voucher.CreditorCode
 290 "Voucher.CreditorCode" "Creditor" ? "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
 291      _FldNameList[5]   > ttpl.Creditor.Name
 292 "Creditor.Name" ? "X(30)" "character" ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
 293      _FldNameList[6]   = ttpl.Voucher.Description
 294      _FldNameList[7]   > "_<CALC>"
 295 "break-2 @ break-2" ? "X" ? ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
 296      _FldNameList[8]   = ttpl.Voucher.PaymentStyle
 297      _FldNameList[9]   > "_<CALC>"
 298 "break-3 @ break-3" ? "X" ? ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
 299      _FldNameList[10]   > "_<CALC>"
 300 "Voucher.GoodsValue + Voucher.TaxValue @ loc_Total" ? ? ? ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
 301      _Query            is OPENED
 302 */  /* BROWSE BROWSE-3 */
 303 &ANALYZE-RESUME
 304
 305 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
 306 /* Query rebuild information for FRAME F-Main
 307      _Options          = "NO-LOCK"
 308      _Query            is NOT OPENED
 309 */  /* FRAME F-Main */
 310 &ANALYZE-RESUME
 311
 312
 313
 314
 315
 316 /* ************************  Control Triggers  ************************ */
 317
 318 &Scoped-define BROWSE-NAME BROWSE-3
 319 &Scoped-define SELF-NAME BROWSE-3
 320 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BROWSE-3 V-table-Win
 321 ON ANY-PRINTABLE OF BROWSE-3 IN FRAME F-Main
 322 DO:
 323   RUN toggle-current-row.
 324 END.
 325
 326 /* _UIB-CODE-BLOCK-END */
 327 &ANALYZE-RESUME
 328
 329
 330 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BROWSE-3 V-table-Win
 331 ON MOUSE-SELECT-DOWN OF BROWSE-3 IN FRAME F-Main
 332 DO:
 333   APPLY 'MOUSE-EXTEND-DOWN' TO {&SELF-NAME}.
 334   RETURN NO-APPLY.
 335 END.
 336
 337 /* _UIB-CODE-BLOCK-END */
 338 &ANALYZE-RESUME
 339
 340
 341 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BROWSE-3 V-table-Win
 342 ON ROW-DISPLAY OF BROWSE-3 IN FRAME F-Main
 343 DO:
 344 DEF VAR row-colour AS INT NO-UNDO   INITIAL ?.
 345 DEF VAR amt-colour AS INT NO-UNDO   INITIAL ?.
 346
 347   IF Voucher.PaymentStyle = "CARD" THEN row-colour = 9.
 348   IF Voucher.GoodsValue + Voucher.TaxValue < 0 THEN amt-colour = 12.
 349
 350   ASSIGN    loc_Total:FGCOLOR IN BROWSE {&BROWSE-NAME} = amt-colour
 351             Voucher.VoucherSeq:FGCOLOR = row-colour
 352             Voucher.Date:FGCOLOR = row-colour
 353             Voucher.CreditorCode:FGCOLOR = row-colour
 354             Creditor.Name:FGCOLOR = row-colour
 355             Voucher.Description:FGCOLOR = row-colour
 356             Voucher.PaymentStyle:FGCOLOR = row-colour .
 357 END.
 358
 359 /* _UIB-CODE-BLOCK-END */
 360 &ANALYZE-RESUME
 361
 362
 363 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BROWSE-3 V-table-Win
 364 ON VALUE-CHANGED OF BROWSE-3 IN FRAME F-Main
 365 DO:
 366   ASSIGN btn_approve:SENSITIVE = SELF:NUM-SELECTED-ROWS <> 0.
 367 END.
 368
 369 /* _UIB-CODE-BLOCK-END */
 370 &ANALYZE-RESUME
 371
 372
 373 &Scoped-define SELF-NAME btn_approve
 374 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_approve V-table-Win
 375 ON CHOOSE OF btn_approve IN FRAME F-Main /* Approve */
 376 DO:
 377   RUN notify( 'set-busy, CONTAINER-SOURCE':u ).
 378   RUN win/w-prgmsg.w PERSISTENT SET h-msg.
 379
 380   RUN approve-vouchers.
 381
 382   IF VALID-HANDLE( h-msg ) THEN RUN dispatch IN h-msg ( 'destroy':U ).
 383   RUN notify( 'set-idle, CONTAINER-SOURCE':u ).
 384
 385   IF RETURN-VALUE <> "FAIL" THEN RUN dispatch( 'exit':U ).
 386   ELSE DO:
 387     MESSAGE "There was an error approving the vouchers" SKIP(1)
 388             "Select different vouchers and try again," SKIP
 389             "or exit and fix the error."
 390             VIEW-AS ALERT-BOX ERROR TITLE "Voucher Approval Error".
 391   END.
 392
 393 END.
 394
 395 /* _UIB-CODE-BLOCK-END */
 396 &ANALYZE-RESUME
 397
 398
 399 &Scoped-define SELF-NAME btn_cancel
 400 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_cancel V-table-Win
 401 ON CHOOSE OF btn_cancel IN FRAME F-Main /* Cancel */
 402 DO:
 403   RUN notify( 'record-source,open-query':U ).
 404   RUN dispatch( 'exit':u ).
 405 END.
 406
 407 /* _UIB-CODE-BLOCK-END */
 408 &ANALYZE-RESUME
 409
 410
 411 &Scoped-define SELF-NAME btn_SelectAll
 412 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_SelectAll V-table-Win
 413 ON CHOOSE OF btn_SelectAll IN FRAME F-Main /* Select All */
 414 DO:
 415   RUN select-all-vouchers.
 416 END.
 417
 418 /* _UIB-CODE-BLOCK-END */
 419 &ANALYZE-RESUME
 420
 421
 422 &Scoped-define SELF-NAME MyVouchers
 423 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL MyVouchers V-table-Win
 424 ON VALUE-CHANGED OF MyVouchers IN FRAME F-Main /* Show My Vouchers Only */
 425 DO:
 426    ASSIGN MyVouchers.
 427   RUN open-vch-query.
 428 END.
 429
 430 /* _UIB-CODE-BLOCK-END */
 431 &ANALYZE-RESUME
 432
 433
 434 &UNDEFINE SELF-NAME
 435
 436 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK V-table-Win
 437
 438
 439 /* ***************************  Main Block  *************************** */
 440
 441 /* _UIB-CODE-BLOCK-END */
 442 &ANALYZE-RESUME
 443
 444
 445 /* **********************  Internal Procedures  *********************** */
 446
 447 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available V-table-Win  _ADM-ROW-AVAILABLE
 448 PROCEDURE adm-row-available :
 449 /*------------------------------------------------------------------------------
 450   Purpose:     Dispatched to this procedure when the Record-
 451                Source has a new row available.  This procedure
 452                tries to get the new row (or foriegn keys) from
 453                the Record-Source and process it.
 454   Parameters:  <none>
 455 ------------------------------------------------------------------------------*/
 456
 457   /* Define variables needed by this internal procedure.             */
 458   {src/adm/template/row-head.i}
 459
 460   /* Process the newly available records (i.e. display fields,
 461      open queries, and/or pass records on to any RECORD-TARGETS).    */
 462   {src/adm/template/row-end.i}
 463
 464 END PROCEDURE.
 465
 466 /* _UIB-CODE-BLOCK-END */
 467 &ANALYZE-RESUME
 468
 469 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE approve-vouchers V-table-Win
 470 PROCEDURE approve-vouchers :
 471 /*------------------------------------------------------------------------------
 472   Purpose:     Approve this Voucher
 473   Parameters:  <none>
 474   Notes:
 475 ------------------------------------------------------------------------------*/
 476 DEF VAR i        AS INT  NO-UNDO.
 477 DEF VAR creditor-ledger AS INT  NO-UNDO.
 478 DEF VAR vch-list AS CHAR NO-UNDO.
 479 DEF VAR vch-total AS DEC NO-UNDO.
 480 DEF VAR mth-code LIKE Month.MonthCode NO-UNDO.
 481 DEF VAR trn-date AS DATE NO-UNDO.
 482 DEF VAR taxed-transactions AS LOGI NO-UNDO.
 483 DEF VAR residual-tax AS DEC NO-UNDO.
 484 DEF VAR document-total AS DEC NO-UNDO INITIAL 0.
 485 DEF VAR gst-et AS CHAR NO-UNDO.
 486 DEF VAR gst-ec AS INT NO-UNDO.
 487
 488 DEF BUFFER mypj FOR Project.
 489
 490 DO TRANSACTION ON ERROR UNDO, RETURN "FAIL":
 491
 492   /* Create the batch in which to approve the Vouchers */
 493   CREATE NewBatch.
 494   ASSIGN
 495     NewBatch.BatchType   = 'NORM'
 496     NewBatch.Description = "Voucher Batch - " + STRING( TODAY, "99/99/9999" ).
 497
 498   DO i = 1 TO {&BROWSE-NAME}:NUM-SELECTED-ROWS IN FRAME {&FRAME-NAME}:
 499     IF {&BROWSE-NAME}:FETCH-SELECTED-ROW(i) THEN.
 500
 501     vch-total = 0.0 .
 502     FOR EACH VoucherLine OF Voucher NO-LOCK: vch-total = vch-total + VoucherLine.Amount. END.
 503     IF lines-include-gst THEN vch-total = vch-total - Voucher.TaxValue.
 504
 505     IF vch-total <> Voucher.GoodsValue THEN DO:
 506       MESSAGE "Voucher" Voucher.VoucherSeq "allocations do not equal voucher." SKIP(1)
 507                 TRIM( STRING( vch-total, "->>,>>>,>>9.99" ) ) + " vs " +
 508                 TRIM( STRING( Voucher.GoodsValue, "->>,>>>,>>9.99" ) )
 509           VIEW-AS ALERT-BOX ERROR TITLE "Incorrect Total, " +
 510                 TRIM( STRING( vch-total, "->>,>>>,>>9.99" ) ) + " vs " +
 511                 TRIM( STRING( Voucher.GoodsValue, "->>,>>>,>>9.99" ) ) .
 512       NEXT.
 513     END.
 514
 515     RUN update-details IN h-msg ( 'Approving Vouchers', ( i / {&BROWSE-NAME}:NUM-SELECTED-ROWS ) * 100 ).
 516
 517     trn-date = get-trn-date( OUTPUT mth-code ).
 518
 519     /* Initialise temp-table */
 520     FOR EACH company-gst EXCLUSIVE-LOCK:
 521           DELETE company-gst.
 522     END.
 523
 524
 525     document-total = 0.
 526     CREATE NewDocument.
 527     ASSIGN
 528       NewDocument.BatchCode    = NewBatch.BatchCode
 529       NewDocument.DocumentType = "VCHR"
 530       NewDocument.Description  = Voucher.Description
 531       NewDocument.Reference    = "VCHR" + STRING( Voucher.VoucherSeq ).
 532
 533     /* Create the account debit transactions */
 534     taxed-transactions = No.
 535     residual-tax = Voucher.TaxValue .
 536
 537     IF multi-ledger-creditors THEN DO:
 538       creditor-ledger = validate-creditor-ledger().
 539       IF creditor-ledger = ? THEN UNDO, RETURN "FAIL".
 540     END.
 541
 542     /* Create Transaction Lines */
 543     FOR EACH VoucherLine OF Voucher NO-LOCK:
 544       IF VoucherLine.TaxAmount <> 0 THEN taxed-transactions = Yes.
 545
 546       CREATE NewAcctTrans.
 547       ASSIGN
 548         NewAcctTrans.BatchCode       = NewBatch.BatchCode
 549         NewAcctTrans.DocumentCode    = NewDocument.DocumentCode
 550         NewAcctTrans.EntityType      = VoucherLine.EntityType
 551         NewAcctTrans.EntityCode      = VoucherLine.EntityCode
 552         NewAcctTrans.AccountCode     = VoucherLine.AccountCode
 553         NewAcctTrans.Amount          = VoucherLine.Amount - VoucherLine.TaxAmount
 554         NewAcctTrans.Date            = trn-date
 555         NewAcctTrans.MonthCode       = mth-code
 556         NewAcctTrans.Description     = VoucherLine.Description
 557         NewAcctTrans.Reference       = NewDocument.Reference
 558         document-total = document-total + NewAcctTrans.Amount.
 559
 560       /* Store Companies proportional GST */
 561       IF GST-Multi-Company = YES AND
 562           gst-applies AND
 563           residual-tax <> 0 AND
 564           VoucherLine.EntityType <> 'T'  AND
 565           VoucherLine.EntityType <> 'C'
 566          THEN RUN update-gst-table.
 567
 568       IF VoucherLine.TaxAmount <> 0 THEN DO:
 569         gst-et = VoucherLine.EntityType.
 570         gst-ec = VoucherLine.EntityCode.
 571         IF gst-et = 'J' THEN DO:
 572           REPEAT WHILE gst-et <> "L":
 573             IF gst-et = "J" THEN DO:
 574               FIND mypj WHERE mypj.ProjectCode = gst-ec NO-LOCK.
 575               gst-et = mypj.EntityType.
 576               gst-ec = mypj.EntityCode.
 577             END.
 578             ELSE DO:
 579               IF gst-et = "P" THEN DO:
 580                 FIND Property WHERE Property.PropertyCode = gst-ec NO-LOCK.
 581                 gst-et = "L".
 582                 gst-ec = Property.CompanyCode.
 583               END.
 584               ELSE DO:
 585                 LEAVE.
 586               END.
 587             END.
 588           END. /* Repeat */
 589         END. /* if */
 590         CREATE NewAcctTrans.
 591         ASSIGN NewAcctTrans.BatchCode       = NewBatch.BatchCode
 592                NewAcctTrans.DocumentCode    = NewDocument.DocumentCode
 593                NewAcctTrans.EntityType      = gst-et
 594                NewAcctTrans.EntityCode      = gst-ec
 595                NewAcctTrans.AccountCode     = (IF INDEX( "TC", VoucherLine.EntityType) > 0 THEN VoucherLine.AccountCode ELSE gst-in)
 596                NewAcctTrans.Amount          = VoucherLine.TaxAmount
 597                NewAcctTrans.Date            = trn-date
 598                NewAcctTrans.MonthCode       = mth-code
 599                NewAcctTrans.Description     = "GST, " + VoucherLine.Description
 600                NewAcctTrans.Reference       = NewDocument.Reference
 601                document-total = document-total + NewAcctTrans.Amount.
 602         residual-tax = residual-tax - VoucherLine.TaxAmount .
 603       END.
 604     END. /* VoucherLine */
 605
 606     /* Create the GST debit transaction */
 607
 608     FIND Creditor OF Voucher NO-LOCK.
 609
 610     IF gst-applies AND residual-tax <> 0 THEN DO:
 611         IF GST-multi-company = YES  THEN DO:
 612           FOR EACH company-gst:
 613              CREATE NewAcctTrans.
 614              ASSIGN
 615                 NewAcctTrans.BatchCode       = NewBatch.BatchCode
 616                 NewAcctTrans.DocumentCode    = NewDocument.DocumentCode
 617                 NewAcctTrans.EntityType      = "L"
 618                 NewAcctTrans.EntityCode      = company-gst.company_id
 619                 NewAcctTrans.AccountCode     = gst-in
 620                 NewAcctTrans.Amount          = company-gst.Tax_Amount
 621                 NewAcctTrans.Date            = trn-date
 622                 NewAcctTrans.MonthCode = mth-code
 623                 NewAcctTrans.Description     = 'GST, ' + NewDocument.Description
 624                 NewAcctTrans.Reference       = NewDocument.Reference
 625                 document-total = document-total + NewAcctTrans.Amount.
 626               residual-tax = residual-tax  - company-gst.Tax_Amount .
 627           END.   /* Each company-gst */
 628       END.  /* GST-multi-company */
 629
 630       /* Remainder of tax (sometimes because of rounding) */
 631       IF residual-tax <> 0 THEN DO:
 632         CREATE NewAcctTrans.
 633          ASSIGN
 634            NewAcctTrans.BatchCode       = NewBatch.BatchCode
 635            NewAcctTrans.DocumentCode    = NewDocument.DocumentCode
 636            NewAcctTrans.EntityType      = "L"
 637            NewAcctTrans.EntityCode      = gst-in-ecode
 638            NewAcctTrans.AccountCode     = gst-in
 639            NewAcctTrans.Amount          = residual-tax
 640            NewAcctTrans.Date            = trn-date
 641            NewAcctTrans.MonthCode       = mth-code
 642            NewAcctTrans.Description     = "GST, " + NewDocument.Description
 643            NewAcctTrans.Reference       = NewDocument.Reference
 644            document-total = document-total + NewAcctTrans.Amount.
 645       END. /* residual tax */
 646
 647       IF multi-ledger-creditors THEN DO:
 648         NewAcctTrans.EntityCode     = creditor-ledger.
 649       END.
 650
 651     END. /* gst applies */
 652
 653     /* Credit the creditor */
 654
 655     CREATE NewAcctTrans.
 656     ASSIGN
 657       NewAcctTrans.BatchCode       = NewBatch.BatchCode
 658       NewAcctTrans.DocumentCode    = NewDocument.DocumentCode
 659       NewAcctTrans.EntityType      = "C"
 660       NewAcctTrans.EntityCode      = Voucher.CreditorCode
 661       NewAcctTrans.AccountCode     = sundry-creditors
 662       NewAcctTrans.Amount          = ( Voucher.GoodsValue + Voucher.TaxValue ) * -1
 663       NewAcctTrans.Date            = trn-date
 664       NewAcctTrans.MonthCode       = mth-code
 665       NewAcctTrans.Description     = NewDocument.Description
 666       NewAcctTrans.Reference       = NewDocument.Reference
 667       document-total = document-total + NewAcctTrans.Amount.
 668
 669     IF multi-ledger-creditors THEN DO:
 670       NewAcctTrans.AccountCode     = creditor-ledger.
 671     END.
 672
 673
 674     FIND CURRENT Voucher EXCLUSIVE-LOCK.
 675     ASSIGN
 676       Voucher.VoucherStatus = "A"
 677       Voucher.BatchCode     = NewDocument.BatchCode
 678       Voucher.DocumentCode  = NewDocument.DocumentCode.
 679
 680     IF document-total <> 0 THEN DO:
 681       MESSAGE "Error approving voucher" Voucher.VoucherSeq SKIP
 682               "Voucher allocations do not match invoice total"
 683               VIEW-AS ALERT-BOX ERROR TITLE "Voucher Allocation Error".
 684       UNDO, RETURN "FAIL".
 685     END.
 686   END.
 687
 688 END.
 689
 690 RUN dispatch IN h-msg( 'destroy':U ).
 691 MESSAGE "Vouchers successfully Approved" VIEW-AS ALERT-BOX INFORMATION.
 692 RUN open-vch-query.
 693
 694 END PROCEDURE.
 695
 696 /* _UIB-CODE-BLOCK-END */
 697 &ANALYZE-RESUME
 698
 699 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI V-table-Win  _DEFAULT-DISABLE
 700 PROCEDURE disable_UI :
 701 /*------------------------------------------------------------------------------
 702   Purpose:     DISABLE the User Interface
 703   Parameters:  <none>
 704   Notes:       Here we clean-up the user-interface by deleting
 705                dynamic widgets we have created and/or hide
 706                frames.  This procedure is usually called when
 707                we are ready to "clean-up" after running.
 708 ------------------------------------------------------------------------------*/
 709   /* Hide all frames. */
 710   HIDE FRAME F-Main.
 711   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 712 END PROCEDURE.
 713
 714 /* _UIB-CODE-BLOCK-END */
 715 &ANALYZE-RESUME
 716
 717 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-initialize V-table-Win
 718 PROCEDURE inst-initialize :
 719 /*------------------------------------------------------------------------------
 720   Purpose:
 721   Parameters:  <none>
 722   Notes:
 723 ------------------------------------------------------------------------------*/
 724   RUN get-username IN sys-mgr( OUTPUT user-name ).
 725   RUN open-vch-query.
 726
 727 END PROCEDURE.
 728
 729 /* _UIB-CODE-BLOCK-END */
 730 &ANALYZE-RESUME
 731
 732 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE open-vch-query V-table-Win
 733 PROCEDURE open-vch-query :
 734 /*------------------------------------------------------------------------------
 735   Purpose:
 736   Parameters:  <none>
 737   Notes:
 738 ------------------------------------------------------------------------------*/
 739
 740   {&OPEN-QUERY-{&BROWSE-NAME}}
 741
 742 END PROCEDURE.
 743
 744 /* _UIB-CODE-BLOCK-END */
 745 &ANALYZE-RESUME
 746
 747 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE select-all-vouchers V-table-Win
 748 PROCEDURE select-all-vouchers :
 749 /*------------------------------------------------------------------------------
 750   Purpose:
 751 ------------------------------------------------------------------------------*/
 752 DEF VAR i AS INT NO-UNDO INITIAL 1.
 753 DEF VAR test-1 AS LOGI NO-UNDO.
 754 DEF VAR test-2 AS LOGI NO-UNDO.
 755
 756   IF NUM-RESULTS("{&BROWSE-NAME}") = 0 OR
 757      NUM-RESULTS("{&BROWSE-NAME}") = ? THEN RETURN.
 758
 759   GET FIRST {&BROWSE-NAME}.
 760   REPOSITION {&BROWSE-NAME} TO ROWID ROWID( Voucher ).
 761
 762   DO WHILE AVAILABLE Voucher:
 763    ASSIGN test-1 = BROWSE {&BROWSE-NAME}:IS-ROW-SELECTED(i) NO-ERROR.
 764    IF NOT test-1 THEN DO:
 765      ASSIGN test-2 = {&BROWSE-NAME}:SELECT-ROW(i) IN FRAME {&FRAME-NAME} NO-ERROR.
 766      IF NOT test-2 THEN DO:
 767        REPOSITION {&BROWSE-NAME} TO ROWID ROWID( Voucher ).
 768        i = 1.
 769        ASSIGN test-1 = BROWSE {&BROWSE-NAME}:IS-ROW-SELECTED(i) NO-ERROR.
 770        ASSIGN test-2 = {&BROWSE-NAME}:SELECT-ROW(i) IN FRAME {&FRAME-NAME} NO-ERROR.
 771      END.
 772      {&BROWSE-NAME}:SELECT-FOCUSED-ROW() IN FRAME {&FRAME-NAME}.
 773    END.
 774    GET NEXT {&BROWSE-NAME}.
 775    i = i + 1.
 776   END.
 777
 778   GET FIRST {&BROWSE-NAME}.
 779   REPOSITION {&BROWSE-NAME} TO ROWID ROWID( Voucher ).
 780
 781 END PROCEDURE.
 782
 783 /* _UIB-CODE-BLOCK-END */
 784 &ANALYZE-RESUME
 785
 786 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records V-table-Win  _ADM-SEND-RECORDS
 787 PROCEDURE send-records :
 788 /*------------------------------------------------------------------------------
 789   Purpose:     Send record ROWID's for all tables used by
 790                this file.
 791   Parameters:  see template/snd-head.i
 792 ------------------------------------------------------------------------------*/
 793
 794   /* Define variables needed by this internal procedure.               */
 795   {src/adm/template/snd-head.i}
 796
 797   /* For each requested table, put it's ROWID in the output list.      */
 798   {src/adm/template/snd-list.i "Voucher"}
 799   {src/adm/template/snd-list.i "Creditor"}
 800   {src/adm/template/snd-list.i "VoucherLine"}
 801
 802   /* Deal with any unexpected table requests before closing.           */
 803   {src/adm/template/snd-end.i}
 804
 805 END PROCEDURE.
 806
 807 /* _UIB-CODE-BLOCK-END */
 808 &ANALYZE-RESUME
 809
 810 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed V-table-Win
 811 PROCEDURE state-changed :
 812 /* -----------------------------------------------------------
 813   Purpose:
 814   Parameters:  <none>
 815   Notes:
 816 -------------------------------------------------------------*/
 817   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE    NO-UNDO.
 818   DEFINE INPUT PARAMETER p-state      AS CHARACTER NO-UNDO.
 819
 820   CASE p-state:
 821       /* Object instance CASEs can go here to replace standard behavior
 822          or add new cases. */
 823       {src/adm/template/vstates.i}
 824   END CASE.
 825 END PROCEDURE.
 826
 827 /* _UIB-CODE-BLOCK-END */
 828 &ANALYZE-RESUME
 829
 830 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE toggle-current-row V-table-Win
 831 PROCEDURE toggle-current-row :
 832 /*------------------------------------------------------------------------------
 833   Purpose:
 834 ------------------------------------------------------------------------------*/
 835 DEF VAR row-num AS INT NO-UNDO.
 836 DEF VAR row-sel AS LOGI NO-UNDO.
 837
 838   row-num = BROWSE {&BROWSE-NAME}:FOCUSED-ROW .
 839   row-sel = BROWSE {&BROWSE-NAME}:IS-ROW-SELECTED(row-num).
 840   MESSAGE row-num row-sel.
 841   IF row-sel THEN
 842     {&BROWSE-NAME}:DESELECT-FOCUSED-ROW() IN FRAME {&FRAME-NAME}.
 843   ELSE
 844     {&BROWSE-NAME}:SELECT-FOCUSED-ROW() IN FRAME {&FRAME-NAME}.
 845
 846 END PROCEDURE.
 847
 848 /* _UIB-CODE-BLOCK-END */
 849 &ANALYZE-RESUME
 850
 851 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-gst-table V-table-Win
 852 PROCEDURE update-gst-table :
 853 /*------------------------------------------------------------------------------
 854   Purpose:  Updates the GST table that stores the proportion of GST to be allocated for each company
 855                     for all the transactions in the current  document.
 856                     2003/03/17 GLF
 857 ------------------------------------------------------------------------------*/
 858 DEF VAR v_eType  LIKE EntityType.EntityType  NO-UNDO.
 859 DEF VAR v_eCode LIKE company.CompanyCode  NO-UNDO.
 860
 861 ASSIGN v_EType =VoucherLine.EntityType
 862                v_ECode= VoucherLine.EntityCode.
 863
 864 /* Drill up to the first company/ledger hierarchy */
 865 IF v_eType <> 'L'  THEN DO:
 866     REPEAT WHILE v_eType <> 'L':
 867          IF v_eType = 'J'  THEN DO:
 868              FIND Project WHERE Project.ProjectCode = v_eCode NO-LOCK.
 869               ASSIGN   v_eType =Project.EntityType
 870                                v_eCode =Project.EntityCode.
 871           END.
 872           ELSE DO:
 873               IF v_eType = 'P' THEN DO:
 874                 FIND Property WHERE Property.PropertyCode = v_eCode NO-LOCK.
 875                 ASSIGN v_eType = 'L'
 876                                 v_eCode = Property.CompanyCode.
 877               END.
 878          END.
 879     END. /* Repeat */
 880 END. /* Do */
 881
 882 /* Update amounts to company gst temporary table */
 883 FIND company-gst WHERE company-gst.company_id  = v_eCode EXCLUSIVE-LOCK NO-ERROR.
 884 IF AVAILABLE company-gst  THEN
 885     company-gst.tax_amount  = company-gst.tax_amount +
 886                                                        ((VoucherLine.Amount  - VoucherLine.TaxAmount) *
 887                                                          (DECIMAL(gst-rate) / 100 )) .
 888 ELSE DO:
 889    CREATE company-gst.
 890     ASSIGN company-gst.company_id = v_eCode
 891                     company-gst.tax_amount = (VoucherLine.Amount  - VoucherLine.TaxAmount) *
 892                                                                        (DECIMAL(gst-rate) / 100 ).
 893 END.
 894
 895
 896 END PROCEDURE.
 897
 898 /* _UIB-CODE-BLOCK-END */
 899 &ANALYZE-RESUME
 900
 901 /* ************************  Function Implementations ***************** */
 902
 903 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-trn-date V-table-Win
 904 FUNCTION get-trn-date RETURNS DATE
 905   ( OUTPUT m-code AS INT ) :
 906 /*------------------------------------------------------------------------------
 907   Purpose:
 908 ------------------------------------------------------------------------------*/
 909 DEF VAR spec1 AS CHAR NO-UNDO.
 910 DEF VAR spec2 AS CHAR NO-UNDO.
 911 DEF VAR n-diff AS INT NO-UNDO INITIAL 0.
 912 DEF VAR result1 AS DATE NO-UNDO.
 913 DEF VAR result2 AS DATE NO-UNDO.
 914
 915   m-code = ?.
 916   IF use-due-dates <> Yes THEN RETURN Voucher.Date.
 917
 918   spec1 = ENTRY( 1, voucher-transaction-date, "/").
 919   spec1 = ENTRY( 1, spec1, "-").
 920   IF NUM-ENTRIES( voucher-transaction-date, "/") = 2 THEN
 921     spec2 = ENTRY( 2, voucher-transaction-date, "/").
 922   ELSE
 923     spec2 = spec1.
 924
 925   IF spec2 MATCHES "*-*" THEN ASSIGN n-diff = - INT(ENTRY( 2, spec2, "-")) NO-ERROR.
 926   IF n-diff < 0 THEN . ELSE n-diff = 0.
 927   spec2 = ENTRY( 1, spec2, "-").
 928
 929   CASE spec1:
 930     WHEN "Due" THEN       result1 = Voucher.DateDue.
 931     WHEN "Invoice" THEN   result1 = Voucher.Date.
 932     WHEN "Created" THEN   result1 = Voucher.CreatedDate.
 933     OTHERWISE result1 = TODAY.
 934   END CASE.
 935   CASE spec2:
 936     WHEN "Due" THEN       result2 = Voucher.DateDue - n-diff.
 937     WHEN "Invoice" THEN   result2 = Voucher.Date - n-diff.
 938     WHEN "Created" THEN   result2 = Voucher.CreatedDate - n-diff.
 939     OTHERWISE result2 = TODAY - n-diff.
 940   END CASE.
 941
 942   IF result1 = ? THEN result1 = TODAY.
 943   IF result2 = ? THEN result2 = TODAY.
 944   IF result2 > result1 THEN DO:
 945     FIND LAST Month WHERE Month.StartDate <= result2 NO-LOCK NO-ERROR.
 946     IF AVAILABLE(Month) THEN m-code = Month.MonthCode.
 947     RETURN result2.
 948   END.
 949
 950   RETURN result1.
 951
 952 END FUNCTION.
 953
 954 /* _UIB-CODE-BLOCK-END */
 955 &ANALYZE-RESUME
 956
 957 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION validate-creditor-ledger V-table-Win
 958 FUNCTION validate-creditor-ledger RETURNS INTEGER
 959   ( /* parameter-definitions */ ) :
 960 /*------------------------------------------------------------------------------
 961   Purpose:
 962     Notes:
 963 ------------------------------------------------------------------------------*/
 964 DEF VAR creditor-company AS INT NO-UNDO INITIAL ?.
 965 DEF VAR this-company AS INT NO-UNDO.
 966
 967   FOR EACH VoucherLine OF Voucher NO-LOCK:
 968     this-company = get-entity-ledger( VoucherLine.EntityType, VoucherLine.EntityCode ).
 969     IF creditor-company = ? THEN creditor-company = this-company. ELSE DO:
 970       IF creditor-company <> this-company THEN RETURN ?.  /* May not split allocations across multiple companies */
 971     END.
 972   END.
 973
 974   RETURN creditor-company.
 975
 976 END FUNCTION.
 977
 978 /* _UIB-CODE-BLOCK-END */
 979 &ANALYZE-RESUME
 980