source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR3.m@ 1250

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1HLCSHDR3 ;SFIRMFO/LJA - Reset MSH Segment Fields ;03/24/04 11:19
2 ;;1.6;HEALTH LEVEL SEVEN;**93,108**;Oct 13, 1995
3 ;
4 ; Reset RECEIVING APPLICATION and RECEIVING SITE of MSH segment - HL*1.6*93
5 ;
6RESET ; Called from HEADER^HLCSHDR1 & BHSHDR^HLCSHDR1, which is called by
7 ; GENERATE^HLMA & GENACK^HLMA1.
8 N MTIEN
9 ;
10 ; Even if set already, set 772 IEN again...
11 S MTIEN=+$G(^HLMA(+$G(IEN),0)) QUIT:$G(^HL(772,+MTIEN,0))']"" ;->
12 ;
13 ; Different variables used for Event Protocol
14 D MSHCHG($G(HLEID),$S($G(EIDS)>0:+EIDS,1:+$G(HLEIDS)),$G(MTIEN),$G(IEN),.SERAPP,.SERFAC,.CLNTAPP,.CLNTFAC,.HLP)
15 ;
16 QUIT
17 ;
18MSHCHG(HLEID,EIDS,MTIEN,IEN,SERAPP,SERFAC,CLNTAPP,CLNTFAC,HLPARR) ; The parameters
19 ; are the required input variables. Call here "by reference".
20 ;
21 ; HLEID=Event driver protocol IEN
22 ; EIDS=Subscriber protocol IEN
23 ; MTIEN=772 IEN
24 ; IEN=773 IEN
25 ; SERAPP=Sending App text
26 ; SERFAC=Sending Fac text
27 ;CLNTAPP=Rec (client) app text
28 ;CLNTFAC=Rec (client) fac text
29 ; HLP()=HLP("SUBSCRIBER") array
30 ;
31 ; The MSH segment is built (usually) in HLCSHDR1. Immediately before
32 ; using the existing local variables to concatenate them together into
33 ; the MSH segment, HLCSHDR1 calls here to see if some of the local
34 ; variables should be reset.
35 ;
36 ; Resetting the local variables used in creating the MSH segment
37 ; gives those creating HL7 messages control over the local variables
38 ; that can be changed below.
39 ;
40 ; There are rules that govern what the creator of the MSH segment
41 ; can change:
42 ;
43 ; Rule #1: The SENDING APPLICATION can be changed. Var=HLMSHSAN
44 ; Rule #2: The SENDING FACILITY can be changed. Var=HLMSHSFN
45 ; Rule #3: The RECEIVING APPLICATION can be changed. Var=HLMSHRAN
46 ; Rule #4: The RECEIVING FACILITY can be changed. Var=HLMSHRFN
47 ; Rule #5: No other fields in the MSH segment can be changed.
48 ;
49 ; If the passed in HLP() array entry used to reset the above four
50 ; fields holds the text used, the variables above will be reset.
51 ; If M code is used, the M code itself is responsible for setting
52 ; these specific local variables.
53 ;
54 ; The following local variables are created and made available for
55 ; use by M code:
56 ;
57 ; Protocol, Event: HLMSHPRE (IEN^NAME)
58 ; Protocol, Subscriber: HLMSHPRS (IEN^NAME)
59 ;
60 ; HL Message Text file (#772) IEN: HLMSH772 (IEN)
61 ; HL Message Admin file (#773) IEN: HLMSH773 (IEN)
62 ;
63 ; Sending Application, Original: HLMSHSAO (SERAPP)
64 ; Sending Application, New: HLMSHSAN
65 ; Sending Facility, Original: HLMSHSFO (SERFAC)
66 ; Sending Facility, New: HLMSHSFN
67 ; Receiving Application, Original: HLMSHRAO (CLNTAPP)
68 ; Receiving Application, New: HLMSHRAN
69 ; Receiving Facility, Original: HLMSHRFO (CLNTFAC)
70 ; Receiving Facility, New: HLMSHRFN
71 ;
72 ; M Code SUBROUTINE: HLMSHTAG
73 ; M Code ROUTINE: HLMSHRTN
74 ;
75 ; See the documentation in patch HL*1.6*93 in the Forum patch module
76 ; for additional information.
77 ;
78 ; CLIENT -- req
79 ;
80 ; HLMSH-namespaced variables created below
81 N HLDEBUG,HLMSH101,HLMSH31,HLMSH31C,HLMSH32,HLMSH32C
82 N HLMSH33,HLMSH33C,HLMSH34,HLMSH34C,HLMSH772,HLMSH773,HLMSH91
83 N HLMSHAN,HLMSHFN,HLMSHPRE,HLMSHPRS
84 N HLMSHRTN,HLMSHRAN,HLMSHRAO,HLMSHRFN
85 N HLMSHRFO,HLMSHSAN,HLMSHSAO,HLMSHSFN,HLMSHSFO
86 N HLMSHPRO,HLMSHREF,HLMSHSUB,HLMSHTAG
87 ;
88 ; Non-HLMSH-namespaced variables created below
89 N HLPWAY,HLRAN,HLRFN,HLSAN,HLSFN,HLTYPE
90 ;
91 ;
92 ; Set up variables pass #1...
93 S (HLMSH31,HLMSH32,HLMSH33,HLMSH34)=""
94 S (HLMSH31C,HLMSH32C,HLMSH33C,HLMSH34C)=""
95 S HLMSHPRE=$G(HLEID)_U_$P($G(^ORD(101,+$G(HLEID),0)),U) ; Event 101
96 S HLMSHPRS=$G(EIDS)_U_$P($G(^ORD(101,+$G(EIDS),0)),U) ; Sub 101
97 S HLMSH772=$G(MTIEN)
98 S HLMSH773=$G(IEN) QUIT:'$D(^HLMA(+HLMSH773,0)) ;->
99 ;
100 ; Get passed-in-by-reference HLP("SUBSCRIBER") data into variable...
101 S HLMSHPRO=$$HLMSHPRO QUIT:HLMSHPRO']"" ;->
102 ;
103 ; Should DEBUG data be stored? (This can be overwritten in $$HLMSHPRO)
104 I $G(HLDEBUG)']"" S HLDEBUG=$P($P(HLMSHPRO,"~",2),U,8)
105 ; HLDEBUG might be already set in $$HLMSHPRO
106 S HLDEBUG=$TR(HLDEBUG,"- /",U) ; Change delimiters to ^
107 ;
108 ; HLDEBUG (#1-#2-#3) Explanation...
109 ; -- #1 can be 0 (NO) or 1 (YES) for whether ^HLMA(#,90) data stored
110 ; -- #2 can be 0 or 1 for whether ^HLMA(#,91) data should be stored
111 ; -- #3 can be 0 or 1 or 2 for what type of ^XTMP data should be stored
112 ; -- Data is stored in ^XTMP("HLCSHDR3 "_IEN773)
113 ; -- 0 = No XTMP data should be stored
114 ; -- 1 = Store only SOME of the data
115 ; -- 2 = Store ALL variable data
116 ;
117 ; Store HLP("SUBSCRIBER"[,#]) in ^HLMA(#,90)
118 I $P(HLDEBUG,U)=1 D
119 . S X=$P(HLMSHPRO,"~",2) I X]"" S ^HLMA(+HLMSH773,90)=X
120 ;
121 ; Found by general HLP("SUBSCRIBER") or specific HLP("SUBSCRIBER",#) entry?
122 ; patch HL*1.6*108 start
123 S HLPWAY=$P(HLMSHPRO,"~"),X=$L(HLMSHPRO,"~"),HLMSHREF=$P(HLMSHPRO,"~",+X),HLMSHPRO=$P(HLMSHPRO,"~",+2,+X-1)
124 ; Above line modified by LJA - 3/18/04 Original line shown below.
125 ; S HLPWAY=$P(HLMSHPRO,"~"),HLMSHREF=$P(HLMSHPRO,"~",3),HLMSHPRO=$P(HLMSHPRO,"~",2)
126 ; patch HL*1.6*108 end
127 ;
128 ; Set up variables pass #2...
129 S HLMSHSAO=$G(SERAPP),(HLSAN,HLMSHSAN)=$P(HLMSHPRO,U,2) ; Send App
130 S HLMSHSFO=$G(SERFAC),(HLSFN,HLMSHSFN)=$P(HLMSHPRO,U,3) ; Send Fac
131 S HLMSHRAO=$G(CLNTAPP),(HLRAN,HLMSHRAN)=$P(HLMSHPRO,U,4) ; Rec App
132 S HLMSHRFO=$G(CLNTFAC),(HLRFN,HLMSHRFN)=$P(HLMSHPRO,U,5) ; Rec Fac
133 ;
134 ; If there's an Xecution routine, do now...
135 S HLMSHTAG=$P(HLMSHPRO,U,6),HLMSHRTN=$P(HLMSHPRO,U,7)
136 I HLMSHTAG]"",HLMSHRTN]"" D @HLMSHTAG^@HLMSHRTN
137 I HLMSHTAG']"",HLMSHRTN]"" D ^@HLMSHRTN
138 ;
139 ; Start work for ^HLMA(#,91) node...
140 S HLMSH91="" ; HLMSH91 is the data that will be stored in ^(91)
141 I SERAPP'=HLMSHSAN D SET91M(1,SERAPP,HLSAN,HLMSHSAN) ; Reset by M code?
142 I SERFAC'=HLMSHSFN D SET91M(3,SERFAC,HLSFN,HLMSHSFN)
143 I CLNTAPP'=HLMSHRAN D SET91M(5,CLNTAPP,HLRAN,HLMSHRAN)
144 I CLNTFAC'=HLMSHRFN D SET91M(7,CLNTFAC,HLRFN,HLMSHRFN)
145 ;
146 ; The real resetting of MSH segment variables work is done here...
147 D SET^HLCSHDR4(HLMSHSAN,"SERAPP",1) ; Update SERAPP if different, and DATA too...
148 D SET^HLCSHDR4(HLMSHSFN,"SERFAC",3) ; Etc
149 D SET^HLCSHDR4(HLMSHRAN,"CLNTAPP",5) ; Etc
150 D SET^HLCSHDR4(HLMSHRFN,"CLNTFAC",7) ; Etc
151 ;
152 ; Set ^HLMA(#,91) node if overwrites occurred...
153 I HLMSH91]"" S ^HLMA(+HLMSH773,91)=HLMSH91
154 ;
155 ; If debugging, record pre variable view...
156 D DEBUG^HLCSHDR4($P(HLDEBUG,U,3))
157 ;
158 QUIT
159 ;
160SET91M(PCE,MSH,PREM,POSTM) ; If M code re/set the MSH field, record...
161 QUIT:PREM=POSTM ;-> M code did not change anything...
162 S $P(HLMSH91,U,PCE)=MSH ; original (pre-overwrite) value
163 S $P(HLMSH91,U,PCE+1)="M" ; Overwrite source (A/M)
164 QUIT
165 ;
166HLMSHPRO() ; Determines whether to use the generic HLP("SUBSCRIBER") data,
167 ; or instead - if existent - the HLP("SUBSCRIBER",#)=SUB PROTOCOL^... data
168 ;CLIENT -- req
169 N HLD,HLFIND,HLI,HLMSHREF,HLMSHSUB,HLX
170 ;
171 ; Get the default information...
172 S HLMSHSUB=$G(HLP("SUBSCRIBER")),HLMSHREF=999
173 ;
174 ; Overwrite HLMSHSUB if found...
175 S HLI=0,HLFIND=""
176 F S HLI=$O(HLP("SUBSCRIBER",HLI)) Q:HLI'>0!(HLFIND]"") D
177 . S HLD=$G(HLP("SUBSCRIBER",+HLI)) QUIT:HLD']"" ;->
178 . S HLD=$P(HLD,U) QUIT:HLD']"" ;->
179 . ; If passed name..
180 . I HLD'=+HLD S HLD=$$FIND101(HLD)
181 . ; Must have IEN by now...
182 . QUIT:+HLD'=+HLMSHPRS ;-> Not for right subscriber protocol
183 . S HLFIND=HLP("SUBSCRIBER",+HLI),HLMSHREF=+HLI
184 ;
185 ; Backdoor overwrite of HLDEBUG value...
186 ; - This is a very important back door!! Even if applications
187 ; - aren't logging debug data, it can be turned on by setting
188 ; - ^XTMP("HLCSHDR3 DEBUG","DEBUG") or ^XTMP("HLCSHDR3 DEBUG","DEBUG",SUB-101)
189 ; If the GENERAL entry exists, set HLDEBUG. Might be written next line though
190 S HLX=$G(^XTMP("HLCSHDR3 DEBUG","DEBUG")) I HLX]"" S HLDEBUG=HLX
191 ; If a SPECIFIC entry found, reset HLDEBUG to it...
192 S HLX=$G(^XTMP("HLCSHDR3 DEBUG","DEBUG",+HLFIND)) I HLX]"" S HLDEBUG=HLX
193 ;
194 QUIT $S(HLFIND]"":"S~"_HLFIND_"~"_HLMSHREF,HLMSHSUB]"":"G~"_HLMSHSUB_"~"_HLMSHREF,1:"")
195 ;
196FIND101(PROTNM) ; Find 101 entry...
197 N D,DIC,X,Y
198 S DIC="^ORD(101,",DIC(0)="MQ",D="B",X=PROTNM
199 D MIX^DIC1
200 QUIT $S(Y>0:+Y,1:"")
201 ;
202SHOW773(IEN773) ; Show reset info from 773 entry...
203 QUIT
204 ;
205EOR ;HLCSHDR3 - Reset MSH Segment Fields ;9/12/02 11:50
Note: See TracBrowser for help on using the repository browser.