- 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 Jan 18, 2025@03:14:33 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