GMRAIAD2 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ADVERSE REACTION - PART 2 ; 5 Oct 2005 8:57 AM
;;4.0;Adverse Reaction Tracking;**22,23**;Mar 29, 1996
; Creates HL7 V2.4 ORU^R01 message for allergy adverse reaction
;
; This routine uses the following IAs:
; #4248 - VDEFEL calls (conrolled)
; #3630 - VAFCQRY calls (controlled)
; #2196 - ^PS(50.416,IEN,0) (controlled)
;
; This routine is called as a subroutine by GMRAIAD1
;
Q
;
ENTRY ; Entry point from GMRAIAD1
;
; OBX3 - QUESTIONS 1 thru 10
OBX3 S Y="",ALRDATA=^GMR(120.85,KEY,0)
F I=3:1:7,9:1:11,16,17 S Y=Y_$P(ALRDATA,U,I)_U
F I=1:1:10 D
. Q:$P(Y,U,I)="" S S=S+1,OUTX=1_HLFS_"CE"_HLFS
. S VAL="Q"_I_HLCM_$P($T(QSTNS+(I)),";",3),$P(OUTX,HLFS,3)=VAL
. S X=$P(Y,U,I),X=$S(X="y":"Y",X="n":"N",1:""),VAL=X_HLCM
. S X=$S(X="Y":"YES",X="N":"NO",1:"")
. S VAL=VAL_X_HLCM_"HL70136",$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)="F"
. S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAD1
;
; OBX4 - # Days in Hospital
OBX4 S X=$P(ALRDATA,U,8)+0 G OBX5:X=0
S S=S+1,OUTX=1_HLFS_"NM"_HLFS_"DAYS IN HOSPITAL"
S $P(OUTX,HLFS,5)=X,$P(OUTX,HLFS,11)="F"
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAD1
;
; OBX5 - Other related history
OBX5 S X=$G(^GMR(120.85,KEY,14,1,0)) G OBX6:X=""
F I=2:1 S Y=$G(^GMR(120.85,KEY,14,I,0)) Q:Y="" S X=X_" "_Y
S S=S+1,OUTX=1_HLFS_"TX"_HLFS_"Other History"_HLFS_HLFS_$$HL7RC^GMRAIAD1(X)
S $P(OUTX,HLFS,11)="F",OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAD1
;
; OBX6 - FDA Questions
OBX6 S PTC=$G(^GMR(120.85,KEY,"PTC1")) G OBX8:PTC=""
F I=1:1:5 D
. S S=S+1,OUTX=1_HLFS_"CE"_HLFS
. S VAL="FDAQ"_I_HLCM_$P($T(FDAQ+I),";",3),$P(OUTX,HLFS,3)=VAL
. S VAL=$P(PTC,U,I+(I=5*8)),VAL=VAL_HLCM_$S(VAL="y":"Yes",VAL="n":"No",1:"Unknown")_HLCM_"HL70136"
. S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)="F",OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAD1
;
; OBX7 - P & T Questions
OBX7 F I=1:1:3 D
. S S=S+1,OUTX=1_HLFS_"CE"_HLFS,Y=$$HL7RC^GMRAIAD1("P&T")_" ACTION "
. S Y=Y_$P("FDA^MFR^RCPM",U,I)_" REPORT",VAL="PTQ"_I_HLCM_Y,$P(OUTX,HLFS,3)=VAL
. S VAL=$P(X,U,I+8),VAL=VAL_HLCM_$S(VAL="y":"Yes",VAL="n":"No",1:"Unknown")_HLCM_"HL70136"
. S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)="F",OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAD1
;
; OBX8 - P & T Addendum
OBX8 S PTC=$O(^GMR(120.85,KEY,"PTC2",0)) G OBX9:PTC="" S IEN=0
S VAL=$$TS^VDEFEL(^GMR(120.85,KEY,"PTC2",1,0))
F S IEN=$O(^GMR(120.85,KEY,"PTC2",1,1,IEN)) Q:IEN="" D
. S S=S+1,OUTX=1_HLFS_"TX"_HLFS_$$HL7RC^GMRAIAD1("P&T Addendum")
. S $P(OUTX,HLFS,5)=$$HL7RC^GMRAIAD1(^GMR(120.85,KEY,"PTC2",1,1,IEN,0))
. S $P(OUTX,HLFS,11)="F",$P(OUTX,HLFS,14)=VAL
. S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAD1
;
; OBX9 - Notification Dates
OBX9 S VAL=$P(^GMR(120.85,KEY,0),U,12) I VAL'="" D
. ;
. ; Date MD notified
. S VAL=$$TS^VDEFEL(VAL) S S=S+1,OUTX=1_HLFS_"DT"_HLFS_"DATE MD NOTIFIED"
. S $P(OUTX,5,HLFS)=VAL,$P(OUTX,11,HLFS)="F"
. S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAD1
;
; Dates reported to FDA, MFR, RCPM, VAERS
S PTC=$G(^GMR(120.85,KEY,"PTC1")) G RETURN:PTC=""
F I=1:1:5 S VAL=$P(PTC,U,I+4) I VAL'="" D
. S VAL=$$TS^VDEFEL(VAL) S S=S+1,OUTX=1_HLFS_"DT"_HLFS_$P($T(RPTXT+I),";",3)
. S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)="F"
. S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAD1
;
; Return to GMRAIAD1
RETURN Q
;
QSTNS ; Question 1-10 Set
;;Patient died from reaction?
;;Patient treated with RX drug?
;;Life threatening illness?
;;Required ER/MD visit?
;;Required hospitalization?
;;Prolonged hospitalization?
;;Resulted in permanent disability?
;;Patient recovered?
;;Is this event a congenital anomaly?
;;Did this event require intervention to prevent impairment or damage?
;
FDAQ ; FDA Questions
;;Serious ADR?
;;ADR related to new drug? (Marketed within last 2 yrs.)
;;Unexpected ADR?
;;ADR related to therapeutic failure?
;;Dose related?
;
RPTXT ; Dates Reported Texts
;;DATE REPORTED TO FDA
;;DATE OF PATIENT CONSENT TO MFR
;;DATE SENT TO MFR
;;DATE SENT TO RCPM
;;DATE SENT TO VAERS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAIAD2 4033 printed Apr 09, 2024@20:45:27 Page 2
GMRAIAD2 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ADVERSE REACTION - PART 2 ; 5 Oct 2005 8:57 AM
+1 ;;4.0;Adverse Reaction Tracking;**22,23**;Mar 29, 1996
+2 ; Creates HL7 V2.4 ORU^R01 message for allergy adverse reaction
+3 ;
+4 ; This routine uses the following IAs:
+5 ; #4248 - VDEFEL calls (conrolled)
+6 ; #3630 - VAFCQRY calls (controlled)
+7 ; #2196 - ^PS(50.416,IEN,0) (controlled)
+8 ;
+9 ; This routine is called as a subroutine by GMRAIAD1
+10 ;
+11 QUIT
+12 ;
ENTRY ; Entry point from GMRAIAD1
+1 ;
+2 ; OBX3 - QUESTIONS 1 thru 10
OBX3 SET Y=""
SET ALRDATA=^GMR(120.85,KEY,0)
+1 FOR I=3:1:7,9:1:11,16,17
SET Y=Y_$PIECE(ALRDATA,U,I)_U
+2 FOR I=1:1:10
Begin DoDot:1
+3 if $PIECE(Y,U,I)=""
QUIT
SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS
+4 SET VAL="Q"_I_HLCM_$PIECE($TEXT(QSTNS+(I)),";",3)
SET $PIECE(OUTX,HLFS,3)=VAL
+5 SET X=$PIECE(Y,U,I)
SET X=$SELECT(X="y":"Y",X="n":"N",1:"")
SET VAL=X_HLCM
+6 SET X=$SELECT(X="Y":"YES",X="N":"NO",1:"")
+7 SET VAL=VAL_X_HLCM_"HL70136"
SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)="F"
+8 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAD1
End DoDot:1
+9 ;
+10 ; OBX4 - # Days in Hospital
OBX4 SET X=$PIECE(ALRDATA,U,8)+0
if X=0
GOTO OBX5
+1 SET S=S+1
SET OUTX=1_HLFS_"NM"_HLFS_"DAYS IN HOSPITAL"
+2 SET $PIECE(OUTX,HLFS,5)=X
SET $PIECE(OUTX,HLFS,11)="F"
+3 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAD1
+4 ;
+5 ; OBX5 - Other related history
OBX5 SET X=$GET(^GMR(120.85,KEY,14,1,0))
if X=""
GOTO OBX6
+1 FOR I=2:1
SET Y=$GET(^GMR(120.85,KEY,14,I,0))
if Y=""
QUIT
SET X=X_" "_Y
+2 SET S=S+1
SET OUTX=1_HLFS_"TX"_HLFS_"Other History"_HLFS_HLFS_$$HL7RC^GMRAIAD1(X)
+3 SET $PIECE(OUTX,HLFS,11)="F"
SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAD1
+4 ;
+5 ; OBX6 - FDA Questions
OBX6 SET PTC=$GET(^GMR(120.85,KEY,"PTC1"))
if PTC=""
GOTO OBX8
+1 FOR I=1:1:5
Begin DoDot:1
+2 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS
+3 SET VAL="FDAQ"_I_HLCM_$PIECE($TEXT(FDAQ+I),";",3)
SET $PIECE(OUTX,HLFS,3)=VAL
+4 SET VAL=$PIECE(PTC,U,I+(I=5*8))
SET VAL=VAL_HLCM_$SELECT(VAL="y":"Yes",VAL="n":"No",1:"Unknown")_HLCM_"HL70136"
+5 SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)="F"
SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAD1
End DoDot:1
+6 ;
+7 ; OBX7 - P & T Questions
OBX7 FOR I=1:1:3
Begin DoDot:1
+1 SET S=S+1
SET OUTX=1_HLFS_"CE"_HLFS
SET Y=$$HL7RC^GMRAIAD1("P&T")_" ACTION "
+2 SET Y=Y_$PIECE("FDA^MFR^RCPM",U,I)_" REPORT"
SET VAL="PTQ"_I_HLCM_Y
SET $PIECE(OUTX,HLFS,3)=VAL
+3 SET VAL=$PIECE(X,U,I+8)
SET VAL=VAL_HLCM_$SELECT(VAL="y":"Yes",VAL="n":"No",1:"Unknown")_HLCM_"HL70136"
+4 SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)="F"
SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAD1
End DoDot:1
+5 ;
+6 ; OBX8 - P & T Addendum
OBX8 SET PTC=$ORDER(^GMR(120.85,KEY,"PTC2",0))
if PTC=""
GOTO OBX9
SET IEN=0
+1 SET VAL=$$TS^VDEFEL(^GMR(120.85,KEY,"PTC2",1,0))
+2 FOR
SET IEN=$ORDER(^GMR(120.85,KEY,"PTC2",1,1,IEN))
if IEN=""
QUIT
Begin DoDot:1
+3 SET S=S+1
SET OUTX=1_HLFS_"TX"_HLFS_$$HL7RC^GMRAIAD1("P&T Addendum")
+4 SET $PIECE(OUTX,HLFS,5)=$$HL7RC^GMRAIAD1(^GMR(120.85,KEY,"PTC2",1,1,IEN,0))
+5 SET $PIECE(OUTX,HLFS,11)="F"
SET $PIECE(OUTX,HLFS,14)=VAL
+6 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAD1
End DoDot:1
+7 ;
+8 ; OBX9 - Notification Dates
OBX9 SET VAL=$PIECE(^GMR(120.85,KEY,0),U,12)
IF VAL'=""
Begin DoDot:1
+1 ;
+2 ; Date MD notified
+3 SET VAL=$$TS^VDEFEL(VAL)
SET S=S+1
SET OUTX=1_HLFS_"DT"_HLFS_"DATE MD NOTIFIED"
+4 SET $PIECE(OUTX,5,HLFS)=VAL
SET $PIECE(OUTX,11,HLFS)="F"
+5 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAD1
End DoDot:1
+6 ;
+7 ; Dates reported to FDA, MFR, RCPM, VAERS
+8 SET PTC=$GET(^GMR(120.85,KEY,"PTC1"))
if PTC=""
GOTO RETURN
+9 FOR I=1:1:5
SET VAL=$PIECE(PTC,U,I+4)
IF VAL'=""
Begin DoDot:1
+10 SET VAL=$$TS^VDEFEL(VAL)
SET S=S+1
SET OUTX=1_HLFS_"DT"_HLFS_$PIECE($TEXT(RPTXT+I),";",3)
+11 SET $PIECE(OUTX,HLFS,5)=VAL
SET $PIECE(OUTX,HLFS,11)="F"
+12 SET OUTX="OBX"_HLFS_OUTX
DO SAVE^GMRAIAD1
End DoDot:1
+13 ;
+14 ; Return to GMRAIAD1
RETURN QUIT
+1 ;
QSTNS ; Question 1-10 Set
+1 ;;Patient died from reaction?
+2 ;;Patient treated with RX drug?
+3 ;;Life threatening illness?
+4 ;;Required ER/MD visit?
+5 ;;Required hospitalization?
+6 ;;Prolonged hospitalization?
+7 ;;Resulted in permanent disability?
+8 ;;Patient recovered?
+9 ;;Is this event a congenital anomaly?
+10 ;;Did this event require intervention to prevent impairment or damage?
+11 ;
FDAQ ; FDA Questions
+1 ;;Serious ADR?
+2 ;;ADR related to new drug? (Marketed within last 2 yrs.)
+3 ;;Unexpected ADR?
+4 ;;ADR related to therapeutic failure?
+5 ;;Dose related?
+6 ;
RPTXT ; Dates Reported Texts
+1 ;;DATE REPORTED TO FDA
+2 ;;DATE OF PATIENT CONSENT TO MFR
+3 ;;DATE SENT TO MFR
+4 ;;DATE SENT TO RCPM
+5 ;;DATE SENT TO VAERS
