- 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 Feb 18, 2025@23:40:42 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