XMUT4C ;ISC-SF/GMB-Integrity Checker for file 3.9 ;04/19/2002 13:00
;;8.0;MailMan;;Jun 28, 2002
; Was (WASH ISC)/CAP
MESSAGE(XMABORT) ;
N XMZ,XMCNT,XMZREC,XMCRE8
W !!,$$EZBLD^DIALOG(36094),! ; Checking MESSAGE file 3.9
F S XMZ=$O(^XMB(3.9,":"),-1) Q:XMZ?1N.N D BOGUS(XMZ)
S (XMZ,XMCNT)=0
F S XMZ=$O(^XMB(3.9,XMZ)) Q:XMZ'>0 D Q:XMABORT
. I XMZ'?1N.N D BOGUS(XMZ) Q
. S XMCNT=XMCNT+1 I XMCNT#5000=0 D Q:XMABORT
. . I '$D(ZTQUEUED) W:$X>40 ! W XMCNT,"." Q
. . I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop
. S XMZREC=$G(^XMB(3.9,XMZ,0))
. I "^^^^^^^^"[XMZREC D
. . D ERR(XMZ,201) ; Msg has bad/no 0 node: not fixed
. E D
. . D SUBJ(XMZ,XMZREC)
. . I $P(XMZREC,U,2)="" D
. . . S $P(^XMB(3.9,XMZ,0),U,2)=$$EZBLD^DIALOG(34009) ;* No Name *
. . . D ERR(XMZ,206) ; Msg has no sender: fixed
. . I $P(XMZREC,U,3)="" D
. . . S $P(^XMB(3.9,XMZ,0),U,3)=DT
. . . D ERR(XMZ,207) ; Msg has no date/time: fixed
. D CRE8DT(XMZ,$P(XMZREC,U,3))
. D RESP(XMZ,XMZREC)
. D:$D(^XMB(3.9,XMZ,1)) RECIP(XMZ)
Q:XMABORT
W !!,$$EZBLD^DIALOG(36093,XMCNT) ; |1| messages in the MESSAGE file 3.9
I XMCNT=$P(^XMB(3.9,0),U,4) W !,$$EZBLD^DIALOG(36095) Q ; Zero node is OK
L +^XMB(3.9,0):1
S $P(^XMB(3.9,0),U,4)=XMCNT
L -^XMB(3.9,0)
W !,$$EZBLD^DIALOG(36096) ; I reset the zero node.
Q
BOGUS(XMZ) ;
D ERR(XMZ,210) ; Msg IEN is corrupted: fixed
I $L($P($G(^XMB(3.9,XMZ,0)),U,1)) K ^XMB(3.9,"B",$E($P(^XMB(3.9,XMZ,0),U,1),1,30),XMZ)
K ^XMB(3.9,"C",+$P($G(^XMB(3.9,XMZ,.6)),U,1),XMZ)
K ^XMB(3.9,XMZ)
Q
SUBJ(XMZ,XMZREC) ;
N XMSUBJ
S XMSUBJ=$P(XMZREC,U)
I XMSUBJ="" D
. S XMSUBJ=$$EZBLD^DIALOG(34012) ;* No Subject *
. S $P(^XMB(3.9,XMZ,0),U,1)=XMSUBJ
. S ^XMB(3.9,"B",XMSUBJ,XMZ)=""
. D ERR(XMZ,202) ; Msg has no subject: fixed
I '$D(^XMB(3.9,"B",$E(XMSUBJ,1,30),XMZ)) D
. I $L(XMSUBJ)>30,$D(^XMB(3.9,"B",XMSUBJ,XMZ)) D
. . K ^XMB(3.9,"B",XMSUBJ,XMZ)
. . D ERR(XMZ,205) ; Subject B xref too long: xref shortened
. E D ERR(XMZ,204) ; Subject has no B xref: xref created
. S ^XMB(3.9,"B",$E(XMSUBJ,1,30),XMZ)=""
I $L(XMSUBJ)<3!($L(XMSUBJ)>65) D
. D ERR(XMZ,203) ; Msg subject <3 or >65: fixed
. S XMSUBJ=$S($L(XMSUBJ)<3:XMSUBJ_"...",1:$E(XMSUBJ,1,65))
. N XMFDA
. S XMFDA(3.9,XMZ_",",.01)=XMSUBJ
. D FILE^DIE("","XMFDA")
Q
RESP(XMZ,XMZREC) ;
N XMZO
I $P(XMZREC,U,8) D Q
. S XMZO=$P(XMZREC,U,8)
. I XMZO=XMZ D Q
. . D ERR(XMZ,211) ; Message thinks it's a response to itself: fixed
. . S $P(^XMB(3.9,XMZ,0),U,8)=""
. I '$D(^XMB(3.9,XMZO,0)) D Q
. . D ERR(XMZ,212,XMZO) ; No original message |1| for this response: fixed
. . S $P(^XMB(3.9,XMZ,0),U,8)=""
. I $$ATTACHED(XMZO,XMZ) Q
. D ERR(XMZ,213,XMZO) ; Not in response chain of |1|: fixed
. S $P(^XMB(3.9,XMZ,0),U,8)=""
N XMSUBJ
S XMSUBJ=$P(XMZREC,U)
Q:XMSUBJ'?1"R"1.N
Q:$P(XMZREC,U,2)["@"
S XMZO=+$E(XMSUBJ,2,99)
I '$D(^XMB(3.9,XMZO,0)) D Q
. D ERR(XMZ,216,XMZO) ; No original message |1| for this response: not fixed
I '$$ATTACHED(XMZO,XMZ) D Q
. D ERR(XMZ,217,XMZO) ; Not in response chain of |1|: not fixed
D ERR(XMZ,218,XMZO) ; Piece 8 didn't point to original message |1|: fixed
S $P(^XMB(3.9,XMZ,0),U,8)=XMZO
Q
ATTACHED(XMZO,XMZ) ; Is XMZ in the response chain of XMZO?
N I
S I=0
F S I=$O(^XMB(3.9,XMZO,3,I)) Q:'I Q:$P($G(^(I,0)),U)=XMZ
Q +I
CRE8DT(XMZ,XMDATE) ;
S XMCRE8=$P($G(^XMB(3.9,XMZ,.6)),U,1)
I 'XMCRE8 D Q
. I $P(XMDATE,".",1)?7N S XMDATE=$P(XMDATE,".",1)
. E I XMDATE="" S XMDATE=DT
. E D
. . S XMDATE=$$CONVERT^XMXUTIL1(XMDATE)
. . S:XMDATE=-1 XMDATE=DT
. S $P(^XMB(3.9,XMZ,.6),U,1)=XMDATE
. S ^XMB(3.9,"C",XMDATE,XMZ)=""
. D ERR(XMZ,208) ; Msg has no local create date: fixed
I '$D(^XMB(3.9,"C",XMCRE8,XMZ)) D
. S ^XMB(3.9,"C",XMCRE8,XMZ)=""
. D ERR(XMZ,209) ; Local create date C xref missing: fixed
Q
RECIP(XMZ) ; Check recipient multiple
N I,XMVAL,XMXREF,XMRECIPS
D CXREF(XMZ)
S (I,XMRECIPS)=0
F S I=$O(^XMB(3.9,XMZ,1,I)) Q:'I D
. S XMVAL=$P($G(^XMB(3.9,XMZ,1,I,0)),U)
. I XMVAL="" D Q
. . Q:$P(^XMB(3.9,XMZ,.6),U,1)=DT
. . K ^XMB(3.9,XMZ,1,I)
. . D ERR(XMZ,221,I) ; Recipient |1| null, no C xref: fixed
. S XMRECIPS=XMRECIPS+1
. Q:$D(^XMB(3.9,XMZ,1,"C",$E(XMVAL,1,30),I))
. I $L(XMVAL)>30,$D(^XMB(3.9,XMZ,1,"C",XMVAL,I)) D Q
. . ;K ^XMB(3.9,XMZ,1,"C",XMVAL,I)
. . ;D ERR(XMZ,223,I) ; Recipient |1| C xref too long: xref shortened
. . ;S ^XMB(3.9,XMZ,1,"C",$E(XMVAL,1,30),I)=""
. D ERR(XMZ,222,I) ; Recipient |1| no C xref: xref created
. S ^XMB(3.9,XMZ,1,"C",$E(XMVAL,1,30),I)=""
I $D(^XMB(3.9,XMZ,1,0)) S:$P(^XMB(3.9,XMZ,1,0),U,4)'=XMRECIPS $P(^(0),U,4)=XMRECIPS Q
S ^XMB(3.9,XMZ,1,0)="^3.91A^"_I_U_XMRECIPS
Q
CXREF(XMZ) ; Check C xref for Recipient multiple
N I,XMVAL,XMXREF
S (I,XMXREF)=""
F S XMXREF=$O(^XMB(3.9,XMZ,1,"C",XMXREF)) Q:XMXREF="" D
. F S I=$O(^XMB(3.9,XMZ,1,"C",XMXREF,I)) Q:'I D
. . S XMVAL=$P($G(^XMB(3.9,XMZ,1,I,0)),U)
. . Q:$E(XMVAL,1,30)=$E(XMXREF,1,30)
. . I XMVAL="" D Q
. . . S $P(^XMB(3.9,XMZ,1,I,0),U)=XMXREF
. . . I $L(XMXREF)<30 D ERR(XMZ,231,I) Q ; C xref, but recip |1| null: fixed using xref
. . . D ERR(XMZ,232,I) ; C xref, but recip |1| null: fixed, but CHECK
. . K ^XMB(3.9,XMZ,1,"C",XMXREF,I)
. . D ERR(XMZ,233,I) ; C xref for recip |1| doesn't match recip: xref killed
Q
ERR(XMZ,XMERRNUM,XMDPARM) ;
N XMPARM
S XMERROR(XMERRNUM)=$G(XMERROR(XMERRNUM))+1
S XMPARM(1)=XMZ,XMPARM(2)=$J(XMERRNUM,3)
S XMPARM(3)=$$EZBLD^DIALOG(36300+XMERRNUM,.XMDPARM)
W !,$$EZBLD^DIALOG(36097,.XMPARM) ;Msg=|1|, Err=|2| |3|
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUT4C 5607 printed Dec 13, 2024@02:13:35 Page 2
XMUT4C ;ISC-SF/GMB-Integrity Checker for file 3.9 ;04/19/2002 13:00
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Was (WASH ISC)/CAP
MESSAGE(XMABORT) ;
+1 NEW XMZ,XMCNT,XMZREC,XMCRE8
+2 ; Checking MESSAGE file 3.9
WRITE !!,$$EZBLD^DIALOG(36094),!
+3 FOR
SET XMZ=$ORDER(^XMB(3.9,":"),-1)
if XMZ?1N.N
QUIT
DO BOGUS(XMZ)
+4 SET (XMZ,XMCNT)=0
+5 FOR
SET XMZ=$ORDER(^XMB(3.9,XMZ))
if XMZ'>0
QUIT
Begin DoDot:1
+6 IF XMZ'?1N.N
DO BOGUS(XMZ)
QUIT
+7 SET XMCNT=XMCNT+1
IF XMCNT#5000=0
Begin DoDot:2
+8 IF '$DATA(ZTQUEUED)
if $X>40
WRITE !
WRITE XMCNT,"."
QUIT
+9 ; User asked the task to stop
IF $$S^%ZTLOAD
SET (XMABORT,ZTSTOP)=1
End DoDot:2
if XMABORT
QUIT
+10 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+11 IF "^^^^^^^^"[XMZREC
Begin DoDot:2
+12 ; Msg has bad/no 0 node: not fixed
DO ERR(XMZ,201)
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 DO SUBJ(XMZ,XMZREC)
+15 IF $PIECE(XMZREC,U,2)=""
Begin DoDot:3
+16 ;* No Name *
SET $PIECE(^XMB(3.9,XMZ,0),U,2)=$$EZBLD^DIALOG(34009)
+17 ; Msg has no sender: fixed
DO ERR(XMZ,206)
End DoDot:3
+18 IF $PIECE(XMZREC,U,3)=""
Begin DoDot:3
+19 SET $PIECE(^XMB(3.9,XMZ,0),U,3)=DT
+20 ; Msg has no date/time: fixed
DO ERR(XMZ,207)
End DoDot:3
End DoDot:2
+21 DO CRE8DT(XMZ,$PIECE(XMZREC,U,3))
+22 DO RESP(XMZ,XMZREC)
+23 if $DATA(^XMB(3.9,XMZ,1))
DO RECIP(XMZ)
End DoDot:1
if XMABORT
QUIT
+24 if XMABORT
QUIT
+25 ; |1| messages in the MESSAGE file 3.9
WRITE !!,$$EZBLD^DIALOG(36093,XMCNT)
+26 ; Zero node is OK
IF XMCNT=$PIECE(^XMB(3.9,0),U,4)
WRITE !,$$EZBLD^DIALOG(36095)
QUIT
+27 LOCK +^XMB(3.9,0):1
+28 SET $PIECE(^XMB(3.9,0),U,4)=XMCNT
+29 LOCK -^XMB(3.9,0)
+30 ; I reset the zero node.
WRITE !,$$EZBLD^DIALOG(36096)
+31 QUIT
BOGUS(XMZ) ;
+1 ; Msg IEN is corrupted: fixed
DO ERR(XMZ,210)
+2 IF $LENGTH($PIECE($GET(^XMB(3.9,XMZ,0)),U,1))
KILL ^XMB(3.9,"B",$EXTRACT($PIECE(^XMB(3.9,XMZ,0),U,1),1,30),XMZ)
+3 KILL ^XMB(3.9,"C",+$PIECE($GET(^XMB(3.9,XMZ,.6)),U,1),XMZ)
+4 KILL ^XMB(3.9,XMZ)
+5 QUIT
SUBJ(XMZ,XMZREC) ;
+1 NEW XMSUBJ
+2 SET XMSUBJ=$PIECE(XMZREC,U)
+3 IF XMSUBJ=""
Begin DoDot:1
+4 ;* No Subject *
SET XMSUBJ=$$EZBLD^DIALOG(34012)
+5 SET $PIECE(^XMB(3.9,XMZ,0),U,1)=XMSUBJ
+6 SET ^XMB(3.9,"B",XMSUBJ,XMZ)=""
+7 ; Msg has no subject: fixed
DO ERR(XMZ,202)
End DoDot:1
+8 IF '$DATA(^XMB(3.9,"B",$EXTRACT(XMSUBJ,1,30),XMZ))
Begin DoDot:1
+9 IF $LENGTH(XMSUBJ)>30
IF $DATA(^XMB(3.9,"B",XMSUBJ,XMZ))
Begin DoDot:2
+10 KILL ^XMB(3.9,"B",XMSUBJ,XMZ)
+11 ; Subject B xref too long: xref shortened
DO ERR(XMZ,205)
End DoDot:2
+12 ; Subject has no B xref: xref created
IF '$TEST
DO ERR(XMZ,204)
+13 SET ^XMB(3.9,"B",$EXTRACT(XMSUBJ,1,30),XMZ)=""
End DoDot:1
+14 IF $LENGTH(XMSUBJ)<3!($LENGTH(XMSUBJ)>65)
Begin DoDot:1
+15 ; Msg subject <3 or >65: fixed
DO ERR(XMZ,203)
+16 SET XMSUBJ=$SELECT($LENGTH(XMSUBJ)<3:XMSUBJ_"...",1:$EXTRACT(XMSUBJ,1,65))
+17 NEW XMFDA
+18 SET XMFDA(3.9,XMZ_",",.01)=XMSUBJ
+19 DO FILE^DIE("","XMFDA")
End DoDot:1
+20 QUIT
RESP(XMZ,XMZREC) ;
+1 NEW XMZO
+2 IF $PIECE(XMZREC,U,8)
Begin DoDot:1
+3 SET XMZO=$PIECE(XMZREC,U,8)
+4 IF XMZO=XMZ
Begin DoDot:2
+5 ; Message thinks it's a response to itself: fixed
DO ERR(XMZ,211)
+6 SET $PIECE(^XMB(3.9,XMZ,0),U,8)=""
End DoDot:2
QUIT
+7 IF '$DATA(^XMB(3.9,XMZO,0))
Begin DoDot:2
+8 ; No original message |1| for this response: fixed
DO ERR(XMZ,212,XMZO)
+9 SET $PIECE(^XMB(3.9,XMZ,0),U,8)=""
End DoDot:2
QUIT
+10 IF $$ATTACHED(XMZO,XMZ)
QUIT
+11 ; Not in response chain of |1|: fixed
DO ERR(XMZ,213,XMZO)
+12 SET $PIECE(^XMB(3.9,XMZ,0),U,8)=""
End DoDot:1
QUIT
+13 NEW XMSUBJ
+14 SET XMSUBJ=$PIECE(XMZREC,U)
+15 if XMSUBJ'?1"R"1.N
QUIT
+16 if $PIECE(XMZREC,U,2)["@"
QUIT
+17 SET XMZO=+$EXTRACT(XMSUBJ,2,99)
+18 IF '$DATA(^XMB(3.9,XMZO,0))
Begin DoDot:1
+19 ; No original message |1| for this response: not fixed
DO ERR(XMZ,216,XMZO)
End DoDot:1
QUIT
+20 IF '$$ATTACHED(XMZO,XMZ)
Begin DoDot:1
+21 ; Not in response chain of |1|: not fixed
DO ERR(XMZ,217,XMZO)
End DoDot:1
QUIT
+22 ; Piece 8 didn't point to original message |1|: fixed
DO ERR(XMZ,218,XMZO)
+23 SET $PIECE(^XMB(3.9,XMZ,0),U,8)=XMZO
+24 QUIT
ATTACHED(XMZO,XMZ) ; Is XMZ in the response chain of XMZO?
+1 NEW I
+2 SET I=0
+3 FOR
SET I=$ORDER(^XMB(3.9,XMZO,3,I))
if 'I
QUIT
if $PIECE($GET(^(I,0)),U)=XMZ
QUIT
+4 QUIT +I
CRE8DT(XMZ,XMDATE) ;
+1 SET XMCRE8=$PIECE($GET(^XMB(3.9,XMZ,.6)),U,1)
+2 IF 'XMCRE8
Begin DoDot:1
+3 IF $PIECE(XMDATE,".",1)?7N
SET XMDATE=$PIECE(XMDATE,".",1)
+4 IF '$TEST
IF XMDATE=""
SET XMDATE=DT
+5 IF '$TEST
Begin DoDot:2
+6 SET XMDATE=$$CONVERT^XMXUTIL1(XMDATE)
+7 if XMDATE=-1
SET XMDATE=DT
End DoDot:2
+8 SET $PIECE(^XMB(3.9,XMZ,.6),U,1)=XMDATE
+9 SET ^XMB(3.9,"C",XMDATE,XMZ)=""
+10 ; Msg has no local create date: fixed
DO ERR(XMZ,208)
End DoDot:1
QUIT
+11 IF '$DATA(^XMB(3.9,"C",XMCRE8,XMZ))
Begin DoDot:1
+12 SET ^XMB(3.9,"C",XMCRE8,XMZ)=""
+13 ; Local create date C xref missing: fixed
DO ERR(XMZ,209)
End DoDot:1
+14 QUIT
RECIP(XMZ) ; Check recipient multiple
+1 NEW I,XMVAL,XMXREF,XMRECIPS
+2 DO CXREF(XMZ)
+3 SET (I,XMRECIPS)=0
+4 FOR
SET I=$ORDER(^XMB(3.9,XMZ,1,I))
if 'I
QUIT
Begin DoDot:1
+5 SET XMVAL=$PIECE($GET(^XMB(3.9,XMZ,1,I,0)),U)
+6 IF XMVAL=""
Begin DoDot:2
+7 if $PIECE(^XMB(3.9,XMZ,.6),U,1)=DT
QUIT
+8 KILL ^XMB(3.9,XMZ,1,I)
+9 ; Recipient |1| null, no C xref: fixed
DO ERR(XMZ,221,I)
End DoDot:2
QUIT
+10 SET XMRECIPS=XMRECIPS+1
+11 if $DATA(^XMB(3.9,XMZ,1,"C",$EXTRACT(XMVAL,1,30),I))
QUIT
+12 IF $LENGTH(XMVAL)>30
IF $DATA(^XMB(3.9,XMZ,1,"C",XMVAL,I))
Begin DoDot:2
+13 ;K ^XMB(3.9,XMZ,1,"C",XMVAL,I)
+14 ;D ERR(XMZ,223,I) ; Recipient |1| C xref too long: xref shortened
+15 ;S ^XMB(3.9,XMZ,1,"C",$E(XMVAL,1,30),I)=""
End DoDot:2
QUIT
+16 ; Recipient |1| no C xref: xref created
DO ERR(XMZ,222,I)
+17 SET ^XMB(3.9,XMZ,1,"C",$EXTRACT(XMVAL,1,30),I)=""
End DoDot:1
+18 IF $DATA(^XMB(3.9,XMZ,1,0))
if $PIECE(^XMB(3.9,XMZ,1,0),U,4)'=XMRECIPS
SET $PIECE(^(0),U,4)=XMRECIPS
QUIT
+19 SET ^XMB(3.9,XMZ,1,0)="^3.91A^"_I_U_XMRECIPS
+20 QUIT
CXREF(XMZ) ; Check C xref for Recipient multiple
+1 NEW I,XMVAL,XMXREF
+2 SET (I,XMXREF)=""
+3 FOR
SET XMXREF=$ORDER(^XMB(3.9,XMZ,1,"C",XMXREF))
if XMXREF=""
QUIT
Begin DoDot:1
+4 FOR
SET I=$ORDER(^XMB(3.9,XMZ,1,"C",XMXREF,I))
if 'I
QUIT
Begin DoDot:2
+5 SET XMVAL=$PIECE($GET(^XMB(3.9,XMZ,1,I,0)),U)
+6 if $EXTRACT(XMVAL,1,30)=$EXTRACT(XMXREF,1,30)
QUIT
+7 IF XMVAL=""
Begin DoDot:3
+8 SET $PIECE(^XMB(3.9,XMZ,1,I,0),U)=XMXREF
+9 ; C xref, but recip |1| null: fixed using xref
IF $LENGTH(XMXREF)<30
DO ERR(XMZ,231,I)
QUIT
+10 ; C xref, but recip |1| null: fixed, but CHECK
DO ERR(XMZ,232,I)
End DoDot:3
QUIT
+11 KILL ^XMB(3.9,XMZ,1,"C",XMXREF,I)
+12 ; C xref for recip |1| doesn't match recip: xref killed
DO ERR(XMZ,233,I)
End DoDot:2
End DoDot:1
+13 QUIT
ERR(XMZ,XMERRNUM,XMDPARM) ;
+1 NEW XMPARM
+2 SET XMERROR(XMERRNUM)=$GET(XMERROR(XMERRNUM))+1
+3 SET XMPARM(1)=XMZ
SET XMPARM(2)=$JUSTIFY(XMERRNUM,3)
+4 SET XMPARM(3)=$$EZBLD^DIALOG(36300+XMERRNUM,.XMDPARM)
+5 ;Msg=|1|, Err=|2| |3|
WRITE !,$$EZBLD^DIALOG(36097,.XMPARM)
+6 QUIT
