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