source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR4.m@ 839

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

initial load of FOIAVistA 6/30/08 version

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