process/report/ctclistg.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5   ------------------------------------------------------------------------*/
   6
   7 &IF DEFINED(UIB_IS_RUNNING) &THEN
   8 DEF VAR report-options AS CHAR NO-UNDO  INITIAL "".
   9 &ELSE
  10 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
  11 &ENDIF
  12
  13 DEF VAR ctype-list AS CHAR NO-UNDO.
  14 DEF VAR ptype-list AS CHAR NO-UNDO.
  15 DEF VAR include-types AS LOGI NO-UNDO INIT Yes.
  16 DEF VAR merge-list AS LOGI NO-UNDO INIT No.
  17
  18 DEF VAR preview   AS LOGI NO-UNDO INIT No.
  19 DEF VAR user-name AS CHAR NO-UNDO.
  20 {inc/username.i "user-name"}
  21 DEF VAR timeStamp AS CHAR FORMAT "X(44)" NO-UNDO.
  22 timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
  23
  24 DEF TEMP-TABLE ListContact NO-UNDO
  25     FIELD PersonCode AS INT
  26     FIELD Company AS CHAR
  27     FIELD LastName AS CHAR
  28     INDEX XPKListContact IS UNIQUE PRIMARY PersonCode
  29     INDEX XAK1ListContact Company Lastname.
  30
  31 /* _UIB-CODE-BLOCK-END */
  32 &ANALYZE-RESUME
  33
  34
  35 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  36
  37 /* ********************  Preprocessor Definitions  ******************** */
  38
  39 &Scoped-define PROCEDURE-TYPE Procedure
  40
  41
  42
  43 /* _UIB-PREPROCESSOR-BLOCK-END */
  44 &ANALYZE-RESUME
  45
  46
  47
  48 /* *********************** Procedure Settings ************************ */
  49
  50 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  51 /* Settings for THIS-PROCEDURE
  52    Type: Procedure
  53    Allow:
  54    Frames: 0
  55    Add Fields to: Neither
  56    Other Settings: CODE-ONLY COMPILE
  57  */
  58 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  59
  60 /* *************************  Create Window  ************************** */
  61
  62 &ANALYZE-SUSPEND _CREATE-WINDOW
  63 /* DESIGN Window definition (used by the UIB)
  64   CREATE WINDOW Procedure ASSIGN
  65          HEIGHT             = .05
  66          WIDTH              = 32.57.
  67 /* END WINDOW DEFINITION */
  68                                                                         */
  69 &ANALYZE-RESUME
  70
  71
  72
  73 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
  74 /* ************************* Included-Libraries *********************** */
  75
  76 {inc/method/m-txtrep.i}
  77 {inc/persndtl.i}
  78 {inc/null.i}
  79
  80 /* _UIB-CODE-BLOCK-END */
  81 &ANALYZE-RESUME
  82
  83
  84
  85 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  86
  87
  88 /* ***************************  Main Block  *************************** */
  89
  90 RUN parse-parameters.
  91
  92 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
  93
  94 RUN pclrep-start( preview, "reset,landscape,tm,2,a4,lm,6,courier,cpi,18,lpi,9").
  95
  96 IF merge-list THEN
  97   RUN merge-contacts.
  98 ELSE
  99   RUN contact-listing.
 100
 101 OUTPUT CLOSE.
 102
 103 RUN pclrep-finish.
 104
 105 /* _UIB-CODE-BLOCK-END */
 106 &ANALYZE-RESUME
 107
 108
 109 /* **********************  Internal Procedures  *********************** */
 110
 111 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE contact-listing Procedure
 112 PROCEDURE contact-listing :
 113 /*------------------------------------------------------------------------------
 114   Purpose:
 115 ------------------------------------------------------------------------------*/
 116 DEF VAR use-contact-type AS LOGI NO-UNDO.
 117
 118   FOR EACH ContactType NO-LOCK:
 119
 120     use-contact-type = LOOKUP( ContactType.ContactType, ctype-list ) <> 0.
 121     IF NOT include-types THEN use-contact-type = NOT use-contact-type.
 122     IF NOT use-contact-type THEN NEXT.
 123     RUN each-contact-type.
 124
 125   END.
 126
 127 END PROCEDURE.
 128
 129 /* _UIB-CODE-BLOCK-END */
 130 &ANALYZE-RESUME
 131
 132
 133 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-contact-type Procedure
 134 PROCEDURE each-contact-type :
 135 /*------------------------------------------------------------------------------
 136   Purpose:
 137 ------------------------------------------------------------------------------*/
 138 DEF VAR person-address AS CHAR NO-UNDO.
 139 DEF VAR last-address AS CHAR NO-UNDO.
 140 DEF VAR phone-no AS CHAR EXTENT 3 NO-UNDO.
 141 DEF VAR phtype-list AS CHAR NO-UNDO INIT "BUS,FAX,MOB".
 142 DEF VAR i AS INT NO-UNDO.
 143
 144   RUN pclrep-line( "Helvetica,Point,12,Bold,Proportional", ContactType.Description + " (" + ContactType.ContactType + ")" ).
 145   RUN pclrep-line( ?, "" ).
 146
 147   FOR EACH Contact OF ContactType NO-LOCK,
 148                 FIRST Person OF Contact NO-LOCK
 149                 BREAK BY Person.Company /* BY Person.City BY Person.Address */:
 150
 151     IF FIRST-OF( Person.Company ) THEN DO:
 152       RUN process/getaddr.p( "PERSON", Person.PersonCode, ptype-list, OUTPUT person-address ).
 153       person-address = TRIM( TRIM( REPLACE( REPLACE( person-address, "~r", ""), "~n", "," ), "," ) ).
 154       IF person-address <> "" THEN person-address = ", " + person-address.
 155       RUN pclrep-line( "Helvetica,Point,8,Normal,Proportional",  null-str(Person.Company,"?") + null-str(person-address,"?") ).
 156       last-address = person-address.
 157     END.
 158     ELSE DO:
 159       RUN process/getaddr.p( "PERSON", Person.PersonCode, ptype-list, OUTPUT person-address ).
 160       person-address = TRIM( TRIM( REPLACE( REPLACE( person-address, "~r", ""), "~n", "," ), "," ) ).
 161       IF person-address <> "" THEN person-address = ", " + person-address.
 162       IF person-address <> last-address THEN
 163         RUN pclrep-line( "Helvetica,Point,8,Normal,Proportional",  null-str(Person.Company,"?") + null-str(person-address,"?") ).
 164     END.
 165     DO i = 1 TO NUM-ENTRIES( phtype-list ):
 166       FIND PhoneDetail WHERE PhoneDetail.PersonCode = Person.PersonCode
 167                        AND PhoneDetail.PhoneType  = ENTRY( i, phtype-list )
 168                        NO-LOCK NO-ERROR.
 169
 170       phone-no[i] = "".
 171       IF AVAILABLE PhoneDetail THEN
 172         RUN combine-phone( PhoneDetail.cCountryCode, PhoneDetail.cSTDCode, PhoneDetail.Number,
 173                                                         OUTPUT phone-no[i] ).
 174     END.
 175
 176     RUN pclrep-line( "courier,Fixed,cpi,18,lpi,9,Normal",
 177         SPC( 4 ) +
 178         STRING( null-str(Person.FirstName, "?"), "X(15)" ) + SPC( 3 ) +
 179         STRING( null-str(Person.LastName, "?"), "X(15)" ) + SPC( 3 ) +
 180         STRING( null-str(phone-no[1], "?"), "X(20)" ) + SPC( 1 ) +
 181         STRING( null-str(phone-no[2], "?"), "X(20)" ) + SPC( 1 ) +
 182         STRING( null-str(phone-no[3], "?"), "X(20)" ) + SPC( 1 ) +
 183         STRING( null-str(Person.JobTitle, "?"), "X(40)" ) + SPC( 1 ) +
 184         STRING( null-str(Person.Department, "?"), "X(40)" )
 185       ).
 186
 187     IF LAST-OF( Person.Company ) THEN RUN pclrep-line( ?, "" ).
 188
 189   END.
 190
 191 END PROCEDURE.
 192
 193 /* _UIB-CODE-BLOCK-END */
 194 &ANALYZE-RESUME
 195
 196
 197 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
 198 PROCEDURE inst-page-footer :
 199 /*------------------------------------------------------------------------------
 200   Purpose:  Print any page footer
 201 ------------------------------------------------------------------------------*/
 202
 203 END PROCEDURE.
 204
 205 /* _UIB-CODE-BLOCK-END */
 206 &ANALYZE-RESUME
 207
 208
 209 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
 210 PROCEDURE inst-page-header :
 211 /*------------------------------------------------------------------------------
 212   Purpose:  Print any page header
 213 ------------------------------------------------------------------------------*/
 214
 215   RUN pclrep-line( "univers,Point,7,bold,proportional", TimeStamp).
 216   RUN pclrep-line( "univers,Point,12,bold,proportional", FILL( " ", 45) + "Contact Listing").
 217
 218   IF merge-list THEN DO:
 219     RUN pclrep-line( "", "").
 220     RUN pclrep-line( "courier,Fixed,cpi,18,lpi,9,Bold", "Contact Types: " + ctype-list ).
 221   END.
 222
 223   RUN pclrep-line( "", "").
 224   RUN pclrep-line( "courier,Fixed,cpi,18,lpi,9,Bold",
 225     SPC( 4 ) +
 226     STRING( "First Name", "X(15)" ) + SPC( 3 ) +
 227     STRING( "Last Name", "X(15)" ) + SPC( 3 ) +
 228     STRING( "Business", "X(20)" ) + SPC( 1 ) +
 229     STRING( "Facsimile", "X(20)" ) + SPC( 1 ) +
 230     STRING( "Mobile", "X(20)" ) + SPC( 1 ) +
 231     STRING( "Position title", "X(41)" ) + "Department~n"
 232   ).
 233
 234 END PROCEDURE.
 235
 236 /* _UIB-CODE-BLOCK-END */
 237 &ANALYZE-RESUME
 238
 239
 240 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE merge-contacts Procedure
 241 PROCEDURE merge-contacts :
 242 /*------------------------------------------------------------------------------
 243   Purpose:
 244 ------------------------------------------------------------------------------*/
 245 DEF VAR use-contact-type AS LOGI NO-UNDO.
 246
 247 DEF VAR person-address AS CHAR NO-UNDO.
 248 DEF VAR phone-no AS CHAR EXTENT 3 NO-UNDO.
 249 DEF VAR phtype-list AS CHAR NO-UNDO INIT "BUS,FAX,MOB".
 250 DEF VAR i AS INT NO-UNDO.
 251
 252   FOR EACH Contact NO-LOCK:
 253     IF CAN-FIND(FIRST ListContact WHERE ListContact.PersonCode = Contact.PersonCode ) THEN NEXT.
 254     use-contact-type = LOOKUP( Contact.ContactType, ctype-list ) <> 0.
 255     IF NOT include-types THEN use-contact-type = NOT use-contact-type.
 256     IF NOT use-contact-type THEN NEXT.
 257     FIND FIRST Person OF Contact NO-LOCK NO-ERROR.
 258     IF AVAILABLE(Person) THEN DO:
 259       CREATE ListContact.
 260       ListContact.PersonCode = Person.PersonCode.
 261       ListContact.Company = Person.Company.
 262       ListContact.LastName = Person.LastName.
 263     END.
 264   END.
 265
 266   FOR EACH ListContact, FIRST Person OF ListContact
 267     BREAK BY ListContact.Company BY ListContact.LastName:
 268
 269     IF FIRST-OF( ListContact.Company ) THEN DO:
 270       RUN process/getaddr.p( "PERSON", Person.PersonCode, ptype-list, OUTPUT person-address ).
 271       person-address = TRIM( TRIM( REPLACE( REPLACE( person-address, CHR(13), ""), "~n", "," ), "," ) ).
 272       IF person-address <> "" THEN person-address = ", " + person-address.
 273       RUN pclrep-line( "Helvetica,Point,8,Normal,Proportional",  Person.Company + person-address ).
 274     END.
 275
 276   DO i = 1 TO NUM-ENTRIES( phtype-list ):
 277     FIND PhoneDetail WHERE
 278       PhoneDetail.PersonCode = Person.PersonCode AND
 279       PhoneDetail.PhoneType  = ENTRY( i, phtype-list )
 280       NO-LOCK NO-ERROR.
 281
 282     phone-no[i] = "".
 283     IF AVAILABLE PhoneDetail THEN
 284     RUN combine-phone( PhoneDetail.cCountryCode, PhoneDetail.cSTDCode, PhoneDetail.Number,
 285       OUTPUT phone-no[i] ).
 286   END.
 287
 288   RUN pclrep-line( "courier,Fixed,cpi,18,lpi,9,Normal",
 289         SPC( 4 ) +
 290         STRING( null-str(Person.FirstName, "?"), "X(15)" ) + SPC( 3 ) +
 291         STRING( null-str(Person.LastName, "?"), "X(15)" ) + SPC( 3 ) +
 292         STRING( null-str(phone-no[1], "?"), "X(20)" ) + SPC( 1 ) +
 293         STRING( null-str(phone-no[2], "?"), "X(20)" ) + SPC( 1 ) +
 294         STRING( null-str(phone-no[3], "?"), "X(20)" ) + SPC( 1 ) +
 295         STRING( null-str(Person.JobTitle, "?"), "X(40)" ) + SPC( 1 ) +
 296         STRING( null-str(Person.Department, "?"), "X(40)" )
 297       ).
 298
 299    IF LAST-OF( ListContact.Company ) THEN
 300      RUN pclrep-line( ?, "" ).
 301
 302   END.
 303
 304 END PROCEDURE.
 305
 306 /* _UIB-CODE-BLOCK-END */
 307 &ANALYZE-RESUME
 308
 309
 310 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 311 PROCEDURE parse-parameters :
 312 /*------------------------------------------------------------------------------
 313   Purpose:
 314   Parameters:  <none>
 315   Notes:
 316 ------------------------------------------------------------------------------*/
 317
 318   DEF VAR i AS INT NO-UNDO.
 319   DEF VAR token AS CHAR NO-UNDO.
 320
 321   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 322     token = ENTRY( i, report-options, "~n" ).
 323
 324     CASE ENTRY( 1, token ):
 325       WHEN "ContactTypes" THEN ctype-list = SUBSTR( token, INDEX( token, "," ) + 1 ).
 326       WHEN "PostalTypes" THEN ptype-list = SUBSTR( token, INDEX( token, "," ) + 1 ).
 327       WHEN "Exclude" THEN include-types = ENTRY( 2, token ) <> "Yes".
 328       WHEN "Preview" THEN preview = Yes.
 329       WHEN "Merge" THEN merge-list = Yes.
 330     END CASE.
 331
 332   END.
 333
 334 END PROCEDURE.
 335
 336 /* _UIB-CODE-BLOCK-END */
 337 &ANALYZE-RESUME
 338
 339