close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU2.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU2.m@ 1073

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

revised back to 6/30/08 version
File size: 8.4 KB
RevLine 
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 TracBrowser for help on using the repository browser.