Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU2.m

    r613 r623  
    1 PXRMEXU2        ; SLC/PKR/PJH - Reminder exchange repository utilities, #2. ;11/21/2007
    2         ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
    3         ;=====================================================
    4 FDA(IND,LC,TMPIND,FILENAME)     ;Build the XML FDA output.
    5         N FIELD,FILENUM,INDEX,INDEX0,JND,SIENS,WPC
    6         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FDA>"
    7         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
    8         ;Get the file number.
    9         S FILENUM=""
    10         F  S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM)) Q:FILENUM=""  D
    11         .;Get the source ien string.
    12         . S SIENS=""
    13         . F  S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS)) Q:SIENS=""  D
    14         .. S INDEX0=FILENUM_";"_SIENS
    15         ..;Get the field number and store the data.
    16         .. S FIELD=""
    17         .. F  S FIELD=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)) Q:FIELD=""  D
    18         ... S INDEX=INDEX0_";"_FIELD
    19         ...;If there is another index past the field then this is a
    20         ...;word-processing field.
    21         ... I $D(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD))=11 D
    22         .... S WPC=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,""),-1)
    23         .... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~WP-start~"_WPC
    24         .... F JND=1:1:WPC D
    25         ..... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,JND)
    26         ... E  S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~"_^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)
    27         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
    28         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FDA>"
    29         Q
    30         ;
    31         ;=====================================================
    32 IENROOT(IND,LC,TMPIND,FILENAME) ;Build the XML IEN_ROOT output.
    33         N INDEX,VALUE
    34         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<IEN_ROOT>"
    35         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
    36         S INDEX=0
    37         F  S INDEX=$O(^TMP(TMPIND,$J,IND,FILENAME,INDEX)) Q:INDEX=""  D
    38         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_U_^TMP(TMPIND,$J,IND,FILENAME,INDEX)
    39         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
    40         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</IEN_ROOT>"
    41         Q
    42         ;
    43         ;=====================================================
    44 STOREPR(SUCCESS,RTM,TMPIND,EXTYPE)      ;^TMP(TMPIND,$J contains data to be
    45         ;stored in the repository. Routines will be found in
    46         ;^TMP(TMPIND,$J,"ROUTINE",ROUTINE NAME,n) where n is the line number.
    47         ;File entries will be found in ^TMP(TMPIND,$J,N,FILENAME,indexes).
    48         ;This is output from the GETS^DIQ call. There are NUMF file entries.
    49         ;Format and store it as XML in the repository.
    50         N DATE,DTEST,FDA,FILENAME,FILENUM
    51         N IENROOT,IND,JND,LC,LINE,NCMPNT,NEWFILE,NUMF,PT01,RNAME
    52         N SIENS,SOURCE,TEMP,VERSN
    53         ;If anything went wrong in the packing process then ^TMP(TMPIND,$J
    54         ;will not exist.
    55         I '$D(^TMP(TMPIND,$J)) S SUCCESS=0 Q
    56         ;
    57         K ^TMP($J,"CIND")
    58         K ^TMP("PXRMEXRS",$J)
    59         S ^TMP("PXRMEXRS",$J,1,0)="<?xml version=""1.0"" standalone=""yes""?>"
    60         S ^TMP("PXRMEXRS",$J,2,0)="<REMINDER_EXCHANGE_FILE_ENTRY>"
    61         S VERSN=$P(^PXRM(800,1,"VERSION"),U,1)
    62         S ^TMP("PXRMEXRS",$J,3,0)="<PACKAGE_VERSION>"_VERSN_"</PACKAGE_VERSION>"
    63         ;The pointer to the index will be on line 4 so leave room.
    64         S LC=4
    65         ;Save the source information.
    66         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SOURCE>"
    67         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NAME>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","REMINDER"))_"</NAME>"
    68         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<USER>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","USER"))_"</USER>"
    69         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SITE>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","SITE"))_"</SITE>"
    70         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DATE_PACKED>"_^TMP(TMPIND,$J,"SRC","DATE")_"</DATE_PACKED>"
    71         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</SOURCE>"
    72         ;
    73         ;Save the Exchange Type.
    74         I EXTYPE="" S EXTYPE="REMINDER"
    75         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<EXCHANGE_TYPE>"_$$TOXML^PXRMEXU3(EXTYPE)_"</EXCHANGE_TYPE>"
    76         ;
    77         ;Save the description.
    78         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DESCRIPTION><![CDATA["
    79         S IND=0
    80         F  S IND=$O(^TMP(TMPIND,$J,"DESC",1,IND)) Q:+IND=0  D
    81         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"DESC",1,IND,0)
    82         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]></DESCRIPTION>"
    83         ;
    84         ;Save the keywords or phrases.
    85         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORDS>"
    86         S IND=0
    87         F  S IND=$O(^TMP(TMPIND,$J,"KEYWORD",1,IND)) Q:+IND=0  D
    88         . S TEMP=^TMP(TMPIND,$J,"KEYWORD",1,IND,0)
    89         . I TEMP["," D
    90         .. F JND=1:1:$L(TEMP,",") D
    91         ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3($P(TEMP,",",JND))_"</KEYWORD>"
    92         . E  S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3(TEMP)_"</KEYWORD>"
    93         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</KEYWORDS>"
    94         ;
    95         S NCMPNT=0
    96         ;Do routines first.
    97         S RNAME=""
    98         F  S RNAME=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME)) Q:RNAME=""  D
    99         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<M_ROUTINE>"
    100         . S NCMPNT=NCMPNT+1
    101         . S ^TMP($J,"CIND",NCMPNT,"M_ROUTINE_START")=LC
    102         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ROUTINE_NAME>"_RNAME_"</ROUTINE_NAME>"
    103         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$J,"ROUTINE",RNAME)_"</CHECKSUM>"
    104         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CODE>"
    105         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
    106         . S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_START")=LC+1
    107         . S LINE=0
    108         . F  S LINE=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE)) Q:LINE=""  D
    109         .. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE,0)
    110         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
    111         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</CODE>"
    112         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</M_ROUTINE>"
    113         . S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_END")=LC-3
    114         ;
    115         ;Do file entries.
    116         ;For word processing fields the first line is
    117         ;file number;source ien string;field~WP-start~line count
    118         ;The next line count lines are the WP data.
    119         S NUMF=+$G(^TMP(TMPIND,$J,"NUMF"))
    120         S FILENAME=""
    121         F IND=1:1:NUMF D
    122         . F  S FILENAME=$O(^TMP(TMPIND,$J,IND,FILENAME)) Q:FILENAME=""  D
    123         .. I FILENAME["IENROOT" D
    124         ... S NEWFILE=0
    125         ... S IENROOT=1
    126         .. E  D
    127         ... S NEWFILE=1
    128         ... S IENROOT=0
    129         .. I NEWFILE D
    130         ... S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,""))
    131         ... S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,""))
    132         ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FILE>"
    133         ... S NCMPNT=NCMPNT+1
    134         ... S ^TMP($J,"CIND",NCMPNT,"FILE_START")=LC
    135         ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NAME>"_$$TOXML^PXRMEXU3(FILENAME)_"</FILE_NAME>"
    136         ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NUMBER>"_FILENUM_"</FILE_NUMBER>"
    137         ... S LC=LC+1,PT01=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,.01)
    138         ... S ^TMP("PXRMEXRS",$J,LC,0)="<POINT_01>"_$$TOXML^PXRMEXU3(PT01)_"</POINT_01>"
    139         ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<INTERNAL_ENTRY_NUMBER>"_+SIENS_"</INTERNAL_ENTRY_NUMBER>"
    140         ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$J,IND,FILENAME)_"</CHECKSUM>"
    141         ... S ^TMP($J,"CIND",NCMPNT,"FDA_START")=LC+3
    142         ... D FDA(IND,.LC,TMPIND,FILENAME)
    143         ... S ^TMP($J,"CIND",NCMPNT,"FDA_END")=LC-2
    144         ..;The ien root information always comes after the FDA.
    145         .. I IENROOT D
    146         ... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_START")=LC+3
    147         ... D IENROOT(IND,.LC,TMPIND,FILENAME)
    148         ... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_END")=LC-2
    149         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FILE>"
    150         ;Save the index.
    151         S LC=LC+1,^TMP("PXRMEXRS",$J,4,0)="<INDEX_AT>"_LC_"</INDEX_AT>"
    152         S ^TMP("PXRMEXRS",$J,LC,0)="<INDEX>"
    153         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NUMBER_OF_COMPONENTS>"_NCMPNT_"</NUMBER_OF_COMPONENTS>"
    154         F IND=1:1:NCMPNT D
    155         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<COMPONENT>"
    156         . S JND=""
    157         . F  S JND=$O(^TMP($J,"CIND",IND,JND)) Q:JND=""  D
    158         .. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<"_JND_">"_^TMP($J,"CIND",IND,JND)_"</"_JND_">"
    159         . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</COMPONENT>"
    160         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</INDEX>"
    161         S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</REMINDER_EXCHANGE_FILE_ENTRY>"
    162         ;Establish the entry in the repository.
    163         S RNAME=$P(RTM,U,2)
    164         S SOURCE=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
    165         S DATE=^TMP(TMPIND,$J,"SRC","DATE")
    166         S FDA(811.8,"+1,",.01)=RNAME
    167         S FDA(811.8,"+1,",.02)=SOURCE
    168         S FDA(811.8,"+1,",.03)=DATE
    169         S FDA(811.8,"+1,",115)=EXTYPE
    170         D UPDATE^PXRMEXPU(.SUCCESS,.FDA,.IENROOT)
    171         I SUCCESS D
    172         . M ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXRS",$J)
    173         .;Set the 0 node.
    174         . S ^PXD(811.8,IENROOT(1),100,0)=U_811.801_U_LC_U_LC
    175         .;Save the Exchange Type.
    176         . S ^PXD(811.8,IENROOT(1),115)=$G(EXTYPE)
    177         .;Create the description for this repository entry.
    178         . N DATEP,DESC,DESL,KEYWORD,RNAME,SOURCE
    179         . S DESL("RNAME")=^TMP(TMPIND,$J,"SRC","REMINDER")
    180         . S DESL("SOURCE")=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
    181         . S DESL("DATEP")=^TMP(TMPIND,$J,"SRC","DATE")
    182         . S DESL("VRSN")=VERSN
    183         . S DESC="^TMP(TMPIND,$J,""DESC"")"
    184         . S KEYWORD="^TMP(TMPIND,$J,""KEYWORD"")"
    185         . D DESC^PXRMEXU1(IENROOT(1),.DESL,$NA(@DESC),$NA(@KEYWORD))
    186         K ^TMP($J,"CIND"),^TMP("PXRMEXRS",$J)
    187         K ^TMP(TMPIND,$J),^TMP("PXRMEXCS",$J)
    188         Q
    189         ;
    190         ;=====================================================
    191 XMLOUT(IEN)     ;Write out the XML content of repository entry ien.
    192         N LC,NLINES
    193         S NLINES=$O(^PXD(811.8,IEN,100,""),-1)
    194         F LC=1:1:NLINES W !,^PXD(811.8,IEN,100,LC,0)
    195         Q
    196         ;
     1PXRMEXU2 ; SLC/PKR/PJH - Reminder exchange repository utilities, #2. ;09/20/2004
     2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
     3 ;=====================================================
     4FDA(IND,LC,TMPIND,FILENAME) ;Build the XML FDA output.
     5 N FIELD,FILENUM,INDEX,INDEX0,JND,SIENS,WPC
     6 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FDA>"
     7 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
     8 ;Get the file number.
     9 S FILENUM=""
     10 F  S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM)) Q:FILENUM=""  D
     11 .;Get the source ien string.
     12 . S SIENS=""
     13 . F  S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS)) Q:SIENS=""  D
     14 .. S INDEX0=FILENUM_";"_SIENS
     15 ..;Get the field number and store the data.
     16 .. S FIELD=""
     17 .. F  S FIELD=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)) Q:FIELD=""  D
     18 ... S INDEX=INDEX0_";"_FIELD
     19 ...;If there is another index past the field then this is a
     20 ...;word-processing field.
     21 ... I $D(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD))=11 D
     22 .... S WPC=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,""),-1)
     23 .... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~WP-start~"_WPC
     24 .... F JND=1:1:WPC D
     25 ..... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,JND)
     26 ... E  S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~"_^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)
     27 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
     28 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FDA>"
     29 Q
     30 ;
     31 ;=====================================================
     32IENROOT(IND,LC,TMPIND,FILENAME) ;Build the XML IEN_ROOT output.
     33 N INDEX,VALUE
     34 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<IEN_ROOT>"
     35 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
     36 S INDEX=0
     37 F  S INDEX=$O(^TMP(TMPIND,$J,IND,FILENAME,INDEX)) Q:INDEX=""  D
     38 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_U_^TMP(TMPIND,$J,IND,FILENAME,INDEX)
     39 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
     40 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</IEN_ROOT>"
     41 Q
     42 ;
     43 ;=====================================================
     44STOREPR(SUCCESS,RTM,TMPIND,EXTYPE) ;^TMP(TMPIND,$J contains data to be
     45 ;stored in the repository. Routines will be found in
     46 ;^TMP(TMPIND,$J,"ROUTINE",ROUTINE NAME,n) where n is the line number.
     47 ;File entries will be found in ^TMP(TMPIND,$J,N,FILENAME,indexes).
     48 ;This is output from the GETS^DIQ call. There are NUMF file entries.
     49 ;Format and store it as XML in the repository.
     50 N DATE,DTEST,FDA,FILENAME,FILENUM
     51 N IENROOT,IND,JND,LC,LINE,NCMPNT,NEWFILE,NUMF,PT01,RNAME
     52 N SIENS,SOURCE,TEMP,VERSN
     53 ;If anything went wrong in the packing process then ^TMP(TMPIND,$J
     54 ;will not exist.
     55 I '$D(^TMP(TMPIND,$J)) S SUCCESS=0 Q
     56 ;
     57 K ^TMP($J,"CIND")
     58 K ^TMP("PXRMEXRS",$J)
     59 S ^TMP("PXRMEXRS",$J,1,0)="<?xml version=""1.0"" standalone=""yes""?>"
     60 S ^TMP("PXRMEXRS",$J,2,0)="<REMINDER_EXCHANGE_FILE_ENTRY>"
     61 S VERSN=^PXRM(800,1,"VERSION")
     62 S ^TMP("PXRMEXRS",$J,3,0)="<PACKAGE_VERSION>"_VERSN_"</PACKAGE_VERSION>"
     63 ;The pointer to the index will be on line 4 so leave room.
     64 S LC=4
     65 ;Save the source information.
     66 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SOURCE>"
     67 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NAME>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","REMINDER"))_"</NAME>"
     68 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<USER>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","USER"))_"</USER>"
     69 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SITE>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","SITE"))_"</SITE>"
     70 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DATE_PACKED>"_^TMP(TMPIND,$J,"SRC","DATE")_"</DATE_PACKED>"
     71 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</SOURCE>"
     72 ;
     73 ;Save the Exchange Type.
     74 I EXTYPE="" S EXTYPE="REMINDER"
     75 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<EXCHANGE_TYPE>"_$$TOXML^PXRMEXU3(EXTYPE)_"</EXCHANGE_TYPE>"
     76 ;
     77 ;Save the description.
     78 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DESCRIPTION><![CDATA["
     79 S IND=0
     80 F  S IND=$O(^TMP(TMPIND,$J,"DESC",1,IND)) Q:+IND=0  D
     81 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"DESC",1,IND,0)
     82 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]></DESCRIPTION>"
     83 ;
     84 ;Save the keywords or phrases.
     85 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORDS>"
     86 S IND=0
     87 F  S IND=$O(^TMP(TMPIND,$J,"KEYWORD",1,IND)) Q:+IND=0  D
     88 . S TEMP=^TMP(TMPIND,$J,"KEYWORD",1,IND,0)
     89 . I TEMP["," D
     90 .. F JND=1:1:$L(TEMP,",") D
     91 ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3($P(TEMP,",",JND))_"</KEYWORD>"
     92 . E  S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3(TEMP)_"</KEYWORD>"
     93 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</KEYWORDS>"
     94 ;
     95 S NCMPNT=0
     96 ;Do routines first.
     97 S RNAME=""
     98 F  S RNAME=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME)) Q:RNAME=""  D
     99 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<M_ROUTINE>"
     100 . S NCMPNT=NCMPNT+1
     101 . S ^TMP($J,"CIND",NCMPNT,"M_ROUTINE_START")=LC
     102 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ROUTINE_NAME>"_RNAME_"</ROUTINE_NAME>"
     103 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CODE>"
     104 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
     105 . S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_START")=LC+1
     106 . S LINE=0
     107 . F  S LINE=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE)) Q:LINE=""  D
     108 .. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE,0)
     109 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
     110 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</CODE>"
     111 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</M_ROUTINE>"
     112 . S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_END")=LC-3
     113 ;
     114 ;Do file entries.
     115 ;For word processing fields the first line is
     116 ;file number;source ien string;field~WP-start~line count
     117 ;The next line count lines are the WP data.
     118 S NUMF=+$G(^TMP(TMPIND,$J,"NUMF"))
     119 S FILENAME=""
     120 F IND=1:1:NUMF D
     121 . F  S FILENAME=$O(^TMP(TMPIND,$J,IND,FILENAME)) Q:FILENAME=""  D
     122 .. I FILENAME["IENROOT" D
     123 ... S NEWFILE=0
     124 ... S IENROOT=1
     125 .. E  D
     126 ... S NEWFILE=1
     127 ... S IENROOT=0
     128 .. I NEWFILE D
     129 ... S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,""))
     130 ... S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,""))
     131 ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FILE>"
     132 ... S NCMPNT=NCMPNT+1
     133 ... S ^TMP($J,"CIND",NCMPNT,"FILE_START")=LC
     134 ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NAME>"_$$TOXML^PXRMEXU3(FILENAME)_"</FILE_NAME>"
     135 ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NUMBER>"_FILENUM_"</FILE_NUMBER>"
     136 ... S LC=LC+1,PT01=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,.01)
     137 ... S ^TMP("PXRMEXRS",$J,LC,0)="<POINT_01>"_$$TOXML^PXRMEXU3(PT01)_"</POINT_01>"
     138 ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<INTERNAL_ENTRY_NUMBER>"_+SIENS_"</INTERNAL_ENTRY_NUMBER>"
     139 ... S ^TMP($J,"CIND",NCMPNT,"FDA_START")=LC+3
     140 ... D FDA(IND,.LC,TMPIND,FILENAME)
     141 ... S ^TMP($J,"CIND",NCMPNT,"FDA_END")=LC-2
     142 ..;The ien root information always comes after the FDA.
     143 .. I IENROOT D
     144 ... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_START")=LC+3
     145 ... D IENROOT(IND,.LC,TMPIND,FILENAME)
     146 ... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_END")=LC-2
     147 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FILE>"
     148 ;Save the index.
     149 S LC=LC+1,^TMP("PXRMEXRS",$J,4,0)="<INDEX_AT>"_LC_"</INDEX_AT>"
     150 S ^TMP("PXRMEXRS",$J,LC,0)="<INDEX>"
     151 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NUMBER_OF_COMPONENTS>"_NCMPNT_"</NUMBER_OF_COMPONENTS>"
     152 F IND=1:1:NCMPNT D
     153 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<COMPONENT>"
     154 . S JND=""
     155 . F  S JND=$O(^TMP($J,"CIND",IND,JND)) Q:JND=""  D
     156 .. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<"_JND_">"_^TMP($J,"CIND",IND,JND)_"</"_JND_">"
     157 . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</COMPONENT>"
     158 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</INDEX>"
     159 S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</REMINDER_EXCHANGE_FILE_ENTRY>"
     160 ;Establish the entry in the repository.
     161 S RNAME=$P(RTM,U,2)
     162 S SOURCE=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
     163 S DATE=^TMP(TMPIND,$J,"SRC","DATE")
     164 S FDA(811.8,"+1,",.01)=RNAME
     165 S FDA(811.8,"+1,",.02)=SOURCE
     166 S FDA(811.8,"+1,",.03)=DATE
     167 S FDA(811.8,"+1,",115)=EXTYPE
     168 D UPDATE^PXRMEXPU(.SUCCESS,.FDA,.IENROOT)
     169 I SUCCESS D
     170 . M ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXRS",$J)
     171 .;Set the 0 node.
     172 . S ^PXD(811.8,IENROOT(1),100,0)=U_811.801_U_LC_U_LC
     173 .;Save the Exchange Type.
     174 . S ^PXD(811.8,IENROOT(1),115)=$G(EXTYPE)
     175 .;Create the description for this repository entry.
     176 . N DATEP,DESC,DESL,KEYWORD,RNAME,SOURCE
     177 . S DESL("RNAME")=^TMP(TMPIND,$J,"SRC","REMINDER")
     178 . S DESL("SOURCE")=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
     179 . S DESL("DATEP")=^TMP(TMPIND,$J,"SRC","DATE")
     180 . S DESL("VRSN")=$G(^PXRM(800,1,"VERSION"))
     181 . S DESC="^TMP(TMPIND,$J,""DESC"")"
     182 . S KEYWORD="^TMP(TMPIND,$J,""KEYWORD"")"
     183 . D DESC^PXRMEXU1(IENROOT(1),.DESL,$NA(@DESC),$NA(@KEYWORD))
     184 K ^TMP($J,"CIND")
     185 K ^TMP("PXRMEXRS",$J)
     186 K ^TMP(TMPIND,$J)
     187 Q
     188 ;
     189 ;=====================================================
     190XMLOUT(IEN) ;Write out the XML content of repository entry ien.
     191 N LC,NLINES
     192 S NLINES=$O(^PXD(811.8,IEN,100,""),-1)
     193 F LC=1:1:NLINES W !,^PXD(811.8,IEN,100,LC,0)
     194 Q
     195 ;
Note: See TracChangeset for help on using the changeset viewer.