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

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1VAQUTL4 ;ALB/JRP - UTILITY ROUTINES;10-JUN-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3MAILGRP(NAME,TYPE,SELF,RESTRICT,DESCRIBE) ;ADD/EDIT BASIC MAIL GROUP INFO
4 ;INPUT : NAME - Name of new mail group
5 ; TYPE - Flag indicating type of mail group
6 ; 0 = public (default)
7 ; 1 = private
8 ; SELF - Flag indicating if self enrollment is allowed
9 ; 0 = no
10 ; 1 = yes (default)
11 ; RESTRICT - Flag indicating restriction of mail group
12 ; 0 to 7 - refer to data dictionary for definitions
13 ; 0 (unrestricted) is default
14 ; DESCRIBE - Array containing description (full global ref)
15 ; (optional)
16 ; DUZ - Current user
17 ;OUTPUT : IFN^0 - Entry number of mail group edited
18 ; IFN^1 - Entry number of mail group added
19 ; -1^ErrorText - Error
20 ;NOTES : If editing an existing mail group, the basic information
21 ; already defined in the mail group will be overwritten. The
22 ; current description will be deleted before the new
23 ; description is added. If a new description is not passed,
24 ; the current description will not be deleted.
25 ; : The organizer of the mail group will be the current user.
26 ;
27 ;CHECK INPUT
28 Q:($G(NAME)="") "-1^Did not pass name of mail group to create"
29 Q:(($L(NAME)<3)!($L(NAME)>30)) "-1^Did not pass valid mail group name"
30 S TYPE=+$G(TYPE)
31 S:($G(SELF)="") SELF=1
32 S:(SELF'=1) SELF=0
33 S RESTRICT=+$G(RESTRICT)
34 S:((RESTRICT<0)!(RESTRICT>7)) RESTRICT=0
35 Q:('$G(DUZ)) "-1^You are not identified (NO DUZ)"
36 ;DECLARE VARIABLES
37 N DIC,X,Y,LINE,ADDED,IFN,DIE,DA,DR,DIK,DA
38 ;SEE IF MAIL GROUP ALREADY EXISTS
39 S ADDED=0
40 S DIC="^XMB(3.8,"
41 S DIC(0)="MX"
42 S X=NAME
43 D ^DIC K DIC
44 S IFN=+Y
45 ;CREATE STUB MAIL GROUP
46 I (IFN<0) D Q:(IFN<0) IFN
47 .S ADDED=1
48 .S DIC="^XMB(3.8,"
49 .S DIC(0)="L"
50 .S X=NAME
51 .K DD,DO
52 .D FILE^DICN K DIC
53 .S IFN=+Y
54 .S:(IFN<0) IFN="-1^Unable to create mail group"
55 ;LOCK ENTRY
56 S X=0
57 L +^XMB(3.8,IFN):60 S:('$T) X=1
58 ;COULDN'T LOCK (ERROR)
59 I (X) D Q Y
60 .;ENTRY NOT CREATED
61 .I ('ADDED) S Y="-1^Mail group was being edited by another user" Q
62 .;DELETE ENTRY CREATED
63 .S DIK="^XMB(3.8,"
64 .S DA=IFN
65 .D ^DIK
66 .;COULDN'T DELETE NEW ENTRY
67 .I ($D(^XMB(3.8,IFN))) S Y="-1^Error creating mail group; unable to delete (IFN:"_IFN_")" Q
68 .;NEW ENTRY DELETED
69 .S Y="-1^Error creating mail group; entry deleted"
70 ;EDIT ENTRY
71 S DIE="^XMB(3.8,"
72 S DA=IFN
73 S DR="4///"_$S(TYPE:"private",1:"public")
74 S DR(1,3.8,5)="5////"_DUZ
75 S DR(1,3.8,7)="7///"_$S(SELF:"YES",1:"NO")
76 S X="UNRESTRICTED^ORGANIZER ONLY^LOCAL^ORGANIZER/LOCAL^INDIVIDUALS^INDIV/ORGANIZER^INDIV/LOCAL^INDIV/LOCAL/ORGANIZER"
77 S Y=$P(X,"^",(RESTRICT+1))
78 S:(Y="") Y=$P(X,"^",1)
79 S DR(1,3.8,10)="10///"_Y
80 I ($G(DESCRIBE)'="") I ($D(@DESCRIBE)) D
81 .;DELETES CURRENT DESCRIPTION
82 .S DR(1,3.8,3)="3///@"
83 .;ADDS NEW DESCRIPTION
84 .S LINE=""
85 .F X=1:1 S LINE=$O(@DESCRIBE@(LINE)) Q:(LINE="") D
86 ..S Y=$G(@DESCRIBE@(LINE))
87 ..S:(Y="") Y=" "
88 ..S DR(1,3.8,(300+X))="3///+"_Y
89 K X,Y D ^DIE
90 ;UNLOCK ENTRY AND QUIT
91 L -^XMB(3.8,IFN)
92 Q IFN_"^"_ADDED
Note: See TracBrowser for help on using the repository browser.