source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU1.m@ 711

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

revised back to 6/30/08 version
File size: 8.2 KB
Line 
1PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1. ;09/20/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
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,IHIND) ;Delete install history IHIND in repository entry RIEN.
101 N DATE
102 S DATE=$P(^PXD(811.8,RIEN,130,IHIND,0),U)
103 K ^PXD(811.8,RIEN,130,IHIND)
104 K ^PXD(811.8,RIEN,130,"B",DATE)
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,"IDX",LIEN,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,TEMP,USER
154 ;Find the first open spot in the Installation History node.
155 S (IND,JND)=0
156 F S IND=+$O(^PXD(811.8,PXRMRIEN,130,IND)) S JND=JND+1 Q:(IND=0)!(JND>IND)
157 ;Set the 0 node.
158 S ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_JND_U_JND
159 S IND=JND
160 S DATE=^TMP("PXRMEXIA",$J,"DT")
161 S USER=$$GET1^DIQ(200,DUZ,.01,"")
162 S ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER
163 S ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)=""
164 S (INDEX,JND)=0
165 F S INDEX=$O(^TMP("PXRMEXIA",$J,INDEX)) Q:+INDEX=0 D
166 . S JND=JND+1
167 . S CMPNT=$O(^TMP("PXRMEXIA",$J,INDEX,""))
168 . S ITEM=$O(^TMP("PXRMEXIA",$J,INDEX,CMPNT,""))
169 . S ACTION=$O(^TMP("PXRMEXIA",$J,INDEX,CMPNT,ITEM,""))
170 . S NEWNAME=$G(^TMP("PXRMEXIA",$J,INDEX,CMPNT,ITEM,ACTION))
171 . S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME
172 .;Set the 0 node.
173 . S ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND
174 .;Check for finding item changes and save them.
175 . S FTYPE=""
176 . I CMPNT["DEFINITION" S FTYPE="DEFF"
177 . I CMPNT["DIALOG" S FTYPE="DIAF"
178 . I CMPNT["TERM" S FTYPE="TRMF"
179 . I (FTYPE'=""),($D(^TMP("PXRMEXIA",$J,FTYPE))) D
180 .. N FI,FINDING,KND,OFINDING
181 .. S KND=2
182 .. S FI=""
183 .. F S FI=$O(^TMP("PXRMEXIA",$J,FTYPE,FI)) Q:FI="" D
184 ... S OFINDING=$O(^TMP("PXRMEXIA",$J,FTYPE,FI,""))
185 ... S FINDING=^TMP("PXRMEXIA",$J,FTYPE,FI,OFINDING)
186 ... I OFINDING=FINDING Q
187 ... S KND=KND+1
188 ... S TEMP=$E(OFINDING,1,33)
189 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_FINDING
190 .. S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
191 .. I KND>2 D
192 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" Finding Changes"
193 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
194 .;
195 .;Check for TIU template replacements and save them.
196 . I CMPNT["DIALOG" S FTYPE="DIATIU"
197 . E S FTYPE=""
198 . I (FTYPE'=""),($D(^TMP("PXRMEXIA",$J,FTYPE))) D
199 .. N KND,OTIUT,TIUT,TYPE
200 .. S TYPE=""
201 .. S KND=2
202 .. F S TYPE=$O(^TMP("PXRMEXIA",$J,FTYPE,TYPE)) Q:TYPE="" D
203 ... S OTIUT=""
204 ... F S OTIUT=$O(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT)) Q:OTIUT="" D
205 .... S TIUT=$G(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT))
206 .... I OTIUT=TIUT Q
207 .... I '$D(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT,ITEM)) Q
208 .... S KND=KND+1
209 .... S TEMP=$E(OTIUT,1,33)
210 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_TIUT
211 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
212 ... I KND>2 D
213 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" "_TYPE
214 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
215 K ^TMP("PXRMEXIA",$J)
216 Q
217 ;
Note: See TracBrowser for help on using the repository browser.