source: FOIAVistA/tag/r/MAILMAN-XM/XMXUTIL3.m@ 1133

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1XMXUTIL3 ;ISC-SF/GMB-List addressees, recipients, message network header ;03/05/2001 15:23
2 ;;8.0;MailMan;**34**;Jun 28, 2002
3 ; All entry points covered by DBIA 2737.
4 ; Common Parameters for Q, QD, QL, QN, QX:
5 ; XMZ message number in message file
6 ; XMAMT How many?
7 ; =number - Get this many
8 ; =* - Get all (default)
9 ; XMSTART("IEN") is used to start the lister going. The lister will
10 ; keep it updated from call to call.
11 ; It is the IEN to start AFTER.
12 ; (Default is to start at the beginning: after 0.)
13 ; XMTROOT is the target root to receive the message list.
14 ; (default is ^TMP("XMLIST",$J))
15 ; XMFLAGS are used to control processing (currently not used, except QX)
16 ; XMFIND Search for recipients/addressees matching this string.
17 ; Same rules as for FileMan lookups.
18 ; (If XMFIND is supplied, XMSTART and XMAMT are ignored, and
19 ; a complete list is returned.)
20 ;
21Q(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Addressee listing
22 N XMCNT,XMIEN,XMREC
23 D QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
24 I $D(XMFIND) D
25 . D FIND^DIC(3.911,","_XMZ_",","","",XMFIND,"","B")
26 E D
27 . D LIST^DIC(3.911,","_XMZ_",","","",XMAMT,.XMSTART,"","B")
28 S XMCNT=0
29 F S XMCNT=$O(^TMP("DILIST",$J,2,XMCNT)) Q:XMCNT="" S XMIEN=^(XMCNT) D
30 . S XMREC=$G(^XMB(3.9,XMZ,6,XMIEN,0))
31 . S @(XMTROOT_XMCNT_",""TO NAME"")")=$P(XMREC,U,1)
32 . I $P(XMREC,U,2)'="" S @(XMTROOT_XMCNT_",""TYPE"")")=$P(XMREC,U,2)
33 S @(XMTROOT_"0)")=$G(^TMP("DILIST",$J,0))
34 K ^TMP("DILIST",$J)
35 Q
36QD(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Recipient listing
37 D QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
38 I $D(XMFIND) D
39 . N XMCNT
40 . D QFIND^XMXUTIL4(XMZ,XMFLAGS,XMFIND,XMTROOT,.XMCNT)
41 . S @(XMTROOT_"0)")=XMCNT_U_"*^0"
42 . K ^TMP("DILIST",$J)
43 E D
44 . D QLIST^XMXUTIL4(XMZ,XMFLAGS,XMAMT,.XMSTART,XMTROOT)
45 Q
46QL(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Later'd Addressee listing
47 N XMCNT,XMIEN,XMREC
48 D QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
49 I $D(XMFIND) D
50 . D FIND^DIC(3.914,","_XMZ_",","","",XMFIND,"","B")
51 E D
52 . D LIST^DIC(3.914,","_XMZ_",","","",XMAMT,.XMSTART,"","B")
53 S XMCNT=0
54 F S XMCNT=$O(^TMP("DILIST",$J,2,XMCNT)) Q:XMCNT="" S XMIEN=^(XMCNT) D
55 . S XMREC=$G(^XMB(3.9,XMZ,7,XMIEN,0))
56 . S @(XMTROOT_XMCNT_",""TO NAME"")")=$P(XMREC,U,1)
57 . I $P(XMREC,U,2)'="" S @(XMTROOT_XMCNT_",""TYPE"")")=$P(XMREC,U,2)
58 . S @(XMTROOT_XMCNT_",""BY DUZ"")")=$P(XMREC,U,3)
59 . S @(XMTROOT_XMCNT_",""BY NAME"")")=$P(XMREC,U,4)
60 . S @(XMTROOT_XMCNT_",""WHEN"")")=$P(XMREC,U,5)
61 . S @(XMTROOT_XMCNT_",""WHEN MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,5))
62 S @(XMTROOT_"0)")=$G(^TMP("DILIST",$J,0))
63 K ^TMP("DILIST",$J)
64 Q
65QINIT(XMFLAGS,XMAMT,XMFIND,XMTROOT) ; For internal MailMan use only.
66 S XMFLAGS=$G(XMFLAGS)
67 I $G(XMAMT)="" S XMAMT="*"
68 I $D(XMFIND),XMFIND="" K XMFIND
69 I $D(XMTROOT),XMTROOT'="" D
70 . K @$$CREF^DILF(XMTROOT)
71 . S XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
72 E D
73 . K ^TMP("XMLIST",$J)
74 . S XMTROOT="^TMP(""XMLIST"",$J,"
75 Q
76QN(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; Get network header lines
77 N XMCNT,XMIEN
78 D QNINIT(.XMAMT,.XMTROOT)
79 S XMCNT=0
80 S XMIEN=+$G(XMSTART("IEN"))
81 F S XMIEN=$O(^XMB(3.9,XMZ,2,XMIEN)) Q:XMIEN'<1 D Q:XMCNT=XMAMT
82 . S XMCNT=XMCNT+1
83 . S @(XMTROOT_XMCNT_")")=^XMB(3.9,XMZ,2,XMIEN,0)
84 S XMSTART("IEN")=XMIEN
85 S @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$S(XMIEN'<1:0,$O(^XMB(3.9,XMZ,2,XMIEN))<1:1,1:0) ; Any more?
86 Q
87QNINIT(XMAMT,XMTROOT) ; For internal MailMan use only.
88 I $G(XMAMT)="" S XMAMT="*"
89 I $D(XMTROOT),XMTROOT'="" D
90 . K @$$CREF^DILF(XMTROOT)
91 . S XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
92 E D
93 . K ^TMP("XMLIST",$J)
94 . S XMTROOT="^TMP(""XMLIST"",$J,"
95 Q
96QX(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; Local Recipient Xtract
97 ; XMFLAGS = "C" list users who are current in reading the message
98 ; "N" list users who are NOT current in reading the message
99 ; "T" list users who have terminated the message
100 N XMFIND,XMCNT,XMIEN,XMREC,XMTO,XMNAME,XMRESPS,XMMORE
101 I $L($G(XMFLAGS))'=1,"CNT"'[XMFLAGS Q
102 D QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
103 S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
104 S XMCNT=0,XMTO=+$G(XMSTART("IEN"))
105 F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:+XMTO'='XMTO D Q:XMCNT=XMAMT
106 . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:'XMIEN
107 . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
108 . I XMFLAGS="C",$P(XMREC,U,2)'=XMRESPS Q ; not current
109 . I XMFLAGS="N",$P(XMREC,U,2)=XMRESPS Q ; current
110 . I XMFLAGS="T",'$G(^XMB(3.9,XMZ,1,XMIEN,"D")) Q ; not terminated
111 . S XMCNT=XMCNT+1
112 . S XMNAME=$$NAME^XMXUTIL(XMTO)
113 . D QDFLDS^XMXUTIL4(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
114 S XMSTART("IEN")=XMTO
115 I XMAMT'="*" D
116 . S XMMORE=0 ; any more?
117 . F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:+XMTO'='XMTO D Q:XMMORE
118 . . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:'XMIEN
119 . . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
120 . . I XMFLAGS="C",$P(XMREC,U,2)'=XMRESPS Q ; not current
121 . . I XMFLAGS="N",$P(XMREC,U,2)=XMRESPS Q ; current
122 . . I XMFLAGS="T",'$G(^XMB(3.9,XMZ,1,XMIEN,"D")) Q ; not terminated
123 . . S XMMORE=1
124 S @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$S(XMAMT="*":0,1:XMMORE)
125 Q
Note: See TracBrowser for help on using the repository browser.