XMXUTIL3 ;ISC-SF/GMB - List addressees, recipients, message network header ;03/05/2001 15:23
;;8.0;MailMan;**34,47**;Jun 28, 2002;Build 6
; 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)
; **XM*8.0*47 Fixes quit logic in both FOR loops and adds a subscript level when setting the XMIEN variable.
S XMCNT=0,XMTO=+$G(XMSTART("IEN")),XMIEN=""
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,XMIEN)) 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,XMIEN)) 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXUTIL3 5336 printed Oct 16, 2024@18:15:15 Page 2
XMXUTIL3 ;ISC-SF/GMB - List addressees, recipients, message network header ;03/05/2001 15:23
+1 ;;8.0;MailMan;**34,47**;Jun 28, 2002;Build 6
+2 ; All entry points covered by DBIA 2737.
+3 ; Common Parameters for Q, QD, QL, QN, QX:
+4 ; XMZ message number in message file
+5 ; XMAMT How many?
+6 ; =number - Get this many
+7 ; =* - Get all (default)
+8 ; XMSTART("IEN") is used to start the lister going. The lister will
+9 ; keep it updated from call to call.
+10 ; It is the IEN to start AFTER.
+11 ; (Default is to start at the beginning: after 0.)
+12 ; XMTROOT is the target root to receive the message list.
+13 ; (default is ^TMP("XMLIST",$J))
+14 ; XMFLAGS are used to control processing (currently not used, except QX)
+15 ; XMFIND Search for recipients/addressees matching this string.
+16 ; Same rules as for FileMan lookups.
+17 ; (If XMFIND is supplied, XMSTART and XMAMT are ignored, and
+18 ; a complete list is returned.)
+19 ;
Q(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Addressee listing
+1 NEW XMCNT,XMIEN,XMREC
+2 DO QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
+3 IF $DATA(XMFIND)
Begin DoDot:1
+4 DO FIND^DIC(3.911,","_XMZ_",","","",XMFIND,"","B")
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 DO LIST^DIC(3.911,","_XMZ_",","","",XMAMT,.XMSTART,"","B")
End DoDot:1
+7 SET XMCNT=0
+8 FOR
SET XMCNT=$ORDER(^TMP("DILIST",$JOB,2,XMCNT))
if XMCNT=""
QUIT
SET XMIEN=^(XMCNT)
Begin DoDot:1
+9 SET XMREC=$GET(^XMB(3.9,XMZ,6,XMIEN,0))
+10 SET @(XMTROOT_XMCNT_",""TO NAME"")")=$PIECE(XMREC,U,1)
+11 IF $PIECE(XMREC,U,2)'=""
SET @(XMTROOT_XMCNT_",""TYPE"")")=$PIECE(XMREC,U,2)
End DoDot:1
+12 SET @(XMTROOT_"0)")=$GET(^TMP("DILIST",$JOB,0))
+13 KILL ^TMP("DILIST",$JOB)
+14 QUIT
QD(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Recipient listing
+1 DO QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
+2 IF $DATA(XMFIND)
Begin DoDot:1
+3 NEW XMCNT
+4 DO QFIND^XMXUTIL4(XMZ,XMFLAGS,XMFIND,XMTROOT,.XMCNT)
+5 SET @(XMTROOT_"0)")=XMCNT_U_"*^0"
+6 KILL ^TMP("DILIST",$JOB)
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 DO QLIST^XMXUTIL4(XMZ,XMFLAGS,XMAMT,.XMSTART,XMTROOT)
End DoDot:1
+9 QUIT
QL(XMZ,XMFLAGS,XMAMT,XMSTART,XMFIND,XMTROOT) ; Later'd Addressee listing
+1 NEW XMCNT,XMIEN,XMREC
+2 DO QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
+3 IF $DATA(XMFIND)
Begin DoDot:1
+4 DO FIND^DIC(3.914,","_XMZ_",","","",XMFIND,"","B")
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 DO LIST^DIC(3.914,","_XMZ_",","","",XMAMT,.XMSTART,"","B")
End DoDot:1
+7 SET XMCNT=0
+8 FOR
SET XMCNT=$ORDER(^TMP("DILIST",$JOB,2,XMCNT))
if XMCNT=""
QUIT
SET XMIEN=^(XMCNT)
Begin DoDot:1
+9 SET XMREC=$GET(^XMB(3.9,XMZ,7,XMIEN,0))
+10 SET @(XMTROOT_XMCNT_",""TO NAME"")")=$PIECE(XMREC,U,1)
+11 IF $PIECE(XMREC,U,2)'=""
SET @(XMTROOT_XMCNT_",""TYPE"")")=$PIECE(XMREC,U,2)
+12 SET @(XMTROOT_XMCNT_",""BY DUZ"")")=$PIECE(XMREC,U,3)
+13 SET @(XMTROOT_XMCNT_",""BY NAME"")")=$PIECE(XMREC,U,4)
+14 SET @(XMTROOT_XMCNT_",""WHEN"")")=$PIECE(XMREC,U,5)
+15 SET @(XMTROOT_XMCNT_",""WHEN MM"")")=$$MMDT^XMXUTIL1($PIECE(XMREC,U,5))
End DoDot:1
+16 SET @(XMTROOT_"0)")=$GET(^TMP("DILIST",$JOB,0))
+17 KILL ^TMP("DILIST",$JOB)
+18 QUIT
QINIT(XMFLAGS,XMAMT,XMFIND,XMTROOT) ; For internal MailMan use only.
+1 SET XMFLAGS=$GET(XMFLAGS)
+2 IF $GET(XMAMT)=""
SET XMAMT="*"
+3 IF $DATA(XMFIND)
IF XMFIND=""
KILL XMFIND
+4 IF $DATA(XMTROOT)
IF XMTROOT'=""
Begin DoDot:1
+5 KILL @$$CREF^DILF(XMTROOT)
+6 SET XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 KILL ^TMP("XMLIST",$JOB)
+9 SET XMTROOT="^TMP(""XMLIST"",$J,"
End DoDot:1
+10 QUIT
QN(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; Get network header lines
+1 NEW XMCNT,XMIEN
+2 DO QNINIT(.XMAMT,.XMTROOT)
+3 SET XMCNT=0
+4 SET XMIEN=+$GET(XMSTART("IEN"))
+5 FOR
SET XMIEN=$ORDER(^XMB(3.9,XMZ,2,XMIEN))
if XMIEN'<1
QUIT
Begin DoDot:1
+6 SET XMCNT=XMCNT+1
+7 SET @(XMTROOT_XMCNT_")")=^XMB(3.9,XMZ,2,XMIEN,0)
End DoDot:1
if XMCNT=XMAMT
QUIT
+8 SET XMSTART("IEN")=XMIEN
+9 ; Any more?
SET @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$SELECT(XMIEN'<1:0,$ORDER(^XMB(3.9,XMZ,2,XMIEN))<1:1,1:0)
+10 QUIT
QNINIT(XMAMT,XMTROOT) ; For internal MailMan use only.
+1 IF $GET(XMAMT)=""
SET XMAMT="*"
+2 IF $DATA(XMTROOT)
IF XMTROOT'=""
Begin DoDot:1
+3 KILL @$$CREF^DILF(XMTROOT)
+4 SET XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 KILL ^TMP("XMLIST",$JOB)
+7 SET XMTROOT="^TMP(""XMLIST"",$J,"
End DoDot:1
+8 QUIT
QX(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; Local Recipient Xtract
+1 ; XMFLAGS = "C" list users who are current in reading the message
+2 ; "N" list users who are NOT current in reading the message
+3 ; "T" list users who have terminated the message
+4 NEW XMFIND,XMCNT,XMIEN,XMREC,XMTO,XMNAME,XMRESPS,XMMORE
+5 IF $LENGTH($GET(XMFLAGS))'=1
IF "CNT"'[XMFLAGS
QUIT
+6 DO QINIT(.XMFLAGS,.XMAMT,.XMFIND,.XMTROOT)
+7 SET XMRESPS=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)
+8 ; **XM*8.0*47 Fixes quit logic in both FOR loops and adds a subscript level when setting the XMIEN variable.
+9 SET XMCNT=0
SET XMTO=+$GET(XMSTART("IEN"))
SET XMIEN=""
+10 FOR
SET XMTO=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO))
if +XMTO'=XMTO
QUIT
Begin DoDot:1
+11 SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO,XMIEN))
if 'XMIEN
QUIT
+12 SET XMREC=$GET(^XMB(3.9,XMZ,1,XMIEN,0))
+13 ; not current
IF XMFLAGS="C"
IF $PIECE(XMREC,U,2)'=XMRESPS
QUIT
+14 ; current
IF XMFLAGS="N"
IF $PIECE(XMREC,U,2)=XMRESPS
QUIT
+15 ; not terminated
IF XMFLAGS="T"
IF '$GET(^XMB(3.9,XMZ,1,XMIEN,"D"))
QUIT
+16 SET XMCNT=XMCNT+1
+17 SET XMNAME=$$NAME^XMXUTIL(XMTO)
+18 DO QDFLDS^XMXUTIL4(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
End DoDot:1
if XMCNT=XMAMT
QUIT
+19 SET XMSTART("IEN")=XMTO
+20 IF XMAMT'="*"
Begin DoDot:1
+21 ; any more?
SET XMMORE=0
+22 FOR
SET XMTO=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO))
if +XMTO'=XMTO
QUIT
Begin DoDot:2
+23 SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO,XMIEN))
if 'XMIEN
QUIT
+24 SET XMREC=$GET(^XMB(3.9,XMZ,1,XMIEN,0))
+25 ; not current
IF XMFLAGS="C"
IF $PIECE(XMREC,U,2)'=XMRESPS
QUIT
+26 ; current
IF XMFLAGS="N"
IF $PIECE(XMREC,U,2)=XMRESPS
QUIT
+27 ; not terminated
IF XMFLAGS="T"
IF '$GET(^XMB(3.9,XMZ,1,XMIEN,"D"))
QUIT
+28 SET XMMORE=1
End DoDot:2
if XMMORE
QUIT
End DoDot:1
+29 SET @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$SELECT(XMAMT="*":0,1:XMMORE)
+30 QUIT
