- 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 Feb 18, 2025@23:05:49 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