process/report/trnpst.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
  17 DEF INPUT PARAMETER batch-no LIKE Batch.BatchCode NO-UNDO.
  18
  19 &SCOPED-DEFINE lines-per-page 112
  20
  21 /* Report counters */
  22 DEF VAR ln AS DEC INIT 0.00 NO-UNDO.
  23
  24 /* Line definitions */
  25
  26 DEF VAR page-no               AS INT INIT 1 NO-UNDO.
  27 DEF VAR reset-page            AS CHAR NO-UNDO.
  28 DEF VAR half-line             AS CHAR NO-UNDO. half-line = CHR(27) + "=".
  29
  30 DEF VAR title-font            AS CHAR NO-UNDO.
  31 DEF VAR column-font           AS CHAR NO-UNDO.
  32 DEF VAR line-printer          AS CHAR NO-UNDO.
  33 DEF VAR trn-font-1            AS CHAR NO-UNDO.
  34 DEF VAR trn-font-2            AS CHAR NO-UNDO.
  35 DEF VAR footer-font           AS CHAR NO-UNDO.
  36 DEF VAR warning-font          AS CHAR NO-UNDO.
  37 DEF VAR normal                AS CHAR NO-UNDO.
  38
  39 DEF VAR i AS INT NO-UNDO.
  40
  41 DEF VAR ledger-total AS DEC NO-UNDO.
  42
  43 {inc/ofc-this.i}
  44 {inc/ofc-set-l.i "Tenant-Accounts" "tenant-accounts"}
  45 {inc/ofc-set-l.i "Period-Closed-Warnings" "Period-Closed-Warnings"}
  46
  47 /* _UIB-CODE-BLOCK-END */
  48 &ANALYZE-RESUME
  49
  50
  51 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  52
  53 /* ********************  Preprocessor Definitions  ******************** */
  54
  55 &Scoped-define PROCEDURE-TYPE Procedure
  56
  57
  58
  59 /* _UIB-PREPROCESSOR-BLOCK-END */
  60 &ANALYZE-RESUME
  61
  62
  63
  64 /* *********************** Procedure Settings ************************ */
  65
  66 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  67 /* Settings for THIS-PROCEDURE
  68    Type: Procedure
  69    Allow:
  70    Frames: 0
  71    Add Fields to: Neither
  72    Other Settings: CODE-ONLY COMPILE
  73  */
  74 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  75
  76 /* *************************  Create Window  ************************** */
  77
  78 &ANALYZE-SUSPEND _CREATE-WINDOW
  79 /* DESIGN Window definition (used by the UIB)
  80   CREATE WINDOW Procedure ASSIGN
  81          HEIGHT             = .08
  82          WIDTH              = 40.
  83 /* END WINDOW DEFINITION */
  84                                                                         */
  85 &ANALYZE-RESUME
  86
  87
  88
  89 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
  90 /* ************************* Included-Libraries *********************** */
  91
  92 {inc/method/m-txtrep.i}
  93 {inc/convert.i}
  94
  95 /* _UIB-CODE-BLOCK-END */
  96 &ANALYZE-RESUME
  97
  98
  99
 100 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 101
 102
 103 /* ***************************  Main Block  *************************** */
 104
 105 DEF VAR user-name AS CHAR NO-UNDO.
 106 {inc/username.i "user-name"}
 107
 108 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 109
 110 RUN update-report.
 111
 112 OUTPUT CLOSE.
 113 RUN view-output-file ( no ).
 114
 115 /* _UIB-CODE-BLOCK-END */
 116 &ANALYZE-RESUME
 117
 118
 119 /* **********************  Internal Procedures  *********************** */
 120
 121 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE carriage-return Procedure
 122 PROCEDURE carriage-return :
 123 /*------------------------------------------------------------------------------
 124   Purpose:
 125   Parameters:  <none>
 126   Notes:
 127 ------------------------------------------------------------------------------*/
 128
 129   PUT CONTROL CHR(13).
 130
 131 END PROCEDURE.
 132
 133 /* _UIB-CODE-BLOCK-END */
 134 &ANALYZE-RESUME
 135
 136
 137 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE column-header Procedure
 138 PROCEDURE column-header :
 139 /*------------------------------------------------------------------------------
 140   Purpose:
 141   Parameters:  <none>
 142   Notes:
 143 ------------------------------------------------------------------------------*/
 144
 145   PUT CONTROL column-font.
 146   PUT UNFORMATTED SPACE(9)
 147     STRING( "Co/Ppty/Proj", "X(13)" ) SPACE(5)
 148     STRING( "Acct", "X(4)" ) SPACE(5)
 149     STRING( "Tn/Cr", "X(5)" ) SPACE(8)
 150     STRING( "Date", "X(4)" ) SPACE(4)
 151     STRING( "Trans Ref", "X(9)" ) SPACE(20)
 152     STRING( "Amount", "X(6)" ).
 153   PUT CONTROL line-printer.
 154   RUN skip-line(2).
 155
 156 END PROCEDURE.
 157
 158 /* _UIB-CODE-BLOCK-END */
 159 &ANALYZE-RESUME
 160
 161
 162 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-document Procedure
 163 PROCEDURE each-document :
 164 /*------------------------------------------------------------------------------
 165   Purpose:
 166   Parameters:  <none>
 167   Notes:
 168 ------------------------------------------------------------------------------*/
 169
 170   PUT CONTROL trn-font-1.
 171   PUT UNFORMATTED
 172     STRING( Document.DocumentType, "X(4)" ) SPACE(2)
 173     STRING( Document.Reference, "X(12)" ) SPACE(2)
 174     STRING( Document.Description, "X(50)" ).
 175   RUN skip-line(1).
 176
 177   FOR EACH AcctTran OF Document NO-LOCK.
 178     RUN each-transaction.
 179   END.
 180
 181   RUN skip-line(1).
 182
 183 END PROCEDURE.
 184
 185 /* _UIB-CODE-BLOCK-END */
 186 &ANALYZE-RESUME
 187
 188
 189 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-transaction Procedure
 190 PROCEDURE each-transaction :
 191 /*------------------------------------------------------------------------------
 192   Purpose:
 193   Parameters:  <none>
 194   Notes:
 195 ------------------------------------------------------------------------------*/
 196
 197   DEF VAR entity-code AS CHAR NO-UNDO.
 198   entity-code = FILL( ' ', IF AcctTran.EntityType = "P" THEN 3 ELSE
 199                            IF AcctTran.EntityType = "J" THEN 8 ELSE 0 ).
 200   entity-code = entity-code + STRING( AcctTran.EntityCode,
 201     IF AcctTran.Entitytype = "L" THEN "999" ELSE "99999" ).
 202   IF LOOKUP( AcctTran.EntityType, "C,T") <> 0 THEN entity-code = "".
 203
 204   PUT CONTROL trn-font-2.
 205
 206   PUT UNFORMATTED SPACE(5)
 207     STRING( entity-code, "X(13)" ) SPACE(1)
 208     STRING( IF AcctTran.EntityType <> "C" AND (tenant-accounts OR AcctTran.EntityType <> "T") THEN
 209       STRING( AcctTran.AccountCode, "9999.99" ) ELSE "", "X(7)" ) SPACE(1)
 210     STRING( IF LOOKUP( AcctTran.EntityType, "T,C" ) <> 0 THEN AcctTran.EntityType +
 211       STRING( AcctTran.EntityCode, "99999" ) ELSE "", "X(6)" ) SPACE(1)
 212     STRING( AcctTran.Date, "99/99/9999" ) SPACE(1)
 213     STRING( IF AcctTran.Reference <> "" THEN AcctTran.Reference
 214                                         ELSE Document.Reference, "X(12)" ) SPACE(1)
 215     STRING( AcctTran.Amount, ">>>,>>>,>>9.99CR" ) SPACE(1)
 216     STRING( IF AcctTran.Description <> "" THEN AcctTran.Description ELSE Document.Description, "X(50)" ).
 217   RUN skip-line(1).
 218
 219   FIND Month WHERE Month.MonthCode = AcctTran.MonthCode NO-LOCK.
 220
 221   IF Period-Closed-Warnings <> No AND (AcctTran.Date < Month.StartDate OR AcctTran.Date > Month.EndDate) THEN DO:
 222     PUT CONTROL warning-font.
 223     PUT UNFORMATTED SPACE(5) STRING(
 224       "( Warning! Period closed - updated to " +
 225       STRING( Month.StartDate, "99/99/9999" ) + " to " + STRING( Month.EndDate, "99/99/9999" ) +
 226       " period instead. )" ).
 227     PUT CONTROL normal.
 228     RUN skip-line(1.5).
 229   END.
 230
 231   ledger-total = ledger-total +
 232     IF AcctTran.EntityType = "L" THEN AcctTran.Amount ELSE 0.
 233
 234 END PROCEDURE.
 235
 236 /* _UIB-CODE-BLOCK-END */
 237 &ANALYZE-RESUME
 238
 239
 240 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-control-strings Procedure
 241 PROCEDURE get-control-strings :
 242 /*------------------------------------------------------------------------------
 243   Purpose:     Get all control strings for this report
 244   Parameters:  <none>
 245   Notes:
 246 ------------------------------------------------------------------------------*/
 247
 248   DEF VAR rows AS DEC NO-UNDO.
 249   DEF VAR cols AS DEC NO-UNDO.
 250
 251   RUN make-control-string ( "PCL", "reset,portrait,a4,tm,0,lm,4",
 252                   OUTPUT reset-page, OUTPUT rows, OUTPUT cols ).
 253
 254   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,10",
 255                   OUTPUT title-font, OUTPUT rows, OUTPUT cols ).
 256
 257   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,8",
 258                   OUTPUT column-font, OUTPUT rows, OUTPUT cols ).
 259
 260   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,10",
 261                   OUTPUT footer-font, OUTPUT rows, OUTPUT cols ).
 262
 263   RUN make-control-string ( "PCL", "LinePrinter,lpi,9.54",
 264                   OUTPUT line-printer, OUTPUT rows, OUTPUT cols ).
 265
 266   RUN make-control-string ( "PCL", "LinePrinter,lpi,9.54",
 267                   OUTPUT trn-font-1, OUTPUT rows, OUTPUT cols ).
 268
 269   RUN make-control-string ( "PCL", "Courier,Pitch,24",
 270                   OUTPUT trn-font-2, OUTPUT rows, OUTPUT cols ).
 271
 272   RUN make-control-string ( "PCL", "Courier,Bold,Pitch,24",
 273                   OUTPUT warning-font, OUTPUT rows, OUTPUT cols ).
 274
 275   RUN make-control-string ( "PCL", "Normal",
 276                   OUTPUT normal, OUTPUT rows, OUTPUT cols ).
 277
 278 END PROCEDURE.
 279
 280 /* _UIB-CODE-BLOCK-END */
 281 &ANALYZE-RESUME
 282
 283
 284 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-feed Procedure
 285 PROCEDURE page-feed :
 286 /*------------------------------------------------------------------------------
 287   Purpose:
 288 ------------------------------------------------------------------------------*/
 289
 290   page-no = page-no + 1.
 291   PUT CONTROL CHR(12).
 292
 293 END PROCEDURE.
 294
 295 /* _UIB-CODE-BLOCK-END */
 296 &ANALYZE-RESUME
 297
 298
 299 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-header Procedure
 300 PROCEDURE page-header :
 301 /*------------------------------------------------------------------------------
 302   Purpose:
 303 ------------------------------------------------------------------------------*/
 304
 305   RUN reset-page.
 306   RUN print-title.
 307   RUN column-header.
 308
 309 END PROCEDURE.
 310
 311 /* _UIB-CODE-BLOCK-END */
 312 &ANALYZE-RESUME
 313
 314
 315 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-ledger-total Procedure
 316 PROCEDURE print-ledger-total :
 317 /*------------------------------------------------------------------------------
 318   Purpose:
 319   Parameters:  <none>
 320   Notes:
 321 ------------------------------------------------------------------------------*/
 322
 323   PUT CONTROL footer-font.
 324   PUT UNFORMATTED SPACE(10)
 325     STRING( "Control Total of Ledger Transactions for Batch = " +
 326              TRIM( STRING( ledger-total, ">>,>>>,>>>,>>9.99CR" ) ), "X(80)" ).
 327
 328 END PROCEDURE.
 329
 330 /* _UIB-CODE-BLOCK-END */
 331 &ANALYZE-RESUME
 332
 333
 334 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-title Procedure
 335 PROCEDURE print-title :
 336 /*------------------------------------------------------------------------------
 337   Purpose:
 338   Parameters:  <none>
 339   Notes:
 340 ------------------------------------------------------------------------------*/
 341
 342   PUT CONTROL line-printer.
 343   RUN skip-line(3).
 344   PUT CONTROL column-font.
 345   PUT UNFORMATTED   STRING( TODAY, "99/99/9999" )
 346                     STRING( ",", "X" ) SPACE
 347                     STRING( TIME, "HH:MM:SS" ) + " for " + user-name
 348                     CHR(13) SPACE(180) "Page " page-no.
 349   PUT CONTROL line-printer.
 350   RUN skip-line( 2 ).
 351   PUT CONTROL title-font.
 352   PUT UNFORMATTED STRING(
 353     "Posted Transactions for batch " + STRING( Batch.BatchCode, "99999" ) + " - " +
 354     Batch.Description,
 355     "X(80)" ).
 356   PUT CONTROL line-printer.
 357   RUN skip-line(3).
 358
 359 END PROCEDURE.
 360
 361 /* _UIB-CODE-BLOCK-END */
 362 &ANALYZE-RESUME
 363
 364
 365 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-page Procedure
 366 PROCEDURE reset-page :
 367 /*------------------------------------------------------------------------------
 368   Purpose:
 369   Parameters:  <none>
 370   Notes:
 371 ------------------------------------------------------------------------------*/
 372
 373   PUT CONTROL reset-page.
 374   ln = 0.
 375
 376 END PROCEDURE.
 377
 378 /* _UIB-CODE-BLOCK-END */
 379 &ANALYZE-RESUME
 380
 381
 382 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-line Procedure
 383 PROCEDURE skip-line :
 384 /*------------------------------------------------------------------------------
 385   Purpose:
 386   Parameters:  <none>
 387   Notes:
 388 ------------------------------------------------------------------------------*/
 389
 390   DEF INPUT PARAMETER n AS DEC NO-UNDO.
 391
 392   IF ln + n >= {&lines-per-page} THEN
 393   DO:
 394     RUN page-feed.
 395     RUN page-header.
 396     RETURN.
 397   END.
 398
 399   DEF VAR int-part AS INT NO-UNDO.
 400   DEF VAR dec-part AS DEC NO-UNDO.
 401
 402   int-part = TRUNCATE( n, 0 ).
 403   IF int-part < 0 THEN RETURN.
 404   dec-part = n - int-part.
 405   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 406
 407   /* Need to have this like the following - do not touch */
 408   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 409   IF dec-part <> 0 THEN PUT CONTROL half-line.
 410
 411   ln = ln + n.
 412
 413   RUN carriage-return.
 414
 415 END PROCEDURE.
 416
 417 /* _UIB-CODE-BLOCK-END */
 418 &ANALYZE-RESUME
 419
 420
 421 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-to-line Procedure
 422 PROCEDURE skip-to-line :
 423 /*------------------------------------------------------------------------------
 424   Purpose:
 425   Parameters:  <none>
 426   Notes:
 427 ------------------------------------------------------------------------------*/
 428
 429   DEF INPUT PARAMETER line-no AS DEC NO-UNDO.
 430
 431   DEF VAR int-part AS INT NO-UNDO.
 432   DEF VAR dec-part AS DEC NO-UNDO.
 433
 434   int-part = TRUNCATE( line-no - ln, 0 ).
 435   IF int-part < 0 THEN RETURN.
 436   dec-part = ( line-no - ln ) - int-part.
 437   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 438
 439   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 440   IF dec-part <> 0 THEN PUT CONTROL half-line.
 441
 442   ln = line-no.
 443
 444   RUN carriage-return.
 445
 446 END PROCEDURE.
 447
 448 /* _UIB-CODE-BLOCK-END */
 449 &ANALYZE-RESUME
 450
 451
 452 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-report Procedure
 453 PROCEDURE update-report :
 454 /*------------------------------------------------------------------------------
 455   Purpose:
 456   Parameters:  <none>
 457   Notes:
 458 ------------------------------------------------------------------------------*/
 459
 460   FIND Batch WHERE Batch.BatchCode = batch-no NO-LOCK NO-ERROR.
 461   IF NOT AVAILABLE Batch THEN RETURN.
 462
 463   RUN get-control-strings.
 464   RUN page-header.
 465
 466   FOR EACH Document OF Batch NO-LOCK:
 467     RUN each-document.
 468   END.
 469
 470   RUN skip-line(1).
 471   RUN print-ledger-total.
 472   RUN page-feed.
 473
 474 END PROCEDURE.
 475
 476 /* _UIB-CODE-BLOCK-END */
 477 &ANALYZE-RESUME
 478
 479