process/one-off/fix/fixchq.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        :
   6     Purpose     :
   7
   8     Syntax      :
   9
  10     Description :
  11
  12     Author(s)   :
  13     Created     :
  14     Notes       :
  15   ------------------------------------------------------------------------*/
  16 /*          This .W file was created with the Progress UIB.             */
  17 /*----------------------------------------------------------------------*/
  18
  19 /* ***************************  Definitions  ************************** */
  20
  21 /* _UIB-CODE-BLOCK-END */
  22 &ANALYZE-RESUME
  23
  24
  25 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  26
  27 /* ********************  Preprocessor Definitions  ******************** */
  28
  29 &Scoped-define PROCEDURE-TYPE Procedure
  30
  31
  32
  33 /* _UIB-PREPROCESSOR-BLOCK-END */
  34 &ANALYZE-RESUME
  35
  36
  37
  38 /* *********************** Procedure Settings ************************ */
  39
  40 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  41 /* Settings for THIS-PROCEDURE
  42    Type: Procedure
  43    Allow:
  44    Frames: 0
  45    Add Fields to: Neither
  46    Other Settings: CODE-ONLY COMPILE
  47  */
  48 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  49
  50 /* *************************  Create Window  ************************** */
  51
  52 &ANALYZE-SUSPEND _CREATE-WINDOW
  53 /* DESIGN Window definition (used by the UIB)
  54   CREATE WINDOW Procedure ASSIGN
  55          HEIGHT             = .25
  56          WIDTH              = 38.43.
  57 /* END WINDOW DEFINITION */
  58                                                                         */
  59 &ANALYZE-RESUME
  60
  61
  62
  63
  64 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  65
  66
  67 /* ***************************  Main Block  *************************** */
  68
  69 OUTPUT TO debug.txt KEEP-MESSAGES.
  70
  71 RUN process-cheques.
  72
  73 OUTPUT CLOSE.
  74
  75 MESSAGE "Completed.".
  76
  77 /* _UIB-CODE-BLOCK-END */
  78 &ANALYZE-RESUME
  79
  80
  81 /* **********************  Internal Procedures  *********************** */
  82
  83 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-cheques Procedure
  84 PROCEDURE process-cheques :
  85 /*------------------------------------------------------------------------------
  86   Purpose:
  87 ------------------------------------------------------------------------------*/
  88 DEF VAR chq-total AS DEC NO-UNDO.
  89 DEF VAR old-chq AS INT NO-UNDO.
  90 DEF VAR ths-chq AS INT NO-UNDO.
  91
  92   FOR EACH Cheque WHERE CAN-FIND( FIRST NewDocument OF Cheque ) NO-LOCK:
  93     FIND NewDocument OF Cheque WHERE NewDocument.DocumentType = "CHEQ" NO-LOCK NO-ERROR.
  94     IF NOT AVAILABLE(NewDocument) THEN NEXT.
  95
  96     MESSAGE "Looking at cheque" Cheque.ChequeNo "for amount" Cheque.Amount.
  97     FIND LAST Voucher WHERE Voucher.VoucherStatus = "P"
  98                         AND Voucher.CreditorCode = Cheque.CreditorCode
  99                         AND Voucher.BankAccountCode = Cheque.BankAccountCode
 100                         AND Voucher.ChequeNo = Cheque.ChequeNo NO-LOCK NO-ERROR.
 101     IF AVAILABLE(Voucher) THEN DO:
 102       MESSAGE "Cheque" Cheque.ChequeNo "has vouchers already".
 103       NEXT.
 104     END.
 105
 106
 107     old-chq = -1.
 108     ths-chq = -2.
 109     chq-total = 0.0 .
 110     each-voucher-of-cheque:
 111     FOR EACH Voucher NO-LOCK WHERE Voucher.VoucherStatus = "P"
 112                       AND Voucher.CreditorCode = Cheque.CreditorCode
 113                       AND Voucher.BankAccountCode = Cheque.BankAccountCode
 114                       BY Voucher.LastModifiedDate DESCENDING:
 115       ths-chq = Voucher.ChequeNo.
 116       IF old-chq <> ths-chq THEN DO:
 117         IF chq-total = Cheque.Amount THEN LEAVE each-voucher-of-cheque.
 118         ELSE IF old-chq > 0 THEN
 119           MESSAGE "Total for cheque" old-chq "was" chq-total "(miss)".
 120         chq-total = 0.0 .
 121         old-chq = ths-chq .
 122       END.
 123       chq-total = chq-total + Voucher.TaxValue + Voucher.GoodsValue .
 124     END.
 125
 126     IF chq-total = Cheque.Amount AND old-chq > 0 THEN DO:
 127       MESSAGE "Total for cheque" old-chq "was" chq-total "(hit)".
 128       FOR EACH Voucher WHERE Voucher.VoucherStatus = "P"
 129                          AND Voucher.CreditorCode = Cheque.CreditorCode
 130                          AND Voucher.BankAccountCode = Cheque.BankAccountCode
 131                          AND Voucher.ChequeNo = old-chq EXCLUSIVE-LOCK:
 132         MESSAGE "Changed voucher" Voucher.VoucherSeq "from cheque" old-chq "to" Cheque.ChequeNo .
 133         Voucher.ChequeNo = Cheque.ChequeNo.
 134       END.
 135     END.
 136   END.
 137
 138 END PROCEDURE.
 139
 140 /* _UIB-CODE-BLOCK-END */
 141 &ANALYZE-RESUME
 142
 143