PXRMEXU2 ; SLC/PKR/PJH - Reminder exchange repository utilities, #2.;08/28/2013
;;2.0;CLINICAL REMINDERS;**6,12,26**;Feb 04, 2005;Build 404
;=====================================================
FDA(IND,LC,TMPIND,FILENAME) ;Build the XML FDA output.
N FIELD,FILENUM,INDEX,INDEX0,JND,SIENS,WPC
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FDA>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
;Get the file number.
S FILENUM=""
F S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM)) Q:FILENUM="" D
.;Get the source ien string.
. S SIENS=""
. F S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS)) Q:SIENS="" D
.. S INDEX0=FILENUM_";"_SIENS
..;Get the field number and store the data.
.. S FIELD=""
.. F S FIELD=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)) Q:FIELD="" D
... S INDEX=INDEX0_";"_FIELD
...;If there is another index past the field then this is a
...;word-processing field.
... I $D(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD))=11 D
.... S WPC=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,""),-1)
.... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~WP-start~"_WPC
.... F JND=1:1:WPC D
..... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,JND)
... E S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~"_^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FDA>"
Q
;
;=====================================================
IENROOT(IND,LC,TMPIND,FILENAME) ;Build the XML IEN_ROOT output.
N INDEX,VALUE
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<IEN_ROOT>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
S INDEX=0
F S INDEX=$O(^TMP(TMPIND,$J,IND,FILENAME,INDEX)) Q:INDEX="" D
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_U_^TMP(TMPIND,$J,IND,FILENAME,INDEX)
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</IEN_ROOT>"
Q
;
;=====================================================
MLWARN(FILENAME,PT01,IEN,LINE,MAXLEN) ;Issue a warning if the length of the
;line exceeds the maximum allowed value.
N DATA,INDICES,FIELD,LEN,TEXT
S LEN=$L(LINE)
S INDICES=$P(LINE,"~",1)
S FIELD=$P(INDICES,";",3)
S DATA=$P(LINE,"~",2)
S TEXT(1)="Warning the following line exceeds the VistA maximum allowed length of "_MAXLEN_"."
S TEXT(2)="Therefore this Exchange entry will not transport correctly."
S TEXT(3)="Line: "_LINE
S TEXT(4)="Its length is: "_LEN
S TEXT(5)="Component: "_FILENAME
S TEXT(6)="Name: "_PT01
S TEXT(7)="IEN: "_IEN
S TEXT(8)="Field number: "_FIELD
S TEXT(9)="Value: "_DATA
S TEXT(10)=""
D EN^DDIOL(.TEXT)
H 2
Q
;
;=====================================================
STOREPR(SUCCESS,EFNAME,TMPIND,SELLIST) ;^TMP(TMPIND,$J contains data to be
;stored in the repository. Routines will be found in
;^TMP(TMPIND,$J,"ROUTINE",ROUTINE NAME,n) where n is the line number.
;File entries will be found in ^TMP(TMPIND,$J,N,FILENAME,indexes).
;This is output from the GETS^DIQ call. There are NUMF file entries.
;Format and store it as XML in the repository.
N DATE,DTEST,FDA,FILENAME,FILENUM,IEN
N IENROOT,IND,JND,LC,LINE,NCMPNT,NEWFILE,NUMF,PT01,RNAME
N SIENS,SOURCE,TEMP,VERSN
;If anything went wrong in the packing process then ^TMP(TMPIND,$J
;will not exist.
I '$D(^TMP(TMPIND,$J)) S SUCCESS=0 Q
;
K ^TMP($J,"CIND")
K ^TMP("PXRMEXRS",$J)
S ^TMP("PXRMEXRS",$J,1,0)="<?xml version=""1.0"" standalone=""yes""?>"
S ^TMP("PXRMEXRS",$J,2,0)="<REMINDER_EXCHANGE_FILE_ENTRY>"
S VERSN=$P(^PXRM(800,1,"VERSION"),U,1)
S ^TMP("PXRMEXRS",$J,3,0)="<PACKAGE_VERSION>"_VERSN_"</PACKAGE_VERSION>"
;The pointer to the index will be on line 4 so leave room.
S LC=4
;Save the source information.
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SOURCE>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NAME>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","NAME"))_"</NAME>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<USER>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","USER"))_"</USER>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SITE>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","SITE"))_"</SITE>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DATE_PACKED>"_^TMP(TMPIND,$J,"SRC","DATE")_"</DATE_PACKED>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</SOURCE>"
;
;Save the description.
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DESCRIPTION><![CDATA["
S IND=0
F S IND=$O(^TMP(TMPIND,$J,"DESC",1,IND)) Q:+IND=0 D
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"DESC",1,IND,0)
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]></DESCRIPTION>"
;
;Save the keywords or phrases.
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORDS>"
S IND=0
F S IND=$O(^TMP(TMPIND,$J,"KEYWORD",1,IND)) Q:+IND=0 D
. S TEMP=^TMP(TMPIND,$J,"KEYWORD",1,IND,0)
. I TEMP["," D
.. F JND=1:1:$L(TEMP,",") D
... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3($P(TEMP,",",JND))_"</KEYWORD>"
. E S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3(TEMP)_"</KEYWORD>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</KEYWORDS>"
;
S NCMPNT=0
;Do routines first.
S RNAME=""
F S RNAME=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME)) Q:RNAME="" D
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<M_ROUTINE>"
. S NCMPNT=NCMPNT+1
. S ^TMP($J,"CIND",NCMPNT,"M_ROUTINE_START")=LC
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ROUTINE_NAME>"_RNAME_"</ROUTINE_NAME>"
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$J,"ROUTINE",RNAME)_"</CHECKSUM>"
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CODE>"
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
. S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_START")=LC+1
. S LINE=0
. F S LINE=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE)) Q:LINE="" D
.. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE,0)
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</CODE>"
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</M_ROUTINE>"
. S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_END")=LC-3
;
;Do file entries. For word processing fields the first line is
;file number;source ien string;field~WP-start~line count
;The next line count lines are the WP data.
S NUMF=+$G(^TMP(TMPIND,$J,"NUMF"))
S FILENAME=""
F IND=1:1:NUMF D
. F S FILENAME=$O(^TMP(TMPIND,$J,IND,FILENAME)) Q:FILENAME="" D
.. I FILENAME["IENROOT" S NEWFILE=0,IENROOT=1
.. E S NEWFILE=1,IENROOT=0
.. I NEWFILE D
... S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,""))
... S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,""))
... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FILE>"
... S NCMPNT=NCMPNT+1
... S ^TMP($J,"CIND",NCMPNT,"FILE_START")=LC
... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NAME>"_$$TOXML^PXRMEXU3(FILENAME)_"</FILE_NAME>"
... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NUMBER>"_FILENUM_"</FILE_NUMBER>"
... S LC=LC+1,PT01=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,.01)
... S ^TMP("PXRMEXRS",$J,LC,0)="<POINT_01>"_$$TOXML^PXRMEXU3(PT01)_"</POINT_01>"
... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<INTERNAL_ENTRY_NUMBER>"_+SIENS_"</INTERNAL_ENTRY_NUMBER>"
... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$J,IND,FILENAME)_"</CHECKSUM>"
... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SELECTED>"_$S($D(SELLIST(FILENUM,"IEN",+SIENS)):"YES",1:"NO")_"</SELECTED>"
... S ^TMP($J,"CIND",NCMPNT,"FDA_START")=LC+3
... D FDA(IND,.LC,TMPIND,FILENAME)
... S ^TMP($J,"CIND",NCMPNT,"FDA_END")=LC-2
..;The ien root information always comes after the FDA.
.. I IENROOT D
... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_START")=LC+3
... D IENROOT(IND,.LC,TMPIND,FILENAME)
... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_END")=LC-2
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FILE>"
;Save the index.
S LC=LC+1,^TMP("PXRMEXRS",$J,4,0)="<INDEX_AT>"_LC_"</INDEX_AT>"
S ^TMP("PXRMEXRS",$J,LC,0)="<INDEX>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NUMBER_OF_COMPONENTS>"_NCMPNT_"</NUMBER_OF_COMPONENTS>"
F IND=1:1:NCMPNT D
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<COMPONENT>"
. S JND=""
. F S JND=$O(^TMP($J,"CIND",IND,JND)) Q:JND="" D
.. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<"_JND_">"_^TMP($J,"CIND",IND,JND)_"</"_JND_">"
. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</COMPONENT>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</INDEX>"
S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</REMINDER_EXCHANGE_FILE_ENTRY>"
;Establish the entry in the repository.
S SOURCE=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
S DATE=^TMP(TMPIND,$J,"SRC","DATE")
S FDA(811.8,"+1,",.01)=EFNAME
S FDA(811.8,"+1,",.02)=SOURCE
S FDA(811.8,"+1,",.03)=DATE
D UPDATE^PXRMEXPU(.SUCCESS,.FDA,.IENROOT)
I SUCCESS D
. M ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXRS",$J)
.;Set the 0 node.
. S ^PXD(811.8,IENROOT(1),100,0)=U_811.801_U_LC_U_LC
.;Create the description for this repository entry.
. N DESC,DESL,KEYWORD
. S DESL("SOURCE")=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
. S DESL("DATEP")=^TMP(TMPIND,$J,"SRC","DATE")
. S DESL("VRSN")=VERSN
. S DESC="^TMP(TMPIND,$J,""DESC"")"
. S KEYWORD="^TMP(TMPIND,$J,""KEYWORD"")"
. D DESC^PXRMEXU1(IENROOT(1),.DESL,$NA(@DESC),$NA(@KEYWORD))
. F IND=1:1:LC D
.. S LINE=^TMP("PXRMEXRS",$J,IND,0)
.. I LINE["<FILE_NAME>" S FILENAME=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
.. I LINE["<POINT_01>" S PT01=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
.. I LINE["<INTERNAL_ENTRY_NUMBER>" S IEN=$$GETTAGV^PXRMEXU3(LINE,"<INTERNAL_ENTRY_NUMBER>",1)
..;Use 245 to be conservative.
.. I $L(LINE)<246 Q
.. D MLWARN(FILENAME,PT01,IEN,LINE,245)
K ^TMP($J,"CIND"),^TMP("PXRMEXRS",$J)
K ^TMP(TMPIND,$J),^TMP("PXRMEXCS",$J)
Q
;
;=====================================================
XMLOUT(IEN) ;Write out the XML content of repository entry ien.
N LC,NLINES
S NLINES=$O(^PXD(811.8,IEN,100,""),-1)
F LC=1:1:NLINES W !,^PXD(811.8,IEN,100,LC,0)
Q
;
PXRMEXU2 ; SLC/PKR/PJH - Reminder exchange repository utilities, #2.;08/28/2013
+1 ;;2.0;CLINICAL REMINDERS;**6,12,26**;Feb 04, 2005;Build 404
+2 ;=====================================================
FDA(IND,LC,TMPIND,FILENAME) ;Build the XML FDA output.
+1 NEW FIELD,FILENUM,INDEX,INDEX0,JND,SIENS,WPC
+2 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<FILEMAN_FDA>"
+3 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<![CDATA["
+4 ;Get the file number.
+5 SET FILENUM=""
+6 FOR
SET FILENUM=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM))
IF FILENUM=""
QUIT
Begin DoDot:1
+7 ;Get the source ien string.
+8 SET SIENS=""
+9 FOR
SET SIENS=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS))
IF SIENS=""
QUIT
Begin DoDot:2
+10 SET INDEX0=FILENUM_";"_SIENS
+11 ;Get the field number and store the data.
+12 SET FIELD=""
+13 FOR
SET FIELD=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD))
IF FIELD=""
QUIT
Begin DoDot:3
+14 SET INDEX=INDEX0_";"_FIELD
+15 ;If there is another index past the field then this is a
+16 ;word-processing field.
+17 IF $DATA(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD))=11
Begin DoDot:4
+18 SET WPC=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD,""),-1)
+19 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)=INDEX_"~WP-start~"_WPC
+20 FOR JND=1:1:WPC
Begin DoDot:5
+21 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)=^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD,JND)
End DoDot:5
End DoDot:4
+22 IF '$TEST
SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)=INDEX_"~"_^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD)
End DoDot:3
End DoDot:2
End DoDot:1
+23 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]>"
+24 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</FILEMAN_FDA>"
+25 QUIT
+26 ;
+27 ;=====================================================
IENROOT(IND,LC,TMPIND,FILENAME) ;Build the XML IEN_ROOT output.
+1 NEW INDEX,VALUE
+2 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<IEN_ROOT>"
+3 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<![CDATA["
+4 SET INDEX=0
+5 FOR
SET INDEX=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,INDEX))
IF INDEX=""
QUIT
Begin DoDot:1
+6 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)=INDEX_U_^TMP(TMPIND,$JOB,IND,FILENAME,INDEX)
End DoDot:1
+7 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]>"
+8 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</IEN_ROOT>"
+9 QUIT
+10 ;
+11 ;=====================================================
MLWARN(FILENAME,PT01,IEN,LINE,MAXLEN) ;Issue a warning if the length of the
+1 ;line exceeds the maximum allowed value.
+2 NEW DATA,INDICES,FIELD,LEN,TEXT
+3 SET LEN=$LENGTH(LINE)
+4 SET INDICES=$PIECE(LINE,"~",1)
+5 SET FIELD=$PIECE(INDICES,";",3)
+6 SET DATA=$PIECE(LINE,"~",2)
+7 SET TEXT(1)="Warning the following line exceeds the VistA maximum allowed length of "_MAXLEN_"."
+8 SET TEXT(2)="Therefore this Exchange entry will not transport correctly."
+9 SET TEXT(3)="Line: "_LINE
+10 SET TEXT(4)="Its length is: "_LEN
+11 SET TEXT(5)="Component: "_FILENAME
+12 SET TEXT(6)="Name: "_PT01
+13 SET TEXT(7)="IEN: "_IEN
+14 SET TEXT(8)="Field number: "_FIELD
+15 SET TEXT(9)="Value: "_DATA
+16 SET TEXT(10)=""
+17 DO EN^DDIOL(.TEXT)
+18 HANG 2
+19 QUIT
+20 ;
+21 ;=====================================================
STOREPR(SUCCESS,EFNAME,TMPIND,SELLIST) ;^TMP(TMPIND,$J contains data to be
+1 ;stored in the repository. Routines will be found in
+2 ;^TMP(TMPIND,$J,"ROUTINE",ROUTINE NAME,n) where n is the line number.
+3 ;File entries will be found in ^TMP(TMPIND,$J,N,FILENAME,indexes).
+4 ;This is output from the GETS^DIQ call. There are NUMF file entries.
+5 ;Format and store it as XML in the repository.
+6 NEW DATE,DTEST,FDA,FILENAME,FILENUM,IEN
+7 NEW IENROOT,IND,JND,LC,LINE,NCMPNT,NEWFILE,NUMF,PT01,RNAME
+8 NEW SIENS,SOURCE,TEMP,VERSN
+9 ;If anything went wrong in the packing process then ^TMP(TMPIND,$J
+10 ;will not exist.
+11 IF '$DATA(^TMP(TMPIND,$JOB))
SET SUCCESS=0
QUIT
+12 ;
+13 KILL ^TMP($JOB,"CIND")
+14 KILL ^TMP("PXRMEXRS",$JOB)
+15 SET ^TMP("PXRMEXRS",$JOB,1,0)="<?xml version=""1.0"" standalone=""yes""?>"
+16 SET ^TMP("PXRMEXRS",$JOB,2,0)="<REMINDER_EXCHANGE_FILE_ENTRY>"
+17 SET VERSN=$PIECE(^PXRM(800,1,"VERSION"),U,1)
+18 SET ^TMP("PXRMEXRS",$JOB,3,0)="<PACKAGE_VERSION>"_VERSN_"</PACKAGE_VERSION>"
+19 ;The pointer to the index will be on line 4 so leave room.
+20 SET LC=4
+21 ;Save the source information.
+22 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<SOURCE>"
+23 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<NAME>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$JOB,"SRC","NAME"))_"</NAME>"
+24 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<USER>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$JOB,"SRC","USER"))_"</USER>"
+25 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<SITE>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$JOB,"SRC","SITE"))_"</SITE>"
+26 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<DATE_PACKED>"_^TMP(TMPIND,$JOB,"SRC","DATE")_"</DATE_PACKED>"
+27 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</SOURCE>"
+28 ;
+29 ;Save the description.
+30 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<DESCRIPTION><![CDATA["
+31 SET IND=0
+32 FOR
SET IND=$ORDER(^TMP(TMPIND,$JOB,"DESC",1,IND))
IF +IND=0
QUIT
Begin DoDot:1
+33 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)=^TMP(TMPIND,$JOB,"DESC",1,IND,0)
End DoDot:1
+34 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]></DESCRIPTION>"
+35 ;
+36 ;Save the keywords or phrases.
+37 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<KEYWORDS>"
+38 SET IND=0
+39 FOR
SET IND=$ORDER(^TMP(TMPIND,$JOB,"KEYWORD",1,IND))
IF +IND=0
QUIT
Begin DoDot:1
+40 SET TEMP=^TMP(TMPIND,$JOB,"KEYWORD",1,IND,0)
+41 IF TEMP[","
Begin DoDot:2
+42 FOR JND=1:1:$LENGTH(TEMP,",")
Begin DoDot:3
+43 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3($PIECE(TEMP,",",JND))_"</KEYWORD>"
End DoDot:3
End DoDot:2
+44 IF '$TEST
SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3(TEMP)_"</KEYWORD>"
End DoDot:1
+45 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</KEYWORDS>"
+46 ;
+47 SET NCMPNT=0
+48 ;Do routines first.
+49 SET RNAME=""
+50 FOR
SET RNAME=$ORDER(^TMP(TMPIND,$JOB,"ROUTINE",RNAME))
IF RNAME=""
QUIT
Begin DoDot:1
+51 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<M_ROUTINE>"
+52 SET NCMPNT=NCMPNT+1
+53 SET ^TMP($JOB,"CIND",NCMPNT,"M_ROUTINE_START")=LC
+54 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<ROUTINE_NAME>"_RNAME_"</ROUTINE_NAME>"
+55 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$JOB,"ROUTINE",RNAME)_"</CHECKSUM>"
+56 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<CODE>"
+57 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<![CDATA["
+58 SET ^TMP($JOB,"CIND",NCMPNT,"ROUTINE_CODE_START")=LC+1
+59 SET LINE=0
+60 FOR
SET LINE=$ORDER(^TMP(TMPIND,$JOB,"ROUTINE",RNAME,LINE))
IF LINE=""
QUIT
Begin DoDot:2
+61 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)=^TMP(TMPIND,$JOB,"ROUTINE",RNAME,LINE,0)
End DoDot:2
+62 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]>"
+63 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</CODE>"
+64 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</M_ROUTINE>"
+65 SET ^TMP($JOB,"CIND",NCMPNT,"ROUTINE_CODE_END")=LC-3
End DoDot:1
+66 ;
+67 ;Do file entries. For word processing fields the first line is
+68 ;file number;source ien string;field~WP-start~line count
+69 ;The next line count lines are the WP data.
+70 SET NUMF=+$GET(^TMP(TMPIND,$JOB,"NUMF"))
+71 SET FILENAME=""
+72 FOR IND=1:1:NUMF
Begin DoDot:1
+73 FOR
SET FILENAME=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME))
IF FILENAME=""
QUIT
Begin DoDot:2
+74 IF FILENAME["IENROOT"
SET NEWFILE=0
SET IENROOT=1
+75 IF '$TEST
SET NEWFILE=1
SET IENROOT=0
+76 IF NEWFILE
Begin DoDot:3
+77 SET FILENUM=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,""))
+78 SET SIENS=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,""))
+79 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<FILEMAN_FILE>"
+80 SET NCMPNT=NCMPNT+1
+81 SET ^TMP($JOB,"CIND",NCMPNT,"FILE_START")=LC
+82 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<FILE_NAME>"_$$TOXML^PXRMEXU3(FILENAME)_"</FILE_NAME>"
+83 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<FILE_NUMBER>"_FILENUM_"</FILE_NUMBER>"
+84 SET LC=LC+1
SET PT01=^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,.01)
+85 SET ^TMP("PXRMEXRS",$JOB,LC,0)="<POINT_01>"_$$TOXML^PXRMEXU3(PT01)_"</POINT_01>"
+86 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<INTERNAL_ENTRY_NUMBER>"_+SIENS_"</INTERNAL_ENTRY_NUMBER>"
+87 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$JOB,IND,FILENAME)_"</CHECKSUM>"
+88 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<SELECTED>"_$SELECT($DATA(SELLIST(FILENUM,"IEN",+SIENS)):"YES",1:"NO")_"</SELECTED>"
+89 SET ^TMP($JOB,"CIND",NCMPNT,"FDA_START")=LC+3
+90 DO FDA(IND,.LC,TMPIND,FILENAME)
+91 SET ^TMP($JOB,"CIND",NCMPNT,"FDA_END")=LC-2
End DoDot:3
+92 ;The ien root information always comes after the FDA.
+93 IF IENROOT
Begin DoDot:3
+94 SET ^TMP($JOB,"CIND",NCMPNT,"IEN_ROOT_START")=LC+3
+95 DO IENROOT(IND,.LC,TMPIND,FILENAME)
+96 SET ^TMP($JOB,"CIND",NCMPNT,"IEN_ROOT_END")=LC-2
End DoDot:3
End DoDot:2
+97 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</FILEMAN_FILE>"
End DoDot:1
+98 ;Save the index.
+99 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,4,0)="<INDEX_AT>"_LC_"</INDEX_AT>"
+100 SET ^TMP("PXRMEXRS",$JOB,LC,0)="<INDEX>"
+101 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<NUMBER_OF_COMPONENTS>"_NCMPNT_"</NUMBER_OF_COMPONENTS>"
+102 FOR IND=1:1:NCMPNT
Begin DoDot:1
+103 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<COMPONENT>"
+104 SET JND=""
+105 FOR
SET JND=$ORDER(^TMP($JOB,"CIND",IND,JND))
IF JND=""
QUIT
Begin DoDot:2
+106 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="<"_JND_">"_^TMP($JOB,"CIND",IND,JND)_"</"_JND_">"
End DoDot:2
+107 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</COMPONENT>"
End DoDot:1
+108 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</INDEX>"
+109 SET LC=LC+1
SET ^TMP("PXRMEXRS",$JOB,LC,0)="</REMINDER_EXCHANGE_FILE_ENTRY>"
+110 ;Establish the entry in the repository.
+111 SET SOURCE=^TMP(TMPIND,$JOB,"SRC","USER")_" at "_^TMP(TMPIND,$JOB,"SRC","SITE")
+112 SET DATE=^TMP(TMPIND,$JOB,"SRC","DATE")
+113 SET FDA(811.8,"+1,",.01)=EFNAME
+114 SET FDA(811.8,"+1,",.02)=SOURCE
+115 SET FDA(811.8,"+1,",.03)=DATE
+116 DO UPDATE^PXRMEXPU(.SUCCESS,.FDA,.IENROOT)
+117 IF SUCCESS
Begin DoDot:1
+118 MERGE ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXRS",$JOB)
+119 ;Set the 0 node.
+120 SET ^PXD(811.8,IENROOT(1),100,0)=U_811.801_U_LC_U_LC
+121 ;Create the description for this repository entry.
+122 NEW DESC,DESL,KEYWORD
+123 SET DESL("SOURCE")=^TMP(TMPIND,$JOB,"SRC","USER")_" at "_^TMP(TMPIND,$JOB,"SRC","SITE")
+124 SET DESL("DATEP")=^TMP(TMPIND,$JOB,"SRC","DATE")
+125 SET DESL("VRSN")=VERSN
+126 SET DESC="^TMP(TMPIND,$J,""DESC"")"
+127 SET KEYWORD="^TMP(TMPIND,$J,""KEYWORD"")"
+128 DO DESC^PXRMEXU1(IENROOT(1),.DESL,$NAME(@DESC),$NAME(@KEYWORD))
+129 FOR IND=1:1:LC
Begin DoDot:2
+130 SET LINE=^TMP("PXRMEXRS",$JOB,IND,0)
+131 IF LINE["<FILE_NAME>"
SET FILENAME=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
+132 IF LINE["<POINT_01>"
SET PT01=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
+133 IF LINE["<INTERNAL_ENTRY_NUMBER>"
SET IEN=$$GETTAGV^PXRMEXU3(LINE,"<INTERNAL_ENTRY_NUMBER>",1)
+134 ;Use 245 to be conservative.
+135 IF $LENGTH(LINE)<246
QUIT
+136 DO MLWARN(FILENAME,PT01,IEN,LINE,245)
End DoDot:2
End DoDot:1
+137 KILL ^TMP($JOB,"CIND"),^TMP("PXRMEXRS",$JOB)
+138 KILL ^TMP(TMPIND,$JOB),^TMP("PXRMEXCS",$JOB)
+139 QUIT
+140 ;
+141 ;=====================================================
XMLOUT(IEN) ;Write out the XML content of repository entry ien.
+1 NEW LC,NLINES
+2 SET NLINES=$ORDER(^PXD(811.8,IEN,100,""),-1)
+3 FOR LC=1:1:NLINES
WRITE !,^PXD(811.8,IEN,100,LC,0)
+4 QUIT
+5 ;
