GMRAIAL2 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ALLERGIES - PART 2 ; 17 Mar 2006 11:55 AM
;;4.0;Adverse Reaction Tracking;**22,23,34**;Mar 29, 1996
; 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)
; #4531 - ZERO^PSN50P41 (supported)
; #2574 - $$CLASS2^PSNAPIS (supported)
;
; This routine is called as a subroutine by GMRAIAL1
;
Q
;
ENTRY ; Entry point from GMRAIAL1
;
; Skip to OBX8 if doing an assessment
G OBX8:ALTYPE=2
;
; OBX 1 - Reactant
OBX1 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"AGENT"_HLFS
S $P(OUTX,HLFS,5)=$$HL7RC^GMRAIAL1($P(ALRDATA,U,2)),$P(OUTX,HLFS,11)=RSLTSTA
S X=$P(SITEPARM,U,6)_HLCM_$P(SITEPARM,U,5)_HLCM_"L",$P(OUTX,HLFS,15)=X
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX2 - Allergy Type
OBX2 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"ALLERGY TYPE"_HLFS
S X=$P(ALRDATA,U,20),VAL=X_HLCM F I=1:1:$L(X) D
. S Y=$E(X,I),Y=$S(Y="D":"DRUG",Y="F":"FOOD",Y="O":"OTHER",1:"")
. S VAL=VAL_Y S:I<$L(X) VAL=VAL_","
S VAL=VAL_HLCM_"L",$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
S X=$P(SITEPARM,U,6)_HLCM_$P(SITEPARM,U,5)_HLCM_"L",$P(OUTX,HLFS,15)=X
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX3 - GMR Allergy
; ALLERGIES FROM VA DRUG CLASS HAVE SPECIAL FORMAT FOR
; OBX-5
OBX3 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"GMR ALLERGY"_HLFS
S VAL="",X=$P(ALRDATA,U,3) G OBX4:X=""
I X'["50.605" D
. S VAL=$P($G(@("^"_$P(X,";",2)_$P(X,";",1)_",0)")),U)
. I VAL="" D ERR^VDEFREQ("No data in GMR Allergy file "_$P(X,";",2)_$P(X,";")_",0)") S ZTSTOP=1 Q
. I X["PSDRUG" S GMRAVUID=$P(X,";",1)_U_$P(SITEPARM,U,6)_"_"_50
. E D
. . S GMRAFILE=+$P($P(X,";",2),"(",2),GMRAIENS=+X_","
. . S GMRAVUID=$$GETVUID^GMRAIAL1(GMRAFILE,.01,GMRAIENS,1)
. S VAL=$P(GMRAVUID,U)_HLCM_VAL_HLCM_$P(GMRAVUID,U,2)
I X["50.605" D
. S GMRAIENS=$P(X,";"),Y=$$CLASS2^PSNAPIS(GMRAIENS)
. S GMRAVUID=$$GETVUID^GMRAIAL1(50.605,.01,GMRAIENS_",",1)
. S VAL=$G(VAL)_$P(GMRAVUID,U)_HLCM_$P(Y,U,2)_HLCM_$P(GMRAVUID,U,2)_HLCM_$P(Y,U)_HLCM_$P(Y,U,2)_HLCM_$P(SITEPARM,U,6)_"_50.605"
G RETURN:ZTSTOP
S $P(VAL,HLCM,2)=$$HL7RC^GMRAIAL1($P(VAL,HLCM,2)),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA ;34
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX4 - List of drug ingredients
OBX4 G OBX5:'$D(^GMR(120.8,KEY,2))
S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"DRUG INGREDIENTS"_HLFS
S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,2,IEN1)) Q:'+IEN1 D
. S Y=^GMR(120.8,KEY,2,IEN1,0),GMRAVUID=$$GETVUID^GMRAIAL1(50.416,.01,Y_",",1)
. D ZERO^PSN50P41(Y,,,"GMRAING") ;34 Gets zero node of ingredient entry from 50.416
. S X=$P(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($P(^TMP($J,"GMRAING",Y,.01),U))_HLCM_$P(GMRAVUID,U,2),VAL=VAL_X_HLRP ;34
S VAL=$E(VAL,1,$L(VAL)-1),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX5 - Drug class
OBX5 G OBX6:'$D(^GMR(120.8,KEY,3))
S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"DRUG CLASSES"_HLFS
S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,3,IEN1)) Q:'+IEN1 D
. S GMRAIENS=^GMR(120.8,KEY,3,IEN1,0),X=$$CLASS2^PSNAPIS(GMRAIENS)
. S GMRAVUID=$$GETVUID^GMRAIAL1(50.605,.01,GMRAIENS_",",1)
. S VAL=$G(VAL)_$P(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($P(X,U,2))_HLCM_$P(GMRAVUID,U,2)_HLCM_$P(X,U)_HLCM_$$HL7RC^GMRAIAL1($P(X,U,2))_HLCM_$P(SITEPARM,U,6)_"_50.605"_HLRP ;34
S VAL=$E(VAL,1,$L(VAL)-1),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX6 - MECHANISM
OBX6 S X=$P(ALRDATA,U,14) G OBX7:X=""
S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"MECHANISM"_HLFS
S GMRAVUID=$$GETVUID^GMRAIAL1(120.8,17,X)
S VAL=$P(GMRAVUID,U)_HLCM_$S(X="A":"ALLERGY",X="P":"PHARMACOLOGIC",X="U":"UNKNOWN",1:"")_HLCM_$P(GMRAVUID,U,2)
S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX7 - Reaction
OBX7 S IEN1=0 F S IEN1=$O(^GMR(120.8,KEY,10,IEN1)) Q:'+IEN1 D Q:ZTSTOP
. S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"REACTION"_HLFS
. S X=^GMR(120.8,KEY,10,IEN1,0),GMRAVUID=""
. S:$P(X,U,2)'="" GMRAVUID="^L"
. S:$P(X,U,2)="" $P(X,U,2)=$P($G(^GMRD(120.83,+X,0)),U)
. S:GMRAVUID'="^L" GMRAVUID=$$GETVUID^GMRAIAL1(120.83,.01,+X_",",1)
. S VAL=$P(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($P(X,U,2))_HLCM_$P(GMRAVUID,U,2) ;34
. S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
. S $P(OUTX,HLFS,14)=$$TS^VDEFEL($P(X,U,4))
. S XX=$$XCN200^VDEFEL($P(X,U,3)) ;34
. F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II)) ;34
. S $P(OUTX,HLFS,16)=XX ;34
. S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; Skip assessment if allergy update
G OBX9:ALTYPE=1
;
; OBX8 - Assessment
OBX8 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"ASSESSMENT"_HLFS
I +ENTERR=1 S VAL=HLCM_"ENTERED IN ERROR"_HLCM G OBX8A ;34
S X=+$P(ALRDATA,U,2),GMRAVUID=$$GETVUID^GMRAIAL1(120.86,1,X)
S VAL=$P(GMRAVUID,U)_HLCM_$S(X=0:"NO KNOWN ALLERGIES",X=1:"YES",1:"")
S VAL=VAL_HLCM_$P(GMRAVUID,U,2)
OBX8A S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=$E("FW",1+ENTERR) ;34
I '+ENTERR S $P(OUTX,HLFS,14)=$$TS^VDEFEL($P(ALRDATA,U,4))
I '+ENTERR D ;Block added in 34
. S XX=$$XCN200^VDEFEL($P(ALRDATA,U,3))
. F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II))
. S $P(OUTX,HLFS,16)=XX
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; Done if assessment
G RETURN:ALTYPE=2
;
; OBX9 - Comments
; One OBX for each comment
OBX9 S IEN=0 F S IEN=$O(^GMR(120.8,KEY,26,IEN)) Q:'+IEN D
. S ALRDATA=$G(^GMR(120.8,KEY,26,IEN,0)) G RETURN:ALRDATA=""
. ; Set up the static fields
. S X1=1_HLFS_"TX"_HLFS_"COMMENT"_HLFS
. S XX=$$XCN200^VDEFEL($P(ALRDATA,U,2)) ;34
. F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II)) ;34
. S $P(X1,HLFS,11)=RSLTSTA,$P(X1,HLFS,16)=XX ;34
. S $P(X1,HLFS,19)=$$TS^VDEFEL($P(ALRDATA,U)),X=$P(ALRDATA,U,3)
. S GMRAVUID=$$GETVUID^GMRAIAL1(120.826,1.5,X)
. S $P(X,HLCM,2)=$S(X="V":"VERIFIED",X="O":"OBSERVED",X="E":"ERRORED",1:"")
. S $P(X,HLCM)=+GMRAVUID,$P(X,HLCM,3)=$P(GMRAVUID,U,2)
. S $P(X1,HLFS,17)=X
. ;
. ; A comment may be more than one line
. S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,26,IEN,2,IEN1)) Q:'+IEN1 D
. . S X=$$HL7RC^GMRAIAL1(^GMR(120.8,KEY,26,IEN,2,IEN1,0)),VAL=VAL_X_HLRP
. S:$E(VAL,$L(VAL))=HLRP VAL=$E(VAL,1,$L(VAL)-1)
. S OUTX=X1,$P(OUTX,HLFS,5)=VAL
. S S=S+1,OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; Return to GMRAIAL1
RETURN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAIAL2 6452 printed Sep 23, 2025@19:15:25 Page 2
GMRAIAL2 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ALLERGIES - PART 2 ; 17 Mar 2006 11:55 AM
+1 ;;4.0;Adverse Reaction Tracking;**22,23,34**;Mar 29, 1996
+2 ; Creates HL7 V2.4 ORU^R01 message for allergy updates & assessments
+3 ;
+4 ; This routine uses the following IAs:
+5 ; #4248 - VDEFEL calls (controlled)
+6 ; #3630 - VAFCQRY calls (controlled)
+7 ; #4531 - ZERO^PSN50P41 (supported)
+8 ; #2574 - $$CLASS2^PSNAPIS (supported)
+9 ;
+10 ; This routine is called as a subroutine by GMRAIAL1
+11 ;
+12 QUIT
+13 ;
ENTRY ; Entry point from GMRAIAL1
+1 ;
+2 ; Skip to OBX8 if doing an assessment
+3 if ALTYPE=2
GOTO OBX8
+4 ;
+5 ; OBX 1 - Reactant
OBX1 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS_"AGENT"_HLFS
+1 SET $PIECE(OUTX,HLFS,5)=$$HL7RC^GMRAIAL1($PIECE(ALRDATA,U,2))
SET $PIECE(OUTX,HLFS,11)=RSLTSTA
+2 SET X=$PIECE(SITEPARM,U,6)_HLCM_$PIECE(SITEPARM,U,5)_HLCM_"L"
SET $PIECE(OUTX,HLFS,15)=X
+3 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
+4 ;
+5 ; OBX2 - Allergy Type
OBX2 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS_"ALLERGY TYPE"_HLFS
+1 SET X=$PIECE(ALRDATA,U,20)
SET VAL=X_HLCM
FOR I=1:1:$LENGTH(X)
Begin DoDot:1
+2 SET Y=$EXTRACT(X,I)
SET Y=$SELECT(Y="D":"DRUG",Y="F":"FOOD",Y="O":"OTHER",1:"")
+3 SET VAL=VAL_Y
if I<$LENGTH(X)
SET VAL=VAL_","
End DoDot:1
+4 SET VAL=VAL_HLCM_"L"
SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)=RSLTSTA
+5 SET X=$PIECE(SITEPARM,U,6)_HLCM_$PIECE(SITEPARM,U,5)_HLCM_"L"
SET $PIECE(OUTX,HLFS,15)=X
+6 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
+7 ;
+8 ; OBX3 - GMR Allergy
+9 ; ALLERGIES FROM VA DRUG CLASS HAVE SPECIAL FORMAT FOR
+10 ; OBX-5
OBX3 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS_"GMR ALLERGY"_HLFS
+1 SET VAL=""
SET X=$PIECE(ALRDATA,U,3)
if X=""
GOTO OBX4
+2 IF X'["50.605"
Begin DoDot:1
+3 SET VAL=$PIECE($GET(@("^"_$PIECE(X,";",2)_$PIECE(X,";",1)_",0)")),U)
+4 IF VAL=""
DO ERR^VDEFREQ("No data in GMR Allergy file "_$PIECE(X,";",2)_$PIECE(X,";")_",0)")
SET ZTSTOP=1
QUIT
+5 IF X["PSDRUG"
SET GMRAVUID=$PIECE(X,";",1)_U_$PIECE(SITEPARM,U,6)_"_"_50
+6 IF '$TEST
Begin DoDot:2
+7 SET GMRAFILE=+$PIECE($PIECE(X,";",2),"(",2)
SET GMRAIENS=+X_","
+8 SET GMRAVUID=$$GETVUID^GMRAIAL1(GMRAFILE,.01,GMRAIENS,1)
End DoDot:2
+9 SET VAL=$PIECE(GMRAVUID,U)_HLCM_VAL_HLCM_$PIECE(GMRAVUID,U,2)
End DoDot:1
+10 IF X["50.605"
Begin DoDot:1
+11 SET GMRAIENS=$PIECE(X,";")
SET Y=$$CLASS2^PSNAPIS(GMRAIENS)
+12 SET GMRAVUID=$$GETVUID^GMRAIAL1(50.605,.01,GMRAIENS_",",1)
+13 SET VAL=$GET(VAL)_$PIECE(GMRAVUID,U)_HLCM_$PIECE(Y,U,2)_HLCM_$PIECE(GMRAVUID,U,2)_HLCM_$PIECE(Y,U)_HLCM_$PIECE(Y,U,2)_HLCM_$PIECE(SITEPARM,U,6)_"_50.605"
End DoDot:1
+14 if ZTSTOP
GOTO RETURN
+15 ;34
SET $PIECE(VAL,HLCM,2)=$$HL7RC^GMRAIAL1($PIECE(VAL,HLCM,2))
SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)=RSLTSTA
+16 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
+17 ;
+18 ; OBX4 - List of drug ingredients
OBX4 if '$DATA(^GMR(120.8,KEY,2))
GOTO OBX5
+1 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS_"DRUG INGREDIENTS"_HLFS
+2 SET IEN1=0
SET VAL=""
FOR
SET IEN1=$ORDER(^GMR(120.8,KEY,2,IEN1))
if '+IEN1
QUIT
Begin DoDot:1
+3 SET Y=^GMR(120.8,KEY,2,IEN1,0)
SET GMRAVUID=$$GETVUID^GMRAIAL1(50.416,.01,Y_",",1)
+4 ;34 Gets zero node of ingredient entry from 50.416
DO ZERO^PSN50P41(Y,,,"GMRAING")
+5 ;34
SET X=$PIECE(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($PIECE(^TMP($JOB,"GMRAING",Y,.01),U))_HLCM_$PIECE(GMRAVUID,U,2)
SET VAL=VAL_X_HLRP
End DoDot:1
+6 SET VAL=$EXTRACT(VAL,1,$LENGTH(VAL)-1)
SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)=RSLTSTA
+7 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
+8 ;
+9 ; OBX5 - Drug class
OBX5 if '$DATA(^GMR(120.8,KEY,3))
GOTO OBX6
+1 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS_"DRUG CLASSES"_HLFS
+2 SET IEN1=0
SET VAL=""
FOR
SET IEN1=$ORDER(^GMR(120.8,KEY,3,IEN1))
if '+IEN1
QUIT
Begin DoDot:1
+3 SET GMRAIENS=^GMR(120.8,KEY,3,IEN1,0)
SET X=$$CLASS2^PSNAPIS(GMRAIENS)
+4 SET GMRAVUID=$$GETVUID^GMRAIAL1(50.605,.01,GMRAIENS_",",1)
+5 ;34
SET VAL=$GET(VAL)_$PIECE(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($PIECE(X,U,2))_HLCM_$PIECE(GMRAVUID,U,2)_HLCM_$PIECE(X,U)_HLCM_$$HL7RC^GMRAIAL1($PIECE(X,U,2))_HLCM_$PIECE(SITEPARM,U,6)_"_50.605"_HLRP
End DoDot:1
+6 SET VAL=$EXTRACT(VAL,1,$LENGTH(VAL)-1)
SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)=RSLTSTA
+7 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
+8 ;
+9 ; OBX6 - MECHANISM
OBX6 SET X=$PIECE(ALRDATA,U,14)
if X=""
GOTO OBX7
+1 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS_"MECHANISM"_HLFS
+2 SET GMRAVUID=$$GETVUID^GMRAIAL1(120.8,17,X)
+3 SET VAL=$PIECE(GMRAVUID,U)_HLCM_$SELECT(X="A":"ALLERGY",X="P":"PHARMACOLOGIC",X="U":"UNKNOWN",1:"")_HLCM_$PIECE(GMRAVUID,U,2)
+4 SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)=RSLTSTA
+5 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
+6 ;
+7 ; OBX7 - Reaction
OBX7 SET IEN1=0
FOR
SET IEN1=$ORDER(^GMR(120.8,KEY,10,IEN1))
if '+IEN1
QUIT
Begin DoDot:1
+1 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS_"REACTION"_HLFS
+2 SET X=^GMR(120.8,KEY,10,IEN1,0)
SET GMRAVUID=""
+3 if $PIECE(X,U,2)'=""
SET GMRAVUID="^L"
+4 if $PIECE(X,U,2)=""
SET $PIECE(X,U,2)=$PIECE($GET(^GMRD(120.83,+X,0)),U)
+5 if GMRAVUID'="^L"
SET GMRAVUID=$$GETVUID^GMRAIAL1(120.83,.01,+X_",",1)
+6 ;34
SET VAL=$PIECE(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($PIECE(X,U,2))_HLCM_$PIECE(GMRAVUID,U,2)
+7 SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)=RSLTSTA
+8 SET $PIECE(OUTX,HLFS,14)=$$TS^VDEFEL($PIECE(X,U,4))
+9 ;34
SET XX=$$XCN200^VDEFEL($PIECE(X,U,3))
+10 ;34
FOR II=2:1:7
SET $PIECE(XX,SEPC,II)=$$HL7RC^GMRAIAL1($PIECE(XX,SEPC,II))
+11 ;34
SET $PIECE(OUTX,HLFS,16)=XX
+12 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
End DoDot:1
if ZTSTOP
QUIT
+13 ;
+14 ; Skip assessment if allergy update
+15 if ALTYPE=1
GOTO OBX9
+16 ;
+17 ; OBX8 - Assessment
OBX8 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS_"ASSESSMENT"_HLFS
+1 ;34
IF +ENTERR=1
SET VAL=HLCM_"ENTERED IN ERROR"_HLCM
GOTO OBX8A
+2 SET X=+$PIECE(ALRDATA,U,2)
SET GMRAVUID=$$GETVUID^GMRAIAL1(120.86,1,X)
+3 SET VAL=$PIECE(GMRAVUID,U)_HLCM_$SELECT(X=0:"NO KNOWN ALLERGIES",X=1:"YES",1:"")
+4 SET VAL=VAL_HLCM_$PIECE(GMRAVUID,U,2)
OBX8A ;34
SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)=$EXTRACT("FW",1+ENTERR)
+1 IF '+ENTERR
SET $PIECE(OUTX,HLFS,14)=$$TS^VDEFEL($PIECE(ALRDATA,U,4))
+2 ;Block added in 34
IF '+ENTERR
Begin DoDot:1
+3 SET XX=$$XCN200^VDEFEL($PIECE(ALRDATA,U,3))
+4 FOR II=2:1:7
SET $PIECE(XX,SEPC,II)=$$HL7RC^GMRAIAL1($PIECE(XX,SEPC,II))
+5 SET $PIECE(OUTX,HLFS,16)=XX
End DoDot:1
+6 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
+7 ;
+8 ; Done if assessment
+9 if ALTYPE=2
GOTO RETURN
+10 ;
+11 ; OBX9 - Comments
+12 ; One OBX for each comment
OBX9 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.8,KEY,26,IEN))
if '+IEN
QUIT
Begin DoDot:1
+1 SET ALRDATA=$GET(^GMR(120.8,KEY,26,IEN,0))
if ALRDATA=""
GOTO RETURN
+2 ; Set up the static fields
+3 SET X1=1_HLFS_"TX"_HLFS_"COMMENT"_HLFS
+4 ;34
SET XX=$$XCN200^VDEFEL($PIECE(ALRDATA,U,2))
+5 ;34
FOR II=2:1:7
SET $PIECE(XX,SEPC,II)=$$HL7RC^GMRAIAL1($PIECE(XX,SEPC,II))
+6 ;34
SET $PIECE(X1,HLFS,11)=RSLTSTA
SET $PIECE(X1,HLFS,16)=XX
+7 SET $PIECE(X1,HLFS,19)=$$TS^VDEFEL($PIECE(ALRDATA,U))
SET X=$PIECE(ALRDATA,U,3)
+8 SET GMRAVUID=$$GETVUID^GMRAIAL1(120.826,1.5,X)
+9 SET $PIECE(X,HLCM,2)=$SELECT(X="V":"VERIFIED",X="O":"OBSERVED",X="E":"ERRORED",1:"")
+10 SET $PIECE(X,HLCM)=+GMRAVUID
SET $PIECE(X,HLCM,3)=$PIECE(GMRAVUID,U,2)
+11 SET $PIECE(X1,HLFS,17)=X
+12 ;
+13 ; A comment may be more than one line
+14 SET IEN1=0
SET VAL=""
FOR
SET IEN1=$ORDER(^GMR(120.8,KEY,26,IEN,2,IEN1))
if '+IEN1
QUIT
Begin DoDot:2
+15 SET X=$$HL7RC^GMRAIAL1(^GMR(120.8,KEY,26,IEN,2,IEN1,0))
SET VAL=VAL_X_HLRP
End DoDot:2
+16 if $EXTRACT(VAL,$LENGTH(VAL))=HLRP
SET VAL=$EXTRACT(VAL,1,$LENGTH(VAL)-1)
+17 SET OUTX=X1
SET $PIECE(OUTX,HLFS,5)=VAL
+18 SET S=S+1
SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAL1
End DoDot:1
+19 ;
+20 ; Return to GMRAIAL1
RETURN QUIT
