source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU2.m@ 1015

Last change on this file since 1015 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1PXRMEXU2 ; SLC/PKR/PJH - Reminder exchange repository utilities, #2. ;11/21/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
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=$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 ;=====================================================
191XMLOUT(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 ;
Note: See TracBrowser for help on using the repository browser.