rplctn/replpost.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5   ------------------------------------------------------------------------*/
   6
   7 DEF VAR user-name AS CHAR NO-UNDO.
   8 {inc/username.i "user-name"}
   9 DEF VAR timeStamp AS CHAR FORMAT "X(44)" NO-UNDO.
  10 timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
  11
  12 DEF VAR preview       AS LOGI NO-UNDO INIT Yes.
  13 DEF VAR prt-ctrl      AS CHAR NO-UNDO.
  14 DEF VAR rows          AS DEC NO-UNDO.
  15 DEF VAR cols          AS DEC NO-UNDO.
  16
  17 /* _UIB-CODE-BLOCK-END */
  18 &ANALYZE-RESUME
  19
  20
  21 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  22
  23 /* ********************  Preprocessor Definitions  ******************** */
  24
  25 &Scoped-define PROCEDURE-TYPE Procedure
  26
  27
  28
  29 /* _UIB-PREPROCESSOR-BLOCK-END */
  30 &ANALYZE-RESUME
  31
  32
  33
  34 /* *********************** Procedure Settings ************************ */
  35
  36 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  37 /* Settings for THIS-PROCEDURE
  38    Type: Procedure
  39    Allow:
  40    Frames: 0
  41    Add Fields to: Neither
  42    Other Settings: CODE-ONLY COMPILE
  43  */
  44 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  45
  46 /* *************************  Create Window  ************************** */
  47
  48 &ANALYZE-SUSPEND _CREATE-WINDOW
  49 /* DESIGN Window definition (used by the UIB)
  50   CREATE WINDOW Procedure ASSIGN
  51          HEIGHT             = .07
  52          WIDTH              = 32.5.
  53 /* END WINDOW DEFINITION */
  54                                                                         */
  55 &ANALYZE-RESUME
  56
  57
  58
  59 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
  60 /* ************************* Included-Libraries *********************** */
  61
  62 {inc/method/m-txtrep.i}
  63 {inc/string.i}
  64
  65 /* _UIB-CODE-BLOCK-END */
  66 &ANALYZE-RESUME
  67
  68
  69
  70 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  71
  72
  73 /* ***************************  Main Block  *************************** */
  74
  75 /* Post all replicated ToPost batches from offices other than
  76    this one and that have not been posted */
  77
  78 RUN make-control-string ( "PCL", "reset,portrait,tm,2,a4,lm,6,courier,cpi,18,lpi,9",
  79                 OUTPUT prt-ctrl, OUTPUT rows, OUTPUT cols ).
  80
  81 RUN output-control-file ( prt-ctrl ).
  82 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE VALUE(rows).
  83
  84 {inc/ofc-this.i}
  85
  86 /* Page header for output report */
  87
  88 PUT UNFORMATTED "Printed: " + timeStamp SKIP(1).
  89 PUT UNFORMATTED
  90   "Batch" SPACE( 2 ) "Date      " SPACE( 2 ) "Time    " SPACE( 2 )
  91   "Originated" SPACE( 2 ) "Description" SKIP(1).
  92
  93 /* Post the batches */
  94
  95 FOR EACH ToPost WHERE
  96   ToPost.Officecode <> Office.OfficeCode AND
  97   ToPost.PostStatus = "REPL"
  98   EXCLUSIVE-LOCK:
  99
 100   FIND FIRST NewBatch WHERE NewBatch.BatchCode = ToPost.BatchCode
 101     NO-LOCK NO-ERROR.
 102
 103   IF NOT AVAILABLE NewBatch THEN
 104   DO:
 105     RUN print-line( ToPost.BatchCode, ToPost.OfficeCode, "Batch does not exist" ).
 106     ASSIGN ToPost.PostStatus = "ERRO".
 107   END.
 108   ELSE
 109   DO:
 110
 111     RUN process/tru.p( NewBatch.BatchCode, "delete,quiet,no-replicate" ).
 112
 113     IF RETURN-VALUE <> "" THEN
 114     DO:
 115       ASSIGN ToPost.PostStatus = "ERRO".
 116       RUN print-line( ToPost.BatchCode, ToPost.OfficeCode, RETURN-VALUE ).
 117     END.
 118     ELSE
 119     DO:
 120       ASSIGN ToPost.PostStatus = "POST".
 121       RUN print-line( ToPost.BatchCode, ToPost.OfficeCode, "Batch Posted successfully" ).
 122     END.
 123
 124   END.
 125
 126 END.
 127
 128
 129 OUTPUT CLOSE.
 130
 131 RUN view-output-file ( preview ).
 132 IF preview THEN WAIT-FOR CLOSE OF txtrep-preview-window.
 133
 134 /* _UIB-CODE-BLOCK-END */
 135 &ANALYZE-RESUME
 136
 137
 138 /* **********************  Internal Procedures  *********************** */
 139
 140 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-line Procedure
 141 PROCEDURE print-line :
 142 /*------------------------------------------------------------------------------
 143   Purpose:
 144   Parameters:  <none>
 145   Notes:
 146 ------------------------------------------------------------------------------*/
 147
 148   DEF INPUT PARAMETER batch-code LIKE Batch.Batchcode NO-UNDO.
 149   DEF INPUT PARAMETER office-code LIKE Office.OfficeCode NO-UNDO.
 150   DEF INPUT PARAMETER description AS CHAR NO-UNDO.
 151
 152   PUT UNFORMATTED
 153     STRING( batch-code, "99999" ) SPACE(2)
 154     STRING( TODAY, "99/99/9999" ) SPACE(2)
 155     STRING( TIME, "HH:MM:SS" )    SPACE(2)
 156     STRING( office-code, "X(10)" ) SPACE(2)
 157     STRING( description, "X(50)" ) SKIP.
 158
 159 END PROCEDURE.
 160
 161 /* _UIB-CODE-BLOCK-END */
 162 &ANALYZE-RESUME
 163
 164