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 Dec 13, 2024@02:14:13 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
