XMXUTIL4 ;ISC-SF/GMB-List message recipients (cont.) ;04/11/2002 10:44
;;8.0;MailMan;;Jun 28, 2002
; All entry points are for internal MailMan use only.
QLIST(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; list them
N XMCNT,XMIEN,XMREC,XMTO,XMNAME
S XMCNT=0,XMIEN=+$G(XMSTART("IEN"))
F S XMIEN=$O(^XMB(3.9,XMZ,1,XMIEN)) Q:'XMIEN D Q:XMCNT=XMAMT
. S XMCNT=XMCNT+1
. S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
. S XMTO=$P(XMREC,U,1)
. S XMNAME=$$NAME^XMXUTIL(XMTO)
. D QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
S XMSTART("IEN")=XMIEN
S @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$S(XMAMT="*":0,1:$O(^XMB(3.9,XMZ,1,XMIEN))>0)
Q
QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT) ;
S @(XMTROOT_XMCNT_",""TO"")")=$P(XMREC,U,1)
S @(XMTROOT_XMCNT_",""TO NAME"")")=XMNAME
I $D(^XMB(3.9,XMZ,1,XMIEN,"T")) S @(XMTROOT_XMCNT_",""TYPE"")")=$P(^("T"),U,1)
I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN)
I $P(XMREC,U,1)?.N D Q
. S @(XMTROOT_XMCNT_",""TO ID"")")="L" ; local user
. S @(XMTROOT_XMCNT_",""TO DUZ"")")=$P(XMREC,U,1)
. I $P(XMREC,U,2)'="" D
. . S @(XMTROOT_XMCNT_",""RESP"")")=$P(XMREC,U,2)
. I $P(XMREC,U,3)'="" D
. . S @(XMTROOT_XMCNT_",""LREAD"")")=$P(XMREC,U,3)
. . S @(XMTROOT_XMCNT_",""LREAD MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,3))
. I $P(XMREC,U,10)'="" D
. . S @(XMTROOT_XMCNT_",""FREAD"")")=$P(XMREC,U,10)
. . S @(XMTROOT_XMCNT_",""FREAD MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,10))
. I $D(^XMB(3.9,XMZ,1,XMIEN,"C")) D
. . N XMD
. . S XMD=^XMB(3.9,XMZ,1,XMIEN,"C")
. . S @(XMTROOT_XMCNT_",""COPY"")")=XMD
. . S @(XMTROOT_XMCNT_",""COPY MM"")")=$$MMDT^XMXUTIL1(XMD)
. I $D(^XMB(3.9,XMZ,1,XMIEN,"D")),$G(^("D")) D
. . N XMD
. . S XMD=^XMB(3.9,XMZ,1,XMIEN,"D")
. . S @(XMTROOT_XMCNT_",""TERM"")")=XMD
. . S @(XMTROOT_XMCNT_",""TERM MM"")")=$$MMDT^XMXUTIL1(XMD)
. I $D(^XMB(3.9,XMZ,1,XMIEN,"S")) D
. . S @(XMTROOT_XMCNT_",""SURR"")")=^XMB(3.9,XMZ,1,XMIEN,"S")
I $E(XMNAME,1,2)="F.",$P(XMREC,U,12)'=""!$P(XMREC,U,11) D Q
. S @(XMTROOT_XMCNT_",""TO ID"")")="F" ; fax
. I $P(XMREC,U,5)'="" D
. . S @(XMTROOT_XMCNT_",""FDATE"")")=$P(XMREC,U,5)
. . S @(XMTROOT_XMCNT_",""FDATE MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,5))
. I $P(XMREC,U,6)'="" D
. . S @(XMTROOT_XMCNT_",""STATUS"")")=$P(XMREC,U,6)
. I $P(XMREC,U,11)'="" D
. . S @(XMTROOT_XMCNT_",""FAX IEN"")")=$P(XMREC,U,11)
. I $P(XMREC,U,12)'="" D
. . S @(XMTROOT_XMCNT_",""ID"")")=$P(XMREC,U,12)
I XMNAME["@" D Q
. S @(XMTROOT_XMCNT_",""TO ID"")")="R" ; remote
. I $P(XMREC,U,4)'="" D
. . S @(XMTROOT_XMCNT_",""ID"")")=$P(XMREC,U,4)
. I $P(XMREC,U,5)'="" D
. . S @(XMTROOT_XMCNT_",""XDATE"")")=$P(XMREC,U,5)
. . S @(XMTROOT_XMCNT_",""XDATE MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,5))
. I $P(XMREC,U,6)'="" D
. . S @(XMTROOT_XMCNT_",""STATUS"")")=$P(XMREC,U,6)
. I $P(XMREC,U,7)'="",$D(^DIC(4.2,$P(XMREC,U,7),0)) D
. . S @(XMTROOT_XMCNT_",""PATH"")")=$P(XMREC,U,7)
. . S @(XMTROOT_XMCNT_",""PATH NAME"")")=$P(^DIC(4.2,$P(XMREC,U,7),0),U)
. I $P(XMREC,U,8)'="" D
. . S @(XMTROOT_XMCNT_",""SECS"")")=$P(XMREC,U,8)
I $E(XMNAME,1,3)="* (" D Q
. S @(XMTROOT_XMCNT_",""TO ID"")")=$E(XMNAME) ; broadcast
; I ".D.H.S."[("."_$E(XMNAME,1,2))
S @(XMTROOT_XMCNT_",""TO ID"")")=$E(XMNAME) ; device or server
I $P(XMREC,U,3)'="" D
. S @(XMTROOT_XMCNT_",""SDATE"")")=$P(XMREC,U,3)
. S @(XMTROOT_XMCNT_",""SDATE MM"")")=$$MMDT^XMXUTIL1($P(XMREC,U,3))
I $P(XMREC,U,6)'="" D
. S @(XMTROOT_XMCNT_",""STATUS"")")=$P(XMREC,U,6)
Q
FWD(XMZ,XMIEN) ;
Q:'$D(^XMB(3.9,XMZ,1,XMIEN,"F"))
N XMFWDREC,XMFWDBY
S XMFWDREC=^XMB(3.9,XMZ,1,XMIEN,"F")
S XMFWDBY=$P(XMFWDREC,U)
I $E(XMFWDBY)?1A!($E(XMFWDBY)="<") D
. N XMLEN
. S XMLEN=$L(XMFWDBY," ")
. S @(XMTROOT_XMCNT_",""FWD BY"")")=$P(XMFWDBY," ",1,XMLEN-4)
. S @(XMTROOT_XMCNT_",""FWD ON"")")=$P(XMFWDBY," ",XMLEN-3,XMLEN)
E I $E(XMFWDBY)?1N!($E(XMFWDBY)=".") D
. N XMLEN
. S XMFWDBY=$$NAME^XMXUTIL(+XMFWDBY)_" "_$P(XMFWDBY," ",2,99)
. S XMLEN=$L(XMFWDBY," ")
. S @(XMTROOT_XMCNT_",""FWD BY"")")=$P(XMFWDBY," ",1,XMLEN-4)
. S @(XMTROOT_XMCNT_",""FWD ON"")")=$P(XMFWDBY," ",XMLEN-3,XMLEN)
E S @(XMTROOT_XMCNT_",""FWD ON"")")=$E(XMFWDBY,2,99)
I $P(XMFWDREC,U,2) S @(XMTROOT_XMCNT_",""FWD BY DUZ"")")=$P(XMFWDREC,U,2)
I "R"'[$P(XMFWDREC,U,3) S @(XMTROOT_XMCNT_",""FWD TYPE"")")=$P(XMFWDREC,U,3)
Q:$P(XMFWDREC,U,4)="" ; or quit if FWD TYPE="A"
S @(XMTROOT_XMCNT_",""FWD BY ORIG"")")=$P(XMFWDREC,U,4)
I "R"'[$P(XMFWDREC,U,5) S @(XMTROOT_XMCNT_",""FWD TYPE ORIG"")")=$P(XMFWDREC,U,5)
Q
QFIND(XMZ,XMFLAGS,XMFIND,XMTROOT,XMCNT) ; find them
S XMCNT=0
D FIND^DIC(200,"","","A",XMFIND,"","B^BB^C^D","I $D(^XMB(3.9,XMZ,1,""C"",+Y))")
I '$D(DIERR) D MOVE(200,XMZ,XMFLAGS,XMTROOT,.XMCNT)
Q:$O(^XMB(3.9,XMZ,1,"C",":"))="" ; Quit if there aren't any non-local addressees
N XMSCREEN
S XMSCREEN=$S(+XMFIND=XMFIND:"I '$D(^XMB(3.9,XMZ,1,""C"",XMFIND))",1:"")
D FIND^DIC(3.91,","_XMZ_",","","C",XMFIND,"","C",XMSCREEN)
I '$D(DIERR) D MOVE(3.91,XMZ,XMFLAGS,XMTROOT,.XMCNT)
Q:$E(XMFIND)'?1U ; Quit if the search string does not begin with an upper case letter
Q:$O(^XMB(3.9,XMZ,1,"C","`"))="" ; Quit if there aren't any lower case addressees
; FM will translate lower case to upper case in its search, but won't
; translate upper to lower, so we do it here.
S XMSCREEN="I ^(0)]""`""" ; Limit search to lower case addresses
D FIND^DIC(3.91,","_XMZ_",","","C",$$LOW^XLFSTR(XMFIND),"","C",XMSCREEN)
I '$D(DIERR) D MOVE(3.91,XMZ,XMFLAGS,XMTROOT,.XMCNT)
Q
MOVE(XMFILE,XMZ,XMFLAGS,XMTROOT,XMCNT) ; move search results
N I,XMIEN,XMREC,XMNAME
S I=0
F S I=$O(^TMP("DILIST",$J,1,I)) Q:I="" D
. S XMIEN=^TMP("DILIST",$J,2,I)
. I XMFILE=200 D
. . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMIEN,0))
. . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
. . S XMNAME=^TMP("DILIST",$J,1,I)
. E D
. . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
. . S XMNAME=$P(XMREC,U,1)
. S XMCNT=XMCNT+1
. D QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXUTIL4 5994 printed Apr 09, 2024@21:14:27 Page 2
XMXUTIL4 ;ISC-SF/GMB-List message recipients (cont.) ;04/11/2002 10:44
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; All entry points are for internal MailMan use only.
QLIST(XMZ,XMFLAGS,XMAMT,XMSTART,XMTROOT) ; list them
+1 NEW XMCNT,XMIEN,XMREC,XMTO,XMNAME
+2 SET XMCNT=0
SET XMIEN=+$GET(XMSTART("IEN"))
+3 FOR
SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,XMIEN))
if 'XMIEN
QUIT
Begin DoDot:1
+4 SET XMCNT=XMCNT+1
+5 SET XMREC=$GET(^XMB(3.9,XMZ,1,XMIEN,0))
+6 SET XMTO=$PIECE(XMREC,U,1)
+7 SET XMNAME=$$NAME^XMXUTIL(XMTO)
+8 DO QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
End DoDot:1
if XMCNT=XMAMT
QUIT
+9 SET XMSTART("IEN")=XMIEN
+10 SET @(XMTROOT_"0)")=XMCNT_U_XMAMT_U_$SELECT(XMAMT="*":0,1:$ORDER(^XMB(3.9,XMZ,1,XMIEN))>0)
+11 QUIT
QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT) ;
+1 SET @(XMTROOT_XMCNT_",""TO"")")=$PIECE(XMREC,U,1)
+2 SET @(XMTROOT_XMCNT_",""TO NAME"")")=XMNAME
+3 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"T"))
SET @(XMTROOT_XMCNT_",""TYPE"")")=$PIECE(^("T"),U,1)
+4 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"F"))
DO FWD(XMZ,XMIEN)
+5 IF $PIECE(XMREC,U,1)?.N
Begin DoDot:1
+6 ; local user
SET @(XMTROOT_XMCNT_",""TO ID"")")="L"
+7 SET @(XMTROOT_XMCNT_",""TO DUZ"")")=$PIECE(XMREC,U,1)
+8 IF $PIECE(XMREC,U,2)'=""
Begin DoDot:2
+9 SET @(XMTROOT_XMCNT_",""RESP"")")=$PIECE(XMREC,U,2)
End DoDot:2
+10 IF $PIECE(XMREC,U,3)'=""
Begin DoDot:2
+11 SET @(XMTROOT_XMCNT_",""LREAD"")")=$PIECE(XMREC,U,3)
+12 SET @(XMTROOT_XMCNT_",""LREAD MM"")")=$$MMDT^XMXUTIL1($PIECE(XMREC,U,3))
End DoDot:2
+13 IF $PIECE(XMREC,U,10)'=""
Begin DoDot:2
+14 SET @(XMTROOT_XMCNT_",""FREAD"")")=$PIECE(XMREC,U,10)
+15 SET @(XMTROOT_XMCNT_",""FREAD MM"")")=$$MMDT^XMXUTIL1($PIECE(XMREC,U,10))
End DoDot:2
+16 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"C"))
Begin DoDot:2
+17 NEW XMD
+18 SET XMD=^XMB(3.9,XMZ,1,XMIEN,"C")
+19 SET @(XMTROOT_XMCNT_",""COPY"")")=XMD
+20 SET @(XMTROOT_XMCNT_",""COPY MM"")")=$$MMDT^XMXUTIL1(XMD)
End DoDot:2
+21 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"D"))
IF $GET(^("D"))
Begin DoDot:2
+22 NEW XMD
+23 SET XMD=^XMB(3.9,XMZ,1,XMIEN,"D")
+24 SET @(XMTROOT_XMCNT_",""TERM"")")=XMD
+25 SET @(XMTROOT_XMCNT_",""TERM MM"")")=$$MMDT^XMXUTIL1(XMD)
End DoDot:2
+26 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"S"))
Begin DoDot:2
+27 SET @(XMTROOT_XMCNT_",""SURR"")")=^XMB(3.9,XMZ,1,XMIEN,"S")
End DoDot:2
End DoDot:1
QUIT
+28 IF $EXTRACT(XMNAME,1,2)="F."
IF $PIECE(XMREC,U,12)'=""!$PIECE(XMREC,U,11)
Begin DoDot:1
+29 ; fax
SET @(XMTROOT_XMCNT_",""TO ID"")")="F"
+30 IF $PIECE(XMREC,U,5)'=""
Begin DoDot:2
+31 SET @(XMTROOT_XMCNT_",""FDATE"")")=$PIECE(XMREC,U,5)
+32 SET @(XMTROOT_XMCNT_",""FDATE MM"")")=$$MMDT^XMXUTIL1($PIECE(XMREC,U,5))
End DoDot:2
+33 IF $PIECE(XMREC,U,6)'=""
Begin DoDot:2
+34 SET @(XMTROOT_XMCNT_",""STATUS"")")=$PIECE(XMREC,U,6)
End DoDot:2
+35 IF $PIECE(XMREC,U,11)'=""
Begin DoDot:2
+36 SET @(XMTROOT_XMCNT_",""FAX IEN"")")=$PIECE(XMREC,U,11)
End DoDot:2
+37 IF $PIECE(XMREC,U,12)'=""
Begin DoDot:2
+38 SET @(XMTROOT_XMCNT_",""ID"")")=$PIECE(XMREC,U,12)
End DoDot:2
End DoDot:1
QUIT
+39 IF XMNAME["@"
Begin DoDot:1
+40 ; remote
SET @(XMTROOT_XMCNT_",""TO ID"")")="R"
+41 IF $PIECE(XMREC,U,4)'=""
Begin DoDot:2
+42 SET @(XMTROOT_XMCNT_",""ID"")")=$PIECE(XMREC,U,4)
End DoDot:2
+43 IF $PIECE(XMREC,U,5)'=""
Begin DoDot:2
+44 SET @(XMTROOT_XMCNT_",""XDATE"")")=$PIECE(XMREC,U,5)
+45 SET @(XMTROOT_XMCNT_",""XDATE MM"")")=$$MMDT^XMXUTIL1($PIECE(XMREC,U,5))
End DoDot:2
+46 IF $PIECE(XMREC,U,6)'=""
Begin DoDot:2
+47 SET @(XMTROOT_XMCNT_",""STATUS"")")=$PIECE(XMREC,U,6)
End DoDot:2
+48 IF $PIECE(XMREC,U,7)'=""
IF $DATA(^DIC(4.2,$PIECE(XMREC,U,7),0))
Begin DoDot:2
+49 SET @(XMTROOT_XMCNT_",""PATH"")")=$PIECE(XMREC,U,7)
+50 SET @(XMTROOT_XMCNT_",""PATH NAME"")")=$PIECE(^DIC(4.2,$PIECE(XMREC,U,7),0),U)
End DoDot:2
+51 IF $PIECE(XMREC,U,8)'=""
Begin DoDot:2
+52 SET @(XMTROOT_XMCNT_",""SECS"")")=$PIECE(XMREC,U,8)
End DoDot:2
End DoDot:1
QUIT
+53 IF $EXTRACT(XMNAME,1,3)="* ("
Begin DoDot:1
+54 ; broadcast
SET @(XMTROOT_XMCNT_",""TO ID"")")=$EXTRACT(XMNAME)
End DoDot:1
QUIT
+55 ; I ".D.H.S."[("."_$E(XMNAME,1,2))
+56 ; device or server
SET @(XMTROOT_XMCNT_",""TO ID"")")=$EXTRACT(XMNAME)
+57 IF $PIECE(XMREC,U,3)'=""
Begin DoDot:1
+58 SET @(XMTROOT_XMCNT_",""SDATE"")")=$PIECE(XMREC,U,3)
+59 SET @(XMTROOT_XMCNT_",""SDATE MM"")")=$$MMDT^XMXUTIL1($PIECE(XMREC,U,3))
End DoDot:1
+60 IF $PIECE(XMREC,U,6)'=""
Begin DoDot:1
+61 SET @(XMTROOT_XMCNT_",""STATUS"")")=$PIECE(XMREC,U,6)
End DoDot:1
+62 QUIT
FWD(XMZ,XMIEN) ;
+1 if '$DATA(^XMB(3.9,XMZ,1,XMIEN,"F"))
QUIT
+2 NEW XMFWDREC,XMFWDBY
+3 SET XMFWDREC=^XMB(3.9,XMZ,1,XMIEN,"F")
+4 SET XMFWDBY=$PIECE(XMFWDREC,U)
+5 IF $EXTRACT(XMFWDBY)?1A!($EXTRACT(XMFWDBY)="<")
Begin DoDot:1
+6 NEW XMLEN
+7 SET XMLEN=$LENGTH(XMFWDBY," ")
+8 SET @(XMTROOT_XMCNT_",""FWD BY"")")=$PIECE(XMFWDBY," ",1,XMLEN-4)
+9 SET @(XMTROOT_XMCNT_",""FWD ON"")")=$PIECE(XMFWDBY," ",XMLEN-3,XMLEN)
End DoDot:1
+10 IF '$TEST
IF $EXTRACT(XMFWDBY)?1N!($EXTRACT(XMFWDBY)=".")
Begin DoDot:1
+11 NEW XMLEN
+12 SET XMFWDBY=$$NAME^XMXUTIL(+XMFWDBY)_" "_$PIECE(XMFWDBY," ",2,99)
+13 SET XMLEN=$LENGTH(XMFWDBY," ")
+14 SET @(XMTROOT_XMCNT_",""FWD BY"")")=$PIECE(XMFWDBY," ",1,XMLEN-4)
+15 SET @(XMTROOT_XMCNT_",""FWD ON"")")=$PIECE(XMFWDBY," ",XMLEN-3,XMLEN)
End DoDot:1
+16 IF '$TEST
SET @(XMTROOT_XMCNT_",""FWD ON"")")=$EXTRACT(XMFWDBY,2,99)
+17 IF $PIECE(XMFWDREC,U,2)
SET @(XMTROOT_XMCNT_",""FWD BY DUZ"")")=$PIECE(XMFWDREC,U,2)
+18 IF "R"'[$PIECE(XMFWDREC,U,3)
SET @(XMTROOT_XMCNT_",""FWD TYPE"")")=$PIECE(XMFWDREC,U,3)
+19 ; or quit if FWD TYPE="A"
if $PIECE(XMFWDREC,U,4)=""
QUIT
+20 SET @(XMTROOT_XMCNT_",""FWD BY ORIG"")")=$PIECE(XMFWDREC,U,4)
+21 IF "R"'[$PIECE(XMFWDREC,U,5)
SET @(XMTROOT_XMCNT_",""FWD TYPE ORIG"")")=$PIECE(XMFWDREC,U,5)
+22 QUIT
QFIND(XMZ,XMFLAGS,XMFIND,XMTROOT,XMCNT) ; find them
+1 SET XMCNT=0
+2 DO FIND^DIC(200,"","","A",XMFIND,"","B^BB^C^D","I $D(^XMB(3.9,XMZ,1,""C"",+Y))")
+3 IF '$DATA(DIERR)
DO MOVE(200,XMZ,XMFLAGS,XMTROOT,.XMCNT)
+4 ; Quit if there aren't any non-local addressees
if $ORDER(^XMB(3.9,XMZ,1,"C","
QUIT
+5 NEW XMSCREEN
+6 SET XMSCREEN=$SELECT(+XMFIND=XMFIND:"I '$D(^XMB(3.9,XMZ,1,""C"",XMFIND))",1:"")
+7 DO FIND^DIC(3.91,","_XMZ_",","","C",XMFIND,"","C",XMSCREEN)
+8 IF '$DATA(DIERR)
DO MOVE(3.91,XMZ,XMFLAGS,XMTROOT,.XMCNT)
+9 ; Quit if the search string does not begin with an upper case letter
if $EXTRACT(XMFIND)'?1U
QUIT
+10 ; Quit if there aren't any lower case addressees
if $ORDER(^XMB(3.9,XMZ,1,"C","`"))=""
QUIT
+11 ; FM will translate lower case to upper case in its search, but won't
+12 ; translate upper to lower, so we do it here.
+13 ; Limit search to lower case addresses
SET XMSCREEN="I ^(0)]""`"""
+14 DO FIND^DIC(3.91,","_XMZ_",","","C",$$LOW^XLFSTR(XMFIND),"","C",XMSCREEN)
+15 IF '$DATA(DIERR)
DO MOVE(3.91,XMZ,XMFLAGS,XMTROOT,.XMCNT)
+16 QUIT
MOVE(XMFILE,XMZ,XMFLAGS,XMTROOT,XMCNT) ; move search results
+1 NEW I,XMIEN,XMREC,XMNAME
+2 SET I=0
+3 FOR
SET I=$ORDER(^TMP("DILIST",$JOB,1,I))
if I=""
QUIT
Begin DoDot:1
+4 SET XMIEN=^TMP("DILIST",$JOB,2,I)
+5 IF XMFILE=200
Begin DoDot:2
+6 SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMIEN,0))
+7 SET XMREC=$GET(^XMB(3.9,XMZ,1,XMIEN,0))
+8 SET XMNAME=^TMP("DILIST",$JOB,1,I)
End DoDot:2
+9 IF '$TEST
Begin DoDot:2
+10 SET XMREC=$GET(^XMB(3.9,XMZ,1,XMIEN,0))
+11 SET XMNAME=$PIECE(XMREC,U,1)
End DoDot:2
+12 SET XMCNT=XMCNT+1
+13 DO QDFLDS(XMZ,XMFLAGS,XMIEN,XMREC,XMNAME,XMTROOT,XMCNT)
End DoDot:1
+14 QUIT
