trigger/wrctctyp.p

   1 TRIGGER PROCEDURE FOR WRITE OF ContactType NEW NewType OLD OldType.
   2
   3 DEF BUFFER OtherContact FOR Contact.
   4 IF AVAILABLE(NewType) AND AVAILABLE(OldType)
   5                       AND NewType.ContactType <> OldType.ContactType
   6 THEN DO:
   7   /* Change all the contacts with this type to the new type */
   8   /* delete any where a new type of that contact already exists */
   9   /* Note that we never delete "Person" records */
  10   FOR EACH Contact WHERE Contact.ContactType = OldType.ContactType EXCLUSIVE-LOCK:
  11     IF CAN-FIND( OtherContact WHERE OtherContact.ContactType = NewType.ContactType
  12                                 AND OtherContact.PersonCode = Contact.PersonCode) THEN
  13       DELETE Contact.
  14     ELSE
  15       Contact.ContactType = NewType.ContactType.
  16   END.
  17 END.