source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQUTL4.m@ 1464

VAQUTL4 ;ALB/JRP - UTILITY ROUTINES;10-JUN-93

 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993

MAILGRP(NAME,TYPE,SELF,RESTRICT,DESCRIBE) ;ADD/EDIT BASIC MAIL GROUP INFO

 ;INPUT  : NAME - Name of new mail group

 ;         TYPE - Flag indicating type of mail group

 ;                0 = public (default)

 ;                1 = private

 ;         SELF - Flag indicating if self enrollment is allowed

 ;                0 = no

 ;                1 = yes (default)

 ;         RESTRICT - Flag indicating restriction of mail group

 ;                    0 to 7 - refer to data dictionary for definitions

 ;                    0 (unrestricted) is default

 ;         DESCRIBE - Array containing description (full global ref)

 ;                    (optional)

 ;         DUZ - Current user

 ;OUTPUT : IFN^0 - Entry number of mail group edited

 ;         IFN^1 - Entry number of mail group added

 ;         -1^ErrorText - Error

 ;NOTES  : If editing an existing mail group, the basic information

 ;         already defined in the mail group will be overwritten.  The

 ;         current description will be deleted before the new

 ;         description is added.  If a new description is not passed,

 ;         the current description will not be deleted.

 ;       : The organizer of the mail group will be the current user.

 ;

 ;CHECK INPUT

 Q:($G(NAME)="") "-1^Did not pass name of mail group to create"

 Q:(($L(NAME)<3)!($L(NAME)>30)) "-1^Did not pass valid mail group name"

 S TYPE=+$G(TYPE)

 S:($G(SELF)="") SELF=1

 S:(SELF'=1) SELF=0

 S RESTRICT=+$G(RESTRICT)

 S:((RESTRICT<0)!(RESTRICT>7)) RESTRICT=0

 Q:('$G(DUZ)) "-1^You are not identified (NO DUZ)"

 ;DECLARE VARIABLES

 N DIC,X,Y,LINE,ADDED,IFN,DIE,DA,DR,DIK,DA

 ;SEE IF MAIL GROUP ALREADY EXISTS

 S ADDED=0

 S DIC="^XMB(3.8,"

 S DIC(0)="MX"

 S X=NAME

 D ^DIC K DIC

 S IFN=+Y

 ;CREATE STUB MAIL GROUP

 I (IFN<0) D  Q:(IFN<0) IFN

 .S ADDED=1

 .S DIC="^XMB(3.8,"

 .S DIC(0)="L"

 .S X=NAME

 .K DD,DO

 .D FILE^DICN K DIC

 .S IFN=+Y

 .S:(IFN<0) IFN="-1^Unable to create mail group"

 ;LOCK ENTRY

 S X=0

 L +^XMB(3.8,IFN):60 S:('$T) X=1

 ;COULDN'T LOCK (ERROR)

 I (X) D  Q Y

 .;ENTRY NOT CREATED

 .I ('ADDED) S Y="-1^Mail group was being edited by another user" Q

 .;DELETE ENTRY CREATED

 .S DIK="^XMB(3.8,"

 .S DA=IFN

 .D ^DIK

 .;COULDN'T DELETE NEW ENTRY

 .I ($D(^XMB(3.8,IFN))) S Y="-1^Error creating mail group; unable to delete (IFN:"_IFN_")" Q

 .;NEW ENTRY DELETED

 .S Y="-1^Error creating mail group; entry deleted"

 ;EDIT ENTRY

 S DIE="^XMB(3.8,"

 S DA=IFN

 S DR="4///"_$S(TYPE:"private",1:"public")

 S DR(1,3.8,5)="5////"_DUZ

 S DR(1,3.8,7)="7///"_$S(SELF:"YES",1:"NO")

 S X="UNRESTRICTED^ORGANIZER ONLY^LOCAL^ORGANIZER/LOCAL^INDIVIDUALS^INDIV/ORGANIZER^INDIV/LOCAL^INDIV/LOCAL/ORGANIZER"

 S Y=$P(X,"^",(RESTRICT+1))

 S:(Y="") Y=$P(X,"^",1)

 S DR(1,3.8,10)="10///"_Y

 I ($G(DESCRIBE)'="") I ($D(@DESCRIBE)) D

 .;DELETES CURRENT DESCRIPTION

 .S DR(1,3.8,3)="3///@"

 .;ADDS NEW DESCRIPTION

 .S LINE=""

 .F X=1:1 S LINE=$O(@DESCRIBE@(LINE)) Q:(LINE="")  D

 ..S Y=$G(@DESCRIBE@(LINE))

 ..S:(Y="") Y=" "

 ..S DR(1,3.8,(300+X))="3///+"_Y

 K X,Y D ^DIE

 ;UNLOCK ENTRY AND QUIT

 L -^XMB(3.8,IFN)

 Q IFN_"^"_ADDED