source: FOIAVistA/trunk/r/MAILMAN-XM/XMJBN.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1XMJBN ;ISC-SF/GMB-Access new mail in mailbox ;05/18/2004 08:37
2 ;;8.0;MailMan;**25**;Jun 28, 2002
3 ; Replaces ^XMA (ISC-WASH/THM/CAP)
4 ; Entry points used by MailMan options (not covered by DBIA):
5 ; NEW XMNEW - Read new messages
6NEW ;
7 ; XMNEW Number of new messages
8 ; XMKMULT 1=New msgs in multiple baskets; 0=new msgs in one basket
9 N XMABORT,XMK,XMKN,XMNEW,XMKMULT,XMNEWS
10 S XMABORT=0
11 D INIT^XMJBN1(XMDUZ,.XMK,.XMKN,.XMNEW,.XMKMULT,.XMABORT) Q:XMABORT
12 S XMNEWS=1 ; Makes 'new'd msgs drop off list 'til next time
13 I XMNEW=1 D Q
14 . N XMZ
15 . S XMZ=$O(^XMB(3.7,XMDUZ,"N0",XMK,""))
16 . I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(XMB(3.9,XMZ,0))) D Q
17 . . D ZSHOW^XMJERR
18 . . D WAIT^XMXUTIL
19 . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,"N0",XMK,XMZ)
20 . D READNEW(XMDUZ,XMK,XMKN,XMZ)
21 . D:$D(^XTMP("XM","MAKENEW",XMDUZ)) NEWAGAIN^XMJBN1(XMDUZ)
22 F D Q:'$D(^XMB(3.7,XMDUZ,"N0"))!XMABORT
23 . N XMDIR,XMOPT,XMOX,XMY
24 . S XMDIR("A")=$$EZBLD^DIALOG(34085) ; Select New mail option
25 . D SET^XMXSEC1("R",34086,.XMOPT,.XMOX) ; Read new mail by basket
26 . D SET^XMXSEC1("LB",34087,.XMOPT,.XMOX) ; List Baskets with new mail
27 . D SET^XMXSEC1("LN",34088,.XMOPT,.XMOX) ; List all new messages
28 . D SET^XMXSEC1("LP",34089,.XMOPT,.XMOX) ; List all priority messages
29 . I '$D(^XMB(3.7,XMDUZ,"N")) S XMOPT("LP","?")=$$EZBLD^DIALOG(34018) ; You have no new priority messages.
30 . D SET^XMXSEC1("P",34090,.XMOPT,.XMOX) ; Print all new messages
31 . D SET^XMXSEC1("S",34091,.XMOPT,.XMOX) ; Scan all new messages
32 . D SET^XMXSEC1("Q",34092,.XMOPT,.XMOX) ; Quit
33 . S XMDIR("B")=XMOX("O",XMV("NEW OPT"))_":"_XMOPT(XMV("NEW OPT"))
34 . S XMDIR("??")="XM-U-R-READ NEW"
35 . D XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT) Q:XMABORT
36 . K XMOPT,XMOX,XMDIR
37 . D @XMY
38 D:$D(^XTMP("XM","MAKENEW",XMDUZ)) NEWAGAIN^XMJBN1(XMDUZ)
39 Q
40LB ; List Baskets with new mail (Replaces NEW^XMA0A)
41 N DIC,D,DZ
42 S DIC="^XMB(3.7,"_XMDUZ_",2,"
43 S DIC(0)="AEQ",D="B",DZ="??"
44 S DIC("S")="I $P(^(0),U,2)"
45 S DIC("W")="W ?31,$$EZBLD^DIALOG($S($P(^(0),U,2)'=1:34027.2,1:34027.4),$P(^(0),U,2))" ; (|1| New)
46 D DQ^DICQ
47 Q
48LN ; List all new messages (Replaces LIST^XMA0A)
49 D LISTALL^XMJMLN(XMDUZ,"N0")
50 Q
51LP ; List all priority messages (Replaces PRIO^XMA0A)
52 D LISTALL^XMJMLN(XMDUZ,"N")
53 Q
54P ; Print all new messages
55 ; Replaces PRINT^XMA0A
56 N XMSAVE,I
57 F I="XMV(","DUZ","XMDUZ","XMKMULT" S XMSAVE(I)=""
58 D EN^XUTMDEVQ("PRTNEW^XMJBN",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
59 Q
60PRTNEW ; Print all new messages
61 N XMSCAN,XMNEWPRT,XMFIRST
62 S (XMSCAN,XMNEWPRT,XMFIRST)=1
63 D R
64 I $D(ZTQUEUED),$D(^XTMP("XM","MAKENEW",XMDUZ)) D NEWAGAIN^XMJBN1(XMDUZ)
65 Q
66Q ; Quit
67 S XMABORT=1
68 Q
69S ; Scan all new messages
70 N XMSCAN
71 S XMSCAN=1
72 D R
73 Q
74R ; Read new mail by basket, priority first.
75 N XMTYPE,XMK,XMKN,XMZ,XMIA,XMKPRI
76 S XMABORT=0 ; (required when printing new messages)
77 S XMIA='$D(ZTQUEUED)
78 S XMKPRI=0,(XMKN,XMKPRI("XMKN"))="" K ^TMP("XM",$J,"APX")
79 F D Q:'$D(^XMB(3.7,XMDUZ,"N0"))!XMABORT
80 . S XMTYPE=$S($D(^XMB(3.7,XMDUZ,"N")):"N",$D(^XMB(3.7,XMDUZ,"N0")):"N0",1:"")
81 . I XMTYPE="" S XMABORT=1 W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(34017) Q ; You have no new messages.
82 . I 'XMKMULT D
83 . . S XMK=$O(^XMB(3.7,XMDUZ,XMTYPE,0))
84 . . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
85 . E D Q:XMABORT
86 . . D NXTBSKT^XMJBN1(XMDUZ,XMTYPE,.XMKN,.XMK,.XMKPRI) I 'XMK S XMABORT=1 Q
87 . . Q:$G(XMSCAN)
88 . . D ASKBSKT(XMDUZ,1,.XMK,.XMKN,.XMABORT) Q:XMABORT
89 . . I XMTYPE="N",'$D(^XMB(3.7,XMDUZ,XMTYPE,XMK)) S XMTYPE="N0"
90 . S XMZ=""
91 . F S XMZ=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("NEW ORDER")) Q:XMZ="" D Q:XMABORT
92 . . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
93 . . I $G(XMNEWPRT) D Q
94 . . . D PRTMULT^XMJMP(XMDUZ,XMK,XMKN,XMZ,0,1,.XMFIRST,"",.XMABORT)
95 . . . I XMDUZ'=DUZ,$$SURRCONF^XMXSEC(XMDUZ,XMZ) D Q
96 . . . . D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
97 . . . . S ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
98 . . I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(XMB(3.9,XMZ,0))) D Q
99 . . . D ZSHOW^XMJERR
100 . . . D WAIT^XMXUTIL
101 . . . D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
102 . . . S ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
103 . . D READNEW(XMDUZ,XMK,XMKN,XMZ,.XMABORT)
104 . Q:XMABORT
105 . S:$D(^XMB(3.7,XMDUZ,"N0")) XMKMULT=1
106 . Q:$G(XMSCAN)!'XMKMULT
107 . W !!,$$EZBLD^DIALOG($S(XMTYPE="N0":34098,1:34099),XMKN) ; Done with new/priority mail in your '|1|' Basket.
108 . W:$D(^XMB(3.7,XMDUZ,"N0")) !!
109 K ^TMP("XM",$J,"APX")
110 Q
111READNEW(XMDUZ,XMK,XMKN,XMZ,XMABORT) ;
112 N XMSECURE,XMPAKMAN,XMSECBAD ; Important 'new' - part of scramble and packman handling
113 I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
114 D DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZ,.XMSECBAD) Q:$G(XMSECBAD)
115 D READMSG^XMJMOI($G(XMNEWS),XMDUZ,XMK,XMKN,XMZ,.XMABORT)
116 Q
117ASKBSKT(XMDUZ,XMNEWMSG,XMK,XMKN,XMABORT) ;
118 ; XMNEWMSG 1=Read new mail; 0=Read any mail
119 N XMDIC,XMPROMPT
120 S XMDIC("W")="N XMPARM S XMPARM(2)=$P(^(0),U,2),XMPARM(1)=+$P($G(^(1,0)),U,4) W ?31,$$EZBLD^DIALOG($S(XMPARM(1)'=1:$S('XMPARM(2):34026,XMPARM(2)>1:34027,1:34027.3),XMPARM(2):34027.1,1:34026.1),.XMPARM)" ; (|1| messages, |2| new)
121 I XMNEWMSG D
122 . S XMPROMPT=34029 ; Read NEW mail in MAIL BASKET:
123 . S XMDIC("S")="I $P(^(0),U,2)"
124 . S XMDIC("B")=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
125 E S XMPROMPT=34028 ; Read mail in MAIL BASKET:
126 D SELBSKT^XMJBU(XMDUZ,XMPROMPT,"",.XMDIC,.XMK,.XMKN)
127 I XMK=U S XMABORT=1
128 Q
129NPBSKT(XMDUZ) ; Return the first priority read basket that has new messages.
130 ; If none has new messages, return the first priority basket.
131 N XMDEFALT
132 S XMDEFALT=$$BNMSGCT^XMXUTIL(XMDUZ,1)_U_1_U_$$EZBLD^DIALOG(37005) ; IN
133 I '$D(^XMB(3.7,XMDUZ,2,"AP")) Q XMDEFALT
134 N XMK,XMKN
135 S XMKN=""
136 D NXTBSKT^XMJBN1(XMDUZ,"N0",.XMKN,.XMK)
137 I $D(^TMP("XM",$J,"APX")) K ^TMP("XM",$J,"APX") Q $$BNMSGCT^XMXUTIL(XMDUZ,XMK)_U_XMK_U_XMKN
138 N XMI
139 S (XMI,XMK)=0
140 S XMI=+$O(^XMB(3.7,XMDUZ,2,"AP",XMI))
141 I 'XMI Q XMDEFALT
142 F S XMK=$O(^XMB(3.7,XMDUZ,2,"AP",XMI,XMK)) Q:'XMK D
143 . S XMK($$BSKTNAME^XMXUTIL(XMDUZ,XMK))=XMK
144 S XMKN=$O(XMK(""))
145 I XMKN="" Q XMDEFALT
146 S XMK=XMK(XMKN)
147 Q "0^"_XMK_U_XMKN
Note: See TracBrowser for help on using the repository browser.