XMUT4 ;ISC-SF/GMB-Integrity Checker for files 3.7, 3.9 ;07/15/2002 07:25
;;8.0;MailMan;;Jun 28, 2002
; Was (WASH ISC)/CAP
;
; Entry points used by MailMan options (not covered by DBIA):
; CHKFILES XMUT-CHKFIL
Q
CHKFILES ;
I $D(ZTQUEUED) D PROCESS Q
N XMABORT
S XMABORT=0
D WARNING^XMUT41(.XMABORT) Q:XMABORT
D EN^XUTMDEVQ("PROCESS^XMUT4",$$EZBLD^DIALOG(36080)) ; MailMan: Global Integrity Checker
Q
PROCESS ;
I $D(ZTQUEUED) S ZTREQ="@"
N XMABORT
S XMABORT=0
D MAILBOX(.XMABORT)
D:'XMABORT MESSAGE^XMUT4C(.XMABORT)
D SUMMARY^XMUT41(XMABORT)
Q
MAILBOX(XMABORT) ;
W:'$D(ZTQUEUED) !!,$$EZBLD^DIALOG(36081) ; Checking MAILBOX file 3.7
D USERS(.XMABORT) Q:XMABORT
D MXREF^XMUT41(.XMABORT) Q:XMABORT
D POSTBSKT^XMUT41
Q
USERS(XMABORT) ;
; XMUCNT # users
; XMUKCNT # bskts for a particular user
; XMUECNT # msg entries for a particular user
; XMKCNT # bskts
; XMECNT # msg entries
N XMUSER,XMECNT,XMUCNT,XMKCNT,XMUKCNT,XMUECNT
W:'$D(ZTQUEUED) !!,$$EZBLD^DIALOG(36082),! ; Checking each user mailbox
S (XMUSER,XMECNT,XMUCNT,XMKCNT)=0
F S XMUSER=$O(^XMB(3.7,XMUSER)) Q:XMUSER'>0 D Q:XMABORT
. S XMUCNT=XMUCNT+1 I XMUCNT#20=0 D Q:XMABORT
. . I '$D(ZTQUEUED) W:$X>40 ! W XMUCNT,"." Q
. . I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop
. D USER(XMUSER,.XMUKCNT,.XMUECNT)
. S XMKCNT=XMKCNT+XMUKCNT
. S XMECNT=XMECNT+XMUECNT
Q:XMABORT
I '$D(ZTQUEUED) D
. N XMPARM,XMTEXT
. S XMPARM(1)=XMUCNT,XMPARM(2)=XMKCNT,XMPARM(3)=XMECNT
. W !
. D BLD^DIALOG(36083,.XMPARM,"","XMTEXT","F")
. D MSG^DIALOG("WM","","","","XMTEXT")
. ;|1| Users, |2| Baskets, |3| Msg Entries"
I $D(^XMB(3.7,0)) S:$P(^XMB(3.7,0),U,4)'=XMUCNT $P(^(0),U,4)=XMUCNT Q
S ^XMB(3.7,0)="MAILBOX^3.7P^3^"_XMUCNT
Q
USER(XMUSER,XMUKCNT,XMUECNT) ;
; XMUNCNT # new msgs for a user
; XMUKECNT # msgs in a user's bskt
; XMUKNCNT # new msgs in a user's bskt
N XMK,XMUKNCNT,XMUKECNT,XMUNCNT
D BXREF(XMUSER)
D N0XREF(XMUSER)
S (XMK,XMUKCNT,XMUNCNT,XMUECNT)=0
F S XMK=$O(^XMB(3.7,XMUSER,2,XMK)) Q:XMK'>0 D
. Q:XMK=.95
. S XMUKCNT=XMUKCNT+1
. D BSKT(XMUSER,XMK,.XMUKNCNT,.XMUKECNT)
. S XMUNCNT=XMUNCNT+XMUKNCNT
. S XMUECNT=XMUECNT+XMUKECNT
S:$P($G(^XMB(3.7,XMUSER,0)),U,1)'=XMUSER $P(^(0),U,1)=XMUSER
S:$P(^XMB(3.7,XMUSER,0),U,6)'=XMUNCNT $P(^(0),U,6)=XMUNCNT
S:'$D(^XMB(3.7,"B",XMUSER,XMUSER)) ^XMB(3.7,"B",XMUSER,XMUSER)=""
I $D(^XMB(3.7,XMUSER,2,0)) S:$P(^XMB(3.7,XMUSER,2,0),U,4)'=XMUKCNT $P(^(0),U,4)=XMUKCNT Q
S ^XMB(3.7,XMUSER,2,0)="^3.701^"_$O(^XMB(3.7,XMUSER,2,"B"),-1)_U_XMUKCNT
Q
BSKT(XMUSER,XMK,XMUKNCNT,XMUKECNT) ;
N XMKN,XMKZ,XMZ,XMREC,XMRESEQ,XMKNAME
S XMKNAME(1)=$$EZBLD^DIALOG(37005) ; IN
S XMKNAME(.5)=$$EZBLD^DIALOG(37004) ; WASTE
S XMKNAME("?")=$$EZBLD^DIALOG(34009) ; * No Name *
D CXREF(XMUSER,XMK,.XMRESEQ)
S (XMZ,XMUKNCNT,XMUKECNT)=0
F S XMZ=$O(^XMB(3.7,XMUSER,2,XMK,1,XMZ)) Q:XMZ'>0 D
. S XMREC=^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)
. I $P(XMREC,U,1)'=XMZ D
. . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,1)=XMZ
. . D ERR(103,XMUSER,XMK,XMZ) ; Msg in bskt, but no .01 field: .01 field created
. I '$D(^XMB(3.9,XMZ,0)) D Q
. . D ERR(101,XMUSER,XMK,XMZ) ; Msg in bskt, but no msg: removed from bskt
. . D ZAPIT^XMXMSGS2(XMUSER,XMK,XMZ)
. S XMUKECNT=XMUKECNT+1
. S XMKZ=$P(XMREC,U,2)
. I XMKZ D
. . I '$D(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)) S ^(XMZ)="" D ERR(112,XMUSER,XMK,XMZ) ; Msg in bskt, but no C xref: xref created
. E D
. . S XMKZ=$O(^XMB(3.7,XMUSER,2,XMK,1,"C",""),-1)+1
. . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)=XMKZ
. . S ^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)=""
. . D ERR(102,XMUSER,XMK,XMZ) ; Msg in bskt, but no seq #: seq # created
. I '$D(^XMB(3.7,"M",XMZ,XMUSER,XMK,XMZ)) S ^(XMZ)="" D ERR(111,XMUSER,XMK,XMZ) ; Msg in bskt, but no M xref: xref created
. ;I XMUSER=.5,XMK>999 Q
. I $P(XMREC,U,3) D
. . I XMK=.5 D Q
. . . D ERR(104,XMUSER,XMK,XMZ) ; New msg in WASTE bskt: msg made not new
. . . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,3)=""
. . . K ^XMB(3.7,XMUSER,"N0",XMK,XMZ)
. . S XMUKNCNT=XMUKNCNT+1
. . I '$D(^XMB(3.7,XMUSER,"N0",XMK,XMZ)) S ^(XMZ)="" D ERR(113,XMUSER,XMK,XMZ) ; New msg, but no N0 xref: xref created
I '$D(^XMB(3.7,XMUSER,2,XMK,0)) D
. S XMKN=$G(XMKNAME(XMK),XMKNAME("?"))
. S ^XMB(3.7,XMUSER,2,XMK,0)=XMKN
. D ERR(131,XMUSER,XMK) ; No bskt 0 node: created
E D
. S XMKN=$P(^XMB(3.7,XMUSER,2,XMK,0),U)
. I XMKN="" D Q
. . S XMKN=$G(XMKNAME(XMK),XMKNAME("?"))
. . S $P(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
. . D ERR(132,XMUSER,XMK) ; Bskt name null: created
. Q:XMK>1
. Q:'$D(XMKNAME(XMK))
. Q:XMKN=XMKNAME(XMK)
. N XMKNBAD
. S XMKNBAD=XMKN
. S XMKN=XMKNAME(XMK)
. S $P(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
. K ^XMB(3.7,XMUSER,2,"B",XMKNBAD,XMK)
. D ERR(134,XMUSER,XMK,"",XMKNBAD) ; Bskt name '|1|' wrong: corrected
I '$D(^XMB(3.7,XMUSER,2,"B",$E(XMKN,1,30),XMK)) S ^(XMK)="" D ERR(141,XMUSER,XMK) ; Bskt name, but no B xref: xref created
S:$P(^XMB(3.7,XMUSER,2,XMK,0),U,2)'=XMUKNCNT $P(^(0),U,2)=XMUKNCNT
I $D(^XMB(3.7,XMUSER,2,XMK,1,0)) D
. S:$P(^XMB(3.7,XMUSER,2,XMK,1,0),U,4)'=XMUKECNT $P(^(0),U,4)=XMUKECNT
E I XMUKECNT D
. S ^XMB(3.7,XMUSER,2,XMK,1,0)="^3.702P^"_$O(^XMB(3.7,XMUSER,2,XMK,1,"C"),-1)_U_XMUKECNT
. D ERR(133,XMUSER,XMK) ; No msg multiple 0 node: created
Q:'$G(XMRESEQ)
D RSEQ^XMXBSKT(XMUSER,XMK)
D ERR(125,XMUSER,XMK) ; C xref duplicate seq #s: bskt reseq'd
Q
CXREF(XMUSER,XMK,XMRESEQ) ; Check the bskt's C xref (msg seq numbers in bskt)
N XMKZ,XMZ,XMCNT
S XMKZ=0
F S XMKZ=$O(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ)) Q:'XMKZ D
. S (XMZ,XMCNT)=0
. F S XMZ=$O(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)) Q:'XMZ D
. . S XMCNT=XMCNT+1
. . Q:$P($G(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)),U,2)=XMKZ
. . I '$D(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)) D Q
. . . S ^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)=XMZ_U_XMKZ
. . . D ERR(122,XMUSER,XMK,XMZ) ; C xref, but msg not in bskt: put in bskt
. . I $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)="" D Q
. . . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)=XMKZ
. . . D ERR(123,XMUSER,XMK,XMZ) ; C xref, but no msg seq #: set seq # using xref
. . K ^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)
. . D ERR(124,XMUSER,XMK,XMZ) ; C xref does not match msg seq #: xref killed
. S:XMCNT>1 XMRESEQ=1
Q
N0XREF(XMUSER) ; Check the user's N0 xref (new msgs)
N XMK,XMZ
S XMK=0
F S XMK=$O(^XMB(3.7,XMUSER,"N0",XMK)) Q:'XMK D
. S XMZ=0
. F S XMZ=$O(^XMB(3.7,XMUSER,"N0",XMK,XMZ)) Q:'XMZ D
. . Q:$P($G(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)),U,3)=1
. . I '$D(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)) D Q
. . . S ^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)=XMZ_"^^1"
. . . D ERR(126,XMUSER,XMK,XMZ) ; N0 xref, but msg not in bskt: msg put in bskt
. . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,3)=1
. . D ERR(127,XMUSER,XMK,XMZ) ; N0 xref, but msg not new: new flag set
Q
BXREF(XMUSER) ; Check the user's B xref (bskt names)
N XMK,XMKN
S XMKN=""
F S XMKN=$O(^XMB(3.7,XMUSER,2,"B",XMKN)) Q:XMKN="" D
. S XMK=0
. F S XMK=$O(^XMB(3.7,XMUSER,2,"B",XMKN,XMK)) Q:'XMK D
. . Q:$E($P($G(^XMB(3.7,XMUSER,2,XMK,0)),U),1,30)=XMKN
. . I $D(^XMB(3.7,XMUSER,2,XMK,0)) D Q
. . . I $P($G(^XMB(3.7,XMUSER,2,XMK,0)),U)="" D Q
. . . . S $P(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
. . . . D ERR(151,XMUSER,XMK) ; B xref, but bskt name null: name set using xref
. . . D ERR(153,XMUSER,XMK) ; B xref does not match bskt name: xref killed
. . . K ^XMB(3.7,XMUSER,2,"B",XMKN,XMK)
. . S $P(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
. . D ERR(152,XMUSER,XMK) ; B xref, but no bskt node: node set using xref
Q
ERR(XMERRNUM,XMUSER,XMK,XMZ,XMDPARM) ;
S XMERROR(XMERRNUM)=$G(XMERROR(XMERRNUM))+1
Q:$D(ZTQUEUED)
N XMPARM
S XMPARM(1)=XMUSER,XMPARM(2)=XMK,XMPARM(3)=XMERRNUM
S XMPARM(4)=$$EZBLD^DIALOG(36000+XMERRNUM,.XMDPARM)
;DUZ=|1|, Bskt=|2|$S($G(XMZ):", Msg=|5|",1:""), Err=|3| |4|
I $G(XMZ) S XMPARM(5)=XMZ W !,$$EZBLD^DIALOG(36099,.XMPARM) Q
W !,$$EZBLD^DIALOG(36098,.XMPARM)
Q
;34009 * No Name *
;37004 WASTE
;37005 IN
;36098 DUZ=|1|, Bskt=|2|, Err=|3| |4|
;36099 DUZ=|1|, Bskt=|2|, Msg=|5|, Err=|3| |4|
;36101 Msg in bskt, but no msg: removed from bskt
;36102 Msg in bskt, but no seq #: seq # created
;36103 Msg in bskt, but no .01 field: .01 field
;36104 New msg in WASTE bskt: msg made not new
;36111 Msg in bskt, but no M xref: xref created
;36112 Msg in bskt, but no C xref: xref created
;36113 New msg, but no N0 xref: xref created
;36122 C xref, but msg not in bskt: put in bskt
;36123 C xref, but no msg seq #: set seq # using
;36124 C xref does not match msg seq #: xref kill
;36125 C xref duplicate seq #s: bskt reseq'd
;36126 N0 xref, but msg not in bskt: msg put in
;36127 N0 xref, but msg not new: new flag set
;36131 No bskt 0 node: created
;36132 Bskt name null: created
;36133 No msg multiple 0 node: created
;36134 Bskt name '|1|' wrong: corrected
;36141 Bskt name, but no B xref: xref created
;36151 B xref, but bskt name null: name set using
;36152 B xref, but no bskt node: node set using
;36153 B xref does not match bskt name: xref kill
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUT4 9241 printed Dec 13, 2024@02:13:32 Page 2
XMUT4 ;ISC-SF/GMB-Integrity Checker for files 3.7, 3.9 ;07/15/2002 07:25
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Was (WASH ISC)/CAP
+3 ;
+4 ; Entry points used by MailMan options (not covered by DBIA):
+5 ; CHKFILES XMUT-CHKFIL
+6 QUIT
CHKFILES ;
+1 IF $DATA(ZTQUEUED)
DO PROCESS
QUIT
+2 NEW XMABORT
+3 SET XMABORT=0
+4 DO WARNING^XMUT41(.XMABORT)
if XMABORT
QUIT
+5 ; MailMan: Global Integrity Checker
DO EN^XUTMDEVQ("PROCESS^XMUT4",$$EZBLD^DIALOG(36080))
+6 QUIT
PROCESS ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW XMABORT
+3 SET XMABORT=0
+4 DO MAILBOX(.XMABORT)
+5 if 'XMABORT
DO MESSAGE^XMUT4C(.XMABORT)
+6 DO SUMMARY^XMUT41(XMABORT)
+7 QUIT
MAILBOX(XMABORT) ;
+1 ; Checking MAILBOX file 3.7
if '$DATA(ZTQUEUED)
WRITE !!,$$EZBLD^DIALOG(36081)
+2 DO USERS(.XMABORT)
if XMABORT
QUIT
+3 DO MXREF^XMUT41(.XMABORT)
if XMABORT
QUIT
+4 DO POSTBSKT^XMUT41
+5 QUIT
USERS(XMABORT) ;
+1 ; XMUCNT # users
+2 ; XMUKCNT # bskts for a particular user
+3 ; XMUECNT # msg entries for a particular user
+4 ; XMKCNT # bskts
+5 ; XMECNT # msg entries
+6 NEW XMUSER,XMECNT,XMUCNT,XMKCNT,XMUKCNT,XMUECNT
+7 ; Checking each user mailbox
if '$DATA(ZTQUEUED)
WRITE !!,$$EZBLD^DIALOG(36082),!
+8 SET (XMUSER,XMECNT,XMUCNT,XMKCNT)=0
+9 FOR
SET XMUSER=$ORDER(^XMB(3.7,XMUSER))
if XMUSER'>0
QUIT
Begin DoDot:1
+10 SET XMUCNT=XMUCNT+1
IF XMUCNT#20=0
Begin DoDot:2
+11 IF '$DATA(ZTQUEUED)
if $X>40
WRITE !
WRITE XMUCNT,"."
QUIT
+12 ; User asked the task to stop
IF $$S^%ZTLOAD
SET (XMABORT,ZTSTOP)=1
End DoDot:2
if XMABORT
QUIT
+13 DO USER(XMUSER,.XMUKCNT,.XMUECNT)
+14 SET XMKCNT=XMKCNT+XMUKCNT
+15 SET XMECNT=XMECNT+XMUECNT
End DoDot:1
if XMABORT
QUIT
+16 if XMABORT
QUIT
+17 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+18 NEW XMPARM,XMTEXT
+19 SET XMPARM(1)=XMUCNT
SET XMPARM(2)=XMKCNT
SET XMPARM(3)=XMECNT
+20 WRITE !
+21 DO BLD^DIALOG(36083,.XMPARM,"","XMTEXT","F")
+22 DO MSG^DIALOG("WM","","","","XMTEXT")
+23 ;|1| Users, |2| Baskets, |3| Msg Entries"
End DoDot:1
+24 IF $DATA(^XMB(3.7,0))
if $PIECE(^XMB(3.7,0),U,4)'=XMUCNT
SET $PIECE(^(0),U,4)=XMUCNT
QUIT
+25 SET ^XMB(3.7,0)="MAILBOX^3.7P^3^"_XMUCNT
+26 QUIT
USER(XMUSER,XMUKCNT,XMUECNT) ;
+1 ; XMUNCNT # new msgs for a user
+2 ; XMUKECNT # msgs in a user's bskt
+3 ; XMUKNCNT # new msgs in a user's bskt
+4 NEW XMK,XMUKNCNT,XMUKECNT,XMUNCNT
+5 DO BXREF(XMUSER)
+6 DO N0XREF(XMUSER)
+7 SET (XMK,XMUKCNT,XMUNCNT,XMUECNT)=0
+8 FOR
SET XMK=$ORDER(^XMB(3.7,XMUSER,2,XMK))
if XMK'>0
QUIT
Begin DoDot:1
+9 if XMK=.95
QUIT
+10 SET XMUKCNT=XMUKCNT+1
+11 DO BSKT(XMUSER,XMK,.XMUKNCNT,.XMUKECNT)
+12 SET XMUNCNT=XMUNCNT+XMUKNCNT
+13 SET XMUECNT=XMUECNT+XMUKECNT
End DoDot:1
+14 if $PIECE($GET(^XMB(3.7,XMUSER,0)),U,1)'=XMUSER
SET $PIECE(^(0),U,1)=XMUSER
+15 if $PIECE(^XMB(3.7,XMUSER,0),U,6)'=XMUNCNT
SET $PIECE(^(0),U,6)=XMUNCNT
+16 if '$DATA(^XMB(3.7,"B",XMUSER,XMUSER))
SET ^XMB(3.7,"B",XMUSER,XMUSER)=""
+17 IF $DATA(^XMB(3.7,XMUSER,2,0))
if $PIECE(^XMB(3.7,XMUSER,2,0),U,4)'=XMUKCNT
SET $PIECE(^(0),U,4)=XMUKCNT
QUIT
+18 SET ^XMB(3.7,XMUSER,2,0)="^3.701^"_$ORDER(^XMB(3.7,XMUSER,2,"B"),-1)_U_XMUKCNT
+19 QUIT
BSKT(XMUSER,XMK,XMUKNCNT,XMUKECNT) ;
+1 NEW XMKN,XMKZ,XMZ,XMREC,XMRESEQ,XMKNAME
+2 ; IN
SET XMKNAME(1)=$$EZBLD^DIALOG(37005)
+3 ; WASTE
SET XMKNAME(.5)=$$EZBLD^DIALOG(37004)
+4 ; * No Name *
SET XMKNAME("?")=$$EZBLD^DIALOG(34009)
+5 DO CXREF(XMUSER,XMK,.XMRESEQ)
+6 SET (XMZ,XMUKNCNT,XMUKECNT)=0
+7 FOR
SET XMZ=$ORDER(^XMB(3.7,XMUSER,2,XMK,1,XMZ))
if XMZ'>0
QUIT
Begin DoDot:1
+8 SET XMREC=^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)
+9 IF $PIECE(XMREC,U,1)'=XMZ
Begin DoDot:2
+10 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,1)=XMZ
+11 ; Msg in bskt, but no .01 field: .01 field created
DO ERR(103,XMUSER,XMK,XMZ)
End DoDot:2
+12 IF '$DATA(^XMB(3.9,XMZ,0))
Begin DoDot:2
+13 ; Msg in bskt, but no msg: removed from bskt
DO ERR(101,XMUSER,XMK,XMZ)
+14 DO ZAPIT^XMXMSGS2(XMUSER,XMK,XMZ)
End DoDot:2
QUIT
+15 SET XMUKECNT=XMUKECNT+1
+16 SET XMKZ=$PIECE(XMREC,U,2)
+17 IF XMKZ
Begin DoDot:2
+18 ; Msg in bskt, but no C xref: xref created
IF '$DATA(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ))
SET ^(XMZ)=""
DO ERR(112,XMUSER,XMK,XMZ)
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 SET XMKZ=$ORDER(^XMB(3.7,XMUSER,2,XMK,1,"C",""),-1)+1
+21 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)=XMKZ
+22 SET ^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)=""
+23 ; Msg in bskt, but no seq #: seq # created
DO ERR(102,XMUSER,XMK,XMZ)
End DoDot:2
+24 ; Msg in bskt, but no M xref: xref created
IF '$DATA(^XMB(3.7,"M",XMZ,XMUSER,XMK,XMZ))
SET ^(XMZ)=""
DO ERR(111,XMUSER,XMK,XMZ)
+25 ;I XMUSER=.5,XMK>999 Q
+26 IF $PIECE(XMREC,U,3)
Begin DoDot:2
+27 IF XMK=.5
Begin DoDot:3
+28 ; New msg in WASTE bskt: msg made not new
DO ERR(104,XMUSER,XMK,XMZ)
+29 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,3)=""
+30 KILL ^XMB(3.7,XMUSER,"N0",XMK,XMZ)
End DoDot:3
QUIT
+31 SET XMUKNCNT=XMUKNCNT+1
+32 ; New msg, but no N0 xref: xref created
IF '$DATA(^XMB(3.7,XMUSER,"N0",XMK,XMZ))
SET ^(XMZ)=""
DO ERR(113,XMUSER,XMK,XMZ)
End DoDot:2
End DoDot:1
+33 IF '$DATA(^XMB(3.7,XMUSER,2,XMK,0))
Begin DoDot:1
+34 SET XMKN=$GET(XMKNAME(XMK),XMKNAME("?"))
+35 SET ^XMB(3.7,XMUSER,2,XMK,0)=XMKN
+36 ; No bskt 0 node: created
DO ERR(131,XMUSER,XMK)
End DoDot:1
+37 IF '$TEST
Begin DoDot:1
+38 SET XMKN=$PIECE(^XMB(3.7,XMUSER,2,XMK,0),U)
+39 IF XMKN=""
Begin DoDot:2
+40 SET XMKN=$GET(XMKNAME(XMK),XMKNAME("?"))
+41 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
+42 ; Bskt name null: created
DO ERR(132,XMUSER,XMK)
End DoDot:2
QUIT
+43 if XMK>1
QUIT
+44 if '$DATA(XMKNAME(XMK))
QUIT
+45 if XMKN=XMKNAME(XMK)
QUIT
+46 NEW XMKNBAD
+47 SET XMKNBAD=XMKN
+48 SET XMKN=XMKNAME(XMK)
+49 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
+50 KILL ^XMB(3.7,XMUSER,2,"B",XMKNBAD,XMK)
+51 ; Bskt name '|1|' wrong: corrected
DO ERR(134,XMUSER,XMK,"",XMKNBAD)
End DoDot:1
+52 ; Bskt name, but no B xref: xref created
IF '$DATA(^XMB(3.7,XMUSER,2,"B",$EXTRACT(XMKN,1,30),XMK))
SET ^(XMK)=""
DO ERR(141,XMUSER,XMK)
+53 if $PIECE(^XMB(3.7,XMUSER,2,XMK,0),U,2)'=XMUKNCNT
SET $PIECE(^(0),U,2)=XMUKNCNT
+54 IF $DATA(^XMB(3.7,XMUSER,2,XMK,1,0))
Begin DoDot:1
+55 if $PIECE(^XMB(3.7,XMUSER,2,XMK,1,0),U,4)'=XMUKECNT
SET $PIECE(^(0),U,4)=XMUKECNT
End DoDot:1
+56 IF '$TEST
IF XMUKECNT
Begin DoDot:1
+57 SET ^XMB(3.7,XMUSER,2,XMK,1,0)="^3.702P^"_$ORDER(^XMB(3.7,XMUSER,2,XMK,1,"C"),-1)_U_XMUKECNT
+58 ; No msg multiple 0 node: created
DO ERR(133,XMUSER,XMK)
End DoDot:1
+59 if '$GET(XMRESEQ)
QUIT
+60 DO RSEQ^XMXBSKT(XMUSER,XMK)
+61 ; C xref duplicate seq #s: bskt reseq'd
DO ERR(125,XMUSER,XMK)
+62 QUIT
CXREF(XMUSER,XMK,XMRESEQ) ; Check the bskt's C xref (msg seq numbers in bskt)
+1 NEW XMKZ,XMZ,XMCNT
+2 SET XMKZ=0
+3 FOR
SET XMKZ=$ORDER(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ))
if 'XMKZ
QUIT
Begin DoDot:1
+4 SET (XMZ,XMCNT)=0
+5 FOR
SET XMZ=$ORDER(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ))
if 'XMZ
QUIT
Begin DoDot:2
+6 SET XMCNT=XMCNT+1
+7 if $PIECE($GET(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)),U,2)=XMKZ
QUIT
+8 IF '$DATA(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0))
Begin DoDot:3
+9 SET ^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)=XMZ_U_XMKZ
+10 ; C xref, but msg not in bskt: put in bskt
DO ERR(122,XMUSER,XMK,XMZ)
End DoDot:3
QUIT
+11 IF $PIECE(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)=""
Begin DoDot:3
+12 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)=XMKZ
+13 ; C xref, but no msg seq #: set seq # using xref
DO ERR(123,XMUSER,XMK,XMZ)
End DoDot:3
QUIT
+14 KILL ^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)
+15 ; C xref does not match msg seq #: xref killed
DO ERR(124,XMUSER,XMK,XMZ)
End DoDot:2
+16 if XMCNT>1
SET XMRESEQ=1
End DoDot:1
+17 QUIT
N0XREF(XMUSER) ; Check the user's N0 xref (new msgs)
+1 NEW XMK,XMZ
+2 SET XMK=0
+3 FOR
SET XMK=$ORDER(^XMB(3.7,XMUSER,"N0",XMK))
if 'XMK
QUIT
Begin DoDot:1
+4 SET XMZ=0
+5 FOR
SET XMZ=$ORDER(^XMB(3.7,XMUSER,"N0",XMK,XMZ))
if 'XMZ
QUIT
Begin DoDot:2
+6 if $PIECE($GET(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)),U,3)=1
QUIT
+7 IF '$DATA(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0))
Begin DoDot:3
+8 SET ^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)=XMZ_"^^1"
+9 ; N0 xref, but msg not in bskt: msg put in bskt
DO ERR(126,XMUSER,XMK,XMZ)
End DoDot:3
QUIT
+10 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,3)=1
+11 ; N0 xref, but msg not new: new flag set
DO ERR(127,XMUSER,XMK,XMZ)
End DoDot:2
End DoDot:1
+12 QUIT
BXREF(XMUSER) ; Check the user's B xref (bskt names)
+1 NEW XMK,XMKN
+2 SET XMKN=""
+3 FOR
SET XMKN=$ORDER(^XMB(3.7,XMUSER,2,"B",XMKN))
if XMKN=""
QUIT
Begin DoDot:1
+4 SET XMK=0
+5 FOR
SET XMK=$ORDER(^XMB(3.7,XMUSER,2,"B",XMKN,XMK))
if 'XMK
QUIT
Begin DoDot:2
+6 if $EXTRACT($PIECE($GET(^XMB(3.7,XMUSER,2,XMK,0)),U),1,30)=XMKN
QUIT
+7 IF $DATA(^XMB(3.7,XMUSER,2,XMK,0))
Begin DoDot:3
+8 IF $PIECE($GET(^XMB(3.7,XMUSER,2,XMK,0)),U)=""
Begin DoDot:4
+9 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
+10 ; B xref, but bskt name null: name set using xref
DO ERR(151,XMUSER,XMK)
End DoDot:4
QUIT
+11 ; B xref does not match bskt name: xref killed
DO ERR(153,XMUSER,XMK)
+12 KILL ^XMB(3.7,XMUSER,2,"B",XMKN,XMK)
End DoDot:3
QUIT
+13 SET $PIECE(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
+14 ; B xref, but no bskt node: node set using xref
DO ERR(152,XMUSER,XMK)
End DoDot:2
End DoDot:1
+15 QUIT
ERR(XMERRNUM,XMUSER,XMK,XMZ,XMDPARM) ;
+1 SET XMERROR(XMERRNUM)=$GET(XMERROR(XMERRNUM))+1
+2 if $DATA(ZTQUEUED)
QUIT
+3 NEW XMPARM
+4 SET XMPARM(1)=XMUSER
SET XMPARM(2)=XMK
SET XMPARM(3)=XMERRNUM
+5 SET XMPARM(4)=$$EZBLD^DIALOG(36000+XMERRNUM,.XMDPARM)
+6 ;DUZ=|1|, Bskt=|2|$S($G(XMZ):", Msg=|5|",1:""), Err=|3| |4|
+7 IF $GET(XMZ)
SET XMPARM(5)=XMZ
WRITE !,$$EZBLD^DIALOG(36099,.XMPARM)
QUIT
+8 WRITE !,$$EZBLD^DIALOG(36098,.XMPARM)
+9 QUIT
+10 ;34009 * No Name *
+11 ;37004 WASTE
+12 ;37005 IN
+13 ;36098 DUZ=|1|, Bskt=|2|, Err=|3| |4|
+14 ;36099 DUZ=|1|, Bskt=|2|, Msg=|5|, Err=|3| |4|
+15 ;36101 Msg in bskt, but no msg: removed from bskt
+16 ;36102 Msg in bskt, but no seq #: seq # created
+17 ;36103 Msg in bskt, but no .01 field: .01 field
+18 ;36104 New msg in WASTE bskt: msg made not new
+19 ;36111 Msg in bskt, but no M xref: xref created
+20 ;36112 Msg in bskt, but no C xref: xref created
+21 ;36113 New msg, but no N0 xref: xref created
+22 ;36122 C xref, but msg not in bskt: put in bskt
+23 ;36123 C xref, but no msg seq #: set seq # using
+24 ;36124 C xref does not match msg seq #: xref kill
+25 ;36125 C xref duplicate seq #s: bskt reseq'd
+26 ;36126 N0 xref, but msg not in bskt: msg put in
+27 ;36127 N0 xref, but msg not new: new flag set
+28 ;36131 No bskt 0 node: created
+29 ;36132 Bskt name null: created
+30 ;36133 No msg multiple 0 node: created
+31 ;36134 Bskt name '|1|' wrong: corrected
+32 ;36141 Bskt name, but no B xref: xref created
+33 ;36151 B xref, but bskt name null: name set using
+34 ;36152 B xref, but no bskt node: node set using
+35 ;36153 B xref does not match bskt name: xref kill
