source: FOIAVistA/trunk/r/MAILMAN-XM/XMVVITAE.m@ 1540

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

initial load of FOIAVistA 6/30/08 version

File size: 7.4 KB
Line 
1XMVVITAE ;ISC-SF/GMB-Initialize User's MailMan Variables ;04/19/2002 13:26
2 ;;8.0;MailMan;**36**;Jun 28, 2002
3 ; Replaces ^XMGAPI1,FWD^XMA21,FWD,BANNER^XMA6,EDIT^XMA7 (ISC-WASH/CAP)
4 ; Entry points (DBIA 2728):
5 ; INIT Set up variables for DUZ or XMDUZ.
6 ; OTHER Set up variables to become a surrogate of someone else.
7 ; SELF Return from being a surrogate to being oneself again.
8 Q
9INIT ; Set up one's variables (for yourself or as a surrogate).
10 N XMAPI
11INIT2 K XMV
12 D SYSTEM(.XMV)
13 S:'$D(XMDUZ) XMDUZ=DUZ
14 D DUZ(DUZ,.XMV,.XMDUN,.XMDISPI,.XMNOSEND)
15 D:XMDUZ'=DUZ SURROGAT(XMDUZ,.XMV,.XMDUN,.XMNOSEND,.XMPRIV)
16 Q
17INITAPI ; (For MailMan use only) Set up variables for an API call.
18 N XMAPI
19 S XMAPI=1 ; "last used MailMan" will not be recorded.
20 G INIT2
21CHECK ; Check to make sure one's variables exist.
22 I '$D(XMV("NAME"))!'$D(XMV("RDR DEF")) D INIT
23 Q
24OTHER ; Become someone else. INIT should have been called previously.
25 I '$D(XMV) D INIT Q
26 N XMAPI
27 D SURROGAT(XMDUZ,.XMV,.XMDUN,.XMNOSEND,.XMPRIV)
28 Q
29SELF ; Return to oneself after having become someone else.
30 ; INIT should have been called previously.
31 S XMDUZ=DUZ
32 I '$D(XMV) D INIT Q
33 N XMAPI
34 D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN)
35 D LASTUSE(XMDUZ,.XMV)
36 Q
37SYSTEM(XMV) ;
38 ; XMV("VERSION")
39 I '$D(DT) D DT^DICRW
40 S XMV("VERSION")="VA MailMan "_$P($T(XMVVITAE+1),";",3)
41 ; Check to make sure that important variables are defined correctly.
42 I +$G(^XMB("NUM")),$G(^XMB("NAME"))=$G(^XMB("NETNAME")),$G(^XMB("NETNAME"))=$P($G(^DIC(4.2,+$G(^XMB("NUM")),0)),U,1),$G(^XMB("NUM"))=$P($G(^XMB(1,1,0)),U,1) Q
43 N XMPARM ; The domain for this facility is not christened correctly.
44 S XMPARM(1)=$G(^XMB("NUM"))
45 S XMPARM(2)=$P($G(^XMB(1,1,0)),U,1)
46 S XMPARM(3)=$P($G(^DIC(4.2,+$G(^XMB("NUM")),0)),U,1)
47 S XMPARM(4)=$P($G(^DIC(4.2,+XMPARM(2),0)),U,1)
48 S XMPARM(5)=$G(^XMB("NETNAME"))
49 S XMPARM(6)=$G(^XMB("NAME"))
50 F I=1:1:6 I XMPARM(I)="" S XMPARM(I)="?"
51 ;The domain for this facility is not christened correctly.
52 ;IRM must correct this for network mail to function properly.
53 ;The following pointers should contain the same numbers,
54 ;which should point to this facility's domain in ^DIC(4.2:
55 ;^XMB("NUM")=|1| ==> |3|
56 ;$P(^XMB(1,1,0),U,1)=|2| ==> |4|
57 ;The following globals should contain the domain name of this facility:
58 ;^XMB("NETNAME")= |5|
59 ;^XMB("NAME")= |6|
60 D BLD^DIALOG(38100,.XMPARM,"","XMV(""SYSERR"")")
61 Q
62DUZ(XMDUZ,XMV,XMDUN,XMDISPI,XMNOSEND) ;
63 ; XMV("DUZ NAME")
64 K XMV("ERROR")
65 I $G(DUZ,0)=0 S XMV("ERROR",1)=$$EZBLD^DIALOG(38105) Q ;You do not have a DUZ.
66 D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN) Q:$D(XMV("ERROR"))
67 S XMV("DUZ NAME")=XMV("NAME")
68 D LASTUSE(XMDUZ,.XMV)
69 D PREFER(XMDUZ,.XMV,.XMDISPI)
70 Q
71SURROGAT(XMDUZ,XMV,XMDUN,XMNOSEND,XMPRIV) ;
72 ; XMV("PRIV")
73 ; XMPRIV
74 Q:XMDUZ=DUZ
75 K XMV("ERROR"),XMV("WARNING")
76 I XMDUZ=.6 D Q
77 . S XMV("PRIV")="R",XMPRIV="y^n"
78 . S (XMDUN,XMV("NAME"))=$$NAME^XMXUTIL(.6)
79 . D SETNET(XMDUZ,.XMV)
80 . S XMV("NEW MSGS")=+$P(^XMB(3.7,XMDUZ,0),U,6)
81 E D Q:$D(XMV("ERROR"))
82 . N XMIEN
83 . S XMIEN=+$O(^XMB(3.7,"AB",DUZ,XMDUZ,0))
84 . ;Commented out because we shouldn't be here if not a valid surrogate
85 . ;I 'XMIEN S XMV("ERROR",5)=$$EZBLD^DIALOG(38106,XMDUZ) Q ;You are not a surrogate of DUZ |1|.
86 . S XMPRIV=$G(^XMB(3.7,XMDUZ,9,XMIEN,0))
87 . S XMV("PRIV")=$S($P(XMPRIV,U,2)="y":"R",1:"")_$S($P(XMPRIV,U,3)="y":"W",1:"")
88 D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN) Q:$D(XMV("ERROR"))
89 D LASTUSE(XMDUZ,.XMV)
90 Q
91USER(XMDUZ,XMV,XMNOSEND,XMDUN) ;
92 ; XMV("WARNING")
93 ; XMV("ERROR")
94 ; XMV("NEW MSGS")
95 ; XMV("NAME")
96 ; XMV("NOSEND")
97 ; XMNOSEND
98 ; XMDUN
99 N XMREC
100 K XMV("ERROR"),XMV("WARNING")
101 S XMREC=$G(^VA(200,XMDUZ,0))
102 I XMREC="" S XMV("ERROR",2)=$$EZBLD^DIALOG(38107,XMDUZ) Q ;There is no person with DUZ |1|.
103 ;I $P(XMREC,U,3)="" S XMV("ERROR",3)=$$EZBLD^DIALOG(38108,XMDUZ) Q ; There is no Access Code for DUZ XMDUZ
104 I $P(XMREC,U,3)="",'$$USERTYPE^XUSAP(XMDUZ,"APPLICATION PROXY") S XMV("ERROR",3)=$$EZBLD^DIALOG(38108,XMDUZ) Q ; There is no Access Code for DUZ XMDUZ
105 ;I '$D(^XMB(3.7,XMDUZ,0)) S XMV("ERROR",4)=$$EZBLD^DIALOG(38109,XMDUZ) Q ;There is no mailbox for DUZ |1|.
106 I '$D(^XMB(3.7,XMDUZ,0)),'$$USERTYPE^XUSAP(XMDUZ,"APPLICATION PROXY") S XMV("ERROR",4)=$$EZBLD^DIALOG(38109,XMDUZ) Q ;There is no mailbox for DUZ |1|.
107 S XMV("NOSEND")=0
108 S (XMDUN,XMV("NAME"))=$$NAME^XMXUTIL(XMDUZ)
109 D SETNET(XMDUZ,.XMV)
110 Q:$D(ZTQUEUED)!$G(XMAPI)
111 I $D(^XTMP("XM","MAKENEW",XMDUZ)) D NEWAGAIN^XMJBN1(XMDUZ)
112 I '$D(DUZ("SAV")),$D(XMMENU(0)) L +^XMB(3.7,"AD",DUZ):0 E S (XMV("NOSEND"),XMNOSEND)=1,XMV("WARNING",4)=$$EZBLD^DIALOG(38110) ;Multiple Signon
113 S:$D(^XMB(3.7,XMDUZ,"N")) XMV("WARNING",1)=$$EZBLD^DIALOG(38111) ;Priority Mail
114 I '$D(DUZ("SAV")),'XMV("NOSEND"),$D(^XMB(3.7,"AD",XMDUZ)) D
115 . I XMDUZ='DUZ,$G(XMV("PRIV"))'["W" Q
116 . N XMZ
117 . S XMREC=$G(^XMB(3.7,XMDUZ,"T"))
118 . S XMZ=$P(XMREC,U,1) I XMZ="" K ^XMB(3.7,"AD",XMDUZ) Q
119 . I '$D(^XMB(3.9,XMZ,0)) K ^XMB(3.7,XMDUZ,"T"),^XMB(3.7,"AD",XMDUZ) Q
120 . S XMZ=$P(XMREC,U,3)
121 . I XMZ,'$D(^XMB(3.9,XMZ,0)) K ^XMB(3.7,XMDUZ,"T"),^XMB(3.7,"AD",XMDUZ) Q
122 . S XMV("WARNING",2)=$$EZBLD^DIALOG(38112) ;Message in Buffer
123 S XMV("NEW MSGS")=+$P(^XMB(3.7,XMDUZ,0),U,6)
124 I XMDUZ=.5 D
125 . N I,XMK
126 . S XMK=.99
127 . F I=1:1 S XMK=$O(^XMB(3.7,.5,2,XMK)) Q:XMK>999!'XMK
128 . S:I>900 XMV("WARNING",5)=$$EZBLD^DIALOG(38113,I) ;POSTMASTER has |1| baskets.
129 D SETBAN(XMDUZ,.XMV)
130 Q
131SETNET(XMDUZ,XMV) ;
132 ; XMV("NETNAME")
133 S XMV("NETNAME")=$$NETNAME^XMXUTIL(XMDUZ)
134 Q
135SETBAN(XMDUZ,XMV) ;
136 ; XMV("BANNER")
137 N XMBANNER
138 S XMBANNER=$G(^XMB(3.7,XMDUZ,"B"))
139 I XMBANNER="" K XMV("BANNER")
140 E S XMV("BANNER")=XMBANNER
141 Q
142PREFER(XMDUZ,XMV,XMDISPI) ;
143 ; XMV("SHOW INST")
144 ; XMV("SHOW TITL")
145 ; XMV("SHOW DUZ")
146 ; XMV("ASK BSKT")
147 ; XMV("MSG DEF")
148 ; XMV("RDR DEF")
149 ; XMV("RDR ASK")
150 ; XMV("ORDER")
151 ; XMV("PREVU")
152 ; XMV("NEW OPT")
153 ; XMV("NEW ORDER")
154 ; XMDISPI
155 N XMUREC,XMSREC
156 S XMSREC=$G(^XMB(1,1,0)) ; Site's preferences
157 ;S XMUREC=^XMB(3.7,DUZ,0) ; User's preferences
158 S XMUREC=$G(^XMB(3.7,DUZ,0)) ; User's preferences
159 S XMV("SHOW INST")=$S($P(XMSREC,U,5)["y":1,1:0) ; Show Institution
160 S XMV("SHOW TITL")=$S($P(XMUREC,U,10)=1:1,1:0) ; Show Titles
161 I XMV("SHOW TITL") S XMV("TITL SRC")=$S($P(XMSREC,U,11)'="":$P(XMSREC,U,11),1:"T") ; Title Source (Signature Block or Title)
162 Q:$D(ZTQUEUED)
163 S XMV("SHOW DUZ")=+$P(XMSREC,U,8) ; Show DUZ when addressing messages
164 S XMV("PREVU")=$S($P(XMUREC,U,4)="Y":1,1:0)
165 S XMV("ASK BSKT")=$S($P(XMUREC,U,5)'["n":1,1:0)
166 ; User's default message action (Delete, Ignore). If user doesn't have one, take site's. If site doesn't have one, make it Ignore.
167 S XMV("MSG DEF")=$S($P(XMUREC,U,9)'="":$P(XMUREC,U,9),$P(XMSREC,U,15)'="":$P(XMSREC,U,15),1:"I")
168 S XMV("ORDER")=$S($P(XMUREC,U,13)="N":-1,1:1)
169 S XMV("RDR DEF")=$S($P(XMUREC,U,16)'="":$P(XMUREC,U,16),1:"C")
170 S XMV("RDR ASK")=$S($P(XMUREC,U,17)'="":$P(XMUREC,U,17),1:"Y")
171 S XMV("NEW OPT")=$S($P(XMUREC,U,18)'="":$P(XMUREC,U,18),1:"R")
172 S XMV("NEW ORDER")=$S($P(XMUREC,U,19)="N":-1,1:1)
173 Q:$G(XMAPI)
174 I $P(XMSREC,U,6)["y",'$D(^XMB(3.7,XMDUZ,1,1,0)) S XMV("WARNING",3)=$$EZBLD^DIALOG(38114) ;No Introduction
175 S XMDISPI="X" ; Show Help (Not used?)
176 I XMV("SHOW INST") S XMDISPI=XMDISPI_"I"
177 I XMV("SHOW TITL") S XMDISPI=XMDISPI_"T"
178 I XMV("ASK BSKT") S XMDISPI=XMDISPI_"A"
179 S XMDISPI=XMDISPI_U_XMV("MSG DEF")
180 Q
181LASTUSE(XMDUZ,XMV) ;
182 ; XMV("LAST USE")
183 I XMDUZ=.6!$D(ZTQUEUED)!$G(XMAPI) Q
184 S XMV("LAST USE")=$P($G(^XMB(3.7,XMDUZ,"L"),$$EZBLD^DIALOG(38002)),U,1) ;Never
185 Q:$D(DUZ("SAV"))
186 S ^XMB(3.7,XMDUZ,"L")=$$MMDT^XMXUTIL1($$NOW^XLFDT)_$S(XMDUZ'=DUZ:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")),1:"")_U_DT_U_DUZ ; (Surrogate: |1|)
187 Q
Note: See TracBrowser for help on using the repository browser.