Routine: XMUT41

XMUT41 ;(ISC-SF/GMB- XMUT4 (Cont.) ;04/17/2002  11:52

 ;;8.0;MailMan;;Jun 28, 2002

WARNING(XMABORT) ;

 N DIR,X,Y,XMTEXT

W !

 D BLD^DIALOG(36084,"","","XMTEXT","F")

 D MSG^DIALOG("WM","","","","XMTEXT")

W !

 ;The MailMan file checker may take some time to process.

 ;If you have not tried it before, PLEASE try it when the

 ;system will be quiescent for a LONG period of time.

 ;Errors listed are generally not fatal.  Most errors are

 ;corrected.  Please enter a NOIS if there are many errors.

 ;Keep the error printout for future reference.  If you see

 ;errors in MailMan, the printout may help to resolve them.

 S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(36085) ; Do you wish to proceed

 S DIR("B")=$$EZBLD^DIALOG(39053) ; "NO"

 D ^DIR

 I $D(DIRUT)!'Y S XMABORT=1

MXREF(XMABORT) ;

 ; XMECNT   # msgs in mailbox

 N XMZ,XMUSER,XMECNT,XMK

 W:'$D(ZTQUEUED) !!,$$EZBLD^DIALOG(36086),! ; Checking M xref

 S (XMZ,XMECNT)=0

 F  S XMZ=$O(^XMB(3.7,"M",XMZ)) Q:'XMZ  D  Q:XMABORT

 . S XMECNT=XMECNT+1 I XMECNT#5000=0 D  Q:XMABORT

 . . I '$D(ZTQUEUED) W:$X>40 ! W XMECNT,"." Q

 . . I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop

 . S XMUSER=""

 . F  S XMUSER=$O(^XMB(3.7,"M",XMZ,XMUSER)) Q:'XMUSER  D

 . . S XMK=""

 . . F  S XMK=$O(^XMB(3.7,"M",XMZ,XMUSER,XMK)) Q:'XMK  D

 . . . Q:$D(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0))

 . . . K ^XMB(3.7,"M",XMZ,XMUSER,XMK)

 . . . D ERR^XMUT4(121,XMUSER,XMK,XMZ) ; M xref, but msg not in bskt: xref killed

 Q:XMABORT!$D(ZTQUEUED)

W !

 D BLD^DIALOG(36092,XMECNT,"","XMTEXT","F")

 D MSG^DIALOG("WM","",IOM,"","XMTEXT")

 ;|1| unique messages referenced in MAILBOX file 3.7

POSTBSKT ; Check the Postmaster's bskts to see if any remote bskts

 ; are numbered below 1000.  If so, move them.

 N XMK,XMKN,XMKINST,XMZ,XMINST,XMPUT

 S XMK=1

 F  S XMK=$O(^XMB(3.7,.5,2,XMK)) Q:XMK>999!'XMK  S XMKN=$P(^(XMK,0),U,1)  D

 . S XMINST=$$FIND1^DIC(4.2,"","XQ",XMKN)

 . Q:'XMINST

 . D ERR^XMUT4(160,.5,XMK) ; Xmit basket<1000 has domain name: investigate msgs.

 . ; This bskt has a remote site name.  Does it have msgs to xmit?

 . S XMKINST=XMINST+1000

 . I '$D(^XMB(3.7,.5,2,XMKINST)) D MAKEBSKT^XMXBSKT(.5,XMKINST,XMKN)

 . S (XMZ,XMPUT)=0

 . F  S XMZ=$O(^XMB(3.7,.5,2,XMK,1,XMZ)) Q:'XMZ  D

 . . I '$D(^XMB(3.9,XMZ,1,"AQUEUE",XMINST)) D  Q

 . . . ; This msg does not need to be transmitted.  Does it belong here?

 . . . Q:$D(^XMB(3.9,XMZ,1,"C",.5))!$$BCAST^XMXSEC(XMZ)

 . . . D ERR^XMUT4(161,.5,XMK,XMZ) ; Msg in xmit basket<1000 not addressed to Postmaster: deleted.

 . . . D ZAPIT^XMXMSGS2(.5,XMK,XMZ)

 . . ; This msg needs to be transmitted.  Is it in the real xmit bskt?

 . . Q:$D(^XMB(3.7,.5,2,XMKINST,1,XMZ))  ; already there

 . . S XMPUT=XMPUT+1

 . . I $D(^XMB(3.9,XMZ,1,"C",.5))!$$BCAST^XMXSEC(XMZ) D  Q

 . . . D ERR^XMUT4(162,.5,XMK,XMZ) ; Msg in xmit basket<1000: copied to proper bskt.

 . . . D PUTMSG^XMXMSGS2(.5,XMKINST,XMKN,XMZ)

 . . D ERR^XMUT4(163,.5,XMK,XMZ) ; Msg in xmit basket<1000: moved to proper bskt.

 . . D COPYIT^XMXMSGS2(.5,XMK,XMZ,XMKINST)

 . . D ZAPIT^XMXMSGS2(.5,XMK,XMZ)

 . Q:$$BMSGCT^XMXUTIL(.5,XMK)

 . N XMFDA

 . S XMFDA(3.701,XMK_",.5,",.01)="@"

 . D FILE^DIE("","XMFDA")

 . D ERR^XMUT4(164,.5,XMK) ; Xmit basket<1000 with no msgs: deleted.

SUMMARY(XMABORT) ;

 I $G(ZTSTOP) W !!,$$EZBLD^DIALOG(36422) ; *** Stopping prematurely per user request ***

 W !!,$$EZBLD^DIALOG(36087)   ; Summary of Integrity Check:

 D SUM(36089,36000.1,99,199)  ; Results for MAILBOX file 3.7:

 D SUM(36091,36300.1,199,299) ; Results for MESSAGE file 3.9:

 K XMERROR

SUM(XMTITLE,XMBASE,XMSTART,XMLIMIT) ;

 N XMERRNUM,XMPARM,XMTEXT

 W !!,$$EZBLD^DIALOG(XMTITLE) ; Results for xxx file xxx:

 S XMERRNUM=XMSTART

 F  S XMERRNUM=$O(XMERROR(XMERRNUM)) Q:'XMERRNUM!(XMERRNUM>XMLIMIT)  D

 . S XMPARM(1)=$J(XMERRNUM,3),XMPARM(2)=XMERROR(XMERRNUM)

 . W !!,$$EZBLD^DIALOG(36090,.XMPARM) ; Type |1| errors=|2|

 . D BLD^DIALOG(XMBASE+XMERRNUM,"","","XMTEXT","F")

 . D MSG^DIALOG("WE","",IOM,"","XMTEXT")

 I '$D(XMPARM) W !,$$EZBLD^DIALOG(36088) ; No errors to report.

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUT41   4092     printed  Mar 13, 2025@21:18:09                                                                                                                                                                                                      Page 2

XMUT41    ;(ISC-SF/GMB- XMUT4 (Cont.) ;04/17/2002  11:52

 +1       ;;8.0;MailMan;;Jun 28, 2002

WARNING(XMABORT) ;

 +1        NEW DIR,X,Y,XMTEXT

 +2        WRITE !

 +3        DO BLD^DIALOG(36084,"","","XMTEXT","F")

 +4        DO MSG^DIALOG("WM","","","","XMTEXT")

 +5        WRITE !

 +6       ;The MailMan file checker may take some time to process.

 +7       ;If you have not tried it before, PLEASE try it when the

 +8       ;system will be quiescent for a LONG period of time.

 +9       ;Errors listed are generally not fatal.  Most errors are

 +10      ;corrected.  Please enter a NOIS if there are many errors.

 +11      ;Keep the error printout for future reference.  If you see

 +12      ;errors in MailMan, the printout may help to resolve them.

 +13      ; Do you wish to proceed

           SET DIR(0)="Y"

           SET DIR("A")=$$EZBLD^DIALOG(36085)

 +14      ; "NO"

           SET DIR("B")=$$EZBLD^DIALOG(39053)

 +15       DO ^DIR

 +16       IF $DATA(DIRUT)!'Y

               SET XMABORT=1

 +17       QUIT

MXREF(XMABORT) ;

 +1       ; XMECNT   # msgs in mailbox

 +2        NEW XMZ,XMUSER,XMECNT,XMK

 +3       ; Checking M xref

           if '$DATA(ZTQUEUED)

               WRITE !!,$$EZBLD^DIALOG(36086),!

 +4        SET (XMZ,XMECNT)=0

 +5        FOR

               SET XMZ=$ORDER(^XMB(3.7,"M",XMZ))

               if 'XMZ

                   QUIT

               Begin DoDot:1

 +6                SET XMECNT=XMECNT+1

                   IF XMECNT#5000=0

                       Begin DoDot:2

 +7                        IF '$DATA(ZTQUEUED)

                               if $X>40

                                   WRITE !

                               WRITE XMECNT,"."

                               QUIT

 +8       ; User asked the task to stop

                           IF $$S^%ZTLOAD

                               SET (XMABORT,ZTSTOP)=1

                       End DoDot:2

                       if XMABORT

                           QUIT

 +9                SET XMUSER=""

 +10               FOR

                       SET XMUSER=$ORDER(^XMB(3.7,"M",XMZ,XMUSER))

                       if 'XMUSER

                           QUIT

                       Begin DoDot:2

 +11                       SET XMK=""

 +12                       FOR

                               SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMUSER,XMK))

                               if 'XMK

                                   QUIT

                               Begin DoDot:3

 +13                               if $DATA(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0))

                                       QUIT

 +14                               KILL ^XMB(3.7,"M",XMZ,XMUSER,XMK)

 +15      ; M xref, but msg not in bskt: xref killed

                                   DO ERR^XMUT4(121,XMUSER,XMK,XMZ)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

               if XMABORT

                   QUIT

 +16       if XMABORT!$DATA(ZTQUEUED)

               QUIT

 +17       WRITE !

 +18       DO BLD^DIALOG(36092,XMECNT,"","XMTEXT","F")

 +19       DO MSG^DIALOG("WM","",IOM,"","XMTEXT")

 +20      ;|1| unique messages referenced in MAILBOX file 3.7

 +21       QUIT

POSTBSKT  ; Check the Postmaster's bskts to see if any remote bskts

 +1       ; are numbered below 1000.  If so, move them.

 +2        NEW XMK,XMKN,XMKINST,XMZ,XMINST,XMPUT

 +3        SET XMK=1

 +4        FOR

               SET XMK=$ORDER(^XMB(3.7,.5,2,XMK))

               if XMK>999!'XMK

                   QUIT

               SET XMKN=$PIECE(^(XMK,0),U,1)

               Begin DoDot:1

 +5                SET XMINST=$$FIND1^DIC(4.2,"","XQ",XMKN)

 +6                if 'XMINST

                       QUIT

 +7       ; Xmit basket<1000 has domain name: investigate msgs.

                   DO ERR^XMUT4(160,.5,XMK)

 +8       ; This bskt has a remote site name.  Does it have msgs to xmit?

 +9                SET XMKINST=XMINST+1000

 +10               IF '$DATA(^XMB(3.7,.5,2,XMKINST))

                       DO MAKEBSKT^XMXBSKT(.5,XMKINST,XMKN)

 +11               SET (XMZ,XMPUT)=0

 +12               FOR

                       SET XMZ=$ORDER(^XMB(3.7,.5,2,XMK,1,XMZ))

                       if 'XMZ

                           QUIT

                       Begin DoDot:2

 +13                       IF '$DATA(^XMB(3.9,XMZ,1,"AQUEUE",XMINST))

                               Begin DoDot:3

 +14      ; This msg does not need to be transmitted.  Does it belong here?

 +15                               if $DATA(^XMB(3.9,XMZ,1,"C",.5))!$$BCAST^XMXSEC(XMZ)

                                       QUIT

 +16      ; Msg in xmit basket<1000 not addressed to Postmaster: deleted.

                                   DO ERR^XMUT4(161,.5,XMK,XMZ)

 +17                               DO ZAPIT^XMXMSGS2(.5,XMK,XMZ)

                               End DoDot:3

                               QUIT

 +18      ; This msg needs to be transmitted.  Is it in the real xmit bskt?

 +19      ; already there

                           if $DATA(^XMB(3.7,.5,2,XMKINST,1,XMZ))

                               QUIT

 +20                       SET XMPUT=XMPUT+1

 +21                       IF $DATA(^XMB(3.9,XMZ,1,"C",.5))!$$BCAST^XMXSEC(XMZ)

                               Begin DoDot:3

 +22      ; Msg in xmit basket<1000: copied to proper bskt.

                                   DO ERR^XMUT4(162,.5,XMK,XMZ)

 +23                               DO PUTMSG^XMXMSGS2(.5,XMKINST,XMKN,XMZ)

                               End DoDot:3

                               QUIT

 +24      ; Msg in xmit basket<1000: moved to proper bskt.

                           DO ERR^XMUT4(163,.5,XMK,XMZ)

 +25                       DO COPYIT^XMXMSGS2(.5,XMK,XMZ,XMKINST)

 +26                       DO ZAPIT^XMXMSGS2(.5,XMK,XMZ)

                       End DoDot:2

 +27               if $$BMSGCT^XMXUTIL(.5,XMK)

                       QUIT

 +28               NEW XMFDA

 +29               SET XMFDA(3.701,XMK_",.5,",.01)="@"

 +30               DO FILE^DIE("","XMFDA")

 +31      ; Xmit basket<1000 with no msgs: deleted.

                   DO ERR^XMUT4(164,.5,XMK)

               End DoDot:1

 +32       QUIT

SUMMARY(XMABORT) ;

 +1       ; *** Stopping prematurely per user request ***

           IF $GET(ZTSTOP)

               WRITE !!,$$EZBLD^DIALOG(36422)

 +2       ; Summary of Integrity Check:

           WRITE !!,$$EZBLD^DIALOG(36087)

 +3       ; Results for MAILBOX file 3.7:

           DO SUM(36089,36000.1,99,199)

 +4       ; Results for MESSAGE file 3.9:

           DO SUM(36091,36300.1,199,299)

 +5        KILL XMERROR

 +6        QUIT

SUM(XMTITLE,XMBASE,XMSTART,XMLIMIT) ;

 +1        NEW XMERRNUM,XMPARM,XMTEXT

 +2       ; Results for xxx file xxx:

           WRITE !!,$$EZBLD^DIALOG(XMTITLE)

 +3        SET XMERRNUM=XMSTART

 +4        FOR

               SET XMERRNUM=$ORDER(XMERROR(XMERRNUM))

               if 'XMERRNUM!(XMERRNUM>XMLIMIT)

                   QUIT

               Begin DoDot:1

 +5                SET XMPARM(1)=$JUSTIFY(XMERRNUM,3)

                   SET XMPARM(2)=XMERROR(XMERRNUM)

 +6       ; Type |1| errors=|2|

                   WRITE !!,$$EZBLD^DIALOG(36090,.XMPARM)

 +7                DO BLD^DIALOG(XMBASE+XMERRNUM,"","","XMTEXT","F")

 +8                DO MSG^DIALOG("WE","",IOM,"","XMTEXT")

               End DoDot:1

 +9       ; No errors to report.

           IF '$DATA(XMPARM)

               WRITE !,$$EZBLD^DIALOG(36088)

 +10       QUIT

XMUT41.m