- XMJMFC ;ISC-SF/GMB-Find message in file 3.9 ;07/12/2002 10:34
- ;;8.0;MailMan;;Jun 28, 2002
- ; Search for messages in the MESSAGE file
- FIND(XMDUZ,XMF,XMWAIT) ;
- I $G(XMF("FLAGS"))["U",'$$SSPRIV^XMXSEC1 D Q
- . D SHOW^XMJERR
- . D WAIT^XMXUTIL
- N XMKZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMMORE,XMFLAGS,XMSCREEN,XMFROM,XMZOOM,XMCD,XMOPT,XMOX,XMSAVE
- S XMSAVE("FDATE")=XMF("FDATE") K XMF("FDATE")
- S XMSAVE("TDATE")=XMF("TDATE") K XMF("TDATE")
- K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
- S (XMKZ,XMZ,XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0,(XMDETAIL,XMMORE)=1,XMPMAX=IOSL-3
- D SRCHINIT(XMDUZ,.XMF,.XMFLAGS,.XMSCREEN,.XMFROM,.XMABORT) Q:XMABORT
- D INIT(XMDUZ,XMFLAGS,XMDETAIL,.XMLEN)
- D SETOPT^XMJMLR1(XMDUZ,$S(XMFLAGS["U":"!",1:0),.XMOPT,.XMOX)
- F D Q:XMABORT
- . I XMCD S XMCD=0,XMDETAIL='XMDETAIL D INIT(XMDUZ,XMFLAGS,XMDETAIL,.XMLEN)
- . D DISPLAY(XMDUZ,.XMF,XMFLAGS,XMSCREEN,.XMFROM,XMDETAIL,.XMKZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
- . I XMCNT=0 S XMABORT=1 Q
- . D CHOOSE^XMJMLN(XMDUZ,1,0,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG^XMJMFC",.XMABORT)
- . S:'$D(^TMP("XM",$J,"MSG")) XMABORT=1
- I XMCNT=0 D
- . W $$EZBLD^DIALOG(34401) ; No matches found.
- . Q:'$G(XMWAIT)
- . W ! D WAIT^XMXUTIL
- K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
- S XMF("FDATE")=XMSAVE("FDATE"),XMF("TDATE")=XMSAVE("TDATE")
- Q
- INIT(XMDUZ,XMFLAGS,XMDETAIL,XMLEN) ;
- I XMFLAGS'["U" S XMLEN("BSKT")=10
- S XMLEN("XMKZ")=3
- D INIT^XMJML(XMDUZ,"","",XMDETAIL,.XMLEN,XMFLAGS["U")
- Q
- SRCHINIT(XMDUZ,XMF,XMFLAGS,XMSCREEN,XMFROM,XMABORT) ;
- I XMV("ORDER")=-1 D
- . S XMFLAGS="B"
- . S XMFROM=$O(^XMB(3.9,"C",XMSAVE("TDATE")))
- E D
- . S XMFLAGS=""
- . S XMFROM=$O(^XMB(3.9,"C",XMSAVE("FDATE")),-1)
- S XMFLAGS=$S(XMV("ORDER")=-1:"B",1:"")
- I $G(XMF("FLAGS"))["U" D Q:XMABORT
- . S XMFLAGS=XMFLAGS_"U" ; Ignore file screen
- . D AUDIT(.XMF)
- . Q:'$D(XMERR)
- . S XMABORT=1
- . D SHOW^XMJERR
- . D WAIT^XMXUTIL
- S:$D(XMF("SUBJ")) XMF("SUBJ","S")=$$UP^XLFSTR(XMF("SUBJ"))
- S:$D(XMF("TEXT")) XMF("TEXT","S")=$S('XMF("TEXT","C"):$$UP^XLFSTR(XMF("TEXT")),1:XMF("TEXT"))
- S XMSCREEN=$$SCREEN(XMDUZ)
- Q
- AUDIT(XMF) ; Send a bulletin to G.XM SUPER SEARCH
- N XMINSTR,XMPARM,XMTEXT,I
- I '$$GOTLOCAL^XMXAPIG("XM SUPER SEARCH",90,2) D ERRSET^XMXUTIL(34413.6) Q
- S XMINSTR("FROM")=.5
- S XMPARM(1)=XMV("DUZ NAME")
- S I=1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34443)_":",30)_$$FMTE^XLFDT(XMSAVE("FDATE"))_" - "_$$FMTE^XLFDT(XMSAVE("TDATE")) ; Search period
- I $D(XMF("SUBJ")) D ; Subject contains
- . S I=I+1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34438)_":",30)_XMF("SUBJ")
- I $D(XMF("FROM")) D ; Message from
- . S I=I+1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34440)_":",30)_$$NAME^XMXUTIL(XMF("FROM"))
- I $D(XMF("TO")) D ; Message to
- . S I=I+1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34440.2)_":",30)_XMF("TO")
- I $D(XMF("FLINE")) D ; Lines of text, minimum
- . S I=I+1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34449)_":",30)_XMF("FLINE")
- ;I $D(XMF("TLINE")) D ; Lines of text, maximum
- ;. S I=I+1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34450)_":",30)_XMF("TLINE")
- I $D(XMF("RFROM")) D ; Response from
- . S I=I+1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34440.1)_":",30)_$$NAME^XMXUTIL(XMF("RFROM"))
- I $D(XMF("TEXT")) D
- . ; x.1:Message / x.2:Message or Response / x.3:Response contains
- . S I=I+1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34446+(XMF("TEXT","L")/10))_":",30)_XMF("TEXT")
- D SENDBULL^XMXBULL(DUZ,"XM SUPER SEARCH",.XMPARM,"XMTEXT","G.XM SUPER SEARCH",.XMINSTR)
- I $D(XMERR) D ERRSET^XMXUTIL(34413.6)
- Q
- SCREEN(XMDUZ) ;
- S XMSCREEN="N X S X=^(0)"
- I XMDUZ'=.5 D
- . N XMMIN
- . S XMMIN=$P(^XMB(3.7,XMDUZ,0),U,7)
- . ; If minimum date, don't choose lower date unless already in user's bskt
- . I XMMIN>0 S XMSCREEN=" I ^(.6)'<"_XMMIN_"!$D(^XMB(3.7,""M"",Y,XMDUZ))"
- ; Msg must not be SPOOL, msg must not be a reply.
- Q XMSCREEN_" I $P(X,U,7)'=""S"",'$P(X,U,8),$P(X,U)'?1""R"".N,$$GOODMSG^XMJMFB(XMDUZ,0,Y,.XMF)"
- DISPLAY(XMDUZ,XMF,XMFLAGS,XMSCREEN,XMFROM,XMDETAIL,XMKZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
- N XMREC
- S XMFIRST(XMPAGE)=XMKZ
- D HEADER^XMJML(XMDETAIL,.XMLEN,$$EZBLD^DIALOG($S(XMFLAGS["U":34403.5,1:34403))) ; All Messages Super Search / All Messages Search
- I XMZOOM D Q
- . F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:XMKZ="" D Q:$Y>XMPMAX
- . . S XMREC=^TMP("XM",$J,"MSG",XMKZ)
- . . D LISTMSG^XMJML($P(XMREC,U,1),$P(XMREC,U,2),XMKZ,$P(XMREC,U,3),XMDETAIL,.XMLEN)
- F S XMKZ=$O(^TMP("XM",$J,"MSG",XMKZ)) Q:XMKZ="" D Q:$Y>XMPMAX
- . S XMREC=^TMP("XM",$J,"MSG",XMKZ)
- . D LISTMSG^XMJML($P(XMREC,U,1),$P(XMREC,U,2),XMKZ,$P(XMREC,U,3),XMDETAIL,.XMLEN)
- Q:$Y>XMPMAX!'XMMORE
- ; File screen ^DD(3.9,0,"SCR") insists that user be author or recipient.
- ; If FLAGS["U", then file screen is ignored.
- D LIST^DIC(3.9,"","@",XMFLAGS,XMPMAX-$Y+1,.XMFROM,"","C",XMSCREEN)
- S:$P(^TMP("DILIST",$J,0),U,3)=0 XMMORE=0
- D LISTMSG(XMDUZ,XMDETAIL,.XMCNT,.XMLEN,.XMMORE)
- S XMKZ=XMCNT
- K ^TMP("DILIST",$J)
- W:'XMMORE !,$$EZBLD^DIALOG(34402) ; Search finished.
- Q
- LISTMSG(XMDUZ,XMDETAIL,XMCNT,XMLEN,XMMORE) ; Check and List
- N XMK,XMKN,XMZ,I,XMNA,XMSTOP,XMDATE
- S I="",XMSTOP=0,XMNA=$$EZBLD^DIALOG(34014) ; * N/A *
- I XMFLAGS["U" S XMK=0,XMKN=XMNA
- F S I=$O(^TMP("DILIST",$J,2,I),XMV("ORDER")) Q:I'>0 D Q:XMSTOP
- . S XMCNT=XMCNT+1
- . S XMZ=^TMP("DILIST",$J,2,I)
- . S XMDATE=+$G(^XMB(3.9,XMZ,.6))
- . I XMDATE,XMDATE<XMSAVE("FDATE")!(XMDATE>XMSAVE("TDATE")) D Q
- . . S XMMORE=0,XMSTOP=1
- . I XMFLAGS'["U" D
- . . S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,0))
- . . S XMKN=$S(XMK:$P(^XMB(3.7,XMDUZ,2,XMK,0),U),1:XMNA)
- . . I XMK,'$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITM^XMUT4A(XMDUZ,XMK,XMZ)
- . D LISTMSG^XMJML(XMK,XMKN,XMCNT,XMZ,XMDETAIL,.XMLEN)
- . S ^TMP("XM",$J,"MSG",XMCNT)=XMK_U_XMKN_U_XMZ
- Q
- READMSG ; (XMDUZ,XMKZ,XMREC) <- needed!
- N XMK,XMKN,XMZ,XMRDR ; $G(XMRDR) is checked in READMSG^XMJBM
- I XMFLAGS["U" D
- . S XMK="!",XMKN=$$EZBLD^DIALOG(34014) ; * N/A *
- E D
- . S XMK=$P(XMREC,U,1),XMKN=$P(XMREC,U,2)
- S XMZ=$P(XMREC,U,3)
- D READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
- Q:XMFLAGS["U"
- Q:$D(^XMB(3.7,"M",XMZ,XMDUZ,XMK))
- S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,0))
- S ^TMP("XM",$J,"MSG",XMKZ)=XMK_U_$S(XMK=0:$$EZBLD^DIALOG(34014),1:$P(^XMB(3.7,XMDUZ,2,XMK,0),U))_U_XMZ ; * N/A *
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMFC 6292 printed Feb 18, 2025@23:38:12 Page 2
- XMJMFC ;ISC-SF/GMB-Find message in file 3.9 ;07/12/2002 10:34
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ; Search for messages in the MESSAGE file
- FIND(XMDUZ,XMF,XMWAIT) ;
- +1 IF $GET(XMF("FLAGS"))["U"
- IF '$$SSPRIV^XMXSEC1
- Begin DoDot:1
- +2 DO SHOW^XMJERR
- +3 DO WAIT^XMXUTIL
- End DoDot:1
- QUIT
- +4 NEW XMKZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMMORE,XMFLAGS,XMSCREEN,XMFROM,XMZOOM,XMCD,XMOPT,XMOX,XMSAVE
- +5 SET XMSAVE("FDATE")=XMF("FDATE")
- KILL XMF("FDATE")
- +6 SET XMSAVE("TDATE")=XMF("TDATE")
- KILL XMF("TDATE")
- +7 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
- +8 SET (XMKZ,XMZ,XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0
- SET (XMDETAIL,XMMORE)=1
- SET XMPMAX=IOSL-3
- +9 DO SRCHINIT(XMDUZ,.XMF,.XMFLAGS,.XMSCREEN,.XMFROM,.XMABORT)
- if XMABORT
- QUIT
- +10 DO INIT(XMDUZ,XMFLAGS,XMDETAIL,.XMLEN)
- +11 DO SETOPT^XMJMLR1(XMDUZ,$SELECT(XMFLAGS["U":"!",1:0),.XMOPT,.XMOX)
- +12 FOR
- Begin DoDot:1
- +13 IF XMCD
- SET XMCD=0
- SET XMDETAIL='XMDETAIL
- DO INIT(XMDUZ,XMFLAGS,XMDETAIL,.XMLEN)
- +14 DO DISPLAY(XMDUZ,.XMF,XMFLAGS,XMSCREEN,.XMFROM,XMDETAIL,.XMKZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
- +15 IF XMCNT=0
- SET XMABORT=1
- QUIT
- +16 DO CHOOSE^XMJMLN(XMDUZ,1,0,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG^XMJMFC",.XMABORT)
- +17 if '$DATA(^TMP("XM",$JOB,"MSG"))
- SET XMABORT=1
- End DoDot:1
- if XMABORT
- QUIT
- +18 IF XMCNT=0
- Begin DoDot:1
- +19 ; No matches found.
- WRITE $$EZBLD^DIALOG(34401)
- +20 if '$GET(XMWAIT)
- QUIT
- +21 WRITE !
- DO WAIT^XMXUTIL
- End DoDot:1
- +22 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
- +23 SET XMF("FDATE")=XMSAVE("FDATE")
- SET XMF("TDATE")=XMSAVE("TDATE")
- +24 QUIT
- INIT(XMDUZ,XMFLAGS,XMDETAIL,XMLEN) ;
- +1 IF XMFLAGS'["U"
- SET XMLEN("BSKT")=10
- +2 SET XMLEN("XMKZ")=3
- +3 DO INIT^XMJML(XMDUZ,"","",XMDETAIL,.XMLEN,XMFLAGS["U")
- +4 QUIT
- SRCHINIT(XMDUZ,XMF,XMFLAGS,XMSCREEN,XMFROM,XMABORT) ;
- +1 IF XMV("ORDER")=-1
- Begin DoDot:1
- +2 SET XMFLAGS="B"
- +3 SET XMFROM=$ORDER(^XMB(3.9,"C",XMSAVE("TDATE")))
- End DoDot:1
- +4 IF '$TEST
- Begin DoDot:1
- +5 SET XMFLAGS=""
- +6 SET XMFROM=$ORDER(^XMB(3.9,"C",XMSAVE("FDATE")),-1)
- End DoDot:1
- +7 SET XMFLAGS=$SELECT(XMV("ORDER")=-1:"B",1:"")
- +8 IF $GET(XMF("FLAGS"))["U"
- Begin DoDot:1
- +9 ; Ignore file screen
- SET XMFLAGS=XMFLAGS_"U"
- +10 DO AUDIT(.XMF)
- +11 if '$DATA(XMERR)
- QUIT
- +12 SET XMABORT=1
- +13 DO SHOW^XMJERR
- +14 DO WAIT^XMXUTIL
- End DoDot:1
- if XMABORT
- QUIT
- +15 if $DATA(XMF("SUBJ"))
- SET XMF("SUBJ","S")=$$UP^XLFSTR(XMF("SUBJ"))
- +16 if $DATA(XMF("TEXT"))
- SET XMF("TEXT","S")=$SELECT('XMF("TEXT","C"):$$UP^XLFSTR(XMF("TEXT")),1:XMF("TEXT"))
- +17 SET XMSCREEN=$$SCREEN(XMDUZ)
- +18 QUIT
- AUDIT(XMF) ; Send a bulletin to G.XM SUPER SEARCH
- +1 NEW XMINSTR,XMPARM,XMTEXT,I
- +2 IF '$$GOTLOCAL^XMXAPIG("XM SUPER SEARCH",90,2)
- DO ERRSET^XMXUTIL(34413.6)
- QUIT
- +3 SET XMINSTR("FROM")=.5
- +4 SET XMPARM(1)=XMV("DUZ NAME")
- +5 ; Search period
- SET I=1
- SET XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34443)_":",30)_$$FMTE^XLFDT(XMSAVE("FDATE"))_" - "_$$FMTE^XLFDT(XMSAVE("TDATE"))
- +6 ; Subject contains
- IF $DATA(XMF("SUBJ"))
- Begin DoDot:1
- +7 SET I=I+1
- SET XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34438)_":",30)_XMF("SUBJ")
- End DoDot:1
- +8 ; Message from
- IF $DATA(XMF("FROM"))
- Begin DoDot:1
- +9 SET I=I+1
- SET XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34440)_":",30)_$$NAME^XMXUTIL(XMF("FROM"))
- End DoDot:1
- +10 ; Message to
- IF $DATA(XMF("TO"))
- Begin DoDot:1
- +11 SET I=I+1
- SET XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34440.2)_":",30)_XMF("TO")
- End DoDot:1
- +12 ; Lines of text, minimum
- IF $DATA(XMF("FLINE"))
- Begin DoDot:1
- +13 SET I=I+1
- SET XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34449)_":",30)_XMF("FLINE")
- End DoDot:1
- +14 ;I $D(XMF("TLINE")) D ; Lines of text, maximum
- +15 ;. S I=I+1,XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34450)_":",30)_XMF("TLINE")
- +16 ; Response from
- IF $DATA(XMF("RFROM"))
- Begin DoDot:1
- +17 SET I=I+1
- SET XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34440.1)_":",30)_$$NAME^XMXUTIL(XMF("RFROM"))
- End DoDot:1
- +18 IF $DATA(XMF("TEXT"))
- Begin DoDot:1
- +19 ; x.1:Message / x.2:Message or Response / x.3:Response contains
- +20 SET I=I+1
- SET XMTEXT(I)=$$LJ^XLFSTR($$EZBLD^DIALOG(34446+(XMF("TEXT","L")/10))_":",30)_XMF("TEXT")
- End DoDot:1
- +21 DO SENDBULL^XMXBULL(DUZ,"XM SUPER SEARCH",.XMPARM,"XMTEXT","G.XM SUPER SEARCH",.XMINSTR)
- +22 IF $DATA(XMERR)
- DO ERRSET^XMXUTIL(34413.6)
- +23 QUIT
- SCREEN(XMDUZ) ;
- +1 SET XMSCREEN="N X S X=^(0)"
- +2 IF XMDUZ'=.5
- Begin DoDot:1
- +3 NEW XMMIN
- +4 SET XMMIN=$PIECE(^XMB(3.7,XMDUZ,0),U,7)
- +5 ; If minimum date, don't choose lower date unless already in user's bskt
- +6 IF XMMIN>0
- SET XMSCREEN=" I ^(.6)'<"_XMMIN_"!$D(^XMB(3.7,""M"",Y,XMDUZ))"
- End DoDot:1
- +7 ; Msg must not be SPOOL, msg must not be a reply.
- +8 QUIT XMSCREEN_" I $P(X,U,7)'=""S"",'$P(X,U,8),$P(X,U)'?1""R"".N,$$GOODMSG^XMJMFB(XMDUZ,0,Y,.XMF)"
- DISPLAY(XMDUZ,XMF,XMFLAGS,XMSCREEN,XMFROM,XMDETAIL,XMKZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
- +1 NEW XMREC
- +2 SET XMFIRST(XMPAGE)=XMKZ
- +3 ; All Messages Super Search / All Messages Search
- DO HEADER^XMJML(XMDETAIL,.XMLEN,$$EZBLD^DIALOG($SELECT(XMFLAGS["U":34403.5,1:34403)))
- +4 IF XMZOOM
- Begin DoDot:1
- +5 FOR
- SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
- if XMKZ=""
- QUIT
- Begin DoDot:2
- +6 SET XMREC=^TMP("XM",$JOB,"MSG",XMKZ)
- +7 DO LISTMSG^XMJML($PIECE(XMREC,U,1),$PIECE(XMREC,U,2),XMKZ,$PIECE(XMREC,U,3),XMDETAIL,.XMLEN)
- End DoDot:2
- if $Y>XMPMAX
- QUIT
- End DoDot:1
- QUIT
- +8 FOR
- SET XMKZ=$ORDER(^TMP("XM",$JOB,"MSG",XMKZ))
- if XMKZ=""
- QUIT
- Begin DoDot:1
- +9 SET XMREC=^TMP("XM",$JOB,"MSG",XMKZ)
- +10 DO LISTMSG^XMJML($PIECE(XMREC,U,1),$PIECE(XMREC,U,2),XMKZ,$PIECE(XMREC,U,3),XMDETAIL,.XMLEN)
- End DoDot:1
- if $Y>XMPMAX
- QUIT
- +11 if $Y>XMPMAX!'XMMORE
- QUIT
- +12 ; File screen ^DD(3.9,0,"SCR") insists that user be author or recipient.
- +13 ; If FLAGS["U", then file screen is ignored.
- +14 DO LIST^DIC(3.9,"","@",XMFLAGS,XMPMAX-$Y+1,.XMFROM,"","C",XMSCREEN)
- +15 if $PIECE(^TMP("DILIST",$JOB,0),U,3)=0
- SET XMMORE=0
- +16 DO LISTMSG(XMDUZ,XMDETAIL,.XMCNT,.XMLEN,.XMMORE)
- +17 SET XMKZ=XMCNT
- +18 KILL ^TMP("DILIST",$JOB)
- +19 ; Search finished.
- if 'XMMORE
- WRITE !,$$EZBLD^DIALOG(34402)
- +20 QUIT
- LISTMSG(XMDUZ,XMDETAIL,XMCNT,XMLEN,XMMORE) ; Check and List
- +1 NEW XMK,XMKN,XMZ,I,XMNA,XMSTOP,XMDATE
- +2 ; * N/A *
- SET I=""
- SET XMSTOP=0
- SET XMNA=$$EZBLD^DIALOG(34014)
- +3 IF XMFLAGS["U"
- SET XMK=0
- SET XMKN=XMNA
- +4 FOR
- SET I=$ORDER(^TMP("DILIST",$JOB,2,I),XMV("ORDER"))
- if I'>0
- QUIT
- Begin DoDot:1
- +5 SET XMCNT=XMCNT+1
- +6 SET XMZ=^TMP("DILIST",$JOB,2,I)
- +7 SET XMDATE=+$GET(^XMB(3.9,XMZ,.6))
- +8 IF XMDATE
- IF XMDATE<XMSAVE("FDATE")!(XMDATE>XMSAVE("TDATE"))
- Begin DoDot:2
- +9 SET XMMORE=0
- SET XMSTOP=1
- End DoDot:2
- QUIT
- +10 IF XMFLAGS'["U"
- Begin DoDot:2
- +11 SET XMK=+$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,0))
- +12 SET XMKN=$SELECT(XMK:$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U),1:XMNA)
- +13 IF XMK
- IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITM^XMUT4A(XMDUZ,XMK,XMZ)
- End DoDot:2
- +14 DO LISTMSG^XMJML(XMK,XMKN,XMCNT,XMZ,XMDETAIL,.XMLEN)
- +15 SET ^TMP("XM",$JOB,"MSG",XMCNT)=XMK_U_XMKN_U_XMZ
- End DoDot:1
- if XMSTOP
- QUIT
- +16 QUIT
- READMSG ; (XMDUZ,XMKZ,XMREC) <- needed!
- +1 ; $G(XMRDR) is checked in READMSG^XMJBM
- NEW XMK,XMKN,XMZ,XMRDR
- +2 IF XMFLAGS["U"
- Begin DoDot:1
- +3 ; * N/A *
- SET XMK="!"
- SET XMKN=$$EZBLD^DIALOG(34014)
- End DoDot:1
- +4 IF '$TEST
- Begin DoDot:1
- +5 SET XMK=$PIECE(XMREC,U,1)
- SET XMKN=$PIECE(XMREC,U,2)
- End DoDot:1
- +6 SET XMZ=$PIECE(XMREC,U,3)
- +7 DO READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
- +8 if XMFLAGS["U"
- QUIT
- +9 if $DATA(^XMB(3.7,"M",XMZ,XMDUZ,XMK))
- QUIT
- +10 SET XMK=+$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,0))
- +11 ; * N/A *
- SET ^TMP("XM",$JOB,"MSG",XMKZ)=XMK_U_$SELECT(XMK=0:$$EZBLD^DIALOG(34014),1:$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U))_U_XMZ
- +12 QUIT