GMRAIAL1 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ALLERGIES - PART 1 ; 17 Mar 2006 11:07 AM
;;4.0;Adverse Reaction Tracking;**22,23,34**;Mar 29, 1996
VALID ;;VDEF HL7 MESSAGE BUILDER
; Creates HL7 V2.4 ORU^R01 message for allergy updates & assessments
;
; This routine uses the following IAs:
; #4248 - VDEFEL calls (controlled)
; #3630 - VAFCQRY calls (controlled)
; #2196 - ^PS(50.416,IEN,0) (controlled)
; #2574 - $$CLASS2^PSNAPIS (supported)
; #4571 - ERR^VDEFREQ (controlled)
; #4631 - XTID calls (supported)
;
; This routine is called at tag EN as a Function by VDEFREQ1
;
; This routine calls GMRAIAL2 for a portion of message
;
Q
;
EN(EVIEN,KEY,VFLAG,OUT,MSHP) ; Entry point
;
; Inputs: EVIEN = IEN of VDEF Event in file 577
; KEY - IEN of file to create message from
; VFLAG - "V" for VistA HL7 destination (default)
; OUT - target array, passed by reference
; MSHP - Piece 4 contains message subtype
;
; Output: Two part string with parts separated by "^"
; Part 1: "LM" - output in local array passed in "OUT" parameter
; "GM" - output in ^TMP("HLS",$J)
; Part 2: No longer used
;
N DFN,HLFS,HLCM,HLSC,HLRP,HLES,HLQ,ALRDATA,ADD,ALTYPE,XX ;34
N DATA,VAL,I,S,X,Y,Z,X1,HL7RC,IEN,IEN1,OUTX,GMRAPID,ENTERR
N SEPF,SEPC,SEPR,SEPE,SEPS,ARRAY,CMP,SEQ,GMRAHL,RSLTSTA
N GMRAFILE,GMRAIENS,GMRAVUID
;
; Initialize stuff
K ^TMP("HLS",$J) S S=0,ARRAY="OUT("_"""HLS"""_",S)",TARGET="LM^"
M GMRAHL=VDEFHL
;
; Determine whether API was Allergy Update or Assessment
S ALTYPE=$S($P(MSHP,"~",4)="ALGY":1,$P(MSHP,"~",4)="ADAS":2,1:1)
;
; Set up HL7 delimiters
S HLCM=$E(GMRAHL("ECH")),HLRP=$E(GMRAHL("ECH"),2),HLSC=$E(GMRAHL("ECH"),4),HLES=$E(GMRAHL("ECH"),3)
S HLFS=GMRAHL("FS"),HLQ=GMRAHL("Q"),HL7RC=HLES_HLFS_HLCM_HLRP_HLSC
D SETDLMS^VDEFEL
;
; Get allergy data, patient ID, 'entered in error data'
; based on whether it's an allergy update or an assessment
; Allergy: ALTYPE=1, Assessment: ALTYPE=2
D:ALTYPE=1 G EXIT:ZTSTOP=1
. S ALRDATA=$G(^GMR(120.8,KEY,0))
. I ALRDATA="" D ERR^VDEFREQ("No data in file GMR(120.8) for IEN "_KEY) S ZTSTOP=1 Q
. S DFN=$P(ALRDATA,U),ENTERR=$G(^GMR(120.8,KEY,"ER"))
. S RSLTSTA=$E("FW",1+ENTERR) ;34
. I $G(^DPT(DFN,0))="" D ERR^VDEFREQ("No data in file DPT for DFN "_DFN) S ZTSTOP=1 Q
D:ALTYPE=2 G EXIT:ZTSTOP=1
. S ENTERR="",ALRDATA=$G(^GMR(120.86,KEY,0))
. I $P(ALRDATA,U,2)="" S ENTERR=1
. S DFN=$S(+ENTERR=1:KEY,1:$P(ALRDATA,U))
. I $G(^DPT(DFN,0))="" D ERR^VDEFREQ("No data in file DPT for DFN "_DFN) S ZTSTOP=1 Q
;
; Build segments for message in OUT, $P # = HL7 field #
;
; PID - Use MPI PID builder
PID K GMRAPID S OUTX="",S=1,SEQ=""
D BLDPID^VAFCQRY(DFN,1,SEQ,.GMRAPID,.GMRAHL)
F I=2:1 Q:$G(GMRAPID(I))="" S GMRAPID(1,I-1)=GMRAPID(I) K GMRAPID(I)
M OUTX=GMRAPID(1) K GMRAPID D SAVE
;
; OBR
OBR S S=S+1,OUTX="",$P(OUTX,HLFS)=1
S $P(OUTX,HLFS,3)=KEY_HLCM_$P(SITEPARM,U,6)_$S(ALTYPE=1:"_120.8",ALTYPE=2:"_120.86")
S $P(OUTX,HLFS,4)=$P("ALLERGY,ASSESSMENT",",",ALTYPE)_HLCM_HLCM_"L"
;
; Result Status
S $P(OUTX,HLFS,25)=$E("FE",1+ENTERR) ;34
;
; Date/time reaction entered in system
S $P(OUTX,HLFS,7)=$$TS^VDEFEL($P(ALRDATA,U,4))
;
; Originator for allergy
S XX=$P(ALRDATA,U,$P("5^3",U,ALTYPE)) ;34
I XX'="" D ;Block added in 34
. S XX=$$XCN200^VDEFEL(XX),XX=$TR(XX,HLCM,HLSC)
. F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II))
. S $P(OUTX,HLFS,32)=XX
G OBRX:ALTYPE=2
;
; Repeating field of various person roles
; Enterer, Verifier, Error User, ID Band Marker, Chart Marker
; and associated dates
S (X,Y,Z)=""
ENT S XX=$P(ALRDATA,U,5) G VER:XX="" ;34
S XX=$$XCN200^VDEFEL(XX),XX=$TR(XX,HLCM,HLSC) ;34
F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
S VAL=XX,$P(VAL,HLSC,8)="E",Z=VAL ;34
S $P(Z,HLCM,2)=$$TS^VDEFEL($P(ALRDATA,U,4)),X=Z
VER G ERR:$P(ALRDATA,U,17)=""
S XX=$$XCN200^VDEFEL($P(ALRDATA,U,18)),XX=$TR(XX,HLCM,HLSC) ;34
F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
S VAL=XX,$P(VAL,HLSC,8)="V",Z=VAL ;34
S $P(Z,HLCM,2)=$$TS^VDEFEL($P(ALRDATA,U,17)),X=$G(X)_HLRP_Z
ERR S XX=+ENTERR G IDBM:'XX ;34
S XX=$$XCN200^VDEFEL($P(ENTERR,U,3)),XX=$TR(XX,HLCM,HLSC) ;34
F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
S VAL=XX,$P(VAL,HLSC,8)="EE",Z=VAL ;34
S $P(Z,HLCM,2)=$$TS^VDEFEL($P(ENTERR,U,2)),X=$G(X)_HLRP_Z
;
; May be multiple entries for ID Band & Chart Marker persons
IDBM G CHRT:'$D(^GMR(120.8,KEY,14))
S IEN1=0 F S IEN1=$O(^GMR(120.8,KEY,14,IEN1)) Q:'+IEN1 D
. S X1=$G(^GMR(120.8,KEY,14,IEN1,0)) ;34
. S XX=$$XCN200^VDEFEL($P(X1,U,2)),XX=$TR(XX,HLCM,HLSC) ;34
. F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
. S VAL=XX S:VAL="" VAL=Y S $P(VAL,HLSC,8)="BM",Z=VAL ;34
. S $P(Z,HLCM,2)=$$TS^VDEFEL($P(X1,U,1)),X=$G(X)_HLRP_Z
CHRT G OBR1:'$D(^GMR(120.8,KEY,13))
S IEN1=0 F S IEN1=$O(^GMR(120.8,KEY,13,IEN1)) Q:'+IEN1 D
. S X1=$G(^GMR(120.8,KEY,13,IEN1,0)) ;34
. S XX=$$XCN200^VDEFEL($P(X1,U,2)),XX=$TR(XX,HLCM,HLSC) ;34
. F II=2:1:7 S $P(XX,SEPS,II)=$$HL7RC($P(XX,SEPS,II)) ;34
. S VAL=XX S:VAL="" VAL=Y S $P(VAL,HLSC,8)="CM",Z=VAL ;34
. S $P(Z,HLCM,2)=$$TS^VDEFEL($P(X1,U,1)),X=$G(X)_HLRP_Z
OBR1 S $P(OUTX,HLFS,34)=X
;
; Observed/Historical Indicator
S X=$P(ALRDATA,U,6),GMRAVUID=$$GETVUID(120.8,6,X)
S VAL=$P(GMRAVUID,U)_HLCM_$S(X="o":"OBSERVED",X="h":"HISTORICAL",1:"")
S VAL=VAL_HLCM_$P(GMRAVUID,U,2)
S $P(OUTX,HLFS,47)=VAL
OBRX S OUTX="OBR"_HLFS_OUTX D SAVE
;
; If the record is missing both the Reactant and the GMR Allergy
; trap it as an error.
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
;
; OK to continue, call GMRAIAL2 for the rest of the message
CALL D ENTRY^GMRAIAL2
;
; Done building segments
EXIT Q TARGET
;
;
; Place current string into message array.
; Turn string into array if length >245.
; Move local array to global if needed.
SAVE N I
I $P(OUTX,HLFS)'="PID",$L(OUTX)>245 D
. K ADD S ADD=$E(OUTX,1,245),OUTX=$E(OUTX,246,$L(OUTX))
. F I=1:1 S ADD(I)=$E(OUTX,1,245),OUTX=$E(OUTX,246,$L(OUTX)) Q:OUTX=""
. K OUTX M OUTX=ADD
M @ARRAY=OUTX
;
; Move local array to global if it's getting big.
I $P(TARGET,U)="LM",$S<16000 D
. K ^TMP("HLS",$J) M ^TMP("HLS",$J)=OUT("HLS") K OUT("HLS")
. S $P(TARGET,U)="GM",ARRAY="^TMP("_"""HLS"""_",$J,S)"
K OUTX,ADD
Q
;
; Replace any HL7 coding chars. in strings with HL7 escape sequence
; Input: X = data string
HL7RC(X) N OCHR,RCHR,RCHRI,TYPE,I F TYPE="E","F","C","R","S" D
. S RCHRI=$S(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
. S OCHR=$E(HL7RC,RCHRI),RCHR=$E("EFSRT",RCHRI)
. Q:'$F(X,OCHR)
. 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
Q X
;
; Get the VUID value and set up name of coding system
GETVUID(GMRAFILE,GMRAFLD,GMRADATA,GMRAFLSW) ;
; Input parameters:
; GMRAFILE - VistA File #
; GMRAFLD - Field # in GMRAFILE
; GMRADATA - Reference value to look up VUID for
; GMRAFLSW - (Optional) Use 8985.1 if nil, else use GMRAFILE
;
; Output parameter:
; 1st '^' piece - VUID # or 0 if no VUID
; 2nd '^' piece - Coding system: "99VA8985.1" if VUID and GMRAFLSW=nil
; "99VA"_GMRAFILE if GMRAFLSW=1
; else = <site_VistA application file #> if no VUID
N X S X=+$$GETVUID^XTID(GMRAFILE,GMRAFLD,GMRADATA),GMRAFLSW=$G(GMRAFLSW)
I X S $P(X,U,2)="99VA"_$S(GMRAFLSW:GMRAFILE,1:"8985.1")
E S $P(X,U,2)=$P(SITEPARM,U,6)_"_"_GMRAFILE
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAIAL1 7728 printed Sep 23, 2025@19:15:24 Page 2
GMRAIAL1 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ALLERGIES - PART 1 ; 17 Mar 2006 11:07 AM
+1 ;;4.0;Adverse Reaction Tracking;**22,23,34**;Mar 29, 1996
VALID ;;VDEF HL7 MESSAGE BUILDER
+1 ; Creates HL7 V2.4 ORU^R01 message for allergy updates & assessments
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #4248 - VDEFEL calls (controlled)
+5 ; #3630 - VAFCQRY calls (controlled)
+6 ; #2196 - ^PS(50.416,IEN,0) (controlled)
+7 ; #2574 - $$CLASS2^PSNAPIS (supported)
+8 ; #4571 - ERR^VDEFREQ (controlled)
+9 ; #4631 - XTID calls (supported)
+10 ;
+11 ; This routine is called at tag EN as a Function by VDEFREQ1
+12 ;
+13 ; This routine calls GMRAIAL2 for a portion of message
+14 ;
+15 QUIT
+16 ;
EN(EVIEN,KEY,VFLAG,OUT,MSHP) ; Entry point
+1 ;
+2 ; Inputs: EVIEN = IEN of VDEF Event in file 577
+3 ; KEY - IEN of file to create message from
+4 ; VFLAG - "V" for VistA HL7 destination (default)
+5 ; OUT - target array, passed by reference
+6 ; MSHP - Piece 4 contains message subtype
+7 ;
+8 ; Output: Two part string with parts separated by "^"
+9 ; Part 1: "LM" - output in local array passed in "OUT" parameter
+10 ; "GM" - output in ^TMP("HLS",$J)
+11 ; Part 2: No longer used
+12 ;
+13 ;34
NEW DFN,HLFS,HLCM,HLSC,HLRP,HLES,HLQ,ALRDATA,ADD,ALTYPE,XX
+14 NEW DATA,VAL,I,S,X,Y,Z,X1,HL7RC,IEN,IEN1,OUTX,GMRAPID,ENTERR
+15 NEW SEPF,SEPC,SEPR,SEPE,SEPS,ARRAY,CMP,SEQ,GMRAHL,RSLTSTA
+16 NEW GMRAFILE,GMRAIENS,GMRAVUID
+17 ;
+18 ; Initialize stuff
+19 KILL ^TMP("HLS",$JOB)
SET S=0
SET ARRAY="OUT("_"""HLS"""_",S)"
SET TARGET="LM^"
+20 MERGE GMRAHL=VDEFHL
+21 ;
+22 ; Determine whether API was Allergy Update or Assessment
+23 SET ALTYPE=$SELECT($PIECE(MSHP,"~",4)="ALGY":1,$PIECE(MSHP,"~",4)="ADAS":2,1:1)
+24 ;
+25 ; Set up HL7 delimiters
+26 SET HLCM=$EXTRACT(GMRAHL("ECH"))
SET HLRP=$EXTRACT(GMRAHL("ECH"),2)
SET HLSC=$EXTRACT(GMRAHL("ECH"),4)
SET HLES=$EXTRACT(GMRAHL("ECH"),3)
+27 SET HLFS=GMRAHL("FS")
SET HLQ=GMRAHL("Q")
SET HL7RC=HLES_HLFS_HLCM_HLRP_HLSC
+28 DO SETDLMS^VDEFEL
+29 ;
+30 ; Get allergy data, patient ID, 'entered in error data'
+31 ; based on whether it's an allergy update or an assessment
+32 ; Allergy: ALTYPE=1, Assessment: ALTYPE=2
+33 if ALTYPE=1
Begin DoDot:1
+34 SET ALRDATA=$GET(^GMR(120.8,KEY,0))
+35 IF ALRDATA=""
DO ERR^VDEFREQ("No data in file GMR(120.8) for IEN "_KEY)
SET ZTSTOP=1
QUIT
+36 SET DFN=$PIECE(ALRDATA,U)
SET ENTERR=$GET(^GMR(120.8,KEY,"ER"))
+37 ;34
SET RSLTSTA=$EXTRACT("FW",1+ENTERR)
+38 IF $GET(^DPT(DFN,0))=""
DO ERR^VDEFREQ("No data in file DPT for DFN "_DFN)
SET ZTSTOP=1
QUIT
End DoDot:1
if ZTSTOP=1
GOTO EXIT
+39 if ALTYPE=2
Begin DoDot:1
+40 SET ENTERR=""
SET ALRDATA=$GET(^GMR(120.86,KEY,0))
+41 IF $PIECE(ALRDATA,U,2)=""
SET ENTERR=1
+42 SET DFN=$SELECT(+ENTERR=1:KEY,1:$PIECE(ALRDATA,U))
+43 IF $GET(^DPT(DFN,0))=""
DO ERR^VDEFREQ("No data in file DPT for DFN "_DFN)
SET ZTSTOP=1
QUIT
End DoDot:1
if ZTSTOP=1
GOTO EXIT
+44 ;
+45 ; Build segments for message in OUT, $P # = HL7 field #
+46 ;
+47 ; PID - Use MPI PID builder
PID KILL GMRAPID
SET OUTX=""
SET S=1
SET SEQ=""
+1 DO BLDPID^VAFCQRY(DFN,1,SEQ,.GMRAPID,.GMRAHL)
+2 FOR I=2:1
if $GET(GMRAPID(I))=""
QUIT
SET GMRAPID(1,I-1)=GMRAPID(I)
KILL GMRAPID(I)
+3 MERGE OUTX=GMRAPID(1)
KILL GMRAPID
DO SAVE
+4 ;
+5 ; OBR
OBR SET S=S+1
SET OUTX=""
SET $PIECE(OUTX,HLFS)=1
+1 SET $PIECE(OUTX,HLFS,3)=KEY_HLCM_$PIECE(SITEPARM,U,6)_$SELECT(ALTYPE=1:"_120.8",ALTYPE=2:"_120.86")
+2 SET $PIECE(OUTX,HLFS,4)=$PIECE("ALLERGY,ASSESSMENT",",",ALTYPE)_HLCM_HLCM_"L"
+3 ;
+4 ; Result Status
+5 ;34
SET $PIECE(OUTX,HLFS,25)=$EXTRACT("FE",1+ENTERR)
+6 ;
+7 ; Date/time reaction entered in system
+8 SET $PIECE(OUTX,HLFS,7)=$$TS^VDEFEL($PIECE(ALRDATA,U,4))
+9 ;
+10 ; Originator for allergy
+11 ;34
SET XX=$PIECE(ALRDATA,U,$PIECE("5^3",U,ALTYPE))
+12 ;Block added in 34
IF XX'=""
Begin DoDot:1
+13 SET XX=$$XCN200^VDEFEL(XX)
SET XX=$TRANSLATE(XX,HLCM,HLSC)
+14 FOR II=2:1:7
SET $PIECE(XX,SEPS,II)=$$HL7RC($PIECE(XX,SEPS,II))
+15 SET $PIECE(OUTX,HLFS,32)=XX
End DoDot:1
+16 if ALTYPE=2
GOTO OBRX
+17 ;
+18 ; Repeating field of various person roles
+19 ; Enterer, Verifier, Error User, ID Band Marker, Chart Marker
+20 ; and associated dates
+21 SET (X,Y,Z)=""
ENT ;34
SET XX=$PIECE(ALRDATA,U,5)
if XX=""
GOTO VER
+1 ;34
SET XX=$$XCN200^VDEFEL(XX)
SET XX=$TRANSLATE(XX,HLCM,HLSC)
+2 ;34
FOR II=2:1:7
SET $PIECE(XX,SEPS,II)=$$HL7RC($PIECE(XX,SEPS,II))
+3 ;34
SET VAL=XX
SET $PIECE(VAL,HLSC,8)="E"
SET Z=VAL
+4 SET $PIECE(Z,HLCM,2)=$$TS^VDEFEL($PIECE(ALRDATA,U,4))
SET X=Z
VER if $PIECE(ALRDATA,U,17)=""
GOTO ERR
+1 ;34
SET XX=$$XCN200^VDEFEL($PIECE(ALRDATA,U,18))
SET XX=$TRANSLATE(XX,HLCM,HLSC)
+2 ;34
FOR II=2:1:7
SET $PIECE(XX,SEPS,II)=$$HL7RC($PIECE(XX,SEPS,II))
+3 ;34
SET VAL=XX
SET $PIECE(VAL,HLSC,8)="V"
SET Z=VAL
+4 SET $PIECE(Z,HLCM,2)=$$TS^VDEFEL($PIECE(ALRDATA,U,17))
SET X=$GET(X)_HLRP_Z
ERR ;34
SET XX=+ENTERR
if 'XX
GOTO IDBM
+1 ;34
SET XX=$$XCN200^VDEFEL($PIECE(ENTERR,U,3))
SET XX=$TRANSLATE(XX,HLCM,HLSC)
+2 ;34
FOR II=2:1:7
SET $PIECE(XX,SEPS,II)=$$HL7RC($PIECE(XX,SEPS,II))
+3 ;34
SET VAL=XX
SET $PIECE(VAL,HLSC,8)="EE"
SET Z=VAL
+4 SET $PIECE(Z,HLCM,2)=$$TS^VDEFEL($PIECE(ENTERR,U,2))
SET X=$GET(X)_HLRP_Z
+5 ;
+6 ; May be multiple entries for ID Band & Chart Marker persons
IDBM if '$DATA(^GMR(120.8,KEY,14))
GOTO CHRT
+1 SET IEN1=0
FOR
SET IEN1=$ORDER(^GMR(120.8,KEY,14,IEN1))
if '+IEN1
QUIT
Begin DoDot:1
+2 ;34
SET X1=$GET(^GMR(120.8,KEY,14,IEN1,0))
+3 ;34
SET XX=$$XCN200^VDEFEL($PIECE(X1,U,2))
SET XX=$TRANSLATE(XX,HLCM,HLSC)
+4 ;34
FOR II=2:1:7
SET $PIECE(XX,SEPS,II)=$$HL7RC($PIECE(XX,SEPS,II))
+5 ;34
SET VAL=XX
if VAL=""
SET VAL=Y
SET $PIECE(VAL,HLSC,8)="BM"
SET Z=VAL
+6 SET $PIECE(Z,HLCM,2)=$$TS^VDEFEL($PIECE(X1,U,1))
SET X=$GET(X)_HLRP_Z
End DoDot:1
CHRT if '$DATA(^GMR(120.8,KEY,13))
GOTO OBR1
+1 SET IEN1=0
FOR
SET IEN1=$ORDER(^GMR(120.8,KEY,13,IEN1))
if '+IEN1
QUIT
Begin DoDot:1
+2 ;34
SET X1=$GET(^GMR(120.8,KEY,13,IEN1,0))
+3 ;34
SET XX=$$XCN200^VDEFEL($PIECE(X1,U,2))
SET XX=$TRANSLATE(XX,HLCM,HLSC)
+4 ;34
FOR II=2:1:7
SET $PIECE(XX,SEPS,II)=$$HL7RC($PIECE(XX,SEPS,II))
+5 ;34
SET VAL=XX
if VAL=""
SET VAL=Y
SET $PIECE(VAL,HLSC,8)="CM"
SET Z=VAL
+6 SET $PIECE(Z,HLCM,2)=$$TS^VDEFEL($PIECE(X1,U,1))
SET X=$GET(X)_HLRP_Z
End DoDot:1
OBR1 SET $PIECE(OUTX,HLFS,34)=X
+1 ;
+2 ; Observed/Historical Indicator
+3 SET X=$PIECE(ALRDATA,U,6)
SET GMRAVUID=$$GETVUID(120.8,6,X)
+4 SET VAL=$PIECE(GMRAVUID,U)_HLCM_$SELECT(X="o":"OBSERVED",X="h":"HISTORICAL",1:"")
+5 SET VAL=VAL_HLCM_$PIECE(GMRAVUID,U,2)
+6 SET $PIECE(OUTX,HLFS,47)=VAL
OBRX SET OUTX="OBR"_HLFS_OUTX
DO SAVE
+1 ;
+2 ; If the record is missing both the Reactant and the GMR Allergy
+3 ; trap it as an error.
+4 IF ALTYPE'=2
IF $PIECE(ALRDATA,U,2)=""
IF $PIECE(ALRDATA,U,3)=""
DO ERR^VDEFREQ("Record is missing Reactant and GMR Allergy")
SET ZTSTOP=1
QUIT
+5 ;
+6 ; OK to continue, call GMRAIAL2 for the rest of the message
CALL DO ENTRY^GMRAIAL2
+1 ;
+2 ; Done building segments
EXIT QUIT TARGET
+1 ;
+2 ;
+3 ; Place current string into message array.
+4 ; Turn string into array if length >245.
+5 ; Move local array to global if needed.
SAVE NEW I
+1 IF $PIECE(OUTX,HLFS)'="PID"
IF $LENGTH(OUTX)>245
Begin DoDot:1
+2 KILL ADD
SET ADD=$EXTRACT(OUTX,1,245)
SET OUTX=$EXTRACT(OUTX,246,$LENGTH(OUTX))
+3 FOR I=1:1
SET ADD(I)=$EXTRACT(OUTX,1,245)
SET OUTX=$EXTRACT(OUTX,246,$LENGTH(OUTX))
if OUTX=""
QUIT
+4 KILL OUTX
MERGE OUTX=ADD
End DoDot:1
+5 MERGE @ARRAY=OUTX
+6 ;
+7 ; Move local array to global if it's getting big.
+8 IF $PIECE(TARGET,U)="LM"
IF $STORAGE<16000
Begin DoDot:1
+9 KILL ^TMP("HLS",$JOB)
MERGE ^TMP("HLS",$JOB)=OUT("HLS")
KILL OUT("HLS")
+10 SET $PIECE(TARGET,U)="GM"
SET ARRAY="^TMP("_"""HLS"""_",$J,S)"
End DoDot:1
+11 KILL OUTX,ADD
+12 QUIT
+13 ;
+14 ; Replace any HL7 coding chars. in strings with HL7 escape sequence
+15 ; Input: X = data string
HL7RC(X) NEW OCHR,RCHR,RCHRI,TYPE,I
FOR TYPE="E","F","C","R","S"
Begin DoDot:1
+1 SET RCHRI=$SELECT(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
+2 SET OCHR=$EXTRACT(HL7RC,RCHRI)
SET RCHR=$EXTRACT("EFSRT",RCHRI)
+3 if '$FIND(X,OCHR)
QUIT
+4 FOR I=1:1
if $EXTRACT(X,I)=""
QUIT
IF $EXTRACT(X,I)=OCHR
SET X=$EXTRACT(X,1,I-1)_HLES_RCHR_HLES_$EXTRACT(X,I+1,999)
SET I=I+2
End DoDot:1
+5 QUIT X
+6 ;
+7 ; Get the VUID value and set up name of coding system
GETVUID(GMRAFILE,GMRAFLD,GMRADATA,GMRAFLSW) ;
+1 ; Input parameters:
+2 ; GMRAFILE - VistA File #
+3 ; GMRAFLD - Field # in GMRAFILE
+4 ; GMRADATA - Reference value to look up VUID for
+5 ; GMRAFLSW - (Optional) Use 8985.1 if nil, else use GMRAFILE
+6 ;
+7 ; Output parameter:
+8 ; 1st '^' piece - VUID # or 0 if no VUID
+9 ; 2nd '^' piece - Coding system: "99VA8985.1" if VUID and GMRAFLSW=nil
+10 ; "99VA"_GMRAFILE if GMRAFLSW=1
+11 ; else = <site_VistA application file #> if no VUID
+12 NEW X
SET X=+$$GETVUID^XTID(GMRAFILE,GMRAFLD,GMRADATA)
SET GMRAFLSW=$GET(GMRAFLSW)
+13 IF X
SET $PIECE(X,U,2)="99VA"_$SELECT(GMRAFLSW:GMRAFILE,1:"8985.1")
+14 IF '$TEST
SET $PIECE(X,U,2)=$PIECE(SITEPARM,U,6)_"_"_GMRAFILE
+15 QUIT X
