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

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1DG53190T ; ALB/SCK - UTILITY TO CREATE RAI/MDS SUBSCRIBER PROTOCOLS ; 10-14-99
2 ;;5.3;Registration;**190,357,416**;Aug 13, 1993
3 ;
4EN ;
5 N DGSTN,FDA,DIR,ERR,HLLP,DGDIV,DGSCN,DGTEST,DGX,DGABRT,HLAPP,HLLINK,DGABRT,I,X,Y,DGIP,DGPORT
6 ;
7 W @IOF
8 F I=0:1 S DGX=$P($T(TEXT+I),";;",2) Q:DGX="$END" W !,DGX
9 S DIR(0)="YA",DIR("B")="NO",DIR("A")="Do you wish to continue? "
10 S DIR("?")="Enter Yes to continue, or No to quit"
11 D ^DIR K DIR
12 Q:'Y!$D(DIRUT)
13 ;
14 F DGX="DIV","SETIP","870","771","408","101","DEM","MFU","FIN" D @DGX Q:$G(DGABRT)
15 Q
16 ;
17DIV ;
18 W !
19 N DIR,DIRUT
20 S DIR(0)="PO^40.8:EMZ"
21 S DIR("A",1)="Enter the Division you are setting up the"
22 S DIR("A")="RAI/MDS HL7 messaging for"
23 S DIR("?")="Select the appropriate division to set up the HL7 messaging parameters for."
24 D ^DIR K DIR I $D(DIRUT)!(+Y'>0) S DGABRT=1 Q
25 S DGDIV=Y
26 S DGSTN=$$SITE^VASITE($$NOW^XLFDT,+DGDIV)
27 ;
28 W !!?4,"You have selected : ",$P(DGDIV,"^",2)
29 W !?4,"Station Number : ",$S(+DGSTN>0:$P(DGSTN,"^",3),1:"Undefined Station Number"),!
30 ;
31 I +DGSTN<0 D G DIV
32 . W !?4,"You cannot proceed with this division until the station number is"
33 . W !?4,"corrected. Check the STATION NUMBER TIME SENSITIVE"
34 . W !?4,"file to be sure this division is active today."
35 . W !?4,"You may select another division or quit.",!
36 ;
37 N DIR,DUOUT,DTOUT
38 ;
39 S DIR(0)="YAO",DIR("A")="Is this correct? ",DIR("B")="YES"
40 S DIR("?")="Enter Yes or No, Yes will select, No will cancel."
41 D ^DIR K DIR Q:$D(DUOUT)!($D(DTOUT))
42 G:'Y DIV
43 W !
44 Q
45 ;
46SETIP ; Get IP address and port number
47 N ERR,RSLT,FDA,DIR,DIRUT
48 ;
49IP S DIR(0)="FAO",DIR("A")="Enter IP address of target COTS receiver: "
50 S DIR("?",1)="The IP address must be in the format 'nnn.nnn.nnn.nnn' where"
51 S DIR("?",2)="nnn is a numeric, 1-3 numbers in length and should designate"
52 S DIR("?")="the static IP address for the COTS database server."
53 D ^DIR K DIR
54 Q:$D(DIRUT)
55 ;
56 G:$P(Y,".",1)'?1.3N IP
57 G:$P(Y,".",2)'?1.3N IP
58 G:$P(Y,".",3)'?1.3N IP
59 G:$P(Y,".",4)'?1.3N IP
60 S DGIP=$G(Y)
61PORT ;
62 N DIR
63 S DIR(0)="FAO",DIR("A")="Enter the port number of the target COTS receiver: "
64 S DIR("?",1)="The port number must be a numeric value and should be"
65 S DIR("?")="the TCP/IP port the target COTS receiver is listening on."
66 D ^DIR K DIR
67 Q:$D(DIRUT)
68 ;
69 G:Y'?1N.N PORT
70 S DGPORT=$G(Y)
71 Q
72 ;
73870 ; Create HL7 Logical Link
74 N ERR,RSLT,FDA,DGLLP,DGLNK
75 ;
76 S DGLNK="DGRU"_$P(DGSTN,"^",3) ; Check for existing Logical Link
77 I $$FIND1^DIC(870,"","MX",DGLNK)>0 D Q
78 . W !?4,"A Logical Link for ",DGLNK," already exists."
79 ;
80 ; Set up the logical link
81 K FDA
82 S FDA(1,870,"+1,",.01)=DGLNK
83 S FDA(1,870,"+1,",4.5)=1
84 S FDA(1,870,"+1,",2)="TCP"
85 S FDA(1,870,"+1,",3)="NC" ;p-416
86 S FDA(1,870,"+1,",200.021)="R" ;added p-416
87 S FDA(1,870,"+1,",200.05)=20
88 S FDA(1,870,"+1,",200.08)=2.3
89 S FDA(1,870,"+1,",400.01)=DGIP
90 S FDA(1,870,"+1,",400.02)=DGPORT
91 S FDA(1,870,"+1,",400.03)="C"
92 S FDA(1,870,"+1,",400.04)="N" ;p-416
93 ;
94 D UPDATE^DIE("E","FDA(1)","RSLT","ERR(1)")
95 I $D(ERR) D Q
96 . W !,DGLNK,": " D MSG^DIALOG("WM","","",4,"ERR(1)")
97 . S DGABRT=1
98 S HLLINK=RSLT(1)
99 Q
100 ;
101771 ; Create HL7 application
102 N ERR,RSLT,FDA,DGNAME
103 ;
104 ; Retrieve ien of HL7 messaging mail group
105 S DIC=3.8,DIC(0)="MZ",X="DGRU ADT/HL7"
106 D ^DIC K DIC
107 S DGMAIL=$G(Y(0,0))
108 ;
109 K FDA
110 S DGNAME="DGRU-"_$P(DGSTN,"^",2)
111 S:$L(DGNAME)>15 DGNAME=$E(DGNAME,1,15)
112 ; Check for existing HL7 Application
113 S HLAPP=$$FIND1^DIC(771,"","MX",DGNAME) I HLAPP>0 D Q ;p-416
114 . W !?4,"A HL7 Application for ",DGNAME," already exists."
115 ;
116 S FDA(1,771,"+1,",.01)=DGNAME
117 S FDA(1,771,"+1,",3)=$P(DGSTN,"^",3)
118 S FDA(1,771,"+1,",4)=DGMAIL
119 S FDA(1,771,"+1,",7)="USA"
120 ;
121 D UPDATE^DIE("E","FDA(1)","RSLT","ERR(1)")
122 I $D(ERR) D Q
123 . W !,DGNAME,": " D MSG^DIALOG("WM","","",4,"ERR(1)")
124 . S DGABRT=1
125 S HLAPP=RSLT(1)
126 Q
127 ;
128408 ; Create subscription registry entry
129 N ERR,RSLT,FDA,DGSCN,DGLL,DGAP
130 ;
131 S DGSCN=$$ACT^HLSUB
132 I '$D(HLAPP)!('$D(HLLINK)) D Q
133 . W !?4,"HL7 Application data not available"
134 ;
135 S DGLL=$$GET1^DIQ(870,HLLINK,.01)
136 S DGAP=$$GET1^DIQ(771,HLAPP,.01)
137 ;
138 D UPD^HLSUB(DGSCN,DGLL,2,,,DGAP,.ERR)
139 I $D(ERR) D Q
140 . W !,DGSCN,": " D MSG^DIALOG("WM","","",4,"ERR(1)")
141 . S DGABRT=1
142 ;
143 S FDA(1,40.8,+DGDIV_",",900.01)=DGSCN
144 ;
145 K ERR D FILE^DIE("","FDA(1)","ERR")
146 I $D(ERR) D
147 . W ! D MSG^DIALOG("WM","","",4,"ERR(1)")
148 . S DGABRT=1
149 Q
150 ;
151101 ; Create subscriber protocols
152 N EVNT,FDA,ERR,RSLT,DGNAME,IEN,DGCLIENT
153 ;
154 S IEN=0
155 F EVNT="A01","A02","A03","A11","A12","A13","A21","A22","A08" D Q:$G(DGABRT)
156 . S IEN=IEN+1
157 . S DGNAME="DGRU-RAI-"_EVNT_"-"_HLAPP ;changed p-357
158 . ;Check for existing protocol
159 . I $$FIND1^DIC(101,"","MX",DGNAME)>0 D Q
160 . . W !?4,"A protocol for ",DGNAME," already exists."
161 . ;
162 . S FDA(1,101,"+"_IEN_",",.01)=DGNAME
163 . S FDA(1,101,"+"_IEN_",",1)=EVNT_" CLIENT PROTOCOL FOR "_$P(DGSTN,"^",2)
164 . S FDA(1,101,"+"_IEN_",",4)="subscriber"
165 . S FDA(1,101,"+"_IEN_",",12)="REGISTRATION"
166 . S DGCLIENT="DGRU-"_$P(DGSTN,"^",2)
167 . S:$L(DGCLIENT)>15 DGCLIENT=$E(DGCLIENT,1,15)
168 . S FDA(1,101,"+"_IEN_",",770.2)=DGCLIENT
169 . S FDA(1,101,"+"_IEN_",",770.3)="ADT"
170 . S FDA(1,101,"+"_IEN_",",770.4)=EVNT
171 . S FDA(1,101,"+"_IEN_",",770.7)="DGRU"_$P(DGSTN,"^",3)
172 . S FDA(1,101,"+"_IEN_",",770.11)="ADT"
173 . S FDA(1,101,"+"_IEN_",",771)="Q"
174 . S FDA(1,101,"+"_IEN_",",773.1)="YES"
175 . S FDA(1,101,"+"_IEN_",",773.2)="YES"
176 . K ERR,RSLT
177 . D UPDATE^DIE("E","FDA(1)","RSLT","ERR(1)")
178 . I +$G(RSLT(IEN))>0 D
179 . . S DIE=101,DR="770.95////2.3",DA=RSLT(IEN) D ^DIE K DIE
180 . I $D(ERR) D
181 .. W ! D MSG^DIALOG("WM","","",4,"ERR(1)")
182 .. S DGABRT=1
183 Q
184 ;
185DEM ;
186 N FDA,RSLT,ERR,DGNAME,DGCLIENT,DGTXT
187 ;
188 S DGNAME="DGRU-PATIENT-A08-"_HLAPP ;changed p-357
189 S FDA(1,101,"+1,",.01)=DGNAME
190 ; Check for existing protocol
191 I $$FIND1^DIC(101,"","MX",DGNAME)>0 D Q
192 . W !?4,"A protocol for ",DGNAME," already exists."
193 ;
194 S DGTXT="A08 DEMOGRAPHIC UPDATES CLIENT PROTOCOL FOR "_$P(DGSTN,"^",2)
195 S:$L(DGTXT)>62 DGTXT=$E(DGTXT,1,62)
196 S FDA(1,101,"+1,",1)=DGTXT
197 S FDA(1,101,"+1,",4)="subscriber"
198 S FDA(1,101,"+1,",12)="REGISTRATION"
199 S DGCLIENT="DGRU-"_$P(DGSTN,"^",2)
200 S:$L(DGCLIENT)>15 DGCLIENT=$E(DGCLIENT,1,15)
201 S FDA(1,101,"+1,",770.2)=DGCLIENT
202 S FDA(1,101,"+1,",770.3)="ADT"
203 S FDA(1,101,"+1,",770.4)="A08"
204 S FDA(1,101,"+1,",770.7)="DGRU"_$P(DGSTN,"^",3)
205 S FDA(1,101,"+1,",770.11)="ADT"
206 S FDA(1,101,"+1,",771)="Q"
207 S FDA(1,101,"+1,",773.1)="YES"
208 S FDA(1,101,"+1,",773.2)="YES"
209 K ERR,RSLT
210 D UPDATE^DIE("E","FDA(1)","RSLT","ERR(1)")
211 I $D(ERR) D Q
212 . W ! D MSG^DIALOG("WM","","",4,"ERR(1)")
213 . S DGABRT=1
214 ;
215 I +$G(RSLT(1))>0 D
216 . S DIE=101,DR="770.95////2.3",DA=RSLT(1) D ^DIE K DIE
217 Q
218 ;
219MFU ;
220 N FDA,RSLT,ERR,DGNAME,DGCLIENT,DGTXT
221 S DGNAME="DGRU-RAI-MFU-"_HLAPP
222 ; Check for existing protocol
223 I $$FIND1^DIC(101,"","MX",DGNAME)>0 D Q
224 . W !?4,"A protocol for ",DGNAME," already exists."
225 ;
226 S FDA(1,101,"+1,",.01)=DGNAME
227 S DGTXT="MFU CLIENT PROTOCOL FOR "_$P(DGSTN,"^",2)
228 S:$L(DGTXT)>62 DGTXT=$E(DGTXT,1,62)
229 S FDA(1,101,"+1,",1)=DGTXT
230 S FDA(1,101,"+1,",4)="subscriber"
231 S FDA(1,101,"+1,",12)="REGISTRATION"
232 S DGCLIENT="DGRU-"_$P(DGSTN,"^",2)
233 S:$L(DGCLIENT)>15 DGCLIENT=$E(DGCLIENT,1,15)
234 S FDA(1,101,"+1,",770.2)=DGCLIENT
235 S FDA(1,101,"+1,",770.3)="MFN"
236 S FDA(1,101,"+1,",770.4)="M01"
237 S FDA(1,101,"+1,",770.7)="DGRU"_$P(DGSTN,"^",3)
238 S FDA(1,101,"+1,",770.11)="MFN"
239 S FDA(1,101,"+1,",771)="Q"
240 S FDA(1,101,"+1,",773.1)="YES"
241 S FDA(1,101,"+1,",773.2)="YES"
242 K ERR,RSLT
243 D UPDATE^DIE("E","FDA(1)","RSLT","ERR(1)")
244 I $D(ERR) D Q
245 .W ! D MSG^DIALOG("WM","","",4,"ERR(1)")
246 .S DGABRT=1
247 I +$G(RSLT(1))>0 D
248 .S DIE=101,DR="770.95////^S X=2.3",DA=RSLT(1) D ^DIE K DIE
249 Q
250 ;
251FIN ;
252 W !!?4,"Setup complete"
253 Q
254 ;
255TEXT ;;This routine will setup the necessary HL7 messaging parameters and client
256 ;;protocols for the selected division for the RAI/MDS Commercial-Off-The-Shelf
257 ;;system. This is required in order to correctly handle the dynamic addressing
258 ;;used by VistA to process HL7 messages to the COTS system.
259 ;;
260 ;;THIS ROUTINE SHOULD ONLY BE EXECUTED WHEN NEW DIVISIONS USING RAI/MDS NEED TO BE INITIALIZED.
261 ;;
262 ;;$END
Note: See TracBrowser for help on using the repository browser.