source: FOIAVistA/trunk/r/MAILMAN-XM/XMJMQ1.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: 6.8 KB
Line 
1XMJMQ1 ;ISC-SF/GMB-Q,QD,QN Query recipients (cont.) ;04/17/2002 10:11
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces ^XMA5,^XMA5A (ISC-WASH/THM/CAP)
4QINIT(XMDUZ,XMK,XMKN,XMZ,XMRESPM,XMABORT) ;
5 N XMZSTR,XMSUBJ,XMRESPS
6 S XMABORT=0
7 S XMZSTR=$$EZBLD^DIALOG(34537,XMZ) ; [#_XMZ_]
8 S XMSUBJ=$P(^XMB(3.9,XMZ,0),U)
9 S:XMSUBJ["~U~" XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
10 S XMSUBJ=$$EZBLD^DIALOG(34536,XMSUBJ) ; Subj: _XMSUBJ
11 S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
12 S XMRESPM=$$EZBLD^DIALOG($S(XMRESPS=1:34557.1,1:34557),XMRESPS) ; XMRESPS_ response / responses
13 W @IOF
14 D PAGE1HDR^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMRESPS,^XMB(3.9,XMZ,0),XMSUBJ,XMZSTR)
15 D INFO(XMDUZ,XMK,XMZ,0,"","","",.XMABORT)
16 Q
17INFO(XMDUZ,XMK,XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;
18 N XMREC,XMRECIPS,XMDIALOG
19 S XMREC=^XMB(3.9,XMZ,0)
20 I $Y+4>IOSL D Q:XMABORT
21 . D PAGE^XMJMQ(.XMABORT)
22 E W !
23 W !,$$EZBLD^DIALOG(34559,XMZ_"@"_^XMB("NETNAME")) ; Local Message-ID:
24 S XMDIALOG=$S($P(XMREC,U,7)["P":34543,$P(XMREC,U,7)["S":34560,$P(XMREC,U,8):34561,1:0) I XMDIALOG D W(XMDIALOG) ; Priority! / [SPOOL] / <RESPONSE>
25 S XMRECIPS=+$P($G(^XMB(3.9,XMZ,1,0)),U,4)
26 I XMRECIPS D W($S(XMRECIPS=1:34562.1,1:34562),XMRECIPS) ; (_XMRECIPS_ Recipient(s))
27 I "^Y^y^"[(U_$P(XMREC,U,5)_U) D W(34564) ; Confirmation requested.
28 I $D(^XMB(3.9,XMZ,"K")) D W($S(" "[$P(XMREC,U,10):34565,1:34566),$P(XMREC,U,10)) ; Scramble Hint:
29 I $O(^XMB(3.9,XMZ,2005,0)) D LIST^XMA2B ; MIME body parts
30 I "^Y^y^"[(U_$P(XMREC,U,9)_U) D W(34567) ; Closed.
31 I "^Y^y^"[(U_$P(XMREC,U,11)_U) D W(34568) ; Confidential.
32 I "^Y^y^"[(U_$P(XMREC,U,12)_U) D W(34570) ; 'Information only' for all recipients.
33 I $D(^XMB(3.9,XMZ,.5)) D
34 . S XMREC=^XMB(3.9,XMZ,.5)
35 . I $P(XMREC,U,1)'="" D W(34571,$P(XMREC,U,1)) ; Delivery basket:
36 ; The following is already listed in the message header:
37 ;I $D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D
38 ;. N XMVAPOR
39 ;. S XMVAPOR=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,5)
40 ;. I XMVAPOR D W(34572,$$MMDT^XMXUTIL1(XMVAPOR)) ; Automatic Deletion Date:
41 D LATER(XMDUZ,XMZ,XMPHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
42 Q
43LATER(XMDUZ,XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ; List dates message will be new on 'later'
44 Q:'$O(^XMB(3.73,"AC",XMZ,XMDUZ,0))
45 N XMIEN,XMSEP
46 I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT
47 W !,$$EZBLD^DIALOG(34595) ; Message will be NEW on:
48 S XMIEN="",XMSEP=" "
49 F S XMIEN=$O(^XMB(3.73,"AC",XMZ,XMDUZ,XMIEN)) Q:XMIEN="" D
50 . D W2(XMSEP,$$FMTE^XLFDT($E($P(^XMB(3.73,XMIEN,0),U),1,12)),.XMABORT)
51 . S XMSEP=", "
52 Q
53W(XMPIECE,XMPARM) ;
54 S XMPIECE=$$EZBLD^DIALOG(XMPIECE,.XMPARM)
55 I 1+$L(XMPIECE)+$X>IOM D Q:XMABORT
56 . I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT
57 . W !
58 W " ",XMPIECE
59 Q
60W2(XMSEP,XMPIECE,XMABORT) ;
61 I $X+$L(XMSEP)+$L(XMPIECE)>IOM D Q:XMABORT
62 . I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT
63 . W !,XMPIECE
64 E W XMSEP,XMPIECE
65 Q
66NETWORK(XMZ,XMABORT) ;
67 N I,J,XMLINE,XMPOS,XMPHDR
68 I $O(^XMB(3.9,XMZ,2,0))'<1 D Q
69 . W !!,$$EZBLD^DIALOG(34550) ; This message originated locally. There is no network header.
70 I $D(^XMB(3.9,XMZ,.7)) W !!,$$EZBLD^DIALOG(34551,$P(^XMB(3.9,XMZ,.7),U,1)) ; Envelope From:
71 W !!,$$EZBLD^DIALOG(34552),! ; Network header:
72 S (I,XMPHDR)=0
73 F S I=$O(^XMB(3.9,XMZ,2,I)) Q:I=""!(I'<1) D Q:XMABORT
74 . S XMLINE=^XMB(3.9,XMZ,2,I,0)
75 . I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT
76 . I $L(XMLINE)<IOM W !,XMLINE Q
77 . S XMPOS=0
78 . F D Q:XMLINE=""!XMABORT
79 . . I $L(XMLINE)+XMPOS+1>IOM F J=IOM-XMPOS-1:-1:IOM-XMPOS-20 Q:", -;)"[$E(XMLINE,J)
80 . . I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT
81 . . W !,?XMPOS,$E(XMLINE,1,J)
82 . . S XMPOS=10
83 . . S XMLINE=$E(XMLINE,J+1,999)
84 Q
85SUMMARY(XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;
86 N XMTYPE
87 I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT
88 W !
89 I '$O(^XMB(3.9,XMZ,6,0)),'$O(^XMB(3.9,XMZ,7,0)) D Q
90 . N XMTEXT
91 . D BLD^DIALOG(34596,"","","XMTEXT","F")
92 . D MSG^DIALOG("WM","","","","XMTEXT")
93 . ;This is an old message which has no summary recipient list.
94 . ;Only the Detail Query (QD) is available.
95 W !,$$EZBLD^DIALOG(34597),! ; This message was addressed as follows:
96 D PRTADDR(XMZ,6,.XMTYPE,.XMABORT) Q:XMABORT ; addressed to
97 D PRTADDR(XMZ,7,.XMTYPE,.XMABORT) ; deliver later to
98 Q
99PRTADDR(XMZ,XMNODE,XMTYPE,XMABORT) ;
100 N XMTO
101 S XMTO="*" ; List Broadcasts first
102 F S XMTO=$O(^XMB(3.9,XMZ,XMNODE,"B",XMTO)) Q:$E(XMTO,1,1)'="*" D PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT) Q:XMABORT
103 Q:XMABORT
104 S XMTO="G." ; List Groups next
105 F S XMTO=$O(^XMB(3.9,XMZ,XMNODE,"B",XMTO)) Q:$E(XMTO,1,2)'="G." D PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT) Q:XMABORT
106 Q:XMABORT
107 S XMTO="" ; Now list the rest
108 F S XMTO=$O(^XMB(3.9,XMZ,XMNODE,"B",XMTO)) Q:XMTO="" D Q:XMABORT
109 . Q:$E(XMTO,1,2)="G."
110 . Q:$E(XMTO,1,1)="*"
111 . D PRTSUMRY(XMZ,XMNODE,XMTO,.XMTYPE,.XMABORT)
112 Q
113PRTSUMRY(XMZ,XMNODE,XMTO,XMTYPE,XMABORT) ;
114 N XMIEN,XMREC
115 S XMIEN=$O(^XMB(3.9,XMZ,XMNODE,"B",XMTO,0)) Q:'XMIEN
116 S XMREC=$G(^XMB(3.9,XMZ,XMNODE,XMIEN,0)) Q:XMREC=""
117 I $Y+3>IOSL D PAGE^XMJMQ(.XMABORT) Q:XMABORT
118 I $P(XMREC,U,2)'="" D
119 . S XMTYPE=$P(XMREC,U,2)
120 . I '$D(XMTYPE(XMTYPE)) S XMTYPE(XMTYPE)=$$EXTERNAL^DILFD(3.91,6.5,"",XMTYPE) I $D(DIERR) S XMTYPE(XMTYPE)=XMTYPE
121 . W !,XMTYPE(XMTYPE),":",$P(XMREC,U,1)
122 E W !,$P(XMREC,U,1)
123 Q:XMNODE=6
124 N XMPARM
125 S XMPARM(1)=$$MMDT^XMXUTIL1($P(XMREC,U,5)),XMPARM(2)=$P(XMREC,U,4)
126 D W(34598,.XMPARM) ; for delivery x by y
127 Q
128SEARCH(XMZ,XMNAME,XMRESPM) ;
129 N XMPHDR,XMUSER,XMSITE
130 S XMPHDR=0
131 I $Y+5>IOSL D Q:XMABORT
132 . D PAGE^XMJMQ(.XMABORT)
133 E W !
134 W !,$$EZBLD^DIALOG(34554,XMNAME),! ; Searching for recipients that match '_XMNAME_'.
135 I XMNAME["@" D
136 . S XMSITE=$$UP^XLFSTR($P(XMNAME,"@",2,99))
137 . ;S XMUSER=$P(XMNAME,"@",1)_$S(XMNAME[",":"@",1:",")
138 . S XMUSER=$P($P(XMNAME,"@",1),",",1)_","
139 . S XMNAME=XMUSER_XMSITE
140 E D Q:XMABORT
141 . D FIND^DIC(200,"","@;.01","AP",XMNAME,"","B^BB^C^D","I $D(^XMB(3.9,XMZ,1,""C"",+Y))")
142 . I '$D(DIERR) D PSEARCH(200,XMZ,XMRESPM,.XMABORT) Q:XMABORT
143 Q:$O(^XMB(3.9,XMZ,1,"C",":"))="" ; Quit if there aren't any non-local addressees
144 N XMSCREEN
145 S XMSCREEN=$S(+XMNAME=XMNAME:"I '$D(^XMB(3.9,XMZ,1,""C"",XMNAME))",1:"")
146 D FIND^DIC(3.91,","_XMZ_",","","CP",XMNAME,"","C",XMSCREEN)
147 I '$D(DIERR) D PSEARCH(3.91,XMZ,XMRESPM,.XMABORT)
148 Q:$E(XMNAME)'?1U ; Quit if the search string does not begin with an upper case letter
149 Q:$O(^XMB(3.9,XMZ,1,"C","`"))="" ; Quit if there aren't any lower case addressees
150 ; FM will translate lower case to upper case in its search, but won't
151 ; translate upper to lower, so we do it here.
152 S XMSCREEN="I ^(0)]""`""" ; Limit search to lower case addresses
153 S XMNAME=$S($D(XMSITE):$$LOW^XLFSTR(XMUSER)_XMSITE,1:$$LOW^XLFSTR(XMNAME))
154 D FIND^DIC(3.91,","_XMZ_",","","CP",XMNAME,"","C",XMSCREEN)
155 I '$D(DIERR) D PSEARCH(3.91,XMZ,XMRESPM,.XMABORT)
156 Q
157PSEARCH(XMFILE,XMZ,XMRESPM,XMABORT) ; Print search results
158 N XMI,XMIEN,XMTYPE,XMREC
159 S XMI=0
160 F S XMI=$O(^TMP("DILIST",$J,XMI)) Q:'XMI S XMREC=^(XMI,0) D Q:XMABORT
161 . S XMIEN=$S(XMFILE=200:$O(^XMB(3.9,XMZ,1,"C",$P(XMREC,U,1),0)),1:$P(XMREC,U,1))
162 . D WNAME^XMJMQ(XMZ,$P(XMREC,U,2),XMIEN,XMRESPM,.XMTYPE,.XMABORT)
163 Q
Note: See TracBrowser for help on using the repository browser.