source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR5.m@ 1150

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

initial load of WorldVistAEHR
File size: 6.2 KB
Line 
1HLCSHDR5 ;OIRMFO/LJA - Make HL7 header for TCP ;1/27/03 15:30
2 ;;1.6;HEALTH LEVEL SEVEN;**93**;Oct 13, 1995
3 ;
4 ; The MSHALL API is not supported!
5 ;
6MSHALL ; Allows application developer, in test and development environments,
7 ; to change almost every field in the MSH segment. This feature
8 ; allows the testing of the ramifications of MSH field changes, avoiding
9 ; the need to edit protocol file (and other file) entries from which
10 ; the MSH segment fields are derived.
11 ;
12 ; Call here ONLY if the full suite of variables used in MSH segment
13 ; creation are available!
14 ;
15 ; Call method: S HLP("SUBSCRIBER"[,n])="^^^^^MSHALL^HLCSHDR5"
16 ; D GENERATE^HLMA(.....,.HLP)
17 ;
18 ; When the above HLP array is passed into the
19 ; GENERATE^HLMA API, the MSHALL subroutine is
20 ; invoked, giving the developer full control over
21 ; most MSH segment fields; even those fields not
22 ; changeable by HL*1.6*93.
23 ;
24 ; See HL*1.6*93 for information about the passing
25 ; of HLP("SUBSCRIBER"[,n]) information, and the
26 ; calling of the GENERATE^HLMA API.
27 ;
28 ; Warning! No audit trail (in ^HLMA or ^XTMP) is maintained.
29 ; Full responsibility rests with the application
30 ; developer.
31 ;
32 ; EC,FS -- req
33 ;
34 N ACTION,CHANGE,IOINHI,IOINORM,MSHFINAL,MSHLAST,MSHORIG
35 N SAVE,PCE,VAL1,VAL2,X
36 ;
37 D SAVEORIG
38 S (MSHFINAL,MSHLAST)=MSHORIG
39 ;
40MSHCONT ;
41 F D Q:'CHANGE
42 . S CHANGE=0
43 . D SHOWMSH
44 . D ASKMSH
45 . S MSHFINAL=$$MSH
46 . QUIT:MSHFINAL=MSHLAST ;->
47 . S CHANGE=1
48 . S MSHLAST=$$MSH
49 ;
50 I MSHFINAL=MSHORIG W !!,"The MSH segment was not changed..."
51 I MSHFINAL'=MSHORIG D
52 . S X="IOINHI;IOINORM" D ENDR^%ZISS
53 . W !!,MSHORIG,!!," changed to...",!!
54 . F PCE=1:1:$L(MSHFINAL,FS) D
55 . . W:PCE'=1 FS
56 . . S VAL1=$P(MSHORIG,FS,PCE),VAL2=$P(MSHFINAL,FS,PCE)
57 . . W:VAL1'=VAL2 IOINHI
58 . . W VAL2
59 . . W IOINORM
60 ;
61 S ACTION=$$DOWHAT
62 I ACTION="B" D G MSHCONT ;->
63 . QUIT:MSHFINAL=MSHORIG ;->
64 . W !!,"You have made some changes to the original MSH segment. Do you want to"
65 . W !,"""forget"" these changes, and reset the MSH segment to it's original state?"
66 . QUIT:'$$YN("Reset MSH segment","No",1) ;->
67 . D RESTORE
68 . S (MSHFINAL,MSHLAST)=MSHORIG
69 ;
70 Q
71 ;
72YN(PMT,DEF,FF) ;
73 N DIR,DIRUT,DTOUT,DUOUT,X,Y
74 F I=1:1:$G(FF) W !
75 S DIR(0)="Y",DIR("A")=PMT
76 S:$G(DEF)]"" DIR("B")=DEF
77 D ^DIR
78 Q $S(+Y=1:1,1:"")
79 ;
80DOWHAT() ; Reenter MSH or send message...
81 N DIR,DIRUT,DTOUT,DUOUT,X,Y
82 S DIR(0)="S^B:Back up and change MSH segment;C:Continue on (and send message)"
83 S DIR("A")="Enter ACTION",DIR("B")="Continue"
84 D ^DIR
85 QUIT $S(Y="B":"B",1:"C")
86 ;
87SHOWMSH ;
88 ; MSHORIG -- req
89 N C2,C3,C4,DATA,IOINHI,IOINORM,MSH,PCE,REF,TAG,VAL,X,XEC
90 ;
91 S X=MSHORIG N MSHORIG S MSHORIG=X
92 S C2=4,C3=18,C4=40
93 I $G(FS)']""!($G(EC)']"") N EC,FS S FS=U,EC="~|\&"
94 S X="IOINHI;IOINORM" D ENDR^%ZISS
95 ;
96 W @IOF,!,$$CJ^XLFSTR("MSH Segment Values",IOM)
97 W !,$$REPEAT^XLFSTR("-",IOM)
98 W !,"#",?C2,"Field",?C3,"Variable",?C4,"Value"
99 W !,$$REPEAT^XLFSTR("=",IOM)
100 ;
101 F PCE=1:1 S DATA=$T(FLDS+PCE) Q:$E(DATA,1,3)'=" ;;"!(DATA']"") S DATA=$P(DATA,";;",2,99) D
102 . S REF=$P(DATA,U),XEC=$P(DATA,U,2),TAG=$P(DATA,U,3)
103 . S VAL=REF
104 . I PCE=11 S REF=$TR(REF,"~",U)
105 . I XEC=1,PCE'=12 S VAL=@REF
106 . I XEC=2!(PCE=12) S X="S VAL="_REF X X KILL X
107 . W !,$J(PCE,2),?C2,$$S(TAG,12),?C3,$$S(REF,18)
108 . W ?C4
109 . I XEC=1 W IOINHI
110 . W VAL,IOINORM
111 . W $S(XEC=1:$$CHG(VAL,PCE),1:"")
112 ;
113 Q
114 ;
115S(T,C) QUIT:$L(T)<(C+1) T ;->
116 QUIT $E(T,1,C-1)_"~"
117 ;
118CHG(VAL,PCE) ; Has data been changed?
119 ; MSHORIG -- req
120 N VALORIG
121 S VALORIG=$P(MSHORIG,FS,+PCE)
122 QUIT:VALORIG=VAL "" ;->
123 Q " *"
124 ;
125ASKMSH ; Ask user to input different field values
126 N DATA,DIR,DIRUT,DTOUT,DUOUT,FIELD,PCE,TITLE,VAL,VAR,X,Y
127 ;
128 W !
129 ;
130 S DIR="SOA^"
131 F PCE=3:1:12,15:1:17 D
132 . S DATA=$P($T(FLDS+PCE),";;",2,999),VAR=$P(DATA,U),TITLE=$P(DATA,U,3)
133 . S DIR=DIR_$S(PCE>3:";",1:"")_PCE_":"_TITLE_" ("_VAR_")"
134 S DIR(0)=DIR
135 S DIR("A")="Enter FIELD #: "
136 D ^DIR
137 QUIT:+Y'>0 ;->
138 ;
139 S FIELD=+Y,VAR=$P($P($T(FLDS+FIELD),";;",2,99),U)
140 I FIELD'=12 S VAL=@VAR
141 I FIELD=12 S X="S VAL="_VAR X X KILL X
142 ;
143 W !!,"Current '",VAR,"' value = ",VAL
144 W !
145 ;
146 KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
147 S DIR(0)="F",DIR("A")="Field value"
148 D ^DIR
149 QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) ;->
150 ;
151 S ANS=Y
152 ;
153 I ANS=VAL W " nothing changed..." QUIT ;->
154 ;
155 ; Make the change...
156 I FIELD'=12 S @VAR=ANS
157 I FIELD=12 S $P(PROT,U,9)=ANS
158 W " changed..."
159 ;
160 Q
161 ;
162MSH() ;Build MSH array
163 N DATA,MSH,PCE,REF,TAG,XEC
164 ;
165 S MSH=""
166 ;
167 F PCE=1:1 S DATA=$T(FLDS+PCE) Q:$E(DATA,1,3)'=" ;;"!(DATA']"") S DATA=$P(DATA,";;",2,99) D
168 . S REF=$P(DATA,U),XEC=$P(DATA,U,2)
169 . I PCE=11 S REF=$TR(REF,"~",U)
170 . I XEC=0 S VAL=REF
171 . I XEC=1,PCE'=12 S VAL=@REF
172 . I XEC=2!(PCE=12) S X="S VAL="_REF X X KILL X
173 . S MSH=MSH_$S(MSH]"":FS,1:"")_VAL
174 ;
175 Q MSH
176 ;
177SAVEORIG ; Save value of original variables...
178 KILL SAVE
179 ;
180 S SAVE("SERAPP")=SERAPP,SAVE("SERFAC")=SERFAC
181 S SAVE("CLNTAPP")=CLNTAPP,SAVE("CLNTFAC")=CLNTFAC
182 S SAVE("HLDATE")=HLDATE,SAVE("SECURITY")=SECURITY
183 S SAVE("MSGTYPE")=MSGTYPE,SAVE("HLID")=HLID
184 S SAVE("HLPID")=HLPID,SAVE("ACCACK")=ACCACK
185 S SAVE("APPACK")=APPACK,SAVE("CNTRY")=CNTRY
186 S SAVE("$P(PROT,U,9)")=$P(PROT,U,9)
187 ;
188 S MSHORIG=$$MSH
189 ;
190 Q
191 ;
192RESTORE ;
193 N VAL,VAR
194 ;
195 ; restore variables...
196 S VAR=""
197 F S VAR=$O(SAVE(VAR)) Q:VAR']"" D
198 . QUIT:VAR["$P(PROT,U,9)" ;->
199 . S @VAR=SAVE(VAR)
200 S $P(PROT,U,9)=SAVE("$P(PROT,U,9)")
201 ;
202 ; Restore beginning MSH...
203 S (MSHFINAL,MSHLAST)=MSHORIG
204 ;
205 Q
206 ;
207FLDS ; List of fields and their variables in MSH segment...
208 ;;MSH^0
209 ;;EC^2
210 ;;SERAPP^1^SND-APP
211 ;;SERFAC^1^SND-FAC
212 ;;CLNTAPP^1^REC-APP
213 ;;CLNTFAC^1^REC-FAC
214 ;;HLDATE^1^D/T
215 ;;SECURITY^1^SECURE
216 ;;MSGTYPE^1^MSGTYPE
217 ;;HLID^1^MSG-ID
218 ;;HLPID^1^PID
219 ;;$P(PROT,U,9)^1^VERSION
220 ;;^0
221 ;;^0^CONTINUATION
222 ;;ACCACK^1^COMACK
223 ;;APPACK^1^APPACK
224 ;;CNTRY^1^COUNTRY
225 Q
226 ;
227PRACTICE ; Practice MSH variables...
228 S EC="~|\&",FS=U
229 S SERAPP="SND-APP",SERFAC=512,CLNTAPP="REC-APP",CLNTFAC=661
230 S HLDATE=200301020135,SECURITY="SEC",MSGTYPE="ORU~R01"
231 S HLID="543010101",HLPID="P"
232 S $P(PROT,U,9)="2.3",TXTP=999
233 S ACCACK="AL",APPACK="AL",CNTRY="US"
234 Q
235 ;
236 ;
237EOR ;HLCSHDR5 - Make HL7 header for TCP ;1/27/03 15:30
Note: See TracBrowser for help on using the repository browser.