source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR4.m@ 1006

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

revised back to 6/30/08 version

File size: 8.3 KB
Line 
1HLCSHDR4 ;SFIRMFO/LJA - Reset MSH Segment Fields ;3/24/2004 14:27
2 ;;1.6;HEALTH LEVEL SEVEN;**93,108**;Oct 13, 1995
3 ;
4DEBUG(STORE) ; If HLP set up for debugging, capture VIEW...
5 ; HLMSH773 -- req
6 ;
7 N NOW,NUM,VAR,VARS,X,XTMP
8 ;
9 ; 1=some, 2=all
10 S STORE=$S(STORE=1:1,STORE=2:2,1:0) QUIT:'STORE ;->
11 ;
12 S NOW=$$NOW^XLFDT
13 ;
14 S XTMP="HLCSHDR3 "_HLMSH773
15 S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,0,4)_U_NOW_U_"Debug data created by DEBUG~HLCSHDR4"
16 ;
17 S NUM=$O(^XTMP(XTMP,":"),-1)+1
18 ;
19 ; Grab only critical (some) variables?
20 I STORE=1 D
21 .
22 . ; Sending information...
23 . S ^XTMP(XTMP,NUM,"SA")=HLMSHSAO_U_HLSAN_U_HLMSHSAN
24 . S ^XTMP(XTMP,NUM,"SF")=HLMSHSFO_U_HLSFN_U_HLMSHSFN
25 .
26 . ; Receiving information...
27 . S ^XTMP(XTMP,NUM,"RA")=HLMSHRAO_U_HLRAN_U_HLMSHRAN
28 . S ^XTMP(XTMP,NUM,"RF")=HLMSHRFO_U_HLRFN_U_HLMSHRFN
29 .
30 . ; Other information... (HLMSHPRE and HLMSHPRS hold 2 pieces!)
31 . S ^XTMP(XTMP,NUM,0)=NOW_U_HLMSH772_U_HLMSHPRE_U_HLMSHPRS
32 . S ^XTMP(XTMP,NUM,1)=HLMSHPRO
33 ;
34 ; Grab all variables?
35 I STORE=2 D
36 . S X="^XTMP("""_XTMP_""","_NUM_","
37 . D DOLRO^%ZOSV
38 ;
39 QUIT
40 ;
41SHOW N I773
42 F R !!,"Enter 773 IEN: ",I773:60 Q:I773'>0 D
43 . D SHOW773(I773)
44 QUIT
45 ;
46SHOW773(I773) ; Show Dynamic Routing MSH Field Reset Details
47 N DIV,MSH,N90,N91
48 ;
49 S N90=$G(^HLMA(+I773,90)),N91=$G(^HLMA(+I773,91))
50 I (N90_N91)']"" D QUIT ;->
51 . W " no debug data found..."
52 ;
53 S MSH=$G(^HLMA(+I773,"MSH",1,0)) QUIT:MSH']"" ;->
54 S DIV=$E(MSH,4)
55 ;
56 W !!,$$CJ^XLFSTR(" 773 # "_I773_" ",IOM,"=")
57 ;
58 D HDR(90,N90)
59 ;
60 W !
61 D HDR(91,N91)
62 ;
63 W !!,$E(MSH,1,IOM)
64 ;
65 S C1=10,C2=30,C3=50
66 W !!,?C1,"Original (91)",?2,"Array (90)",?3,"MSH-Segment"
67 W !,$$REPEAT^XLFSTR("-",IOM)
68 D LINE("snd app",1,2,3)
69 D LINE("snd fac",3,3,4)
70 D LINE("rec app",5,4,5)
71 D LINE("rec fac",7,5,6)
72 ;
73 QUIT
74 ;
75LINE(HDR,PCE1,PCE2,PCE3) ; Print one comparison line...
76 N P1,P2,P3,P4
77 S P1=$P(N91,U,PCE1),P2=$P(N90,U,PCE2),P3=$P(MSH,DIV,PCE3),P4=$P(N91,U,PCE1+1)
78 W !,HDR,":",?C1,P1,?2,P2,?3,P3,$S(P4]"":" ["_P4_"]",1:"")
79 QUIT
80 ;
81HDR(NUM,DATA) N TXT
82 S TXT=$S(NUM=90:"Array (90)",NUM=91:"Original (91)",1:"")
83 W !,$$CJ^XLFSTR("---------- "_TXT_" ----------",IOM)
84 W $$CJ^XLFSTR(DATA,IOM)
85 QUIT
86 ;
87SET(NEW,VAR,PCE) ; This subroutine performs these actions:
88 ; (1) Resets variables used in MSH segment
89 ; (2) Resets SERAPP and CLNTAPP in ^HLMA(#,0)
90 ; (3) Sets HLMSH91 nodes if overwrite occurs by ARRAY value.
91 ; If overwrite occurs by M code, the overwrite has already
92 ; been recorded in HLMSH91. (An overwrite produced by M code
93 ; is never overwritten by ARRAY data.)
94 ;
95 N IEN771N,IEN771O,HLTCP
96 ;
97 ; VAR is the name of the variable, and not it's value...
98 S PRE=@VAR ; PRE is now the value of the VAR (pre-overwrite) variable...
99 ;
100 ; Tests whether anything was changed...
101 QUIT:NEW']"" ;-> No new value exists to change to...
102 QUIT:NEW=PRE ;-> New value = Original value. Nothing changed...
103 ;
104 ; THIS IS THE EPICENTER!! This is where the variables used in
105 ; the MSH segment is overwritten.
106 S @VAR=NEW
107 ;
108 ; If PRE exists at this point, it was done by M code...
109 QUIT:$P(HLMSH91,U,PCE)]"" ;->
110 ;
111 ; Change was made, but not by M code. Must be by array...
112 S $P(HLMSH91,U,PCE)=PRE,$P(HLMSH91,U,PCE+1)="A"
113 ;
114 ; Upgrade ^HLMA(#,0)...
115 QUIT:PCE'=1&(PCE'=5) ;->
116 ;
117 ; patch HL*1.6*108 start
118 ;S IEN771O=$O(^HL(771,"B",PRE,0)) QUIT:IEN771O'>0 ;-> Orig IEN
119 ;S IEN771N=$O(^HL(771,"B",NEW,0)) QUIT:IEN771N'>0 ;-> New IEN
120 S IEN771O=$O(^HL(771,"B",$E(PRE,1,30),0)) QUIT:IEN771O'>0 ;-> Orig IEN
121 S IEN771N=$O(^HL(771,"B",$E(NEW,1,30),0)) QUIT:IEN771N'>0 ;-> New IEN
122 ; patch HL*1.6*108 end
123 ;
124 QUIT:'IEN771O!('IEN771N)!(IEN771O=IEN771N) ;->
125 S HLTCP=1 ; So 773 is updated...
126 I PCE=1 D UPDATE^HLTF0(MTIENS,"","O","","",IEN771N)
127 I PCE=5 D UPDATE^HLTF0(MTIENS,"","O","",IEN771N)
128 ;
129 QUIT
130 ;
131FIELDS ; Display the Protocol file fields used by the VistA HL7 package,
132 ; when messages are received, to find the event and subscriber
133 ; protocols.
134 N BY,DIC,DIOEND,L
135 ;
136 D HD
137 ;
138 W !
139 ;
140 S L="",DIC="^ORD(101,",BY="[HL PROTOCOL MESSAGING FIELDS]"
141 S DIOEND="D EXPL^HLCSHDR4"
142 D EN1^DIP
143 ;
144 Q
145 ;
146HD W @IOF,$$CJ^XLFSTR("HL7 Protocol Messaging Fields",IOM)
147 W !,$$REPEAT^XLFSTR("=",IOM)
148 W !,"This 'HL7 Protocol Messaging Fields' report holds information that will help"
149 W !,"you determine the effects from changes to routing-related fields in the MSH"
150 W !,"segment when messages are sent between or within VistA HL7 systems."
151 W !,"Additional explanation is included at the bottom of the report."
152 Q
153 ;
154EXPL N I,T QUIT:'$$EXPL1("Press RETURN for 'printout help', or '^' to exit... ") X "F I=1:1 S T=$T(EXPL+I) QUIT:T'["";;"" W !,$P(T,"";;"",2,99)" S I=$$EXPL1("Press RETURN to exit... ",1)
155 ;;
156 ;;When messages are received, their SENDING APPLICATION (MSH-3), MESSAGE
157 ;;TYPE (MSH-9), EVENT TYPE (MSH-9), and HL7 VERSION (MSH-12) fields are used to
158 ;;find the event driver protocol to be used in processing the just-received
159 ;;message. After the event protocol is found, that protocol's subscriber
160 ;;protocols are evaluated. The subscriber protocol with a RECEIVING
161 ;;APPLICATION value that matches the RECEIVING APPLICATION field in the MSH
162 ;;segment (MSH-5) is used.
163 ;;
164 ;;The first line for every "section" in the printout is the event driver
165 ;;protocol. Lines preceded by dashes, are related subscriber protocols. An
166 ;;example is shown below.
167 ;;
168 ;;Snd/Rec App's mTYP eTYP Ver Protocol Link
169 ;;------------------------------------------------------------------------------
170 ;;AC-VOICERAD ORU R01 2.3 | AC ORU SERVER
171 ;;-AC-RADIOLOGY ORU R01 2.3 | AC ORU CLIENT NC TCP
172 ;;
173 ;;In this example, the 'AC-VOICERAD' line holds information for the 'AC ORU
174 ;;SERVER' event protocol. And, the '-AC-RADIOLOGY' line holds information for
175 ;;the 'AC ORU CLIENT' subscriber protocol.
176 Q
177 ;
178EXPL1(PMT,FF) ;
179 N DIR,DIRUT,DTOUT,DUOUT,X,Y
180 QUIT:$E($G(IOST),1,2)'="C-" 1 ;->
181 F X=1:1:$G(FF) W !
182 S DIR(0)="EA",DIR("A")=PMT
183 D ^DIR
184 QUIT $S(Y=1:1,1:"")
185 ;
186M ; Covered by Integration Agreement #3988
187 ; Application developers may call here when creating new messages,
188 ; when experimenting with M code to evaluate and conditionally change
189 ; routing-related fields.
190 ;
191 ; This API is called immediately before the MSH segment is created.
192 N IOINHI,IOINORM,MSHOLD,MSHNEW,MSHPRE,X
193 ;
194 S X="IOINHI;IOINORM" D ENDR^%ZISS
195 ;
196 S MSHOLD=$$MSHBUILD(0),MSHPRE=$$MSHBUILD(1)
197 W !!,"The original MSH segment is...",!!,IOINHI,MSHOLD,IOINORM
198 I MSHPRE'=MSHOLD D
199 . W !!,"The MSH segment, after modification by passed-in data, is..."
200 . W !!,IOINHI,MSHPRE,IOINORM
201 ;
202 D MVAR("SENDING APPLICATION","HLMSHSAN","SERAPP")
203 D MVAR("SENDING FACILITY","HLMSHSFN","SERFAC")
204 D MVAR("RECEIVING APPLICATION","HLMSHRAN","CLNTAPP")
205 D MVAR("RECEIVING FACILITY","HLMSHRFN","CLNTFAC")
206 ;
207 S MSHNEW=$$MSHBUILD
208 I MSHNEW'=MSHPRE D
209 . W !!,"Before your changes above, the modified MSH segment was..."
210 . W !!,IOINHI,MSHPRE,IOINORM
211 . W !!,"After your changes, the MSH segment is..."
212 . W !!,IOINHI,MSHNEW,IOINORM
213 W !!,$$REPEAT^XLFSTR("-",IOM)
214 W !!,"Message being sent..."
215 W !
216 ;
217 Q
218 ;
219MVAR(FLD,VAR,VARO) ; Generic resetting of variable...
220 ;IOINHI,IOINORM -- req
221 N ANS
222 W !!,?4,"Protocol-derived value of ",FLD,": "
223 W IOINHI,@VARO,IOINORM
224 W !,"Passed-in value of ",FLD," (",VAR,"): "
225 W IOINHI,@VAR,IOINORM
226 W !,?10,"Enter new value for ",FLD,": "
227 R ANS:60 Q:'$T ;->
228 I ANS[U!(ANS']"") D
229 . W !!,?10,"No changes will be made..."
230 I ANS'[U&(ANS]"") D
231 . S @VAR=ANS
232 . W !!,?10,"The variable ",IOINHI,VAR,IOINORM
233 . W " will be changed to '",IOINHI,ANS,IOINORM,"'."
234 . W !,?10,"This value will be stored in the ",FLD
235 . W !,?10,"field in the MSH segment..."
236 . W !!,$$REPEAT^XLFSTR("-",IOM)
237 Q
238 ;
239MSHBUILD(TYPE) ; Build MSH using current variables...
240 N MSH,PCE,RAN,RFN,SAN,SFN
241 S MSH="MSH"_FS_EC
242 I $G(TYPE)=0 F PCE=SERAPP,SERFAC,CLNTAPP,CLNTFAC,HLDATE,SECURITY,MSGTYPE,HLID,HLPID,$P(PROT,U,9),"",$G(^HL(772,TXTP,1)),ACCACK,APPACK,CNTRY D
243 . S MSH=MSH_FS_PCE
244 I $G(TYPE)'=0 D
245 . S SAN=HLMSHSAN,SAN=$S(SAN]"":SAN,1:SERAPP)
246 . S SFN=HLMSHSFN,SFN=$S(SFN]"":SFN,1:SERFAC)
247 . S RAN=HLMSHRAN,RAN=$S(RAN]"":RAN,1:CLNTAPP)
248 . S RFN=HLMSHRFN,RFN=$S(RFN]"":RFN,1:CLNTFAC)
249 . F PCE=SAN,SFN,RAN,RFN,HLDATE,SECURITY,MSGTYPE,HLID,HLPID,$P(PROT,U,9),"",$G(^HL(772,TXTP,1)),ACCACK,APPACK,CNTRY D
250 . . S MSH=MSH_FS_PCE
251 QUIT MSH
252 ;
253EOR ;HLCSHDR4 - Reset MSH Segment Fields ;9/12/02 11:50
Note: See TracBrowser for help on using the repository browser.