source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU1.m@ 1783

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1.;08/16/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;=====================================================
4CLIST(IEN) ;Build the list of components for the repository
5 ;entry IEN. EXTYPE is the type of Exchange entry. The default is
6 ;reminder.
7 N COMIND,COMORDR,CSTART,CSUM,END,FILENAME,FILENUM
8 N IND,INDEXAT,JND,LINE,NCMPNT,NCTYPE,NITEMS,NLINES,NUMCMPNT
9 N PT01,START,TEMP,TAG,TYPE,UCOM,VERSN
10 S LINE=^PXD(811.8,IEN,100,1,0)
11 ;Make sure it is XML version 1.
12 I LINE'["<?xml version=""1.0""" D Q
13 . W !,"Exchange file entry not in proper format!"
14 . S IEN=-1
15 . H 2
16 S LINE=^PXD(811.8,IEN,100,2,0)
17 I LINE'="<REMINDER_EXCHANGE_FILE_ENTRY>" D Q
18 . W !,"Not an Exchange File entry!"
19 . S IEN=-1
20 . H 2
21 S LINE=^PXD(811.8,IEN,100,3,0)
22 S VERSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")
23 S LINE=^PXD(811.8,IEN,100,4,0)
24 S INDEXAT=+$P(LINE,"<INDEX_AT>",2)
25 S LINE=^PXD(811.8,IEN,100,INDEXAT,0)
26 I LINE'="<INDEX>" D Q
27 . W !,"Index missing, cannot continue!"
28 . S IEN=-1
29 . H 2
30 S JND=INDEXAT+1
31 S LINE=^PXD(811.8,IEN,100,JND,0)
32 S NCMPNT=+$$GETTAGV^PXRMEXU3(LINE,"<NUMBER_OF_COMPONENTS>")
33 K ^TMP($J,"CMPNT")
34 F IND=1:1:NCMPNT D
35 . K END,START
36 . F S JND=JND+1,LINE=^PXD(811.8,IEN,100,JND,0) Q:LINE="</COMPONENT>" D
37 .. S TAG=$$GETTAG^PXRMEXU3(LINE)
38 .. I TAG["START" S START(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
39 .. I TAG["END" S END(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
40 . I $D(START("<M_ROUTINE_START>")) D
41 .. S CSTART=START("<M_ROUTINE_START>")
42 .. S ^TMP($J,"CMPNT",IND,"TYPE")="ROUTINE"
43 .. S LINE=^PXD(811.8,IEN,100,CSTART+1,0)
44 .. S ^TMP($J,"CMPNT",IND,"NAME")=$$GETTAGV^PXRMEXU3(LINE,"<ROUTINE_NAME>")
45 .. S ^TMP($J,"CMPNT",IND,"FILENUM")=0
46 ..;Save the actual start and end of the code.
47 .. S ^TMP($J,"CMPNT",IND,"START")=START("<ROUTINE_CODE_START>")
48 .. S ^TMP($J,"CMPNT",IND,"END")=END("<ROUTINE_CODE_END>")
49 . I $D(START("<FILE_START>")) D
50 .. S CSTART=START("<FILE_START>")
51 .. S LINE=^PXD(811.8,IEN,100,CSTART+1,0)
52 .. S (^TMP($J,"CMPNT",IND,"TYPE"),^TMP($J,"CMPNT",IND,"FILENAME"))=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
53 .. S LINE=^PXD(811.8,IEN,100,CSTART+2,0)
54 .. S ^TMP($J,"CMPNT",IND,"FILENUM")=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NUMBER>")
55 .. S LINE=^PXD(811.8,IEN,100,CSTART+3,0)
56 .. S (^TMP($J,"CMPNT",IND,"NAME"),^TMP($J,"CMPNT",IND,"POINT_01"))=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
57 ..;Save the actual start and end of the FileMan FDA.
58 .. S ^TMP($J,"CMPNT",IND,"FDA_START")=START("<FDA_START>")
59 .. S ^TMP($J,"CMPNT",IND,"FDA_END")=END("<FDA_END>")
60 .. S ^TMP($J,"CMPNT",IND,"IEN_ROOT_START")=$G(START("<IEN_ROOT_START>"))
61 .. S ^TMP($J,"CMPNT",IND,"IEN_ROOT_END")=$G(END("<IEN_ROOT_END>"))
62 ;Build some indexes to order the component list.
63 F IND=1:1:NCMPNT D
64 . S TYPE=^TMP($J,"CMPNT",IND,"TYPE")
65 . S COMIND(TYPE,IND)=""
66 . S UCOM(TYPE)=""
67 ;Build the component order for display and install.
68 D CORDER^PXRMEXCO(IEN,.UCOM,.NUMCMPNT,.COMORDR)
69 ;Set the 0 node.
70 S ^PXD(811.8,IEN,120,0)=U_"811.802A"_U_NCMPNT_U_NCMPNT
71 S NCTYPE=0
72 S NITEMS=0
73 F NCTYPE=1:1:NUMCMPNT D
74 . S TYPE=$O(COMORDR(NCTYPE,""))
75 . S NITEMS=0
76 . S IND=""
77 . F S IND=$O(COMIND(TYPE,IND)) Q:IND="" D
78 .. S NITEMS=NITEMS+1
79 .. I NITEMS=1 S FILENUM=^TMP($J,"CMPNT",IND,"FILENUM")
80 .. I TYPE="ROUTINE" S TEMP=^TMP($J,"CMPNT",IND,"NAME")_U_^TMP($J,"CMPNT",IND,"START")_U_^TMP($J,"CMPNT",IND,"END")
81 .. E S TEMP=^TMP($J,"CMPNT",IND,"NAME")_U_^TMP($J,"CMPNT",IND,"FDA_START")_U_^TMP($J,"CMPNT",IND,"FDA_END")_U_$G(^TMP($J,"CMPNT",IND,"IEN_ROOT_START"))_U_$G(^TMP($J,"CMPNT",IND,"IEN_ROOT_END"))
82 .. S ^PXD(811.8,IEN,120,NCTYPE,1,NITEMS,0)=TEMP
83 . S ^PXD(811.8,IEN,120,NCTYPE,0)=TYPE_U_FILENUM_U_NITEMS
84 . S ^PXD(811.8,IEN,120,NCTYPE,1,0)=U_"811.8021A"_U_NITEMS_U_NITEMS
85 ;
86 ;Save the number of component types.
87 S ^PXD(811.8,IEN,119)=NCTYPE
88 K ^TMP($J,"CMPNT")
89 Q
90 ;
91 ;=====================================================
92DELETE(LIST) ;Delete the repository entries in LIST.
93 N DA,DIK
94 S DIK="^PXD(811.8,"
95 S DA=""
96 F S DA=$O(LIST(DA)) Q:+DA=0 D ^DIK
97 Q
98 ;
99 ;=====================================================
100DELHIST(RIEN,IHIEN) ;Delete install history IHIEN in repository entry RIEN.
101 N DA,DIK
102 S DA=IHIEN,DA(1)=RIEN
103 S DIK="^PXD(811.8,"_DA(1)_",130,"
104 D ^DIK
105 Q
106 ;
107 ;=====================================================
108DESC(RIEN,DESL,DESC,KEYWORD) ;Build the description.
109 N JND,LC,NKEYW
110 S LC=1
111 S ^PXD(811.8,RIEN,110,LC,0)="Reminder: "_DESL("RNAME")
112 S LC=LC+1
113 S ^PXD(811.8,RIEN,110,LC,0)="Source: "_DESL("SOURCE")
114 S LC=LC+1
115 S ^PXD(811.8,RIEN,110,LC,0)="Date Packed: "_DESL("DATEP")
116 S LC=LC+1
117 S ^PXD(811.8,RIEN,110,LC,0)="Package Version: "_DESL("VRSN")
118 S LC=LC+1
119 S ^PXD(811.8,RIEN,110,LC,0)=""
120 ;Add the user's description.
121 S LC=LC+1
122 S ^PXD(811.8,RIEN,110,LC,0)="Description:"
123 F JND=1:1:+$P($G(@DESC@(1,0)),U,4) D
124 . S LC=LC+1
125 . S ^PXD(811.8,RIEN,110,LC,0)=@DESC@(1,JND,0)
126 S LC=LC+1
127 S ^PXD(811.8,RIEN,110,LC,0)=""
128 ;Add the keywords.
129 S LC=LC+1
130 S ^PXD(811.8,RIEN,110,LC,0)="Keywords:"
131 S NKEYW=+$P($G(@KEYWORD@(1,0)),U,4)
132 I NKEYW=0 D
133 . S LC=LC+1
134 . S ^PXD(811.8,RIEN,110,LC,0)="No keywords given"
135 F JND=1:1:NKEYW D
136 . S LC=LC+1
137 . S ^PXD(811.8,RIEN,110,LC,0)=@KEYWORD@(1,JND,0)
138 S LC=LC+1
139 S ^PXD(811.8,RIEN,110,LC,0)=""
140 S LC=LC+1
141 S ^PXD(811.8,RIEN,110,LC,0)="Components:"
142 S ^PXD(811.8,RIEN,110,0)=U_811.804_U_LC_U_LC
143 Q
144 ;
145 ;=====================================================
146RIEN(LIEN) ;Given the list ien return the repository ien.
147 N RIEN
148 S RIEN=$G(^TMP("PXRMEXLR",$J,"SEL",LIEN))
149 Q RIEN
150 ;
151 ;=====================================================
152SAVHIST ;Save the installation history in the repository.
153 N ACTION,DATE,CMPNT,FTYPE,IND,INDEX,ITEM,JND,NEWNAME
154 N SUB,TEMP,TOTAL,TYPE,USER
155 ;Find the first open spot in the Installation History node.
156 S (IND,JND)=0
157 F S IND=+$O(^PXD(811.8,PXRMRIEN,130,IND)) S JND=JND+1 Q:(IND=0)!(IND>JND)
158 S IND=JND
159 S JND=0
160 F SUB="PXRMEXIA","PXRMEXIAD" D
161 . S INDEX=0
162 . F S INDEX=$O(^TMP(SUB,$J,INDEX)) Q:+INDEX=0 D
163 .. S JND=JND+1
164 .. S CMPNT=$O(^TMP(SUB,$J,INDEX,""))
165 .. S ITEM=$O(^TMP(SUB,$J,INDEX,CMPNT,""))
166 .. S ACTION=$O(^TMP(SUB,$J,INDEX,CMPNT,ITEM,""))
167 .. S NEWNAME=$G(^TMP(SUB,$J,INDEX,CMPNT,ITEM,ACTION))
168 .. S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME
169 ..;Set the 0 node.
170 .. S ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND
171 ..;Check for finding item changes and save them.
172 .. S FTYPE=""
173 .. I CMPNT["DEFINITION" S FTYPE="DEFF"
174 .. I CMPNT["DIALOG" S FTYPE="DIAF"
175 .. I CMPNT["TERM" S FTYPE="TRMF"
176 .. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D
177 ... N FI,FINDING,KND,OFINDING
178 ... S KND=2
179 ... S FI=""
180 ... F S FI=$O(^TMP(SUB,$J,FTYPE,FI)) Q:FI="" D
181 .... S OFINDING=$O(^TMP(SUB,$J,FTYPE,FI,""))
182 .... S FINDING=^TMP(SUB,$J,FTYPE,FI,OFINDING)
183 .... I OFINDING=FINDING Q
184 .... S KND=KND+1
185 .... S TEMP=$E(OFINDING,1,33)
186 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_FINDING
187 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
188 ... I KND>2 D
189 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" Finding Changes"
190 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
191 ..;
192 ..;Check for TIU template replacements and save them.
193 .. I CMPNT["DIALOG" S FTYPE="DIATIU"
194 .. E S FTYPE=""
195 .. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D
196 ... N KND,OTIUT,TIUT,TYPE
197 ... S TYPE=""
198 ... S KND=2
199 ... F S TYPE=$O(^TMP(SUB,$J,FTYPE,TYPE)) Q:TYPE="" D
200 .... S OTIUT=""
201 .... F S OTIUT=$O(^TMP(SUB,$J,FTYPE,TYPE,OTIUT)) Q:OTIUT="" D
202 ..... S TIUT=$G(^TMP(SUB,$J,FTYPE,TYPE,OTIUT))
203 ..... I OTIUT=TIUT Q
204 ..... I '$D(^TMP(SUB,$J,FTYPE,TYPE,OTIUT,ITEM)) Q
205 ..... S KND=KND+1
206 ..... S TEMP=$E(OTIUT,1,33)
207 ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_TIUT
208 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
209 .... I KND>2 D
210 ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" "_TYPE
211 ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
212 ;If JND is still 0 then there was nothing to save.
213 I JND>0 D
214 .;Save the header information.
215 . S DATE=^TMP("PXRMEXIA",$J,"DT")
216 . S TYPE=^TMP("PXRMEXIA",$J,"TYPE")
217 . S USER=$$GET1^DIQ(200,DUZ,.01,"")
218 . S ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER_U_TYPE
219 . S ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)=""
220 .;Set the 0 node.
221 . S (KND,TOTAL)=0
222 . F S KND=+$O(^PXD(811.8,PXRMRIEN,130,KND)) Q:KND=0 S TOTAL=TOTAL+1
223 . S ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_IND_U_TOTAL
224 K ^TMP("PXRMEXIA",$J)
225 K ^TMP("PXRMEXIAD",$J)
226 Q
227 ;
Note: See TracBrowser for help on using the repository browser.