Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMXUTIL4

XMXUTIL4.m

Go to the documentation of this file.
  1. XMXUTIL4 ;ISC-SF/GMB-List message recipients (cont.) ;04/11/2002 10:44
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. ; All entry points are for internal MailMan use only.
  1. QLIST(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; list them
  1. N XMCNT,XMIEN,XMREC,XMTO,XMNAME
  1. S XMCNT=0,XMIEN=+$G(XMSTART("IEN"))
  1. F S XMIEN=$O(^XMB(3.9,XMZ,1,XMIEN)) Q:'XMIEN D Q:XMCNT=XMAMT
  1. . S XMCNT=XMCNT+1
  1. . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
  1. . S XMTO=$P(XMREC,U,1)
  1. . S XMNAME=$$NAME^XMXUTIL(XMTO)
  1. . D QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
  1. S XMSTART("IEN")=XMIEN
  1. S @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$S(XMAMT="*":0,1:$O(^XMB(3.9,XMZ,1,XMIEN))>0)
  1. Q
  1. QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT) ;
  1. S @(XMTROOT_XMCNT_",""TO"")")=$P(XMREC,U,1)
  1. S @(XMTROOT_XMCNT_",""TO NAME"")")=XMNAME
  1. I $D(^XMB(3.9,XMZ,1,XMIEN,"T")) S @(XMTROOT_XMCNT_",""TYPE"")")=$P(^("T"),U,1)
  1. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN)
  1. I $P(XMREC,U,1)?.N D Q
  1. . S @(XMTROOT_XMCNT_",""TO ID"")")="L" ; local user
  1. . S @(XMTROOT_XMCNT_",""TO DUZ"")")=$P(XMREC,U,1)
  1. . I $P(XMREC,U,2)'="" D
  1. . . S @(XMTROOT_XMCNT_",""RESP"")")=$P(XMREC,U,2)
  1. . I $P(XMREC,U,3)'="" D
  1. . . S @(XMTROOT_XMCNT_",""LREAD"")")=$P(XMREC,U,3)
  1. . . S @(XMTROOT_XMCNT_",""LREAD MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,3))
  1. . I $P(XMREC,U,10)'="" D
  1. . . S @(XMTROOT_XMCNT_",""FREAD"")")=$P(XMREC,U,10)
  1. . . S @(XMTROOT_XMCNT_",""FREAD MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,10))
  1. . I $D(^XMB(3.9,XMZ,1,XMIEN,"C")) D
  1. . . N XMD
  1. . . S XMD=^XMB(3.9,XMZ,1,XMIEN,"C")
  1. . . S @(XMTROOT_XMCNT_",""COPY"")")=XMD
  1. . . S @(XMTROOT_XMCNT_",""COPY MM"")")=$$MMDT^XMXUTIL1(XMD)
  1. . I $D(^XMB(3.9,XMZ,1,XMIEN,"D")),$G(^("D")) D
  1. . . N XMD
  1. . . S XMD=^XMB(3.9,XMZ,1,XMIEN,"D")
  1. . . S @(XMTROOT_XMCNT_",""TERM"")")=XMD
  1. . . S @(XMTROOT_XMCNT_",""TERM MM"")")=$$MMDT^XMXUTIL1(XMD)
  1. . I $D(^XMB(3.9,XMZ,1,XMIEN,"S")) D
  1. . . S @(XMTROOT_XMCNT_",""SURR"")")=^XMB(3.9,XMZ,1,XMIEN,"S")
  1. I $E(XMNAME,1,2)="F.",$P(XMREC,U,12)'=""!$P(XMREC,U,11) D Q
  1. . S @(XMTROOT_XMCNT_",""TO ID"")")="F" ; fax
  1. . I $P(XMREC,U,5)'="" D
  1. . . S @(XMTROOT_XMCNT_",""FDATE"")")=$P(XMREC,U,5)
  1. . . S @(XMTROOT_XMCNT_",""FDATE MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,5))
  1. . I $P(XMREC,U,6)'="" D
  1. . . S @(XMTROOT_XMCNT_",""STATUS"")")=$P(XMREC,U,6)
  1. . I $P(XMREC,U,11)'="" D
  1. . . S @(XMTROOT_XMCNT_",""FAX IEN"")")=$P(XMREC,U,11)
  1. . I $P(XMREC,U,12)'="" D
  1. . . S @(XMTROOT_XMCNT_",""ID"")")=$P(XMREC,U,12)
  1. I XMNAME["@" D Q
  1. . S @(XMTROOT_XMCNT_",""TO ID"")")="R" ; remote
  1. . I $P(XMREC,U,4)'="" D
  1. . . S @(XMTROOT_XMCNT_",""ID"")")=$P(XMREC,U,4)
  1. . I $P(XMREC,U,5)'="" D
  1. . . S @(XMTROOT_XMCNT_",""XDATE"")")=$P(XMREC,U,5)
  1. . . S @(XMTROOT_XMCNT_",""XDATE MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,5))
  1. . I $P(XMREC,U,6)'="" D
  1. . . S @(XMTROOT_XMCNT_",""STATUS"")")=$P(XMREC,U,6)
  1. . I $P(XMREC,U,7)'="",$D(^DIC(4.2,$P(XMREC,U,7),0)) D
  1. . . S @(XMTROOT_XMCNT_",""PATH"")")=$P(XMREC,U,7)
  1. . . S @(XMTROOT_XMCNT_",""PATH NAME"")")=$P(^DIC(4.2,$P(XMREC,U,7),0),U)
  1. . I $P(XMREC,U,8)'="" D
  1. . . S @(XMTROOT_XMCNT_",""SECS"")")=$P(XMREC,U,8)
  1. I $E(XMNAME,1,3)="* (" D Q
  1. . S @(XMTROOT_XMCNT_",""TO ID"")")=$E(XMNAME) ; broadcast
  1. ; I ".D.H.S."[("."_$E(XMNAME,1,2))
  1. S @(XMTROOT_XMCNT_",""TO ID"")")=$E(XMNAME) ; device or server
  1. I $P(XMREC,U,3)'="" D
  1. . S @(XMTROOT_XMCNT_",""SDATE"")")=$P(XMREC,U,3)
  1. . S @(XMTROOT_XMCNT_",""SDATE MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,3))
  1. I $P(XMREC,U,6)'="" D
  1. . S @(XMTROOT_XMCNT_",""STATUS"")")=$P(XMREC,U,6)
  1. Q
  1. FWD(XMZ,XMIEN) ;
  1. Q:'$D(^XMB(3.9,XMZ,1,XMIEN,"F"))
  1. N XMFWDREC,XMFWDBY
  1. S XMFWDREC=^XMB(3.9,XMZ,1,XMIEN,"F")
  1. S XMFWDBY=$P(XMFWDREC,U)
  1. I $E(XMFWDBY)?1A!($E(XMFWDBY)="<") D
  1. . N XMLEN
  1. . S XMLEN=$L(XMFWDBY," ")
  1. . S @(XMTROOT_XMCNT_",""FWD BY"")")=$P(XMFWDBY," ",1,XMLEN-4)
  1. . S @(XMTROOT_XMCNT_",""FWD ON"")")=$P(XMFWDBY," ",XMLEN-3,XMLEN)
  1. E I $E(XMFWDBY)?1N!($E(XMFWDBY)=".") D
  1. . N XMLEN
  1. . S XMFWDBY=$$NAME^XMXUTIL(+XMFWDBY)_" "_$P(XMFWDBY," ",2,99)
  1. . S XMLEN=$L(XMFWDBY," ")
  1. . S @(XMTROOT_XMCNT_",""FWD BY"")")=$P(XMFWDBY," ",1,XMLEN-4)
  1. . S @(XMTROOT_XMCNT_",""FWD ON"")")=$P(XMFWDBY," ",XMLEN-3,XMLEN)
  1. E S @(XMTROOT_XMCNT_",""FWD ON"")")=$E(XMFWDBY,2,99)
  1. I $P(XMFWDREC,U,2) S @(XMTROOT_XMCNT_",""FWD BY DUZ"")")=$P(XMFWDREC,U,2)
  1. I "R"'[$P(XMFWDREC,U,3) S @(XMTROOT_XMCNT_",""FWD TYPE"")")=$P(XMFWDREC,U,3)
  1. Q:$P(XMFWDREC,U,4)="" ; or quit if FWD TYPE="A"
  1. S @(XMTROOT_XMCNT_",""FWD BY ORIG"")")=$P(XMFWDREC,U,4)
  1. I "R"'[$P(XMFWDREC,U,5) S @(XMTROOT_XMCNT_",""FWD TYPE ORIG"")")=$P(XMFWDREC,U,5)
  1. Q
  1. QFIND(XMZ,XMFLAGS,XMFIND,XMTROOT,XMCNT) ; find them
  1. S XMCNT=0
  1. D FIND^DIC(200,"","","A",XMFIND,"","B^BB^C^D","I $D(^XMB(3.9,XMZ,1,""C"",+Y))")
  1. I '$D(DIERR) D MOVE(200,XMZ,XMFLAGS,XMTROOT,.XMCNT)
  1. Q:$O(^XMB(3.9,XMZ,1,"C",":"))="" ; Quit if there aren't any non-local addressees
  1. N XMSCREEN
  1. S XMSCREEN=$S(+XMFIND=XMFIND:"I '$D(^XMB(3.9,XMZ,1,""C"",XMFIND))",1:"")
  1. D FIND^DIC(3.91,","_XMZ_",","","C",XMFIND,"","C",XMSCREEN)
  1. I '$D(DIERR) D MOVE(3.91,XMZ,XMFLAGS,XMTROOT,.XMCNT)
  1. Q:$E(XMFIND)'?1U ; Quit if the search string does not begin with an upper case letter
  1. Q:$O(^XMB(3.9,XMZ,1,"C","`"))="" ; Quit if there aren't any lower case addressees
  1. ; FM will translate lower case to upper case in its search, but won't
  1. ; translate upper to lower, so we do it here.
  1. S XMSCREEN="I ^(0)]""`""" ; Limit search to lower case addresses
  1. D FIND^DIC(3.91,","_XMZ_",","","C",$$LOW^XLFSTR(XMFIND),"","C",XMSCREEN)
  1. I '$D(DIERR) D MOVE(3.91,XMZ,XMFLAGS,XMTROOT,.XMCNT)
  1. Q
  1. MOVE(XMFILE,XMZ,XMFLAGS,XMTROOT,XMCNT) ; move search results
  1. N I,XMIEN,XMREC,XMNAME
  1. S I=0
  1. F S I=$O(^TMP("DILIST",$J,1,I)) Q:I="" D
  1. . S XMIEN=^TMP("DILIST",$J,2,I)
  1. . I XMFILE=200 D
  1. . . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMIEN,0))
  1. . . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
  1. . . S XMNAME=^TMP("DILIST",$J,1,I)
  1. . E D
  1. . . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
  1. . . S XMNAME=$P(XMREC,U,1)
  1. . S XMCNT=XMCNT+1
  1. . D QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
  1. Q