- XMJMFB ;ISC-SF/GMB-Find message: multiple conditions ;07/12/2002 10:40
- ;;8.0;MailMan;;Jun 28, 2002
- ; Replaces ^XMAL0,^XMAL0A (ISC-WASH/JSH/CAP)
- ; XMF("BSKT") =number - Look in this basket ONLY
- ; =* - Look in all baskets
- ; XMF("SUBJ") Subject contains this string
- ; XMF("SUBJ","S") Look for this string in the subject
- ; XMF("FLINE") Message has this many or more lines
- ; XMF("TLINE") Message has this many or fewer lines
- ; XMF("FROM") Message is from this person
- ; XMF("TO") Message is to this person
- ; XMF("FDATE") Message was sent on or after this date
- ; XMF("TDATE") Message was sent on or before this date
- ; XMF("RFROM") Message has a response from this person
- ; XMF("TEXT") Message contains this string
- ; XMF("TEXT","S") Look for this string in the message
- ; XMF("TEXT","L") =1 - Look in message only
- ; =2 - Look in both message and responses
- ; =3 - Look in responses only
- ; XMF("TEXT","C") =0 - Search is not case-sensitive
- ; =1 - Search is case-sensitive
- FIND1(XMDUZ,XMF,XMWAIT) ;
- N XMK,XMKN,XMKZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMMORE,XMZOOM,XMCD,XMOPT,XMOX
- K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
- S XMKZ="",(XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0,(XMDETAIL,XMMORE)=1,XMPMAX=IOSL-3
- D INIT1(XMDUZ,.XMF,XMDETAIL,XMPMAX,.XMK,.XMKN,.XMLEN)
- D SETOPT^XMJMLR1(XMDUZ,$S(XMDUZ'=.5:0,XMK<1000:0,1:XMK),.XMOPT,.XMOX)
- F D Q:XMABORT
- . I XMCD S XMCD=0,XMDETAIL='XMDETAIL D INIT1(XMDUZ,.XMF,XMDETAIL,XMPMAX,.XMK,.XMKN,.XMLEN)
- . D DISPLAY1(XMDUZ,.XMF,XMDETAIL,.XMK,XMKN,.XMKZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
- . I XMCNT=0 S XMABORT=1 Q
- . D CHOOSE^XMJMLN(XMDUZ,0,XMK,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG^XMJMFB",.XMABORT)
- . S:'$D(^TMP("XM",$J,"MSG")) XMABORT=1
- I XMCNT=0 D
- . W $C(7),$$EZBLD^DIALOG(34401) ; No matches found.
- . Q:'$G(XMWAIT)
- . W ! D WAIT^XMXUTIL
- K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
- Q
- INIT1(XMDUZ,XMF,XMDETAIL,XMPMAX,XMK,XMKN,XMLEN) ;
- 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 XMK=XMF("BSKT")
- S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
- D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
- Q
- DISPLAY1(XMDUZ,XMF,XMDETAIL,XMK,XMKN,XMKZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
- N XMREC,XMZ
- S XMFIRST(XMPAGE)=XMKZ
- D HEADER^XMJML(XMDETAIL,.XMLEN,$$EZBLD^DIALOG(34404,XMKN)) ; XMKN_ Basket Search
- I XMZOOM D Q
- . F S XMKZ=$O(^TMP("XM",$J,".",XMKZ),XMV("ORDER")) 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),XMV("ORDER")) 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
- D CHKNLST1(XMDUZ,.XMF,XMDETAIL,XMK,XMKN,.XMKZ,.XMCNT,XMPMAX,.XMLEN)
- S:XMKZ'>0 XMMORE=0
- W:'XMMORE !,$$EZBLD^DIALOG(34402) ; Search finished.
- Q
- CHKNLST1(XMDUZ,XMF,XMDETAIL,XMK,XMKN,XMKZ,XMCNT,XMPMAX,XMLEN) ; Check and List
- N XMZ
- S:XMKZ="" XMKZ=$O(^TMP("XM",$J,"MSG",""),-XMV("ORDER"))
- F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")) Q:XMKZ'>0 D Q:$Y>XMPMAX
- . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,0))
- . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
- . Q:'$$GOODMSG(XMDUZ,XMK,XMZ,.XMF)
- . S XMCNT=XMCNT+1
- . D LISTMSG^XMJML(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- . S ^TMP("XM",$J,"MSG",XMKZ)=XMK_U_XMKN_U_XMZ
- Q
- FINDALL(XMDUZ,XMF) ;
- N XMK,XMKN,XMKZZ,XMKZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMMORE,XMZOOM,XMCD,XMOPT,XMOX
- S (XMKZ,XMKZZ)="",(XMK,XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0,(XMDETAIL,XMMORE)=1,XMPMAX=IOSL-3
- D INITA(XMDUZ,.XMF,.XMK,.XMKN,.XMKZZ,.XMLEN,.XMABORT) Q:XMABORT
- D SETOPT^XMJMLR1(XMDUZ,0,.XMOPT,.XMOX)
- K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
- F D Q:XMABORT
- . D DISPLAYA(XMDUZ,.XMF,.XMDETAIL,.XMK,XMKN,.XMKZZ,.XMKZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
- . D CHOOSE^XMJMLN(XMDUZ,1,0,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG^XMJMFB",.XMABORT)
- . S:'$D(^TMP("XM",$J,"MSG")) XMABORT=1
- K ^TMP("XM",$J,"MSG"),^TMP("XM",$J,".")
- Q
- INITA(XMDUZ,XMF,XMK,XMKN,XMKZZ,XMLEN,XMABORT) ;
- 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 XMLEN("XMKZ")=0
- F S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:XMK'>0 D Q:$D(XMKN)
- . F S XMKZZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZZ),XMV("ORDER")) Q:XMKZZ'>0 D Q:$D(XMKN)
- . . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZZ,0))
- . . Q:'$$GOODMSG(XMDUZ,XMK,XMZ,.XMF)
- . . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
- I $D(XMKN) S XMKZZ=XMKZZ-XMV("ORDER") Q
- S XMABORT=1
- W $C(7),$$EZBLD^DIALOG(34401),! ; No matches found.
- D WAIT^XMXUTIL
- Q
- DISPLAYA(XMDUZ,XMF,XMDETAIL,XMK,XMKN,XMKZZ,XMKZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
- N XMREC,XMZ
- S XMFIRST(XMPAGE)=XMKZ
- I XMCD D
- . S XMCD=0,XMDETAIL='XMDETAIL
- . D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN)
- E I $L(XMCNT+XMPMAX)>XMLEN("XMKZ") D
- . S XMLEN("XMKZ")=$L(XMCNT+XMPMAX)
- . D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN)
- D HEADER^XMJML(XMDETAIL,.XMLEN,$$EZBLD^DIALOG(34405)) ; All Baskets 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
- S XMK=XMK-.01
- F S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:XMK'>0 D Q:$Y>XMPMAX
- . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
- . D CHKNLSTA(XMDUZ,.XMF,XMDETAIL,XMK,XMKN,.XMKZZ,.XMCNT,XMPMAX,.XMLEN)
- I XMK'>0,XMKZZ'>0 S XMMORE=0
- S XMKZ=XMCNT
- W:'XMMORE !,$$EZBLD^DIALOG(34402) ; Search finished.
- Q
- CHKNLSTA(XMDUZ,XMF,XMDETAIL,XMK,XMKN,XMKZZ,XMCNT,XMPMAX,XMLEN) ; Check and List
- N XMZ
- F S XMKZZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZZ),XMV("ORDER")) Q:XMKZZ'>0 D Q:$Y>XMPMAX
- . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZZ,0))
- . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZZ)
- . Q:'$$GOODMSG(XMDUZ,XMK,XMZ,.XMF)
- . I $L(XMKN)>$G(XMLEN("BSKT")) D
- . . S XMLEN("BSKT")=$$MIN^XLFMTH($L(XMKN),10)
- . . D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN)
- . S XMCNT=XMCNT+1
- . D LISTMSG^XMJML(XMK,XMKN,XMCNT,XMZ,XMDETAIL,.XMLEN)
- . S ^TMP("XM",$J,"MSG",XMCNT)=XMK_U_XMKN_U_XMZ
- Q
- GOODMSG(XMDUZ,XMK,XMZ,XMF) ;
- N XMZREC,XMNOGOOD,XMZFROM,XMZDATE
- S XMZREC=$G(^XMB(3.9,XMZ,0))
- I XMZREC="",XMK D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q 0
- I $D(XMF("SUBJ")),$$UP^XLFSTR($P(XMZREC,U,1))'[XMF("SUBJ","S") Q 0
- I $D(XMF("FROM")) Q:'$$GOODFROM(XMZREC,XMF("FROM")) 0
- I $D(XMF("FLINE"))!$D(XMF("TLINE")) D Q:XMNOGOOD 0
- . N XMLINES
- . S XMNOGOOD=1
- . S XMLINES=$$LINE^XMXUTIL2(XMZ)
- . I $D(XMF("FLINE")),XMLINES<XMF("FLINE") Q
- . I $D(XMF("TLINE")),XMF("TLINE")<XMLINES Q
- . S XMNOGOOD=0
- I $D(XMF("FDATE"))!$D(XMF("TDATE")) D Q:XMNOGOOD 0
- . S XMNOGOOD=1
- . S XMZDATE=$P(XMZREC,U,3)
- . S:XMZDATE'=+XMZDATE XMZDATE=$$CONVERT^XMXUTIL1(XMZDATE)
- . S XMZDATE=$P(XMZDATE,".")
- . I $D(XMF("FDATE")),XMZDATE<XMF("FDATE") Q
- . I $D(XMF("TDATE")),XMF("TDATE")<XMZDATE Q
- . S XMNOGOOD=0
- I $D(XMF("TO")) D Q:XMNOGOOD 0
- . I $D(^XMB(3.9,XMZ,6,"B",XMF("TO"))) S XMNOGOOD=0 Q
- . I $L(XMF("TO"))>30,$D(^XMB(3.9,XMZ,6,"B",$E(XMF("TO"),1,30))),XMF("TO")=$P($G(^XMB(3.9,XMZ,6,+$O(^XMB(3.9,XMZ,6,"B",$E(XMF("TO"),1,30),0)),0)),U,1) S XMNOGOOD=0 Q
- . S XMNOGOOD=1
- . Q:XMF("TO")'["@"
- . N XMTOX,XMTO
- . S XMTO=""
- . F S XMTO=$O(^XMB(3.9,XMZ,6,"B",XMTO)) Q:XMTO="" D Q:'XMNOGOOD
- . . Q:XMTO'["@"
- . . S XMTOX=$$UP^XLFSTR(XMTO)
- . . Q:$P(XMTOX,"@")'[$P(XMF("TO"),"@")
- . . Q:$P(XMTOX,"@",2)'[$P(XMF("TO"),"@",2)
- . . S XMNOGOOD=0
- I $D(XMF("RFROM")) D Q:XMNOGOOD 0
- . N XMIEN,XMZR
- . S XMNOGOOD=1
- . S XMIEN=0
- . F S XMIEN=$O(^XMB(3.9,XMZ,3,XMIEN)) Q:'XMIEN S XMZR=^(XMIEN,0) I $$GOODFROM($G(^XMB(3.9,XMZR,0)),XMF("RFROM")) S XMNOGOOD=0 Q
- I $D(XMF("TEXT")) D Q:XMNOGOOD 0
- . S XMNOGOOD=1
- . I XMF("TEXT","L")<3 D Q:XMF("TEXT","L")=1!(XMNOGOOD=0)
- . . S:$$GOODTEXT(XMZ,XMF("TEXT","S"),XMF("TEXT","C")) XMNOGOOD=0
- . N XMIEN,XMZR
- . S XMIEN=0
- . F S XMIEN=$O(^XMB(3.9,XMZ,3,XMIEN)) Q:'XMIEN S XMZR=^(XMIEN,0) I $$GOODTEXT(XMZR,XMF("TEXT","S"),XMF("TEXT","C")) S XMNOGOOD=0 Q
- Q 1
- GOODFROM(XMZREC,XMF) ; Returns 1 if msg is from XMF; 0 if not
- N XMZFROM
- S XMZFROM=$P(XMZREC,U,2)
- I XMF=+XMF,XMF=XMZFROM Q 1
- Q:XMF'["@" 0
- S XMZFROM=$$UP^XLFSTR(XMZFROM)
- Q:$P(XMZFROM,"@")'[$P(XMF,"@") 0
- Q:$P(XMZFROM,"@",2)'[$P(XMF,"@",2) 0
- Q 1
- GOODTEXT(XMZ,XMF,XMFMATTR) ; Returns positive number if msg contains XMF; 0 if not
- N I
- S I=.999999
- I XMFMATTR D
- . F S I=$O(^XMB(3.9,XMZ,2,I)) Q:'I Q:^(I,0)[XMF
- E D
- . F S I=$O(^XMB(3.9,XMZ,2,I)) Q:'I Q:$$UP^XLFSTR(^(I,0))[XMF
- Q +I
- 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)
- D READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
- Q:$D(^XMB(3.7,"M",XMZ,XMDUZ,XMK))
- I XMF("BSKT")=XMK K ^TMP("XM",$J,"MSG",XMKZ) Q
- 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[HXMJMFB 9651 printed Jan 18, 2025@03:13:02 Page 2
- XMJMFB ;ISC-SF/GMB-Find message: multiple conditions ;07/12/2002 10:40
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ; Replaces ^XMAL0,^XMAL0A (ISC-WASH/JSH/CAP)
- +3 ; XMF("BSKT") =number - Look in this basket ONLY
- +4 ; =* - Look in all baskets
- +5 ; XMF("SUBJ") Subject contains this string
- +6 ; XMF("SUBJ","S") Look for this string in the subject
- +7 ; XMF("FLINE") Message has this many or more lines
- +8 ; XMF("TLINE") Message has this many or fewer lines
- +9 ; XMF("FROM") Message is from this person
- +10 ; XMF("TO") Message is to this person
- +11 ; XMF("FDATE") Message was sent on or after this date
- +12 ; XMF("TDATE") Message was sent on or before this date
- +13 ; XMF("RFROM") Message has a response from this person
- +14 ; XMF("TEXT") Message contains this string
- +15 ; XMF("TEXT","S") Look for this string in the message
- +16 ; XMF("TEXT","L") =1 - Look in message only
- +17 ; =2 - Look in both message and responses
- +18 ; =3 - Look in responses only
- +19 ; XMF("TEXT","C") =0 - Search is not case-sensitive
- +20 ; =1 - Search is case-sensitive
- FIND1(XMDUZ,XMF,XMWAIT) ;
- +1 NEW XMK,XMKN,XMKZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMMORE,XMZOOM,XMCD,XMOPT,XMOX
- +2 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
- +3 SET XMKZ=""
- SET (XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0
- SET (XMDETAIL,XMMORE)=1
- SET XMPMAX=IOSL-3
- +4 DO INIT1(XMDUZ,.XMF,XMDETAIL,XMPMAX,.XMK,.XMKN,.XMLEN)
- +5 DO SETOPT^XMJMLR1(XMDUZ,$SELECT(XMDUZ'=.5:0,XMK<1000:0,1:XMK),.XMOPT,.XMOX)
- +6 FOR
- Begin DoDot:1
- +7 IF XMCD
- SET XMCD=0
- SET XMDETAIL='XMDETAIL
- DO INIT1(XMDUZ,.XMF,XMDETAIL,XMPMAX,.XMK,.XMKN,.XMLEN)
- +8 DO DISPLAY1(XMDUZ,.XMF,XMDETAIL,.XMK,XMKN,.XMKZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
- +9 IF XMCNT=0
- SET XMABORT=1
- QUIT
- +10 DO CHOOSE^XMJMLN(XMDUZ,0,XMK,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG^XMJMFB",.XMABORT)
- +11 if '$DATA(^TMP("XM",$JOB,"MSG"))
- SET XMABORT=1
- End DoDot:1
- if XMABORT
- QUIT
- +12 IF XMCNT=0
- Begin DoDot:1
- +13 ; No matches found.
- WRITE $CHAR(7),$$EZBLD^DIALOG(34401)
- +14 if '$GET(XMWAIT)
- QUIT
- +15 WRITE !
- DO WAIT^XMXUTIL
- End DoDot:1
- +16 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
- +17 QUIT
- INIT1(XMDUZ,XMF,XMDETAIL,XMPMAX,XMK,XMKN,XMLEN) ;
- +1 if $DATA(XMF("SUBJ"))
- SET XMF("SUBJ","S")=$$UP^XLFSTR(XMF("SUBJ"))
- +2 if $DATA(XMF("TEXT"))
- SET XMF("TEXT","S")=$SELECT('XMF("TEXT","C"):$$UP^XLFSTR(XMF("TEXT")),1:XMF("TEXT"))
- +3 SET XMK=XMF("BSKT")
- +4 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U)
- +5 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
- +6 QUIT
- DISPLAY1(XMDUZ,XMF,XMDETAIL,XMK,XMKN,XMKZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
- +1 NEW XMREC,XMZ
- +2 SET XMFIRST(XMPAGE)=XMKZ
- +3 ; XMKN_ Basket Search
- DO HEADER^XMJML(XMDETAIL,.XMLEN,$$EZBLD^DIALOG(34404,XMKN))
- +4 IF XMZOOM
- Begin DoDot:1
- +5 FOR
- SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ),XMV("ORDER"))
- 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),XMV("ORDER"))
- 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 DO CHKNLST1(XMDUZ,.XMF,XMDETAIL,XMK,XMKN,.XMKZ,.XMCNT,XMPMAX,.XMLEN)
- +13 if XMKZ'>0
- SET XMMORE=0
- +14 ; Search finished.
- if 'XMMORE
- WRITE !,$$EZBLD^DIALOG(34402)
- +15 QUIT
- CHKNLST1(XMDUZ,XMF,XMDETAIL,XMK,XMKN,XMKZ,XMCNT,XMPMAX,XMLEN) ; Check and List
- +1 NEW XMZ
- +2 if XMKZ=""
- SET XMKZ=$ORDER(^TMP("XM",$JOB,"MSG",""),-XMV("ORDER"))
- +3 FOR
- SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER"))
- if XMKZ'>0
- QUIT
- Begin DoDot:1
- +4 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,0))
- +5 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
- +6 if '$$GOODMSG(XMDUZ,XMK,XMZ,.XMF)
- QUIT
- +7 SET XMCNT=XMCNT+1
- +8 DO LISTMSG^XMJML(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- +9 SET ^TMP("XM",$JOB,"MSG",XMKZ)=XMK_U_XMKN_U_XMZ
- End DoDot:1
- if $Y>XMPMAX
- QUIT
- +10 QUIT
- FINDALL(XMDUZ,XMF) ;
- +1 NEW XMK,XMKN,XMKZZ,XMKZ,XMCNT,XMABORT,XMLEN,XMFIRST,XMPAGE,XMDETAIL,XMPMAX,XMMORE,XMZOOM,XMCD,XMOPT,XMOX
- +2 SET (XMKZ,XMKZZ)=""
- SET (XMK,XMPAGE,XMCNT,XMZOOM,XMCD,XMABORT)=0
- SET (XMDETAIL,XMMORE)=1
- SET XMPMAX=IOSL-3
- +3 DO INITA(XMDUZ,.XMF,.XMK,.XMKN,.XMKZZ,.XMLEN,.XMABORT)
- if XMABORT
- QUIT
- +4 DO SETOPT^XMJMLR1(XMDUZ,0,.XMOPT,.XMOX)
- +5 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
- +6 FOR
- Begin DoDot:1
- +7 DO DISPLAYA(XMDUZ,.XMF,.XMDETAIL,.XMK,XMKN,.XMKZZ,.XMKZ,.XMCNT,.XMFIRST,.XMPAGE,.XMMORE,.XMLEN,XMZOOM,XMPMAX)
- +8 DO CHOOSE^XMJMLN(XMDUZ,1,0,.XMKZ,.XMFIRST,.XMPAGE,XMMORE,.XMLEN,.XMZOOM,.XMOPT,.XMOX,"READMSG^XMJMFB",.XMABORT)
- +9 if '$DATA(^TMP("XM",$JOB,"MSG"))
- SET XMABORT=1
- End DoDot:1
- if XMABORT
- QUIT
- +10 KILL ^TMP("XM",$JOB,"MSG"),^TMP("XM",$JOB,".")
- +11 QUIT
- INITA(XMDUZ,XMF,XMK,XMKN,XMKZZ,XMLEN,XMABORT) ;
- +1 if $DATA(XMF("SUBJ"))
- SET XMF("SUBJ","S")=$$UP^XLFSTR(XMF("SUBJ"))
- +2 if $DATA(XMF("TEXT"))
- SET XMF("TEXT","S")=$SELECT('XMF("TEXT","C"):$$UP^XLFSTR(XMF("TEXT")),1:XMF("TEXT"))
- +3 SET XMLEN("XMKZ")=0
- +4 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- if XMK'>0
- QUIT
- Begin DoDot:1
- +5 FOR
- SET XMKZZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZZ),XMV("ORDER"))
- if XMKZZ'>0
- QUIT
- Begin DoDot:2
- +6 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZZ,0))
- +7 if '$$GOODMSG(XMDUZ,XMK,XMZ,.XMF)
- QUIT
- +8 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U)
- End DoDot:2
- if $DATA(XMKN)
- QUIT
- End DoDot:1
- if $DATA(XMKN)
- QUIT
- +9 IF $DATA(XMKN)
- SET XMKZZ=XMKZZ-XMV("ORDER")
- QUIT
- +10 SET XMABORT=1
- +11 ; No matches found.
- WRITE $CHAR(7),$$EZBLD^DIALOG(34401),!
- +12 DO WAIT^XMXUTIL
- +13 QUIT
- DISPLAYA(XMDUZ,XMF,XMDETAIL,XMK,XMKN,XMKZZ,XMKZ,XMCNT,XMFIRST,XMPAGE,XMMORE,XMLEN,XMZOOM,XMPMAX) ;
- +1 NEW XMREC,XMZ
- +2 SET XMFIRST(XMPAGE)=XMKZ
- +3 IF XMCD
- Begin DoDot:1
- +4 SET XMCD=0
- SET XMDETAIL='XMDETAIL
- +5 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN)
- End DoDot:1
- +6 IF '$TEST
- IF $LENGTH(XMCNT+XMPMAX)>XMLEN("XMKZ")
- Begin DoDot:1
- +7 SET XMLEN("XMKZ")=$LENGTH(XMCNT+XMPMAX)
- +8 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN)
- End DoDot:1
- +9 ; All Baskets Search
- DO HEADER^XMJML(XMDETAIL,.XMLEN,$$EZBLD^DIALOG(34405))
- +10 IF XMZOOM
- Begin DoDot:1
- +11 FOR
- SET XMKZ=$ORDER(^TMP("XM",$JOB,".",XMKZ))
- if XMKZ=""
- QUIT
- Begin DoDot:2
- +12 SET XMREC=^TMP("XM",$JOB,"MSG",XMKZ)
- +13 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
- +14 FOR
- SET XMKZ=$ORDER(^TMP("XM",$JOB,"MSG",XMKZ))
- if XMKZ=""
- QUIT
- Begin DoDot:1
- +15 SET XMREC=^TMP("XM",$JOB,"MSG",XMKZ)
- +16 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
- +17 if $Y>XMPMAX!'XMMORE
- QUIT
- +18 SET XMK=XMK-.01
- +19 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- if XMK'>0
- QUIT
- Begin DoDot:1
- +20 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U)
- +21 DO CHKNLSTA(XMDUZ,.XMF,XMDETAIL,XMK,XMKN,.XMKZZ,.XMCNT,XMPMAX,.XMLEN)
- End DoDot:1
- if $Y>XMPMAX
- QUIT
- +22 IF XMK'>0
- IF XMKZZ'>0
- SET XMMORE=0
- +23 SET XMKZ=XMCNT
- +24 ; Search finished.
- if 'XMMORE
- WRITE !,$$EZBLD^DIALOG(34402)
- +25 QUIT
- CHKNLSTA(XMDUZ,XMF,XMDETAIL,XMK,XMKN,XMKZZ,XMCNT,XMPMAX,XMLEN) ; Check and List
- +1 NEW XMZ
- +2 FOR
- SET XMKZZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZZ),XMV("ORDER"))
- if XMKZZ'>0
- QUIT
- Begin DoDot:1
- +3 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZZ,0))
- +4 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZZ)
- +5 if '$$GOODMSG(XMDUZ,XMK,XMZ,.XMF)
- QUIT
- +6 IF $LENGTH(XMKN)>$GET(XMLEN("BSKT"))
- Begin DoDot:2
- +7 SET XMLEN("BSKT")=$$MIN^XLFMTH($LENGTH(XMKN),10)
- +8 DO INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN)
- End DoDot:2
- +9 SET XMCNT=XMCNT+1
- +10 DO LISTMSG^XMJML(XMK,XMKN,XMCNT,XMZ,XMDETAIL,.XMLEN)
- +11 SET ^TMP("XM",$JOB,"MSG",XMCNT)=XMK_U_XMKN_U_XMZ
- End DoDot:1
- if $Y>XMPMAX
- QUIT
- +12 QUIT
- GOODMSG(XMDUZ,XMK,XMZ,XMF) ;
- +1 NEW XMZREC,XMNOGOOD,XMZFROM,XMZDATE
- +2 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +3 IF XMZREC=""
- IF XMK
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT 0
- +4 IF $DATA(XMF("SUBJ"))
- IF $$UP^XLFSTR($PIECE(XMZREC,U,1))'[XMF("SUBJ","S")
- QUIT 0
- +5 IF $DATA(XMF("FROM"))
- if '$$GOODFROM(XMZREC,XMF("FROM"))
- QUIT 0
- +6 IF $DATA(XMF("FLINE"))!$DATA(XMF("TLINE"))
- Begin DoDot:1
- +7 NEW XMLINES
- +8 SET XMNOGOOD=1
- +9 SET XMLINES=$$LINE^XMXUTIL2(XMZ)
- +10 IF $DATA(XMF("FLINE"))
- IF XMLINES<XMF("FLINE")
- QUIT
- +11 IF $DATA(XMF("TLINE"))
- IF XMF("TLINE")<XMLINES
- QUIT
- +12 SET XMNOGOOD=0
- End DoDot:1
- if XMNOGOOD
- QUIT 0
- +13 IF $DATA(XMF("FDATE"))!$DATA(XMF("TDATE"))
- Begin DoDot:1
- +14 SET XMNOGOOD=1
- +15 SET XMZDATE=$PIECE(XMZREC,U,3)
- +16 if XMZDATE'=+XMZDATE
- SET XMZDATE=$$CONVERT^XMXUTIL1(XMZDATE)
- +17 SET XMZDATE=$PIECE(XMZDATE,".")
- +18 IF $DATA(XMF("FDATE"))
- IF XMZDATE<XMF("FDATE")
- QUIT
- +19 IF $DATA(XMF("TDATE"))
- IF XMF("TDATE")<XMZDATE
- QUIT
- +20 SET XMNOGOOD=0
- End DoDot:1
- if XMNOGOOD
- QUIT 0
- +21 IF $DATA(XMF("TO"))
- Begin DoDot:1
- +22 IF $DATA(^XMB(3.9,XMZ,6,"B",XMF("TO")))
- SET XMNOGOOD=0
- QUIT
- +23 IF $LENGTH(XMF("TO"))>30
- IF $DATA(^XMB(3.9,XMZ,6,"B",$EXTRACT(XMF("TO"),1,30)))
- IF XMF("TO")=$PIECE($GET(^XMB(3.9,XMZ,6,+$ORDER(^XMB(3.9,XMZ,6,"B",$EXTRACT(XMF("TO"),1,30),0)),0)),U,1)
- SET XMNOGOOD=0
- QUIT
- +24 SET XMNOGOOD=1
- +25 if XMF("TO")'["@"
- QUIT
- +26 NEW XMTOX,XMTO
- +27 SET XMTO=""
- +28 FOR
- SET XMTO=$ORDER(^XMB(3.9,XMZ,6,"B",XMTO))
- if XMTO=""
- QUIT
- Begin DoDot:2
- +29 if XMTO'["@"
- QUIT
- +30 SET XMTOX=$$UP^XLFSTR(XMTO)
- +31 if $PIECE(XMTOX,"@")'[$PIECE(XMF("TO"),"@")
- QUIT
- +32 if $PIECE(XMTOX,"@",2)'[$PIECE(XMF("TO"),"@",2)
- QUIT
- +33 SET XMNOGOOD=0
- End DoDot:2
- if 'XMNOGOOD
- QUIT
- End DoDot:1
- if XMNOGOOD
- QUIT 0
- +34 IF $DATA(XMF("RFROM"))
- Begin DoDot:1
- +35 NEW XMIEN,XMZR
- +36 SET XMNOGOOD=1
- +37 SET XMIEN=0
- +38 FOR
- SET XMIEN=$ORDER(^XMB(3.9,XMZ,3,XMIEN))
- if 'XMIEN
- QUIT
- SET XMZR=^(XMIEN,0)
- IF $$GOODFROM($GET(^XMB(3.9,XMZR,0)),XMF("RFROM"))
- SET XMNOGOOD=0
- QUIT
- End DoDot:1
- if XMNOGOOD
- QUIT 0
- +39 IF $DATA(XMF("TEXT"))
- Begin DoDot:1
- +40 SET XMNOGOOD=1
- +41 IF XMF("TEXT","L")<3
- Begin DoDot:2
- +42 if $$GOODTEXT(XMZ,XMF("TEXT","S"),XMF("TEXT","C"))
- SET XMNOGOOD=0
- End DoDot:2
- if XMF("TEXT","L")=1!(XMNOGOOD=0)
- QUIT
- +43 NEW XMIEN,XMZR
- +44 SET XMIEN=0
- +45 FOR
- SET XMIEN=$ORDER(^XMB(3.9,XMZ,3,XMIEN))
- if 'XMIEN
- QUIT
- SET XMZR=^(XMIEN,0)
- IF $$GOODTEXT(XMZR,XMF("TEXT","S"),XMF("TEXT","C"))
- SET XMNOGOOD=0
- QUIT
- End DoDot:1
- if XMNOGOOD
- QUIT 0
- +46 QUIT 1
- GOODFROM(XMZREC,XMF) ; Returns 1 if msg is from XMF; 0 if not
- +1 NEW XMZFROM
- +2 SET XMZFROM=$PIECE(XMZREC,U,2)
- +3 IF XMF=+XMF
- IF XMF=XMZFROM
- QUIT 1
- +4 if XMF'["@"
- QUIT 0
- +5 SET XMZFROM=$$UP^XLFSTR(XMZFROM)
- +6 if $PIECE(XMZFROM,"@")'[$PIECE(XMF,"@")
- QUIT 0
- +7 if $PIECE(XMZFROM,"@",2)'[$PIECE(XMF,"@",2)
- QUIT 0
- +8 QUIT 1
- GOODTEXT(XMZ,XMF,XMFMATTR) ; Returns positive number if msg contains XMF; 0 if not
- +1 NEW I
- +2 SET I=.999999
- +3 IF XMFMATTR
- Begin DoDot:1
- +4 FOR
- SET I=$ORDER(^XMB(3.9,XMZ,2,I))
- if 'I
- QUIT
- if ^(I,0)[XMF
- QUIT
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 FOR
- SET I=$ORDER(^XMB(3.9,XMZ,2,I))
- if 'I
- QUIT
- if $$UP^XLFSTR(^(I,0))[XMF
- QUIT
- End DoDot:1
- +7 QUIT +I
- 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 DO READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
- +4 if $DATA(^XMB(3.7,"M",XMZ,XMDUZ,XMK))
- QUIT
- +5 IF XMF("BSKT")=XMK
- KILL ^TMP("XM",$JOB,"MSG",XMKZ)
- QUIT
- +6 SET XMK=+$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,0))
- +7 ; * 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
- +8 QUIT