XMJMFA ;ISC-SF/GMB-Find message: Subject starts with ;04/18/2002 07:47
;;8.0;MailMan;;Jun 28, 2002
; Search for message subjects that partial match input.
; Replaces ^XMA03 (ISC-WASH/CAP/THM)
FIND(XMDUZ,XMSTRING,XMWAIT) ;
N XMKZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMMORE,XMFLAGS,XMSCREEN,XMFROM,XMZOOM,XMCD,XMOPT,XMOX
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,.XMFLAGS,.XMSCREEN)
D INIT(XMDUZ,XMDETAIL,.XMLEN)
D SETOPT^XMJMLR1(XMDUZ,0,.XMOPT,.XMOX)
F D Q:XMABORT
. I XMCD S XMCD=0,XMDETAIL='XMDETAIL D INIT(XMDUZ,XMDETAIL,.XMLEN)
. D DISPLAY(XMDUZ,XMSTRING,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^XMJMFA",.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,".")
Q
SRCHINIT(XMDUZ,XMFLAGS,XMSCREEN) ;
S XMSCREEN="",XMFLAGS=$S(XMV("ORDER")=-1:"B",1:"")
I XMDUZ=.5 S XMFLAGS=XMFLAGS_"U" Q ; Ignore file screen
S XMSCREEN=XMSCREEN_"N X S X=^(0)"
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.
S XMSCREEN=XMSCREEN_" I $P(X,U,7)'=""S"",$S($P(X,U,8):0,$P(X,U)?1""R"".N:0,1:1)"
Q
INIT(XMDUZ,XMDETAIL,XMLEN) ;
S XMLEN("BSKT")=10
S XMLEN("XMKZ")=3
D INIT^XMJML(XMDUZ,"","",XMDETAIL,.XMLEN)
Q
DISPLAY(XMDUZ,XMSTRING,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(34403)) ; 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,XMSTRING,"",XMSCREEN)
S:$P(^TMP("DILIST",$J,0),U,3)=0 XMMORE=0
D LISTMSG(XMDUZ,XMDETAIL,.XMCNT,.XMLEN)
S XMKZ=XMCNT
K ^TMP("DILIST",$J)
W:'XMMORE !,$$EZBLD^DIALOG(34402) ; Search finished.
Q
LISTMSG(XMDUZ,XMDETAIL,XMCNT,XMLEN) ; Check and List
N XMK,XMKN,XMZ,I
S I=""
F S I=$O(^TMP("DILIST",$J,2,I),XMV("ORDER")) Q:I'>0 D
. S XMCNT=XMCNT+1
. S XMZ=^TMP("DILIST",$J,2,I)
. S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,0))
. S XMKN=$S(XMK:$P(^XMB(3.7,XMDUZ,2,XMK,0),U),1:$$EZBLD^DIALOG(34014)) ; * N/A *
. 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
S XMK=$P(XMREC,U,1),XMKN=$P(XMREC,U,2),XMZ=$P(XMREC,U,3)
I XMDUZ=.5,'XMK,'$$ACCESS^XMXSEC(XMDUZ,XMZ,$G(^XMB(3.9,XMZ,0))) D Q
. D SHOW^XMJERR
. D WAIT^XMXUTIL
D READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
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[HXMJMFA 3791 printed Apr 09, 2024@21:13:23 Page 2
XMJMFA ;ISC-SF/GMB-Find message: Subject starts with ;04/18/2002 07:47
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Search for message subjects that partial match input.
+3 ; Replaces ^XMA03 (ISC-WASH/CAP/THM)
FIND(XMDUZ,XMSTRING,XMWAIT) ;
+1 NEW XMKZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMMORE,XMFLAGS,XMSCREEN,XMFROM,XMZOOM,XMCD,XMOPT,XMOX
+2 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
+3 SET (XMKZ,XMZ,XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0
SET (XMDETAIL,XMMORE)=1
SET XMPMAX=IOSL-3
+4 DO SRCHINIT(XMDUZ,.XMFLAGS,.XMSCREEN)
+5 DO INIT(XMDUZ,XMDETAIL,.XMLEN)
+6 DO SETOPT^XMJMLR1(XMDUZ,0,.XMOPT,.XMOX)
+7 FOR
Begin DoDot:1
+8 IF XMCD
SET XMCD=0
SET XMDETAIL='XMDETAIL
DO INIT(XMDUZ,XMDETAIL,.XMLEN)
+9 DO DISPLAY(XMDUZ,XMSTRING,XMFLAGS,XMSCREEN,.XMFROM,XMDETAIL,.XMKZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
+10 IF XMCNT=0
SET XMABORT=1
QUIT
+11 DO CHOOSE^XMJMLN(XMDUZ,1,0,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG^XMJMFA",.XMABORT)
+12 if '$DATA(^TMP("XM",$JOB,"MSG"))
SET XMABORT=1
End DoDot:1
if XMABORT
QUIT
+13 IF XMCNT=0
Begin DoDot:1
+14 ; No matches found.
WRITE $$EZBLD^DIALOG(34401)
+15 if '$GET(XMWAIT)
QUIT
+16 WRITE !
DO WAIT^XMXUTIL
End DoDot:1
+17 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
+18 QUIT
SRCHINIT(XMDUZ,XMFLAGS,XMSCREEN) ;
+1 SET XMSCREEN=""
SET XMFLAGS=$SELECT(XMV("ORDER")=-1:"B",1:"")
+2 ; Ignore file screen
IF XMDUZ=.5
SET XMFLAGS=XMFLAGS_"U"
QUIT
+3 SET XMSCREEN=XMSCREEN_"N X S X=^(0)"
+4 NEW XMMIN
+5 SET XMMIN=$PIECE(^XMB(3.7,XMDUZ,0),U,7)
+6 ; If minimum date, don't choose lower date unless already in user's bskt
+7 IF XMMIN>0
SET XMSCREEN=" I ^(.6)'<"_XMMIN_"!$D(^XMB(3.7,""M"",Y,XMDUZ))"
+8 ; Msg must not be SPOOL, msg must not be a reply.
+9 SET XMSCREEN=XMSCREEN_" I $P(X,U,7)'=""S"",$S($P(X,U,8):0,$P(X,U)?1""R"".N:0,1:1)"
+10 QUIT
INIT(XMDUZ,XMDETAIL,XMLEN) ;
+1 SET XMLEN("BSKT")=10
+2 SET XMLEN("XMKZ")=3
+3 DO INIT^XMJML(XMDUZ,"","",XMDETAIL,.XMLEN)
+4 QUIT
DISPLAY(XMDUZ,XMSTRING,XMFLAGS,XMSCREEN,XMFROM,XMDETAIL,XMKZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
+1 NEW XMREC
+2 SET XMFIRST(XMPAGE)=XMKZ
+3 ; All Messages Search
DO HEADER^XMJML(XMDETAIL,.XMLEN,$$EZBLD^DIALOG(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,XMSTRING,"",XMSCREEN)
+15 if $PIECE(^TMP("DILIST",$JOB,0),U,3)=0
SET XMMORE=0
+16 DO LISTMSG(XMDUZ,XMDETAIL,.XMCNT,.XMLEN)
+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) ; Check and List
+1 NEW XMK,XMKN,XMZ,I
+2 SET I=""
+3 FOR
SET I=$ORDER(^TMP("DILIST",$JOB,2,I),XMV("ORDER"))
if I'>0
QUIT
Begin DoDot:1
+4 SET XMCNT=XMCNT+1
+5 SET XMZ=^TMP("DILIST",$JOB,2,I)
+6 SET XMK=+$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,0))
+7 ; * N/A *
SET XMKN=$SELECT(XMK:$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U),1:$$EZBLD^DIALOG(34014))
+8 IF XMK
IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
DO ADDITM^XMUT4A(XMDUZ,XMK,XMZ)
+9 DO LISTMSG^XMJML(XMK,XMKN,XMCNT,XMZ,XMDETAIL,.XMLEN)
+10 SET ^TMP("XM",$JOB,"MSG",XMCNT)=XMK_U_XMKN_U_XMZ
End DoDot:1
+11 QUIT
READMSG ; (XMDUZ,XMKZ,XMREC) <- needed!
+1 ; $G(XMRDR) is checked in READMSG^XMJBM
NEW XMK,XMKN,XMZ,XMRDR
+2 SET XMK=$PIECE(XMREC,U,1)
SET XMKN=$PIECE(XMREC,U,2)
SET XMZ=$PIECE(XMREC,U,3)
+3 IF XMDUZ=.5
IF 'XMK
IF '$$ACCESS^XMXSEC(XMDUZ,XMZ,$GET(^XMB(3.9,XMZ,0)))
Begin DoDot:1
+4 DO SHOW^XMJERR
+5 DO WAIT^XMXUTIL
End DoDot:1
QUIT
+6 DO READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
+7 if $DATA(^XMB(3.7,"M",XMZ,XMDUZ,XMK))
QUIT
+8 SET XMK=+$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,0))
+9 ; * 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
+10 QUIT
