- XMXLIST1 ;ISC-SF/GMB-List message: multiple conditions (cont.) ;08/30/2000 15:29
- ;;8.0;MailMan;;Jun 28, 2002
- ; Look in all of the user's baskets.
- NEWA(XMDUZ,XMTYPE,XMORDER,XMFLDS,XMAMT,XMSTART,XMF,XMTROOT) ; New messages in all baskets
- N XMCNT,XMK,XMKN,XMZ
- S XMCNT=0
- S XMK=+$G(XMSTART("XMK")) I XMK S XMK=XMK-.01
- S XMZ=$G(XMSTART("XMZ"))
- F S XMK=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK)) Q:'XMK D Q:XMCNT=XMAMT
- . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- . F S XMZ=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMORDER) Q:'XMZ D Q:XMCNT=XMAMT
- . . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- . . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . . I $D(XMF) Q:'$$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- . . S XMCNT=XMCNT+1
- . . S @(XMTROOT_XMCNT_")")=XMZ
- . . Q:'$D(XMFLDS)
- . . D FIELDS(XMDUZ,XMK,XMKN,XMZ,.XMFLDS,XMTROOT,XMCNT)
- . . I XMFLDS["SEQN" D KSEQN(XMDUZ,XMK,XMZ,.XMFLDS,XMTROOT,XMCNT)
- S XMSTART("XMK")=XMK
- S XMSTART("XMZ")=XMZ
- S @(XMTROOT_"0)")=XMCNT_U_XMAMT
- ; Any more?
- I 'XMK S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0" Q
- I '$O(^XMB(3.7,XMDUZ,XMTYPE,XMK)),'$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMORDER) S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0" Q
- I '$D(XMF) S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^1" Q
- N XMORE
- S XMORE=0,XMK=XMK-.01
- F S XMK=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK)) Q:'XMK D Q:XMORE
- . F S XMZ=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMORDER) Q:'XMZ D Q:XMORE
- . . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- . . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . . I $$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF) S XMORE=1
- S @(XMTROOT_"0)")=@(XMTROOT_"0)")_U_XMORE
- Q
- REGAC(XMDUZ,XMORDER,XMFLDS,XMAMT,XMSTART,XMF,XMTROOT) ; Messages (by C-xref) in all baskets
- N XMCNT,XMK,XMKN,XMKZ,XMZ
- S XMCNT=0
- S XMK=+$G(XMSTART("XMK")) I XMK S XMK=XMK-.01
- S XMKZ=$G(XMSTART("XMKZ"))
- F S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:'XMK D Q:XMCNT=XMAMT
- . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMORDER) Q:'XMKZ S XMZ=$O(^(XMKZ,"")) D Q:XMCNT=XMAMT
- . . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
- . . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . . I $D(XMF) Q:'$$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- . . S XMCNT=XMCNT+1
- . . S @(XMTROOT_XMCNT_")")=XMZ
- . . Q:'$D(XMFLDS)
- . . D FIELDS(XMDUZ,XMK,XMKN,XMZ,.XMFLDS,XMTROOT,XMCNT)
- . . I XMFLDS["SEQN" D SEQN(XMDUZ,XMKZ,.XMFLDS,XMTROOT,XMCNT)
- S XMSTART("XMK")=XMK
- S XMSTART("XMKZ")=XMKZ
- S @(XMTROOT_"0)")=XMCNT_U_XMAMT
- ; Any more?
- I 'XMK S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0" Q
- I '$O(^XMB(3.7,XMDUZ,2,XMK)),'$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMORDER) S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0" Q
- I '$D(XMF) S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^1" Q
- N XMORE
- S XMORE=0,XMK=XMK-.01
- F S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:'XMK D Q:XMORE
- . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMORDER) Q:'XMKZ S XMZ=$O(^(XMKZ,"")) D Q:XMORE
- . . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
- . . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . . I $$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF) S XMORE=1
- S @(XMTROOT_"0)")=@(XMTROOT_"0)")_U_XMORE
- Q
- REGAZ(XMDUZ,XMORDER,XMFLDS,XMAMT,XMSTART,XMF,XMTROOT) ; Messages (by IEN) in all baskets
- N XMCNT,XMK,XMKN,XMZ
- S XMCNT=0
- S XMK=+$G(XMSTART("XMK")) I XMK S XMK=XMK-.01
- S XMZ=$G(XMSTART("XMZ"))
- F S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:'XMK D Q:XMCNT=XMAMT
- . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- . I +XMZ=0 S XMZ=0 I XMORDER=-1 S XMZ=":"
- . F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,XMZ),XMORDER) Q:'XMZ D Q:XMCNT=XMAMT
- . . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . . I $D(XMF) Q:'$$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- . . S XMCNT=XMCNT+1
- . . S @(XMTROOT_XMCNT_")")=XMZ
- . . Q:'$D(XMFLDS)
- . . D FIELDS(XMDUZ,XMK,XMKN,XMZ,.XMFLDS,XMTROOT,XMCNT)
- . . I XMFLDS["SEQN" D KSEQN(XMDUZ,XMK,XMZ,.XMFLDS,XMTROOT,XMCNT)
- S XMSTART("XMK")=XMK
- S XMSTART("XMZ")=XMZ
- S @(XMTROOT_"0)")=XMCNT_U_XMAMT
- ; Any more?
- I 'XMK S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0" Q
- I '$O(^XMB(3.7,XMDUZ,2,XMK)),'$O(^XMB(3.7,XMDUZ,2,XMK,1,XMZ),XMORDER) S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0" Q
- I '$D(XMF) S @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^1" Q
- N XMORE
- S XMORE=0,XMK=XMK-.01
- F S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:'XMK D Q:XMORE
- . I +XMZ=0 S XMZ=0 I XMORDER=-1 S XMZ=":"
- . F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,XMZ),XMORDER) Q:'XMZ D Q:XMORE
- . . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . . I $$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF) S XMORE=1
- S @(XMTROOT_"0)")=@(XMTROOT_"0)")_U_XMORE
- Q
- FIELDS(XMDUZ,XMK,XMKN,XMZ,XMFLDS,XMTROOT,XMCNT) ;
- N XMZREC,XMLOOK,XMVAL
- I XMFLDS["BSKT" D
- . S XMLOOK=$P($P(XMFLDS,"BSKT",2),";",1)
- . S @(XMTROOT_XMCNT_",""BSKT"")")=XMK_$S(XMLOOK["I":"",1:U_XMKN)
- . I XMLOOK["X" S @(XMTROOT_"""BSKT"",XMKN,XMCNT)")=""
- I XMFLDS["FROM" D
- . I '$D(XMZREC) S XMZREC=$G(^XMB(3.9,XMZ,0))
- . S XMLOOK=$P($P(XMFLDS,"FROM",2),";",1)
- . I XMLOOK["I" S @(XMTROOT_XMCNT_",""FROM"")")=$P(XMZREC,U,2) Q:XMLOOK'["X"
- . S XMVAL=$$FROM^XMXUTIL2(XMZREC)
- . I $E(XMVAL)="<" S XMVAL=$E(XMVAL,2,$L(XMVAL)-1)
- . I XMLOOK'["I" S @(XMTROOT_XMCNT_",""FROM"")")=$P(XMZREC,U,2)_U_XMVAL Q:XMLOOK'["X"
- . S @(XMTROOT_"""FROM"",XMVAL,XMCNT)")=""
- I XMFLDS["DATE" D
- . I '$D(XMZREC) S XMZREC=$G(^XMB(3.9,XMZ,0))
- . S XMLOOK=$P($P(XMFLDS,"DATE",2),";",1)
- . I XMLOOK'["X" D Q
- . . I XMLOOK["I" S @(XMTROOT_XMCNT_",""DATE"")")=$P(XMZREC,U,3) Q
- . . I XMLOOK["F" D Q
- . . . S XMVAL=$P(XMZREC,U,3)
- . . . I XMVAL'?7N.E S XMVAL=$$CONVERT^XMXUTIL1(XMVAL,1) I XMVAL=-1 S XMVAL=$P(XMZREC,U,3)
- . . . S @(XMTROOT_XMCNT_",""DATE"")")=$P(XMZREC,U,3)_U_XMVAL
- . . S @(XMTROOT_XMCNT_",""DATE"")")=$P(XMZREC,U,3)_U_$$DATE^XMXUTIL2(XMZREC)
- . S XMVAL=$P(XMZREC,U,3)
- . I XMVAL'?7N.E S XMVAL=$$CONVERT^XMXUTIL1(XMVAL,1)
- . S @(XMTROOT_"""DATE"",XMVAL,XMCNT)")=""
- . I XMLOOK["I" S @(XMTROOT_XMCNT_",""DATE"")")=$P(XMZREC,U,3) Q
- . I XMLOOK["F" S @(XMTROOT_XMCNT_",""DATE"")")=$P(XMZREC,U,3)_U_XMVAL Q
- . S @(XMTROOT_XMCNT_",""DATE"")")=$P(XMZREC,U,3)_U_$$DATE^XMXUTIL2(XMZREC)
- I XMFLDS["SUBJ" D
- . I '$D(XMZREC) S XMZREC=$G(^XMB(3.9,XMZ,0))
- . S XMLOOK=$P($P(XMFLDS,"SUBJ",2),";",1)
- . I XMLOOK'["X" S @(XMTROOT_XMCNT_",""SUBJ"")")=$$SUBJ^XMXUTIL2(XMZREC) Q
- . S XMVAL=$$SUBJ^XMXUTIL2(XMZREC)
- . S @(XMTROOT_XMCNT_",""SUBJ"")")=XMVAL
- . S @(XMTROOT_"""SUBJ"",XMVAL,XMCNT)")=""
- I XMFLDS["PRI" D
- . I '$D(XMZREC) S XMZREC=$G(^XMB(3.9,XMZ,0))
- . S @(XMTROOT_XMCNT_",""PRI"")")=$$PRI^XMXUTIL2(XMZREC)
- I XMFLDS["LINE" S @(XMTROOT_XMCNT_",""LINE"")")=$$LINE^XMXUTIL2(XMZ)
- I XMFLDS["NEW" S @(XMTROOT_XMCNT_",""NEW"")")=$$NEW^XMXUTIL2(XMDUZ,XMK,XMZ)
- I XMFLDS["RESP" S @(XMTROOT_XMCNT_",""RESP"")")=$$RESP^XMXUTIL2(XMZ)
- I XMFLDS["READ" S @(XMTROOT_XMCNT_",""READ"")")=$$ZREAD^XMXUTIL2(XMDUZ,XMZ)
- Q
- KSEQN(XMDUZ,XMK,XMZ,XMFLDS,XMTROOT,XMCNT) ;
- S @(XMTROOT_XMCNT_",""SEQN"")")=$$KSEQN^XMXUTIL2(XMDUZ,XMK,XMZ)
- Q
- SEQN(XMDUZ,XMKZ,XMFLDS,XMTROOT,XMCNT) ;
- S @(XMTROOT_XMCNT_",""SEQN"")")=XMKZ
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXLIST1 7107 printed Feb 18, 2025@23:40:23 Page 2
- XMXLIST1 ;ISC-SF/GMB-List message: multiple conditions (cont.) ;08/30/2000 15:29
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ; Look in all of the user's baskets.
- NEWA(XMDUZ,XMTYPE,XMORDER,XMFLDS,XMAMT,XMSTART,XMF,XMTROOT) ; New messages in all baskets
- +1 NEW XMCNT,XMK,XMKN,XMZ
- +2 SET XMCNT=0
- +3 SET XMK=+$GET(XMSTART("XMK"))
- IF XMK
- SET XMK=XMK-.01
- +4 SET XMZ=$GET(XMSTART("XMZ"))
- +5 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK))
- if 'XMK
- QUIT
- Begin DoDot:1
- +6 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- +7 FOR
- SET XMZ=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMORDER)
- if 'XMZ
- QUIT
- Begin DoDot:2
- +8 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- +9 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +10 IF $DATA(XMF)
- if '$$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- QUIT
- +11 SET XMCNT=XMCNT+1
- +12 SET @(XMTROOT_XMCNT_")")=XMZ
- +13 if '$DATA(XMFLDS)
- QUIT
- +14 DO FIELDS(XMDUZ,XMK,XMKN,XMZ,.XMFLDS,XMTROOT,XMCNT)
- +15 IF XMFLDS["SEQN"
- DO KSEQN(XMDUZ,XMK,XMZ,.XMFLDS,XMTROOT,XMCNT)
- End DoDot:2
- if XMCNT=XMAMT
- QUIT
- End DoDot:1
- if XMCNT=XMAMT
- QUIT
- +16 SET XMSTART("XMK")=XMK
- +17 SET XMSTART("XMZ")=XMZ
- +18 SET @(XMTROOT_"0)")=XMCNT_U_XMAMT
- +19 ; Any more?
- +20 IF 'XMK
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0"
- QUIT
- +21 IF '$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK))
- IF '$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMORDER)
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0"
- QUIT
- +22 IF '$DATA(XMF)
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^1"
- QUIT
- +23 NEW XMORE
- +24 SET XMORE=0
- SET XMK=XMK-.01
- +25 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK))
- if 'XMK
- QUIT
- Begin DoDot:1
- +26 FOR
- SET XMZ=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMORDER)
- if 'XMZ
- QUIT
- Begin DoDot:2
- +27 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- +28 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +29 IF $$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- SET XMORE=1
- End DoDot:2
- if XMORE
- QUIT
- End DoDot:1
- if XMORE
- QUIT
- +30 SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_U_XMORE
- +31 QUIT
- REGAC(XMDUZ,XMORDER,XMFLDS,XMAMT,XMSTART,XMF,XMTROOT) ; Messages (by C-xref) in all baskets
- +1 NEW XMCNT,XMK,XMKN,XMKZ,XMZ
- +2 SET XMCNT=0
- +3 SET XMK=+$GET(XMSTART("XMK"))
- IF XMK
- SET XMK=XMK-.01
- +4 SET XMKZ=$GET(XMSTART("XMKZ"))
- +5 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- if 'XMK
- QUIT
- Begin DoDot:1
- +6 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- +7 FOR
- SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMORDER)
- if 'XMKZ
- QUIT
- SET XMZ=$ORDER(^(XMKZ,""))
- Begin DoDot:2
- +8 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
- +9 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +10 IF $DATA(XMF)
- if '$$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- QUIT
- +11 SET XMCNT=XMCNT+1
- +12 SET @(XMTROOT_XMCNT_")")=XMZ
- +13 if '$DATA(XMFLDS)
- QUIT
- +14 DO FIELDS(XMDUZ,XMK,XMKN,XMZ,.XMFLDS,XMTROOT,XMCNT)
- +15 IF XMFLDS["SEQN"
- DO SEQN(XMDUZ,XMKZ,.XMFLDS,XMTROOT,XMCNT)
- End DoDot:2
- if XMCNT=XMAMT
- QUIT
- End DoDot:1
- if XMCNT=XMAMT
- QUIT
- +16 SET XMSTART("XMK")=XMK
- +17 SET XMSTART("XMKZ")=XMKZ
- +18 SET @(XMTROOT_"0)")=XMCNT_U_XMAMT
- +19 ; Any more?
- +20 IF 'XMK
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0"
- QUIT
- +21 IF '$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- IF '$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMORDER)
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0"
- QUIT
- +22 IF '$DATA(XMF)
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^1"
- QUIT
- +23 NEW XMORE
- +24 SET XMORE=0
- SET XMK=XMK-.01
- +25 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- if 'XMK
- QUIT
- Begin DoDot:1
- +26 FOR
- SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMORDER)
- if 'XMKZ
- QUIT
- SET XMZ=$ORDER(^(XMKZ,""))
- Begin DoDot:2
- +27 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
- +28 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +29 IF $$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- SET XMORE=1
- End DoDot:2
- if XMORE
- QUIT
- End DoDot:1
- if XMORE
- QUIT
- +30 SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_U_XMORE
- +31 QUIT
- REGAZ(XMDUZ,XMORDER,XMFLDS,XMAMT,XMSTART,XMF,XMTROOT) ; Messages (by IEN) in all baskets
- +1 NEW XMCNT,XMK,XMKN,XMZ
- +2 SET XMCNT=0
- +3 SET XMK=+$GET(XMSTART("XMK"))
- IF XMK
- SET XMK=XMK-.01
- +4 SET XMZ=$GET(XMSTART("XMZ"))
- +5 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- if 'XMK
- QUIT
- Begin DoDot:1
- +6 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- +7 IF +XMZ=0
- SET XMZ=0
- IF XMORDER=-1
- SET XMZ=":"
- +8 FOR
- SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,XMZ),XMORDER)
- if 'XMZ
- QUIT
- Begin DoDot:2
- +9 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +10 IF $DATA(XMF)
- if '$$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- QUIT
- +11 SET XMCNT=XMCNT+1
- +12 SET @(XMTROOT_XMCNT_")")=XMZ
- +13 if '$DATA(XMFLDS)
- QUIT
- +14 DO FIELDS(XMDUZ,XMK,XMKN,XMZ,.XMFLDS,XMTROOT,XMCNT)
- +15 IF XMFLDS["SEQN"
- DO KSEQN(XMDUZ,XMK,XMZ,.XMFLDS,XMTROOT,XMCNT)
- End DoDot:2
- if XMCNT=XMAMT
- QUIT
- End DoDot:1
- if XMCNT=XMAMT
- QUIT
- +16 SET XMSTART("XMK")=XMK
- +17 SET XMSTART("XMZ")=XMZ
- +18 SET @(XMTROOT_"0)")=XMCNT_U_XMAMT
- +19 ; Any more?
- +20 IF 'XMK
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0"
- QUIT
- +21 IF '$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- IF '$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,XMZ),XMORDER)
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^0"
- QUIT
- +22 IF '$DATA(XMF)
- SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_"^1"
- QUIT
- +23 NEW XMORE
- +24 SET XMORE=0
- SET XMK=XMK-.01
- +25 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- if 'XMK
- QUIT
- Begin DoDot:1
- +26 IF +XMZ=0
- SET XMZ=0
- IF XMORDER=-1
- SET XMZ=":"
- +27 FOR
- SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,XMZ),XMORDER)
- if 'XMZ
- QUIT
- Begin DoDot:2
- +28 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +29 IF $$GOODMSG^XMJMFB(XMDUZ,XMK,XMZ,.XMF)
- SET XMORE=1
- End DoDot:2
- if XMORE
- QUIT
- End DoDot:1
- if XMORE
- QUIT
- +30 SET @(XMTROOT_"0)")=@(XMTROOT_"0)")_U_XMORE
- +31 QUIT
- FIELDS(XMDUZ,XMK,XMKN,XMZ,XMFLDS,XMTROOT,XMCNT) ;
- +1 NEW XMZREC,XMLOOK,XMVAL
- +2 IF XMFLDS["BSKT"
- Begin DoDot:1
- +3 SET XMLOOK=$PIECE($PIECE(XMFLDS,"BSKT",2),";",1)
- +4 SET @(XMTROOT_XMCNT_",""BSKT"")")=XMK_$SELECT(XMLOOK["I":"",1:U_XMKN)
- +5 IF XMLOOK["X"
- SET @(XMTROOT_"""BSKT"",XMKN,XMCNT)")=""
- End DoDot:1
- +6 IF XMFLDS["FROM"
- Begin DoDot:1
- +7 IF '$DATA(XMZREC)
- SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +8 SET XMLOOK=$PIECE($PIECE(XMFLDS,"FROM",2),";",1)
- +9 IF XMLOOK["I"
- SET @(XMTROOT_XMCNT_",""FROM"")")=$PIECE(XMZREC,U,2)
- if XMLOOK'["X"
- QUIT
- +10 SET XMVAL=$$FROM^XMXUTIL2(XMZREC)
- +11 IF $EXTRACT(XMVAL)="<"
- SET XMVAL=$EXTRACT(XMVAL,2,$LENGTH(XMVAL)-1)
- +12 IF XMLOOK'["I"
- SET @(XMTROOT_XMCNT_",""FROM"")")=$PIECE(XMZREC,U,2)_U_XMVAL
- if XMLOOK'["X"
- QUIT
- +13 SET @(XMTROOT_"""FROM"",XMVAL,XMCNT)")=""
- End DoDot:1
- +14 IF XMFLDS["DATE"
- Begin DoDot:1
- +15 IF '$DATA(XMZREC)
- SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +16 SET XMLOOK=$PIECE($PIECE(XMFLDS,"DATE",2),";",1)
- +17 IF XMLOOK'["X"
- Begin DoDot:2
- +18 IF XMLOOK["I"
- SET @(XMTROOT_XMCNT_",""DATE"")")=$PIECE(XMZREC,U,3)
- QUIT
- +19 IF XMLOOK["F"
- Begin DoDot:3
- +20 SET XMVAL=$PIECE(XMZREC,U,3)
- +21 IF XMVAL'?7N.E
- SET XMVAL=$$CONVERT^XMXUTIL1(XMVAL,1)
- IF XMVAL=-1
- SET XMVAL=$PIECE(XMZREC,U,3)
- +22 SET @(XMTROOT_XMCNT_",""DATE"")")=$PIECE(XMZREC,U,3)_U_XMVAL
- End DoDot:3
- QUIT
- +23 SET @(XMTROOT_XMCNT_",""DATE"")")=$PIECE(XMZREC,U,3)_U_$$DATE^XMXUTIL2(XMZREC)
- End DoDot:2
- QUIT
- +24 SET XMVAL=$PIECE(XMZREC,U,3)
- +25 IF XMVAL'?7N.E
- SET XMVAL=$$CONVERT^XMXUTIL1(XMVAL,1)
- +26 SET @(XMTROOT_"""DATE"",XMVAL,XMCNT)")=""
- +27 IF XMLOOK["I"
- SET @(XMTROOT_XMCNT_",""DATE"")")=$PIECE(XMZREC,U,3)
- QUIT
- +28 IF XMLOOK["F"
- SET @(XMTROOT_XMCNT_",""DATE"")")=$PIECE(XMZREC,U,3)_U_XMVAL
- QUIT
- +29 SET @(XMTROOT_XMCNT_",""DATE"")")=$PIECE(XMZREC,U,3)_U_$$DATE^XMXUTIL2(XMZREC)
- End DoDot:1
- +30 IF XMFLDS["SUBJ"
- Begin DoDot:1
- +31 IF '$DATA(XMZREC)
- SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +32 SET XMLOOK=$PIECE($PIECE(XMFLDS,"SUBJ",2),";",1)
- +33 IF XMLOOK'["X"
- SET @(XMTROOT_XMCNT_",""SUBJ"")")=$$SUBJ^XMXUTIL2(XMZREC)
- QUIT
- +34 SET XMVAL=$$SUBJ^XMXUTIL2(XMZREC)
- +35 SET @(XMTROOT_XMCNT_",""SUBJ"")")=XMVAL
- +36 SET @(XMTROOT_"""SUBJ"",XMVAL,XMCNT)")=""
- End DoDot:1
- +37 IF XMFLDS["PRI"
- Begin DoDot:1
- +38 IF '$DATA(XMZREC)
- SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +39 SET @(XMTROOT_XMCNT_",""PRI"")")=$$PRI^XMXUTIL2(XMZREC)
- End DoDot:1
- +40 IF XMFLDS["LINE"
- SET @(XMTROOT_XMCNT_",""LINE"")")=$$LINE^XMXUTIL2(XMZ)
- +41 IF XMFLDS["NEW"
- SET @(XMTROOT_XMCNT_",""NEW"")")=$$NEW^XMXUTIL2(XMDUZ,XMK,XMZ)
- +42 IF XMFLDS["RESP"
- SET @(XMTROOT_XMCNT_",""RESP"")")=$$RESP^XMXUTIL2(XMZ)
- +43 IF XMFLDS["READ"
- SET @(XMTROOT_XMCNT_",""READ"")")=$$ZREAD^XMXUTIL2(XMDUZ,XMZ)
- +44 QUIT
- KSEQN(XMDUZ,XMK,XMZ,XMFLDS,XMTROOT,XMCNT) ;
- +1 SET @(XMTROOT_XMCNT_",""SEQN"")")=$$KSEQN^XMXUTIL2(XMDUZ,XMK,XMZ)
- +2 QUIT
- SEQN(XMDUZ,XMKZ,XMFLDS,XMTROOT,XMCNT) ;
- +1 SET @(XMTROOT_XMCNT_",""SEQN"")")=XMKZ
- +2 QUIT