source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQEPST1.m@ 1154

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1DGQEPST1 ;ALB/JFP- VIC POST INIT UTILITIES; 09/01/96
2 ;;V5.3;REGISTRATION;**73**;DEC 11,1996
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5APPUPD ;Updates HL7 Application parameter file (#771) with site #
6 ;
7 ;Input : None
8 ;Output : None
9 ;Note : This is a KIDS complient check point
10 ;
11 ;Declare variables
12 N FACNUM,DA,DIR,DIE,MSGTXT
13 D BMES^XPDUTL(">>> Updates entry DGQE VIC EVENTS in HL APPLICATION file (#771)")
14 ;-- Check for application
15 I '$D(^HL(771,"B","DGQE VIC EVENTS")) D Q
16 .S MSGTXT(1)=" ** Entries for 'DGQE VIC EVENTS' in the HL APPLICATION"
17 .S MSGTXT(2)=" file (#771) can not be created"
18 .S MSGTXT(3)=" ** Entries must be manually entered"
19 .D MES^XPDUTL(.MSGTXT)
20 .K MSGTXT
21 ;
22 S DA="",DA=+$O(^HL(771,"B","DGQE VIC EVENTS",DA))
23 S FACNUM=+$P($$SITE^VASITE(),"^",3)
24 S DIE="^HL(771,"
25 S DR="3///"_FACNUM
26 D ^DIE
27 S MSGTXT(1)=" "
28 S MSGTXT(2)=" DGQE VIC EVENTS updated with site number"
29 D MES^XPDUTL(.MSGTXT)
30 K MSGTXT
31 Q
32 ;
33UPDLL ;Updates logical link with device, HL LOWER LEVEL PROTOCOL PARAMETERS
34 ;file (#869.2)
35 ;
36 ;Input : None
37 ;Output : None
38 ;Note : This is a KIDS complient check point
39 ;
40 ;Declare variables
41 N FACNUM,DA,DIR,DIE,MSGTXT,FIND
42 D BMES^XPDUTL(">>> Updates entry 'VIC-LINK' in HL LOWER LEVEL PROTOCOL PARAMETER")
43 D MES^XPDUTL(" file (#869.2) with device 'VIC CARD'")
44 ;-- Check for device
45 S FIND=$$FIND1^DIC(3.5,"","X","VIC CARD")
46 I FIND=0 D Q
47 .S MSGTXT(1)=" ** Entry for 'VIC CARD' in DEVICE file does not exist"
48 .S MSGTXT(2)=""
49 .S MSGTXT(3)=" ** The 'VIC CARD' device needs to exist before it can"
50 .S MSGTXT(4)=" be updated to the logical link. These entries"
51 .S MSGTXT(5)=" will need to be built manually"
52 .D MES^XPDUTL(.MSGTXT)
53 .K MSGTXT
54 ;
55 ;-- Check for Locial Link
56 S DA=$$FIND1^DIC(869.2,"","X","VIC-LINK")
57 I DA=0 D Q
58 .S MSGTXT(1)=" ** Entry for 'VIC-LINK' in the HL LOWER LEVEL PARAMETER"
59 .S MSGTXT(2)=" file (#869.2) is not found"
60 .S MSGTXT(3)=" ** Entries must be manually entered and updated with"
61 .S MSGTXT(4)=" 'VIC CARD' device"
62 .D MES^XPDUTL(.MSGTXT)
63 .K MSGTXT
64 ;
65 S DIE="^HLCS(869.2,"
66 S DR="200.01///VIC CARD"
67 D ^DIE
68 S MSGTXT(1)=" "
69 S MSGTXT(2)=" Logical link 'VIC-LINK' updated with device 'VIC CARD'"
70 D MES^XPDUTL(.MSGTXT)
71 K MSGTXT
72 Q
73 ;
74UPDBULL ;Updates BULLETIN file (#3.6) with mail group VIC
75 ;
76 ;Input : None
77 ;Output : None
78 ;Note : This is a KIDS complient check point
79 ;
80 ;Declare variables
81 N FACNUM,DA,DIR,DIE,MSGTXT
82 D BMES^XPDUTL(">>> Updates entry 'DGQE PHOTO CAPTURE' bulletin with VIC mail group")
83 ;-- Check for mail group
84 S X=$$FIND1^DIC(3.8,"","X","VIC")
85 I X=0 D Q
86 .S MSGTXT(1)=" ** Entry for 'VIC' in MAIL GROUP file does not exist"
87 .S MSGTXT(2)=""
88 .S MSGTXT(3)=" ** The 'VIC' mail group needs to exist before it can"
89 .S MSGTXT(4)=" be updated to the bulletin file. These entries"
90 .S MSGTXT(5)=" will need to be built manually"
91 .D MES^XPDUTL(.MSGTXT)
92 .K MSGTXT
93 ;
94 ;-- Check for bulletin
95 S DA(1)=$$FIND1^DIC(3.6,"","X","DGQE PHOTO CAPTURE")
96 I DA(1)=0 D Q
97 .S MSGTXT(1)=" ** Entry for 'DGQE PHOTO CAPTURE' in the bulletin"
98 .S MSGTXT(2)=" file (#3.6) is not found"
99 .S MSGTXT(3)=" ** The entry must be manually entered and updated"
100 .S MSGTXT(4)=" 'VIC' mail group"
101 .D MES^XPDUTL(.MSGTXT)
102 .K MSGTXT
103 ;
104 S DIC="^XMB(3.6,"_DA(1)_",2,"
105 S DIC("P")=$P(^DD(3.6,4,0),"^",2)
106 S DIC(0)="L"
107 K DO,DD
108 I X,'$$FIND1^DIC(3.62,","_DA(1)_",","Q",X) D FILE^DICN K DO,DD
109 S MSGTXT(1)=" "
110 S MSGTXT(2)=" VIC mail group associated DGQE PHOTO CAPTURE bulletin"
111 D MES^XPDUTL(.MSGTXT)
112 K MSGTXT
113 Q
114 ;
115MAILMEM ; -- A message to adds mail group members to VIC mail group
116 ;INPUT : None
117 ;OUTPUT : None
118 ;Note : - This is a KID complient check point
119 ;
120 ; -- Declare variables
121 N DA,DIR,DIE,MSGTXT
122 D BMES^XPDUTL(">>> Updates VIC mail group with one member")
123 ;-- Check for mail group
124 S DA(1)=$$FIND1^DIC(3.8,"","X","VIC")
125 I DA(1)=0 D Q
126 .S MSGTXT(1)=" ** Entry for 'VIC' mail group can not be found"
127 .S MSGTXT(2)=" ** The VIC mail group and members will need to be"
128 .S MSGTXT(3)=" entered manually"
129 .D MES^XPDUTL(.MSGTXT)
130 .K MSGTXT
131 ;
132 ;-- Check for member
133 I '$D(XPDQUES("POS1","B")) D Q
134 .S MSGTXT(1)=" ** No member added to VIC mail group."
135 .S MSGTXT(2)=" ** Members will need to be entered manually"
136 .D MES^XPDUTL(.MSGTXT)
137 .K MSGTXT
138 ;
139 S DIC="^XMB(3.8,"_DA(1)_",1,"
140 S DIC("P")=$P(^DD(3.8,2,0),"^",2)
141 S DIC(0)="L"
142 S X=$P($G(XPDQUES("POS1","B")),"^",1) K DO,DD
143 I X,'$$FIND1^DIC(3.81,","_DA(1)_",","Q",X) D FILE^DICN K DO,DD
144 ;
145 S MSGTXT(1)=" "
146 S MSGTXT(2)=" VIC mail group updated with new member"
147 D MES^XPDUTL(.MSGTXT)
148 K MSGTXT
149 ;
150 D BMES^XPDUTL(">>> Additional members should be added to the VIC Mail Group...")
151 S MSGTXT(1)=" The members in this group would be those people"
152 S MSGTXT(2)=" responsible for taking care of problems associated"
153 S MSGTXT(3)=" with the VIC interface"
154 D MES^XPDUTL(.MSGTXT)
155 K MSGTXT
156 Q
157 ;
158CHKVER ; Check for version 2.2 in HL7 VERSION file (#771.5)
159 ;
160 ;Input : None
161 ;Output : None
162 ;Note : This is a KIDS complient check point
163 ;
164 ;Declare variables
165 N X,Y,DIC,MSGTXT,DIE,DR,DA
166 D BMES^XPDUTL(">>> Checks for version 2.2 in HL7 VERSION file (#771.5)")
167 ;-- Check for version 2.2
168 I $D(^HL(771.5,"B",2.2)) D Q
169 .S MSGTXT(1)=" "
170 .S MSGTXT(2)=" ** Version 2.2 exist in the HL7 version file (#771.5)"
171 .D MES^XPDUTL(.MSGTXT)
172 .K MSGTXT
173 ; -- DIC to add entry
174 S DIC(0)="LX"
175 S DIC="^HL(771.5,"
176 S X=2.2
177 D ^DIC
178 I Y=-1 D Q
179 .S MSGTXT(1)=" ** Entry for version 2.2 in the HL7 version file "
180 .S MSGTXT(2)=" (#771.5) can not be created"
181 .S MSGTXT(3)=" ** Entry must be manually entered"
182 .D MES^XPDUTL(.MSGTXT)
183 .K MSGTXT
184 ; -- Entry created, update remaining field
185 S DA=$P(Y,"^",1)
186 S DIE="^HL(771.5,"
187 S DR="2///HEALTH LEVEL SEVEN"
188 D ^DIE
189 S MSGTXT(1)=" "
190 S MSGTXT(2)=" Version 2.2 added to file #771.5"
191 D MES^XPDUTL(.MSGTXT)
192 K MSGTXT
193 Q
194 ;
195CHKA08 ;Checks for version 2.2 in entry A08 of file HL7 EVENT TYPE CODE file
196 ;(#779.001)
197 ;
198 ;Input : None
199 ;Output : None
200 ;Note : This is a KIDS complient check point
201 ;
202 ;Declare variables
203 N DA,DIR,DIE,MSGTXT
204 D BMES^XPDUTL(">>> Check for version 2.2 in entry A08 in file #779.001")
205 ;-- Check for A08 entry
206 I '$D(^HL(779.001,"B","A08")) D Q
207 .S MSGTXT(1)=" ** Entry for 'A08' in HL7 EVENT TYPE CODE file does "
208 .S MSGTXT(2)=" not exist"
209 .S MSGTXT(3)=""
210 .S MSGTXT(4)=" ** The 'A08' event type will need to exist before it"
211 .S MSGTXT(5)=" can be updated with version 2.2. The A08 entry"
212 .S MSGTXT(6)=" will need to be built manually and updated"
213 .D MES^XPDUTL(.MSGTXT)
214 .K MSGTXT
215 ;
216 ;Check for version 2.2 in A08 entry
217 ; -- get pointer from 771.5 for version 2.2
218 S DA="",DA=$O(^HL(771.5,"B","2.2",DA))
219 ; -- get ien for A08
220 S DA(1)="",DA(1)=$O(^HL(779.001,"B","A08",DA(1)))
221 ; -- check for AO8 entry; for version 2.2
222 I $D(^HL(779.001,DA(1),1,"B",DA)) D Q
223 .S MSGTXT(1)=" "
224 .S MSGTXT(2)=" ** Version 2.2 already associated with A08 entry"
225 .D MES^XPDUTL(.MSGTXT)
226 .K MSGTXT
227 ;
228 ; -- Entry Doesn't exist, add it
229 S DIC="^HL(779.001,"_DA(1)_",1,"
230 S DIC("P")=$P(^DD(779.001,100,0),"^",2)
231 S DIC(0)="L"
232 S X=DA
233 I X,'$D(^HL(779.001,DA(1),1,"B",X)) D FILE^DICN K DO,DD
234 S MSGTXT(1)=" "
235 S MSGTXT(2)=" Version 2.2 added to entry A08 "
236 D MES^XPDUTL(.MSGTXT)
237 K MSGTXT
238 Q
239 ;
240CHKACK ;Checks for version 2.2 in entry ACK of file HL7 MESSAGE TYPE file
241 ;(#771.2)
242 ;
243 ;Input : None
244 ;Output : None
245 ;Note : This is a KIDS complient check point
246 ;
247 ;Declare variables
248 N DA,DIR,DIE,MSGTXT
249 D BMES^XPDUTL(">>> Check for version 2.2 in entry ACK in file #771.2")
250 ;-- Check for ACK entry
251 I '$D(^HL(771.2,"B","ACK")) D Q
252 .S MSGTXT(1)=" ** Entry for 'ACK' in HL7 MESSAGE TYPE file does "
253 .S MSGTXT(2)=" not exist"
254 .S MSGTXT(3)=""
255 .S MSGTXT(4)=" ** The 'ACK' message type will need to exist before it"
256 .S MSGTXT(5)=" can be updated with version 2.2. The ACK entry"
257 .S MSGTXT(6)=" will need to be built manually and updated"
258 .D MES^XPDUTL(.MSGTXT)
259 .K MSGTXT
260 ;
261 ;Check for version 2.2 in ACK entry
262 ; -- get pointer from 771.5 for version 2.2
263 S DA="",DA=$O(^HL(771.5,"B","2.2",DA))
264 ; -- get ien for ACK
265 S DA(1)="",DA(1)=$O(^HL(771.2,"B","ACK",DA(1)))
266 ; -- check for ACK entry; for version 2.2
267 I $D(^HL(771.2,DA(1),"V","B",DA)) D Q
268 .S MSGTXT(1)=" "
269 .S MSGTXT(2)=" ** Version 2.2 already associated with ACK entry"
270 .D MES^XPDUTL(.MSGTXT)
271 .K MSGTXT
272 ;
273 ; -- Entry Doesn't exist, add it
274 S DIC="^HL(771.2,"_DA(1)_",""V"","
275 S DIC("P")=$P(^DD(771.2,3,0),"^",2)
276 S DIC(0)="L"
277 S X=DA
278 I X,'$D(^HL(771.2,DA(1),"V","B",X)) D FILE^DICN K DO,DD
279 S MSGTXT(1)=" "
280 S MSGTXT(2)=" Version 2.2 added to entry ACK "
281 D MES^XPDUTL(.MSGTXT)
282 K MSGTXT
283 Q
284 ;
285ALLP ; -- Sets ALLP xref in file 870 for VIC entry
286 ;Input : None
287 ;Output : None
288 ;Note : This is a KIDS complient check point
289 ;
290 S DA=$$FIND1^DIC(870,"","X","VIC")
291 S DIK="^HLCS(870,"
292 D IX^DIK
293 K DA,DIK
294 Q
295 ;
296 ; -- Done
297 Q
Note: See TracBrowser for help on using the repository browser.