1 | GMRAIAL1 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ALLERGIES - PART 1 ; 17 Mar 2006 11:07 AM
|
---|
2 | ;;4.0;Adverse Reaction Tracking;**22,23,34**;Mar 29, 1996
|
---|
3 | VALID ;;VDEF HL7 MESSAGE BUILDER
|
---|
4 | ; Creates HL7 V2.4 ORU^R01 message for allergy updates & assessments
|
---|
5 | ;
|
---|
6 | ; This routine uses the following IAs:
|
---|
7 | ; #4248 - VDEFEL calls (controlled)
|
---|
8 | ; #3630 - VAFCQRY calls (controlled)
|
---|
9 | ; #2196 - ^PS(50.416,IEN,0) (controlled)
|
---|
10 | ; #2574 - $$CLASS2^PSNAPIS (supported)
|
---|
11 | ; #4571 - ERR^VDEFREQ (controlled)
|
---|
12 | ; #4631 - XTID calls (supported)
|
---|
13 | ;
|
---|
14 | ; This routine is called at tag EN as a Function by VDEFREQ1
|
---|
15 | ;
|
---|
16 | ; This routine calls GMRAIAL2 for a portion of message
|
---|
17 | ;
|
---|
18 | Q
|
---|
19 | ;
|
---|
20 | EN(EVIEN,KEY,VFLAG,OUT,MSHP) ; Entry point
|
---|
21 | ;
|
---|
22 | ; Inputs: EVIEN = IEN of VDEF Event in file 577
|
---|
23 | ; KEY - IEN of file to create message from
|
---|
24 | ; VFLAG - "V" for VistA HL7 destination (default)
|
---|
25 | ; OUT - target array, passed by reference
|
---|
26 | ; MSHP - Piece 4 contains message subtype
|
---|
27 | ;
|
---|
28 | ; Output: Two part string with parts separated by "^"
|
---|
29 | ; Part 1: "LM" - output in local array passed in "OUT" parameter
|
---|
30 | ; "GM" - output in ^TMP("HLS",$J)
|
---|
31 | ; Part 2: No longer used
|
---|
32 | ;
|
---|
33 | N DFN,HLFS,HLCM,HLSC,HLRP,HLES,HLQ,ALRDATA,ADD,ALTYPE,XX ;34
|
---|
34 | N DATA,VAL,I,S,X,Y,Z,X1,HL7RC,IEN,IEN1,OUTX,GMRAPID,ENTERR
|
---|
35 | N SEPF,SEPC,SEPR,SEPE,SEPS,ARRAY,CMP,SEQ,GMRAHL,RSLTSTA
|
---|
36 | N GMRAFILE,GMRAIENS,GMRAVUID
|
---|
37 | ;
|
---|
38 | ; Initialize stuff
|
---|
39 | K ^TMP("HLS",$J) S S=0,ARRAY="OUT("_"""HLS"""_",S)",TARGET="LM^"
|
---|
40 | M GMRAHL=VDEFHL
|
---|
41 | ;
|
---|
42 | ; Determine whether API was Allergy Update or Assessment
|
---|
43 | S ALTYPE=$S($P(MSHP,"~",4)="ALGY":1,$P(MSHP,"~",4)="ADAS":2,1:1)
|
---|
44 | ;
|
---|
45 | ; Set up HL7 delimiters
|
---|
46 | S HLCM=$E(GMRAHL("ECH")),HLRP=$E(GMRAHL("ECH"),2),HLSC=$E(GMRAHL("ECH"),4),HLES=$E(GMRAHL("ECH"),3)
|
---|
47 | S HLFS=GMRAHL("FS"),HLQ=GMRAHL("Q"),HL7RC=HLES_HLFS_HLCM_HLRP_HLSC
|
---|
48 | D SETDLMS^VDEFEL
|
---|
49 | ;
|
---|
50 | ; Get allergy data, patient ID, 'entered in error data'
|
---|
51 | ; based on whether it's an allergy update or an assessment
|
---|
52 | ; Allergy: ALTYPE=1, Assessment: ALTYPE=2
|
---|
53 | D:ALTYPE=1 G EXIT:ZTSTOP=1
|
---|
54 | . S ALRDATA=$G(^GMR(120.8,KEY,0))
|
---|
55 | . I ALRDATA="" D ERR^VDEFREQ("No data in file GMR(120.8) for IEN "_KEY) S ZTSTOP=1 Q
|
---|
56 | . S DFN=$P(ALRDATA,U),ENTERR=$G(^GMR(120.8,KEY,"ER"))
|
---|
57 | . S RSLTSTA=$E("FW",1+ENTERR) ;34
|
---|
58 | . I $G(^DPT(DFN,0))="" D ERR^VDEFREQ("No data in file DPT for DFN "_DFN) S ZTSTOP=1 Q
|
---|
59 | D:ALTYPE=2 G EXIT:ZTSTOP=1
|
---|
60 | . S ENTERR="",ALRDATA=$G(^GMR(120.86,KEY,0))
|
---|
61 | . I $P(ALRDATA,U,2)="" S ENTERR=1
|
---|
62 | . S DFN=$S(+ENTERR=1:KEY,1:$P(ALRDATA,U))
|
---|
63 | . I $G(^DPT(DFN,0))="" D ERR^VDEFREQ("No data in file DPT for DFN "_DFN) S ZTSTOP=1 Q
|
---|
64 | ;
|
---|
65 | ; Build segments for message in OUT, $P # = HL7 field #
|
---|
66 | ;
|
---|
67 | ; PID - Use MPI PID builder
|
---|
68 | PID K GMRAPID S OUTX="",S=1,SEQ=""
|
---|
69 | D BLDPID^VAFCQRY(DFN,1,SEQ,.GMRAPID,.GMRAHL)
|
---|
70 | F I=2:1 Q:$G(GMRAPID(I))="" S GMRAPID(1,I-1)=GMRAPID(I) K GMRAPID(I)
|
---|
71 | M OUTX=GMRAPID(1) K GMRAPID D SAVE
|
---|
72 | ;
|
---|
73 | ; OBR
|
---|
74 | OBR S S=S+1,OUTX="",$P(OUTX,HLFS)=1
|
---|
75 | S $P(OUTX,HLFS,3)=KEY_HLCM_$P(SITEPARM,U,6)_$S(ALTYPE=1:"_120.8",ALTYPE=2:"_120.86")
|
---|
76 | S $P(OUTX,HLFS,4)=$P("ALLERGY,ASSESSMENT",",",ALTYPE)_HLCM_HLCM_"L"
|
---|
77 | ;
|
---|
78 | ; Result Status
|
---|
79 | S $P(OUTX,HLFS,25)=$E("FE",1+ENTERR) ;34
|
---|
80 | ;
|
---|
81 | ; Date/time reaction entered in system
|
---|
82 | S $P(OUTX,HLFS,7)=$$TS^VDEFEL($P(ALRDATA,U,4))
|
---|
83 | ;
|
---|
84 | ; Originator for allergy
|
---|
85 | S XX=$P(ALRDATA,U,$P("5^3",U,ALTYPE)) ;34
|
---|
86 | I XX'="" D ;Block added in 34
|
---|
87 | . S XX=$$XCN200^VDEFEL(XX),XX=$TR(XX,HLCM,HLSC)
|
---|
88 | . F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II))
|
---|
89 | . S $P(OUTX,HLFS,32)=XX
|
---|
90 | G OBRX:ALTYPE=2
|
---|
91 | ;
|
---|
92 | ; Repeating field of various person roles
|
---|
93 | ; Enterer, Verifier, Error User, ID Band Marker, Chart Marker
|
---|
94 | ; and associated dates
|
---|
95 | S (X,Y,Z)=""
|
---|
96 | ENT S XX=$P(ALRDATA,U,5) G VER:XX="" ;34
|
---|
97 | S XX=$$XCN200^VDEFEL(XX),XX=$TR(XX,HLCM,HLSC) ;34
|
---|
98 | F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
|
---|
99 | S VAL=XX,$P(VAL,HLSC,8)="E",Z=VAL ;34
|
---|
100 | S $P(Z,HLCM,2)=$$TS^VDEFEL($P(ALRDATA,U,4)),X=Z
|
---|
101 | VER G ERR:$P(ALRDATA,U,17)=""
|
---|
102 | S XX=$$XCN200^VDEFEL($P(ALRDATA,U,18)),XX=$TR(XX,HLCM,HLSC) ;34
|
---|
103 | F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
|
---|
104 | S VAL=XX,$P(VAL,HLSC,8)="V",Z=VAL ;34
|
---|
105 | S $P(Z,HLCM,2)=$$TS^VDEFEL($P(ALRDATA,U,17)),X=$G(X)_HLRP_Z
|
---|
106 | ERR S XX=+ENTERR G IDBM:'XX ;34
|
---|
107 | S XX=$$XCN200^VDEFEL($P(ENTERR,U,3)),XX=$TR(XX,HLCM,HLSC) ;34
|
---|
108 | F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
|
---|
109 | S VAL=XX,$P(VAL,HLSC,8)="EE",Z=VAL ;34
|
---|
110 | S $P(Z,HLCM,2)=$$TS^VDEFEL($P(ENTERR,U,2)),X=$G(X)_HLRP_Z
|
---|
111 | ;
|
---|
112 | ; May be multiple entries for ID Band & Chart Marker persons
|
---|
113 | IDBM G CHRT:'$D(^GMR(120.8,KEY,14))
|
---|
114 | S IEN1=0 F S IEN1=$O(^GMR(120.8,KEY,14,IEN1)) Q:'+IEN1 D
|
---|
115 | . S X1=$G(^GMR(120.8,KEY,14,IEN1,0)) ;34
|
---|
116 | . S XX=$$XCN200^VDEFEL($P(X1,U,2)),XX=$TR(XX,HLCM,HLSC) ;34
|
---|
117 | . F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
|
---|
118 | . S VAL=XX S:VAL="" VAL=Y S $P(VAL,HLSC,8)="BM",Z=VAL ;34
|
---|
119 | . S $P(Z,HLCM,2)=$$TS^VDEFEL($P(X1,U,1)),X=$G(X)_HLRP_Z
|
---|
120 | CHRT G OBR1:'$D(^GMR(120.8,KEY,13))
|
---|
121 | S IEN1=0 F S IEN1=$O(^GMR(120.8,KEY,13,IEN1)) Q:'+IEN1 D
|
---|
122 | . S X1=$G(^GMR(120.8,KEY,13,IEN1,0)) ;34
|
---|
123 | . S XX=$$XCN200^VDEFEL($P(X1,U,2)),XX=$TR(XX,HLCM,HLSC) ;34
|
---|
124 | . F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
|
---|
125 | . S VAL=XX S:VAL="" VAL=Y S $P(VAL,HLSC,8)="CM",Z=VAL ;34
|
---|
126 | . S $P(Z,HLCM,2)=$$TS^VDEFEL($P(X1,U,1)),X=$G(X)_HLRP_Z
|
---|
127 | OBR1 S $P(OUTX,HLFS,34)=X
|
---|
128 | ;
|
---|
129 | ; Observed/Historical Indicator
|
---|
130 | S X=$P(ALRDATA,U,6),GMRAVUID=$$GETVUID(120.8,6,X)
|
---|
131 | S VAL=$P(GMRAVUID,U)_HLCM_$S(X="o":"OBSERVED",X="h":"HISTORICAL",1:"")
|
---|
132 | S VAL=VAL_HLCM_$P(GMRAVUID,U,2)
|
---|
133 | S $P(OUTX,HLFS,47)=VAL
|
---|
134 | OBRX S OUTX="OBR"_HLFS_OUTX D SAVE
|
---|
135 | ;
|
---|
136 | ; If the record is missing both the Reactant and the GMR Allergy
|
---|
137 | ; trap it as an error.
|
---|
138 | I ALTYPE'=2,$P(ALRDATA,U,2)="",$P(ALRDATA,U,3)="" D ERR^VDEFREQ("Record is missing Reactant and GMR Allergy") S ZTSTOP=1 Q
|
---|
139 | ;
|
---|
140 | ; OK to continue, call GMRAIAL2 for the rest of the message
|
---|
141 | CALL D ENTRY^GMRAIAL2
|
---|
142 | ;
|
---|
143 | ; Done building segments
|
---|
144 | EXIT Q TARGET
|
---|
145 | ;
|
---|
146 | ;
|
---|
147 | ; Place current string into message array.
|
---|
148 | ; Turn string into array if length >245.
|
---|
149 | ; Move local array to global if needed.
|
---|
150 | SAVE N I
|
---|
151 | I $P(OUTX,HLFS)'="PID",$L(OUTX)>245 D
|
---|
152 | . K ADD S ADD=$E(OUTX,1,245),OUTX=$E(OUTX,246,$L(OUTX))
|
---|
153 | . F I=1:1 S ADD(I)=$E(OUTX,1,245),OUTX=$E(OUTX,246,$L(OUTX)) Q:OUTX=""
|
---|
154 | . K OUTX M OUTX=ADD
|
---|
155 | M @ARRAY=OUTX
|
---|
156 | ;
|
---|
157 | ; Move local array to global if it's getting big.
|
---|
158 | I $P(TARGET,U)="LM",$S<16000 D
|
---|
159 | . K ^TMP("HLS",$J) M ^TMP("HLS",$J)=OUT("HLS") K OUT("HLS")
|
---|
160 | . S $P(TARGET,U)="GM",ARRAY="^TMP("_"""HLS"""_",$J,S)"
|
---|
161 | K OUTX,ADD
|
---|
162 | Q
|
---|
163 | ;
|
---|
164 | ; Replace any HL7 coding chars. in strings with HL7 escape sequence
|
---|
165 | ; Input: X = data string
|
---|
166 | HL7RC(X) N OCHR,RCHR,RCHRI,TYPE,I F TYPE="E","F","C","R","S" D
|
---|
167 | . S RCHRI=$S(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
|
---|
168 | . S OCHR=$E(HL7RC,RCHRI),RCHR=$E("EFSRT",RCHRI)
|
---|
169 | . Q:'$F(X,OCHR)
|
---|
170 | . F I=1:1 Q:$E(X,I)="" I $E(X,I)=OCHR S X=$E(X,1,I-1)_HLES_RCHR_HLES_$E(X,I+1,999),I=I+2
|
---|
171 | Q X
|
---|
172 | ;
|
---|
173 | ; Get the VUID value and set up name of coding system
|
---|
174 | GETVUID(GMRAFILE,GMRAFLD,GMRADATA,GMRAFLSW) ;
|
---|
175 | ; Input parameters:
|
---|
176 | ; GMRAFILE - VistA File #
|
---|
177 | ; GMRAFLD - Field # in GMRAFILE
|
---|
178 | ; GMRADATA - Reference value to look up VUID for
|
---|
179 | ; GMRAFLSW - (Optional) Use 8985.1 if nil, else use GMRAFILE
|
---|
180 | ;
|
---|
181 | ; Output parameter:
|
---|
182 | ; 1st '^' piece - VUID # or 0 if no VUID
|
---|
183 | ; 2nd '^' piece - Coding system: "99VA8985.1" if VUID and GMRAFLSW=nil
|
---|
184 | ; "99VA"_GMRAFILE if GMRAFLSW=1
|
---|
185 | ; else = <site_VistA application file #> if no VUID
|
---|
186 | N X S X=+$$GETVUID^XTID(GMRAFILE,GMRAFLD,GMRADATA),GMRAFLSW=$G(GMRAFLSW)
|
---|
187 | I X S $P(X,U,2)="99VA"_$S(GMRAFLSW:GMRAFILE,1:"8985.1")
|
---|
188 | E S $P(X,U,2)=$P(SITEPARM,U,6)_"_"_GMRAFILE
|
---|
189 | Q X
|
---|