PXRMEXMM ; SLC/PKR - Routines to select and deal with MailMan messages ;07/20/2020
 ;;2.0;CLINICAL REMINDERS;**12,26,74**;Feb 04, 2005;Build 5
 ;===============
CHECKOVF(TMPSUB,LINE,LNUM) ;Check for overflow lines.
 N DONE,LN,TEMP
 S DONE=0,LN=LNUM
 F  Q:DONE  D
 . S LN=LN+1
 . S TEMP=$G(^TMP(TMPSUB,$J,LN))
 . I $P(TEMP,U,1)'="OVF" S DONE=1 Q
 . S LINE=LINE_$P(TEMP,U,2)
 . S LNUM=LN
 Q
 ;
 ;===============
CMM(SUCCESS,LIST) ;Create a MailMan message containing the repository
 ;entries in LIST.
 ;Get a new MailMan message number.
 N EXCHIEN,ENTRY,IC,IND,JND,LC,LEN,LINE,LNUM,NENTRIES,NLINES,TEMP
 N TLC,XMSUB
 S TEMP=$$GETSUB
 I (TEMP["^")!(TEMP="") Q
 S XMSUB="CREX: "_TEMP
 S TEMP=$$SUBCHK^XMGAPI0(XMSUB,0)
 I $P(TEMP,U,1)'="" S XMSUB=$E(XMSUB,1,65)
RETRY ;
 D XMZ^XMA2
 I XMZ<1 G RETRY
 S SUCCESS("XMZ")=XMZ
 S SUCCESS("SUB")=XMSUB
 ;
 S (IC,TLC)=0
 S NENTRIES=$L(LIST,",")-1
 F IND=1:1:NENTRIES D
 . S ENTRY=$P(LIST,",",IND)
 . S EXCHIEN=$$RIEN^PXRMEXU1(ENTRY)
 . S LC=$O(^PXD(811.8,EXCHIEN,100,""),-1)
 . S TLC=TLC+LC
 . F JND=1:1:LC D
 .. S LINE=^PXD(811.8,EXCHIEN,100,JND,0)
 .. S LEN=$L(LINE)
 .. I LEN>250 D OVERFLOW(XMZ,.IC,LEN,LINE) Q
 .. S IC=IC+1,^XMB(3.9,XMZ,2,IC,0)=^PXD(811.8,EXCHIEN,100,JND,0)
 S ^XMB(3.9,XMZ,2,0)="^3.92^"_TLC_"^"_TLC_"^"_DT
 ;
 ;Make the message information only.
 S $P(^XMB(3.9,XMZ,0),U,12)="Y"
 ;
 ;Get a list of who to send it to and send it.
 D ENT2^XMD
 Q
 ;
 ;===============
GETMESSN() ;Get the message number.
 N BSKT,DIC,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,ZN
 S DIC("A")="Select a MailMan message: "
 S DIC=3.9
 S DIC(0)="EQV"
 ;Look for messages that start with "C" for either CREX or Copy of.
 S X="CREX:"
 ;DBIA #2736 for XMXUTIL2
 S DIC("S")="S BSKT=$$BSKT^XMXUTIL2(DUZ,+Y) I BSKT>0,BSKT'=.5"
 S DIC("W")="S ZN=$$ZNODE^XMXUTIL2(+Y) W !,""         "",$$FROM^XMXUTIL2(ZN),"" "",$$DATE^XMXUTIL2(ZN),!"
 W !
 D ^DIC K DIC
 I X=(U_U) S DTOUT=1
 I $D(DIROUT)!$D(DIRUT) Q ""
 I $D(DTOUT)!$D(DUOUT) Q ""
 I +Y'=-1 Q $P(Y,U,1)
 ;
 S DIC("A")="Select a MailMan message: "
 S DIC=3.9
 S DIC(0)="EQV"
 S X="Copy of: CREX:"
 ;DBIA #2736 for XMXUTIL2
 S DIC("S")="S BSKT=$$BSKT^XMXUTIL2(DUZ,+Y) I BSKT>0,BSKT'=.5"
 S DIC("W")="S ZN=$$ZNODE^XMXUTIL2(+Y) W !,""         "",$$FROM^XMXUTIL2(ZN),"" "",$$DATE^XMXUTIL2(ZN),!"
 W !
 D ^DIC K DIC
 I X=(U_U) S DTOUT=1
 I $D(DIROUT)!$D(DIRUT) Q ""
 I $D(DTOUT)!$D(DUOUT) Q ""
 Q $P(Y,U,1)
 ;
 ;===============
GETSUB() ;Prompt the user for a subject.
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
 S DIR(0)="FAU"_U_"1:59"
 S DIR("A")="Enter a subject: "
 D ^DIR
 I $D(DIROUT)!$D(DIRUT) Q ""
 I $D(DTOUT)!$D(DUOUT) Q ""
 Q Y
 ;
 ;===============
LMM(SUCCESS,XMZ) ;Load repository entries from a MailMan message.
 N CSUM,DATEP,EXIEN,EXTYPE,FDA,FDAIEN,IENROOT,IND,LINE,LNUM,MSG
 N NENTRY,NLINES,RESULT,RETMP,RNAME,SITE,SOURCE,SSOURCE,TEMP
 N US,USER,VRSN,XMER
 ;Get the message information
 ;DBIA #1144
 S TEMP=$$HDR^XMGAPI2(XMZ,.XMVAR,0)
 I TEMP'=0 D  Q
 . W !,"This MailMan message has a corrupted header."
 . S SUCCESS=0
 . H 2
 ;Load the message
 W !,"Loading MailMan message number ",XMZ
 K ^TMP("PXRMEXMM",$J),^TMP("PXRMEXLMM",$J)
 S RESULT=$$GET1^DIQ(3.9,XMZ_",",3,"","^TMP(""PXRMEXMM"",$J)","MSG")
 I RESULT="" W !,"Could not load the message." Q
 S RETMP="^TMP(""PXRMEXLMM"",$J)"
 S (NENTRY,NLINES,SSOURCE)=0
 S LNUM=$$STARTLINE("PXRMEXMM")
 I LNUM=-1 D  Q
 . W !,"Could not locate the XML header."
 . K ^TMP("PXRMEXMM",$J),^TMP("PXRMEXLMM",$J)
 F  S LNUM=$O(^TMP("PXRMEXMM",$J,LNUM)) Q:LNUM=""  D
 . S LINE=^TMP("PXRMEXMM",$J,LNUM)
 .;Check for overflow lines.
 . D CHECKOVF("PXRMEXMM",.LINE,.LNUM)
 . S NLINES=NLINES+1
 . S ^TMP("PXRMEXLMM",$J,NLINES,0)=LINE
 . I LINE["<PACKAGE_VERSION>" S VRSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")
 . I LINE["<EXCHANGE_TYPE>" S EXTYPE=$$GETTAGV^PXRMEXU3(LINE,"<EXCHANGE_TYPE>",1)
 . I LINE="<SOURCE>" S SSOURCE=1
 . I SSOURCE D
 .. I LINE["<NAME>" S RNAME=$$GETTAGV^PXRMEXU3(LINE,"<NAME>",1)
 .. I LINE["<USER>" S USER=$$GETTAGV^PXRMEXU3(LINE,"<USER>",1)
 .. I LINE["<SITE>" S SITE=$$GETTAGV^PXRMEXU3(LINE,"<SITE>",1)
 .. I LINE["<DATE_PACKED>" S DATEP=$$GETTAGV^PXRMEXU3(LINE,"<DATE_PACKED>")
 . I LINE="</SOURCE>" D
 .. S SSOURCE=0
 .. S SOURCE=USER_" at "_SITE
 .;See if the entry is loaded into the temporary storage.
 . I LINE="</REMINDER_EXCHANGE_FILE_ENTRY>" D
 .. S NLINES=0
 .. S NENTRY=NENTRY+1
 ..;Make sure it has the correct format.
 .. I (^TMP("PXRMEXLMM",$J,1,0)'["xml")!(^TMP("PXRMEXLMM",$J,2,0)'="<REMINDER_EXCHANGE_FILE_ENTRY>") D  Q
 ... W !,"There is a problem reading this MailMan message for entry ",NENTRY,", try it again."
 ... W !,"If it fails twice it is not in the proper reminder exchange format."
 ... S SUCCESS(NENTRY)=0
 ... H 2
 ..;Make sure this entry does not already exist.
 .. S EXIEN=$$REXISTS^PXRMEXIU(RNAME,DATEP) D
 .. I EXIEN>0 D
 ... W !,RNAME
 ... W !,"with a date packed of ",DATEP
 ... W !,"is already in the Exchange File, it will not be added again."
 ... ;S SUCCESS(NENTRY)=0
 ... S SUCCESS(NENTRY)=EXIEN_"A"
 ... H 2
 .. E  D
 ... K FDA,IENROOT
 ... S FDA(811.8,"+1,",.01)=RNAME
 ... S FDA(811.8,"+1,",.02)=SOURCE
 ... S FDA(811.8,"+1,",.03)=DATEP
 ... D UPDATE^PXRMEXPU(.US,.FDA,.IENROOT)
 ... S SUCCESS(NENTRY)=US
 ...;Create the description and save the data.
 ... N DESL,DESCT,KEYWORDT
 ... D DESC^PXRMEXU3(RETMP,.DESCT)
 ... D KEYWORD^PXRMEXU3(RETMP,.KEYWORDT)
 ... S DESL("RNAME")=RNAME,DESL("SOURCE")=SOURCE,DESL("DATEP")=DATEP
 ... S DESL("VRSN")=VRSN
 ... D DESC^PXRMEXU1(IENROOT(1),.DESL,"DESCT","KEYWORDT")
 ... M ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXLMM",$J)
 ... W !,"Added Reminder Exchange entry ",RNAME H 2
 .. K ^TMP("PXRMEXLMM",$J)
 ;Check the success of the entry installs.
 K ^TMP("PXRMEXMM",$J),^TMP("PXRMEXLMM",$J)
 S SUCCESS=1
 S IND=""
 F  S IND=$O(SUCCESS(IND)) Q:+IND=0  D
 . I 'SUCCESS(IND) S SUCCESS=0 Q
 Q
 ;
 ;===============
OVERFLOW(XMZ,IC,LEN,LINE) ;MailMan does not allow lines longer than 255;
 ;to be safe, for lines longer than 250 break it into overflow segments.
 N CHUNK,END,N250,START
 S IC=IC+1,^XMB(3.9,XMZ,2,IC,0)=$E(LINE,1,250)
 S N250=((LEN-250)\246)+1
 S START=251,END=250+246
 F CHUNK=1:1:N250 D
 . S IC=IC+1,^XMB(3.9,XMZ,2,IC,0)="OVF^"_$E(LINE,START,END)
 . S START=START+246,END=END+246
 Q
 ;
 ;===============
STARTLINE(TMPSUB) ;Find the starting line by looking for the XML header.
 ;This will skip over extra header information created by things like
 ;copying, forwarding, or using p-message. Return the line previous
 ;to the header line so the first $O will be the header line.
 N DONE,LNUM,STARTLINE
 S DONE=0,LNUM=""
 F  S LNUM=$O(^TMP(TMPSUB,$J,LNUM)) Q:(DONE)!(LNUM="")  D
 . I ^TMP(TMPSUB,$J,LNUM)="<?xml version=""1.0"" standalone=""yes""?>" S DONE=1,STARTLINE=LNUM
 S STARTLINE=$S(LNUM="":-1,1:$O(^TMP(TMPSUB,$J,STARTLINE),-1))
 Q STARTLINE
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXMM   6976     printed  Sep 23, 2025@19:21:08                                                                                                                                                                                                    Page 2
PXRMEXMM  ; SLC/PKR - Routines to select and deal with MailMan messages ;07/20/2020
 +1       ;;2.0;CLINICAL REMINDERS;**12,26,74**;Feb 04, 2005;Build 5
 +2       ;===============
CHECKOVF(TMPSUB,LINE,LNUM) ;Check for overflow lines.
 +1        NEW DONE,LN,TEMP
 +2        SET DONE=0
           SET LN=LNUM
 +3        FOR 
               if DONE
                   QUIT 
               Begin DoDot:1
 +4                SET LN=LN+1
 +5                SET TEMP=$GET(^TMP(TMPSUB,$JOB,LN))
 +6                IF $PIECE(TEMP,U,1)'="OVF"
                       SET DONE=1
                       QUIT 
 +7                SET LINE=LINE_$PIECE(TEMP,U,2)
 +8                SET LNUM=LN
               End DoDot:1
 +9        QUIT 
 +10      ;
 +11      ;===============
CMM(SUCCESS,LIST) ;Create a MailMan message containing the repository
 +1       ;entries in LIST.
 +2       ;Get a new MailMan message number.
 +3        NEW EXCHIEN,ENTRY,IC,IND,JND,LC,LEN,LINE,LNUM,NENTRIES,NLINES,TEMP
 +4        NEW TLC,XMSUB
 +5        SET TEMP=$$GETSUB
 +6        IF (TEMP["^")!(TEMP="")
               QUIT 
 +7        SET XMSUB="CREX: "_TEMP
 +8        SET TEMP=$$SUBCHK^XMGAPI0(XMSUB,0)
 +9        IF $PIECE(TEMP,U,1)'=""
               SET XMSUB=$EXTRACT(XMSUB,1,65)
RETRY     ;
 +1        DO XMZ^XMA2
 +2        IF XMZ<1
               GOTO RETRY
 +3        SET SUCCESS("XMZ")=XMZ
 +4        SET SUCCESS("SUB")=XMSUB
 +5       ;
 +6        SET (IC,TLC)=0
 +7        SET NENTRIES=$LENGTH(LIST,",")-1
 +8        FOR IND=1:1:NENTRIES
               Begin DoDot:1
 +9                SET ENTRY=$PIECE(LIST,",",IND)
 +10               SET EXCHIEN=$$RIEN^PXRMEXU1(ENTRY)
 +11               SET LC=$ORDER(^PXD(811.8,EXCHIEN,100,""),-1)
 +12               SET TLC=TLC+LC
 +13               FOR JND=1:1:LC
                       Begin DoDot:2
 +14                       SET LINE=^PXD(811.8,EXCHIEN,100,JND,0)
 +15                       SET LEN=$LENGTH(LINE)
 +16                       IF LEN>250
                               DO OVERFLOW(XMZ,.IC,LEN,LINE)
                               QUIT 
 +17                       SET IC=IC+1
                           SET ^XMB(3.9,XMZ,2,IC,0)=^PXD(811.8,EXCHIEN,100,JND,0)
                       End DoDot:2
               End DoDot:1
 +18       SET ^XMB(3.9,XMZ,2,0)="^3.92^"_TLC_"^"_TLC_"^"_DT
 +19      ;
 +20      ;Make the message information only.
 +21       SET $PIECE(^XMB(3.9,XMZ,0),U,12)="Y"
 +22      ;
 +23      ;Get a list of who to send it to and send it.
 +24       DO ENT2^XMD
 +25       QUIT 
 +26      ;
 +27      ;===============
GETMESSN() ;Get the message number.
 +1        NEW BSKT,DIC,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,ZN
 +2        SET DIC("A")="Select a MailMan message: "
 +3        SET DIC=3.9
 +4        SET DIC(0)="EQV"
 +5       ;Look for messages that start with "C" for either CREX or Copy of.
 +6        SET X="CREX:"
 +7       ;DBIA #2736 for XMXUTIL2
 +8        SET DIC("S")="S BSKT=$$BSKT^XMXUTIL2(DUZ,+Y) I BSKT>0,BSKT'=.5"
 +9        SET DIC("W")="S ZN=$$ZNODE^XMXUTIL2(+Y) W !,""         "",$$FROM^XMXUTIL2(ZN),"" "",$$DATE^XMXUTIL2(ZN),!"
 +10       WRITE !
 +11       DO ^DIC
           KILL DIC
 +12       IF X=(U_U)
               SET DTOUT=1
 +13       IF $DATA(DIROUT)!$DATA(DIRUT)
               QUIT ""
 +14       IF $DATA(DTOUT)!$DATA(DUOUT)
               QUIT ""
 +15       IF +Y'=-1
               QUIT $PIECE(Y,U,1)
 +16      ;
 +17       SET DIC("A")="Select a MailMan message: "
 +18       SET DIC=3.9
 +19       SET DIC(0)="EQV"
 +20       SET X="Copy of: CREX:"
 +21      ;DBIA #2736 for XMXUTIL2
 +22       SET DIC("S")="S BSKT=$$BSKT^XMXUTIL2(DUZ,+Y) I BSKT>0,BSKT'=.5"
 +23       SET DIC("W")="S ZN=$$ZNODE^XMXUTIL2(+Y) W !,""         "",$$FROM^XMXUTIL2(ZN),"" "",$$DATE^XMXUTIL2(ZN),!"
 +24       WRITE !
 +25       DO ^DIC
           KILL DIC
 +26       IF X=(U_U)
               SET DTOUT=1
 +27       IF $DATA(DIROUT)!$DATA(DIRUT)
               QUIT ""
 +28       IF $DATA(DTOUT)!$DATA(DUOUT)
               QUIT ""
 +29       QUIT $PIECE(Y,U,1)
 +30      ;
 +31      ;===============
GETSUB()  ;Prompt the user for a subject.
 +1        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
 +2        SET DIR(0)="FAU"_U_"1:59"
 +3        SET DIR("A")="Enter a subject: "
 +4        DO ^DIR
 +5        IF $DATA(DIROUT)!$DATA(DIRUT)
               QUIT ""
 +6        IF $DATA(DTOUT)!$DATA(DUOUT)
               QUIT ""
 +7        QUIT Y
 +8       ;
 +9       ;===============
LMM(SUCCESS,XMZ) ;Load repository entries from a MailMan message.
 +1        NEW CSUM,DATEP,EXIEN,EXTYPE,FDA,FDAIEN,IENROOT,IND,LINE,LNUM,MSG
 +2        NEW NENTRY,NLINES,RESULT,RETMP,RNAME,SITE,SOURCE,SSOURCE,TEMP
 +3        NEW US,USER,VRSN,XMER
 +4       ;Get the message information
 +5       ;DBIA #1144
 +6        SET TEMP=$$HDR^XMGAPI2(XMZ,.XMVAR,0)
 +7        IF TEMP'=0
               Begin DoDot:1
 +8                WRITE !,"This MailMan message has a corrupted header."
 +9                SET SUCCESS=0
 +10               HANG 2
               End DoDot:1
               QUIT 
 +11      ;Load the message
 +12       WRITE !,"Loading MailMan message number ",XMZ
 +13       KILL ^TMP("PXRMEXMM",$JOB),^TMP("PXRMEXLMM",$JOB)
 +14       SET RESULT=$$GET1^DIQ(3.9,XMZ_",",3,"","^TMP(""PXRMEXMM"",$J)","MSG")
 +15       IF RESULT=""
               WRITE !,"Could not load the message."
               QUIT 
 +16       SET RETMP="^TMP(""PXRMEXLMM"",$J)"
 +17       SET (NENTRY,NLINES,SSOURCE)=0
 +18       SET LNUM=$$STARTLINE("PXRMEXMM")
 +19       IF LNUM=-1
               Begin DoDot:1
 +20               WRITE !,"Could not locate the XML header."
 +21               KILL ^TMP("PXRMEXMM",$JOB),^TMP("PXRMEXLMM",$JOB)
               End DoDot:1
               QUIT 
 +22       FOR 
               SET LNUM=$ORDER(^TMP("PXRMEXMM",$JOB,LNUM))
               if LNUM=""
                   QUIT 
               Begin DoDot:1
 +23               SET LINE=^TMP("PXRMEXMM",$JOB,LNUM)
 +24      ;Check for overflow lines.
 +25               DO CHECKOVF("PXRMEXMM",.LINE,.LNUM)
 +26               SET NLINES=NLINES+1
 +27               SET ^TMP("PXRMEXLMM",$JOB,NLINES,0)=LINE
 +28               IF LINE["<PACKAGE_VERSION>"
                       SET VRSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")
 +29               IF LINE["<EXCHANGE_TYPE>"
                       SET EXTYPE=$$GETTAGV^PXRMEXU3(LINE,"<EXCHANGE_TYPE>",1)
 +30               IF LINE="<SOURCE>"
                       SET SSOURCE=1
 +31               IF SSOURCE
                       Begin DoDot:2
 +32                       IF LINE["<NAME>"
                               SET RNAME=$$GETTAGV^PXRMEXU3(LINE,"<NAME>",1)
 +33                       IF LINE["<USER>"
                               SET USER=$$GETTAGV^PXRMEXU3(LINE,"<USER>",1)
 +34                       IF LINE["<SITE>"
                               SET SITE=$$GETTAGV^PXRMEXU3(LINE,"<SITE>",1)
 +35                       IF LINE["<DATE_PACKED>"
                               SET DATEP=$$GETTAGV^PXRMEXU3(LINE,"<DATE_PACKED>")
                       End DoDot:2
 +36               IF LINE="</SOURCE>"
                       Begin DoDot:2
 +37                       SET SSOURCE=0
 +38                       SET SOURCE=USER_" at "_SITE
                       End DoDot:2
 +39      ;See if the entry is loaded into the temporary storage.
 +40               IF LINE="</REMINDER_EXCHANGE_FILE_ENTRY>"
                       Begin DoDot:2
 +41                       SET NLINES=0
 +42                       SET NENTRY=NENTRY+1
 +43      ;Make sure it has the correct format.
 +44                       IF (^TMP("PXRMEXLMM",$JOB,1,0)'["xml")!(^TMP("PXRMEXLMM",$JOB,2,0)'="<REMINDER_EXCHANGE_FILE_ENTRY>")
                               Begin DoDot:3
 +45                               WRITE !,"There is a problem reading this MailMan message for entry ",NENTRY,", try it again."
 +46                               WRITE !,"If it fails twice it is not in the proper reminder exchange format."
 +47                               SET SUCCESS(NENTRY)=0
 +48                               HANG 2
                               End DoDot:3
                               QUIT 
 +49      ;Make sure this entry does not already exist.
 +50                       SET EXIEN=$$REXISTS^PXRMEXIU(RNAME,DATEP)
                           Begin DoDot:3
                           End DoDot:3
 +51                       IF EXIEN>0
                               Begin DoDot:3
 +52                               WRITE !,RNAME
 +53                               WRITE !,"with a date packed of ",DATEP
 +54                               WRITE !,"is already in the Exchange File, it will not be added again."
 +55      ;S SUCCESS(NENTRY)=0
 +56                               SET SUCCESS(NENTRY)=EXIEN_"A"
 +57                               HANG 2
                               End DoDot:3
 +58                      IF '$TEST
                               Begin DoDot:3
 +59                               KILL FDA,IENROOT
 +60                               SET FDA(811.8,"+1,",.01)=RNAME
 +61                               SET FDA(811.8,"+1,",.02)=SOURCE
 +62                               SET FDA(811.8,"+1,",.03)=DATEP
 +63                               DO UPDATE^PXRMEXPU(.US,.FDA,.IENROOT)
 +64                               SET SUCCESS(NENTRY)=US
 +65      ;Create the description and save the data.
 +66                               NEW DESL,DESCT,KEYWORDT
 +67                               DO DESC^PXRMEXU3(RETMP,.DESCT)
 +68                               DO KEYWORD^PXRMEXU3(RETMP,.KEYWORDT)
 +69                               SET DESL("RNAME")=RNAME
                                   SET DESL("SOURCE")=SOURCE
                                   SET DESL("DATEP")=DATEP
 +70                               SET DESL("VRSN")=VRSN
 +71                               DO DESC^PXRMEXU1(IENROOT(1),.DESL,"DESCT","KEYWORDT")
 +72                               MERGE ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXLMM",$JOB)
 +73                               WRITE !,"Added Reminder Exchange entry ",RNAME
                                   HANG 2
                               End DoDot:3
 +74                       KILL ^TMP("PXRMEXLMM",$JOB)
                       End DoDot:2
               End DoDot:1
 +75      ;Check the success of the entry installs.
 +76       KILL ^TMP("PXRMEXMM",$JOB),^TMP("PXRMEXLMM",$JOB)
 +77       SET SUCCESS=1
 +78       SET IND=""
 +79       FOR 
               SET IND=$ORDER(SUCCESS(IND))
               if +IND=0
                   QUIT 
               Begin DoDot:1
 +80               IF 'SUCCESS(IND)
                       SET SUCCESS=0
                       QUIT 
               End DoDot:1
 +81       QUIT 
 +82      ;
 +83      ;===============
OVERFLOW(XMZ,IC,LEN,LINE) ;MailMan does not allow lines longer than 255;
 +1       ;to be safe, for lines longer than 250 break it into overflow segments.
 +2        NEW CHUNK,END,N250,START
 +3        SET IC=IC+1
           SET ^XMB(3.9,XMZ,2,IC,0)=$EXTRACT(LINE,1,250)
 +4        SET N250=((LEN-250)\246)+1
 +5        SET START=251
           SET END=250+246
 +6        FOR CHUNK=1:1:N250
               Begin DoDot:1
 +7                SET IC=IC+1
                   SET ^XMB(3.9,XMZ,2,IC,0)="OVF^"_$EXTRACT(LINE,START,END)
 +8                SET START=START+246
                   SET END=END+246
               End DoDot:1
 +9        QUIT 
 +10      ;
 +11      ;===============
STARTLINE(TMPSUB) ;Find the starting line by looking for the XML header.
 +1       ;This will skip over extra header information created by things like
 +2       ;copying, forwarding, or using p-message. Return the line previous
 +3       ;to the header line so the first $O will be the header line.
 +4        NEW DONE,LNUM,STARTLINE
 +5        SET DONE=0
           SET LNUM=""
 +6        FOR 
               SET LNUM=$ORDER(^TMP(TMPSUB,$JOB,LNUM))
               if (DONE)!(LNUM="")
                   QUIT 
               Begin DoDot:1
 +7                IF ^TMP(TMPSUB,$JOB,LNUM)="<?xml version=""1.0"" standalone=""yes""?>"
                       SET DONE=1
                       SET STARTLINE=LNUM
               End DoDot:1
 +8        SET STARTLINE=$SELECT(LNUM="":-1,1:$ORDER(^TMP(TMPSUB,$JOB,STARTLINE),-1))
 +9        QUIT STARTLINE
 +10      ;