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 Nov 22, 2024@16:55:21 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 ;
