source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXUTIL3.m@ 1384

XMXUTIL3 ;ISC-SF/GMB-List addressees, recipients, message network header ;03/05/2001  15:23
 ;;8.0;MailMan;**34**;Jun 28, 2002
 ; All entry points covered by DBIA 2737.
 ; Common Parameters for Q, QD, QL, QN, QX:
 ; XMZ     message number in message file
 ; XMAMT   How many?
 ;         =number - Get this many
 ;         =*      - Get all (default)
 ; XMSTART("IEN") is used to start the lister going.  The lister will
 ;         keep it updated from call to call.
 ;         It is the IEN to start AFTER.
 ;         (Default is to start at the beginning: after 0.)
 ; XMTROOT is the target root to receive the message list.
 ;         (default is ^TMP("XMLIST",$J))
 ; XMFLAGS are used to control processing (currently not used, except QX)
 ; XMFIND  Search for recipients/addressees matching this string.
 ;         Same rules as for FileMan lookups.
 ;         (If XMFIND is supplied, XMSTART and XMAMT are ignored, and
 ;          a complete list is returned.)
 ;
Q(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Addressee listing
 N XMCNT,XMIEN,XMREC
 D QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
 I $D(XMFIND) D
 . D FIND^DIC(3.911,","_XMZ_",","","",XMFIND,"","B")
 E  D
 . D LIST^DIC(3.911,","_XMZ_",","","",XMAMT,.XMSTART,"","B")
 S XMCNT=0
 F  S XMCNT=$O(^TMP("DILIST",$J,2,XMCNT)) Q:XMCNT=""  S XMIEN=^(XMCNT) D
 . S XMREC=$G(^XMB(3.9,XMZ,6,XMIEN,0))
 . S @(XMTROOT_XMCNT_",""TO NAME"")")=$P(XMREC,U,1)
 . I $P(XMREC,U,2)'="" S @(XMTROOT_XMCNT_",""TYPE"")")=$P(XMREC,U,2)
 S @(XMTROOT_"0)")=$G(^TMP("DILIST",$J,0))
 K ^TMP("DILIST",$J)
 Q
QD(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Recipient listing
 D QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
 I $D(XMFIND) D
 . N XMCNT
 . D QFIND^XMXUTIL4(XMZ,XMFLAGS,XMFIND,XMTROOT,.XMCNT)
 . S @(XMTROOT_"0)")=XMCNT_U_"*^0"
 . K ^TMP("DILIST",$J)
 E  D
 . D QLIST^XMXUTIL4(XMZ,XMFLAGS,XMAMT,.XMSTART,XMTROOT)
 Q
QL(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Later'd Addressee listing
 N XMCNT,XMIEN,XMREC
 D QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
 I $D(XMFIND) D
 . D FIND^DIC(3.914,","_XMZ_",","","",XMFIND,"","B")
 E  D
 . D LIST^DIC(3.914,","_XMZ_",","","",XMAMT,.XMSTART,"","B")
 S XMCNT=0
 F  S XMCNT=$O(^TMP("DILIST",$J,2,XMCNT)) Q:XMCNT=""  S XMIEN=^(XMCNT) D
 . S XMREC=$G(^XMB(3.9,XMZ,7,XMIEN,0))
 . S @(XMTROOT_XMCNT_",""TO NAME"")")=$P(XMREC,U,1)
 . I $P(XMREC,U,2)'="" S @(XMTROOT_XMCNT_",""TYPE"")")=$P(XMREC,U,2)
 . S @(XMTROOT_XMCNT_",""BY DUZ"")")=$P(XMREC,U,3)
 . S @(XMTROOT_XMCNT_",""BY NAME"")")=$P(XMREC,U,4)
 . S @(XMTROOT_XMCNT_",""WHEN"")")=$P(XMREC,U,5)
 . S @(XMTROOT_XMCNT_",""WHEN MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,5))
 S @(XMTROOT_"0)")=$G(^TMP("DILIST",$J,0))
 K ^TMP("DILIST",$J)
 Q
QINIT(XMFLAGS,XMAMT,XMFIND,XMTROOT) ; For internal MailMan use only.
 S XMFLAGS=$G(XMFLAGS)
 I $G(XMAMT)="" S XMAMT="*"
 I $D(XMFIND),XMFIND="" K XMFIND
 I $D(XMTROOT),XMTROOT'="" D
 . K @$$CREF^DILF(XMTROOT)
 . S XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
 E  D
 . K ^TMP("XMLIST",$J)
 . S XMTROOT="^TMP(""XMLIST"",$J,"
 Q
QN(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; Get network header lines
 N XMCNT,XMIEN
 D QNINIT(.XMAMT,.XMTROOT)
 S XMCNT=0
 S XMIEN=+$G(XMSTART("IEN"))
 F  S XMIEN=$O(^XMB(3.9,XMZ,2,XMIEN)) Q:XMIEN'<1  D  Q:XMCNT=XMAMT
 . S XMCNT=XMCNT+1
 . S @(XMTROOT_XMCNT_")")=^XMB(3.9,XMZ,2,XMIEN,0)
 S XMSTART("IEN")=XMIEN
 S @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$S(XMIEN'<1:0,$O(^XMB(3.9,XMZ,2,XMIEN))<1:1,1:0) ; Any more?
 Q
QNINIT(XMAMT,XMTROOT) ; For internal MailMan use only.
 I $G(XMAMT)="" S XMAMT="*"
 I $D(XMTROOT),XMTROOT'="" D
 . K @$$CREF^DILF(XMTROOT)
 . S XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
 E  D
 . K ^TMP("XMLIST",$J)
 . S XMTROOT="^TMP(""XMLIST"",$J,"
 Q
QX(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; Local Recipient Xtract
 ; XMFLAGS = "C" list users who are current in reading the message
 ;           "N" list users who are NOT current in reading the message
 ;           "T" list users who have terminated the message
 N XMFIND,XMCNT,XMIEN,XMREC,XMTO,XMNAME,XMRESPS,XMMORE
 I $L($G(XMFLAGS))'=1,"CNT"'[XMFLAGS Q
 D QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
 S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
 S XMCNT=0,XMTO=+$G(XMSTART("IEN"))
 F  S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:+XMTO'='XMTO  D  Q:XMCNT=XMAMT
 . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:'XMIEN
 . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
 . I XMFLAGS="C",$P(XMREC,U,2)'=XMRESPS Q  ; not current
 . I XMFLAGS="N",$P(XMREC,U,2)=XMRESPS Q  ; current
 . I XMFLAGS="T",'$G(^XMB(3.9,XMZ,1,XMIEN,"D")) Q  ; not terminated
 . S XMCNT=XMCNT+1
 . S XMNAME=$$NAME^XMXUTIL(XMTO)
 . D QDFLDS^XMXUTIL4(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
 S XMSTART("IEN")=XMTO
 I XMAMT'="*" D
 . S XMMORE=0 ; any more?
 . F  S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:+XMTO'='XMTO  D  Q:XMMORE
 . . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:'XMIEN
 . . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
 . . I XMFLAGS="C",$P(XMREC,U,2)'=XMRESPS Q  ; not current
 . . I XMFLAGS="N",$P(XMREC,U,2)=XMRESPS Q  ; current
 . . I XMFLAGS="T",'$G(^XMB(3.9,XMZ,1,XMIEN,"D")) Q  ; not terminated
 . . S XMMORE=1
 S @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$S(XMAMT="*":0,1:XMMORE)
 Q