ORQQAL ; slc/CLA,JFR - Functions which return patient allergy data ;28-Jan-2016 08:49;DU
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,162,190,1007,216,232,243,1010,1011,1015**;Dec 17, 1997;Build 29
;Modified - IHS/MSC/MGH Modified to remove inactive allergies
; IHS/MSC/MGH - 04/06/2012 - Patch 10 added data for reactions
; IHS/MSC/MGH - 12/21/2012 - Patch 12 for compound medications
LIST(ORAY,ORPT) ; RETURN PATIENT'S ALLERGY/ADVERSE REACTION INFO:
; null:no allergy assessment, 0:no known allergies, 1:pt has allergies
; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien
N I,J,K
S I=1,J=0,K=0
D EN1^GMRAOR1(ORPT,"GMRARXN")
I $G(GMRARXN)="" S ORAY(I)="^No Allergy Assessment"
I $G(GMRARXN)=0 S ORAY(I)="^No Known Allergies"
I $G(GMRARXN)=1 F S J=$O(GMRARXN(J)) Q:J="" S ORAY(I)=$P(GMRARXN(J),"^",3)_"^"_$P(GMRARXN(J),"^")_"^"_$P(GMRARXN(J),"^",2) D SIGNS S I=I+1
S:'$D(ORAY(1)) ORAY(1)="^No allergies found."
K GMRARXN
Q
SIGNS S K=0,N=0 F S K=$O(GMRARXN(J,"S",K)) Q:K'>0 D
.I N=0 S ORAY(I)=ORAY(I)_"^"_$P(GMRARXN(J,"S",K),";")
.E S ORAY(I)=ORAY(I)_";"_$P(GMRARXN(J,"S",K),";")
.S N=N+1
Q
LRPT(ORAY,ORPT) ; RETURN PT'S ALLERGY/ADVERSE REACTION INFO IN REPORT FORMAT:
; null:no allergy assessment, 0:no known allergies, 1:pt has allergies
; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien
N I,J,K,SEVER,CR,GMRAIDT ;216
S CR=$CHAR(13)
S I=1,J=0,K=0,SEVER="",GMRAIDT=1 ;216
D EN1^GMRAOR1(ORPT,"GMRARXN")
I $G(GMRARXN)="" S ORAY(I)="No Allergy Assessment"
I $G(GMRARXN)=0 S ORAY(I)="No Known Allergies"
I $G(GMRARXN)=1 F S J=$O(GMRARXN(J)) Q:J="" D
.S SEVER=$P(GMRARXN(J),U,2)
.S ORAY(I)=$P(GMRARXN(J),U)_" "_$S($L($G(SEVER)):"[Severity: "_SEVER_"]",1:""),I=I+1
.S K=0,N=0 F S K=$O(GMRARXN(J,"S",K)) Q:K'>0 D
..I N=0 S ORAY(I)=" Signs/symptoms: "_$P(GMRARXN(J,"S",K),";")
..E S ORAY(I)=" "_$P(GMRARXN(J,"S",K),";")
..I $P(GMRARXN(J,"S",K),";",2) S ORAY(I)=ORAY(I)_" ("_$$FMTE^XLFDT($P(GMRARXN(J,"S",K),";",2),2)_")" ;216
..S N=N+1,I=I+1
.S ORAY(I)=" ",I=I+1
S:'$D(ORAY(1)) ORAY(1)="No allergies found."
K GMRARXN
Q
RXN(ORAY,ORPT,SRC,NDF,PSDRUG) ; RETURN TRUE OR FALSE IF PATIENT IS ALLERGIC TO AGENT
; SRC: ALLERGEN SOURCE (CM=CONTRAST MEDIA, DR=DRUG)
; NDF: IF SRC=DR, NDF=Nat'l Drug File ien ELSE NDF=""
; PSDRUG:IF SRC=DR, PSDRUG=(local) Drug file ien ELSE PSDRUG=""
N CMP,CMPDR,SAVE,TEMP,TEMP2,CDRG,CNT,NDF2
I +PSDRUG D
.S SAVE=0,TEMP2=""
.;IHS/MSC/MGH Mod for compound meds patch 1011
.S CMP=$P($G(^PSDRUG(PSDRUG,999999935)),U,1)
.I CMP=1 D
..S CMPDR=0
..F S CMPDR=$O(^PSDRUG(PSDRUG,999999936,CMPDR)) Q:'+CMPDR D
...S CDRG=$P($G(^PSDRUG(PSDRUG,999999936,CMPDR,0)),U,1)
...S NDF2=$$GET1^DIQ(50,CDRG,20,"I")_"."_$$GET1^DIQ(50,CDRG,22,"I")
...S ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF2,"",1)
...I ORAY=1 S SAVE=1
...D SETARRY
...I $P(ORAY,U,2)'="" S TEMP($P(ORAY,U,2))=""
...K ORAY
..;end MOD for compound meds
.S (X,TEMP2)="",CNT=0
.F S X=$O(TEMP(X)) Q:X="" D
..S CNT=CNT+1
..S TEMP2=TEMP2_" "_CNT_") "_X
.S ORAY=SAVE_U_TEMP2
;IHS/MSC/MGH Removed requirement for a NDF match
;I +NDF D
S ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF,"",1)
D SETARRY
Q
SETARRY ; Get the data
I SRC="DR",ORAY=1 D ;drug ingredient allergy found
.S I=1,J=0 F S J=$O(GMRAING(J)) Q:J="" D
..I I=1 S ORAY=ORAY_U_GMRAING(J)
..E S ORAY=ORAY_";"_GMRAING(J)
..S I=I+1
.N K
.;IHS/MSC/MGH added reaction data patch 1010
.I $D(GMRAREAC) D
..S K=0 F S K=$O(GMRAREAC(K)) Q:K="" D
...I K=1 S ORAY=ORAY_" Reac: "_GMRAREAC(K)
...E S ORAY=ORAY_";"_GMRAREAC(K)
.;END MOD
I SRC="DR",ORAY=2 D ;drug class allergy found
.S CL="",I=1,J=0 F S J=$O(GMRADRCL(J)) Q:J="" D
..; per test sites 3/17/04 - no oc for pt allergy to entire HERBS class:
..Q:$P(GMRADRCL(J),U)="HA000"
..I I=1 S ORAY=ORAY_U_$P(GMRADRCL(J),U,2)
..E S CL=$P(GMRADRCL(J),U,2) I ORAY'[CL S ORAY=ORAY_";"_CL
..;IHS/MSC/MGH added reaction data patch 1010
..I $D(GMRAREAC) D
...S K=0 F S K=$O(GMRAREAC(K)) Q:K="" D
....I K=1 S ORAY=ORAY_" Reac: "_GMRAREAC(K)
....E S ORAY=ORAY_";"_GMRAREAC(K)
..;END MOD
..S I=I+1
I SRC="DR",(+$G(ORAY)<1) D MEDCLASS(.ORAY,ORPT,PSDRUG)
K I,J,GMRADRCL,GMRAING,CL,GMRAREAC
Q
MEDCLASS(ORAY,DFN,PSDRUG) ;check for allergens with medications in same VA drug class
N ORVACLS,CL,X,I,RET,TYP
S TYP="DR"
Q:+$G(PSDRUG)<1
;S ORVACLS=$P(^PSDRUG(PSDRUG,0),U,2)
S ORVACLS=$$CLASS50^ORPEAPI(PSDRUG)
Q:$L(ORVACLS)<4
Q:$G(ORVACLS)="HA000" ;don't process herbal drug class for order checks
S CL=$S($E(ORVACLS,1,4)="CN10":5,1:4) ;look at 5 chars if ANALGESICS
D GETDATA^GMRAOR(DFN)
Q:'$D(^TMP("GMRAOC",$J,"APC"))
S I="" F S I=$O(^TMP("GMRAOC",$J,"APC",I)) Q:'$L(I) D
.I $E(I,1,CL)=$E(ORVACLS,1,CL) S X=I
I $L($G(X)) D
.N IEN,NAME
.D IEN^PSN50P65(,X,"ORQQAL")
.S IEN=$O(^TMP($J,"ORQQAL","B",X,0))
.I 'IEN S ORAY="2"_U_X Q
.S NAME=$G(^TMP($J,"ORQQAL",IEN,1))
.I '$L(NAME) S ORAY="2"_U_X Q
.S ORAY="2"_U_NAME_": ("_$G(^TMP("GMRAOC",$J,"APC",X))_")"
.N K S K=0 S K=$O(^TMP("GMRAOC",$J,"APC",X,"REAC",K)) Q:'+K D
..I K=1 S ORAY=ORAY_"Reac: "_$G(^TMP("GMRAOC",$J,"APC",X,"REAC",K))
..E S ORAY=ORAY_";"_$G(^TMP("GMRAOC",$J,"APC",X,"REAC",K))
K ^TMP("GMRAOC",$J)
Q
DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION:
D EN1^GMRAOR2(ALLR,"GMRACT")
N CR,OX,OH S CR=$CHAR(13),I=1
S ORAY(I)=" Causative agent: "_$P(GMRACT,U),I=I+1
S ORAY(I)=" Nature of Reaction: "_$S($P(GMRACT,U,6)="ALLERGY":"Allergy",$P(GMRACT,U,6)="PHARMACOLOGIC":"Adverse Reaction",$P(GMRACT,U,6)="UNKNOWN":"Unknown",1:""),I=I+1 ;216
S ORAY(I)=" ",I=I+1
I $D(GMRACT("S",1)) D SYMP
I $D(GMRACT("V",1)) D CLAS
S ORAY(I)=" Originator: "_$P(GMRACT,U,2)_$S($L($P(GMRACT,U,3)):" ("_$P(GMRACT,U,3)_")",1:""),I=I+1 ;216
S ORAY(I)=" Originated: "_$P(GMRACT,U,10),I=I+1 ;216
I $D(GMRACT("O",1)) D OBS
S ORAY(I)=" Verified: "_$S($P(GMRACT,U,4)="VERIFIED":$P(GMRACT,U,8),1:"No"),I=I+1 ;216
S ORAY(I)="Observed/Historical: "_$S($P(GMRACT,U,5)="OBSERVED":"Observed",$P(GMRACT,U,5)="HISTORICAL":"Historical",1:""),I=I+1
I $D(GMRACT("C",1)) D COM
K GMRACT
Q
SYMP S K=0,N=0 F S K=$O(GMRACT("S",K)) Q:K'>0 D
.I N=0 S ORAY(I)=" Signs/symptoms: "_GMRACT("S",K),I=I+1
.E S ORAY(I)=" "_GMRACT("S",K),I=I+1
.S N=N+1
S ORAY(I)=" ",I=I+1
K N,K
Q
CLAS S K=0,N=0 F S K=$O(GMRACT("V",K)) Q:K'>0 D
.I N=0 S ORAY(I)=" Drug Classes: "_$P(GMRACT("V",K),U,2),I=I+1
.E S ORAY(I)=" "_$P(GMRACT("V",K),U,2),I=I+1
.S N=N+1
S ORAY(I)=" ",I=I+1
K N,K
Q
OBS S K=0,N=0 F S K=$O(GMRACT("O",K)) Q:K'>0 D
.I N=0 D
..S Y=$P(GMRACT("O",K),U) D DD^%DT
..S ORAY(I)=" Obs dates/severity: "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1
.E D
..S Y=$P(GMRACT("O",K),U) D DD^%DT
..S ORAY(I)=" "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1
.S N=N+1
S ORAY(I)=" ",I=I+1
K N,K,Y
Q
COM S K=0,N=0,ORAY(I)=" ",I=I+1
F S K=$O(GMRACT("C",K)) Q:K'>0 D
.I N=0 S ORAY(I)="Comments:",I=I+1
.S Y=$P(GMRACT("C",K),U) D DD^%DT
.S ORAY(I)=" "_Y_" by "_$P(GMRACT("C",K),U,2),I=I+1
.I $D(GMRACT("C",K,1,0)) S L=0 F S L=$O(GMRACT("C",K,L)) Q:L'>0 D
..S ORAY(I)=GMRACT("C",K,L,0),I=I+1
.S N=N+1
S ORAY(I)=" ",I=I+1
K N,K,L,Y
Q
ORQQAL ; slc/CLA,JFR - Functions which return patient allergy data ;28-Jan-2016 08:49;DU
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,162,190,1007,216,232,243,1010,1011,1015**;Dec 17, 1997;Build 29
+2 ;Modified - IHS/MSC/MGH Modified to remove inactive allergies
+3 ; IHS/MSC/MGH - 04/06/2012 - Patch 10 added data for reactions
+4 ; IHS/MSC/MGH - 12/21/2012 - Patch 12 for compound medications
LIST(ORAY,ORPT) ; RETURN PATIENT'S ALLERGY/ADVERSE REACTION INFO:
+1 ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies
+2 ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien
+3 NEW I,J,K
+4 SET I=1
SET J=0
SET K=0
+5 DO EN1^GMRAOR1(ORPT,"GMRARXN")
+6 IF $GET(GMRARXN)=""
SET ORAY(I)="^No Allergy Assessment"
+7 IF $GET(GMRARXN)=0
SET ORAY(I)="^No Known Allergies"
+8 IF $GET(GMRARXN)=1
FOR
SET J=$ORDER(GMRARXN(J))
IF J=""
QUIT
SET ORAY(I)=$PIECE(GMRARXN(J),"^",3)_"^"_$PIECE(GMRARXN(J),"^")_"^"_$PIECE(GMRARXN(J),"^",2)
DO SIGNS
SET I=I+1
+9 IF '$DATA(ORAY(1))
SET ORAY(1)="^No allergies found."
+10 KILL GMRARXN
+11 QUIT
SIGNS SET K=0
SET N=0
FOR
SET K=$ORDER(GMRARXN(J,"S",K))
IF K'>0
QUIT
Begin DoDot:1
+1 IF N=0
SET ORAY(I)=ORAY(I)_"^"_$PIECE(GMRARXN(J,"S",K),";")
+2 IF '$TEST
SET ORAY(I)=ORAY(I)_";"_$PIECE(GMRARXN(J,"S",K),";")
+3 SET N=N+1
End DoDot:1
+4 QUIT
LRPT(ORAY,ORPT) ; RETURN PT'S ALLERGY/ADVERSE REACTION INFO IN REPORT FORMAT:
+1 ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies
+2 ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien
+3 ;216
NEW I,J,K,SEVER,CR,GMRAIDT
+4 SET CR=$CHAR(13)
+5 ;216
SET I=1
SET J=0
SET K=0
SET SEVER=""
SET GMRAIDT=1
+6 DO EN1^GMRAOR1(ORPT,"GMRARXN")
+7 IF $GET(GMRARXN)=""
SET ORAY(I)="No Allergy Assessment"
+8 IF $GET(GMRARXN)=0
SET ORAY(I)="No Known Allergies"
+9 IF $GET(GMRARXN)=1
FOR
SET J=$ORDER(GMRARXN(J))
IF J=""
QUIT
Begin DoDot:1
+10 SET SEVER=$PIECE(GMRARXN(J),U,2)
+11 SET ORAY(I)=$PIECE(GMRARXN(J),U)_" "_$SELECT($LENGTH($GET(SEVER)):"[Severity: "_SEVER_"]",1:"")
SET I=I+1
+12 SET K=0
SET N=0
FOR
SET K=$ORDER(GMRARXN(J,"S",K))
IF K'>0
QUIT
Begin DoDot:2
+13 IF N=0
SET ORAY(I)=" Signs/symptoms: "_$PIECE(GMRARXN(J,"S",K),";")
+14 IF '$TEST
SET ORAY(I)=" "_$PIECE(GMRARXN(J,"S",K),";")
+15 ;216
IF $PIECE(GMRARXN(J,"S",K),";",2)
SET ORAY(I)=ORAY(I)_" ("_$$FMTE^XLFDT($PIECE(GMRARXN(J,"S",K),";",2),2)_")"
+16 SET N=N+1
SET I=I+1
End DoDot:2
+17 SET ORAY(I)=" "
SET I=I+1
End DoDot:1
+18 IF '$DATA(ORAY(1))
SET ORAY(1)="No allergies found."
+19 KILL GMRARXN
+20 QUIT
RXN(ORAY,ORPT,SRC,NDF,PSDRUG) ; RETURN TRUE OR FALSE IF PATIENT IS ALLERGIC TO AGENT
+1 ; SRC: ALLERGEN SOURCE (CM=CONTRAST MEDIA, DR=DRUG)
+2 ; NDF: IF SRC=DR, NDF=Nat'l Drug File ien ELSE NDF=""
+3 ; PSDRUG:IF SRC=DR, PSDRUG=(local) Drug file ien ELSE PSDRUG=""
+4 NEW CMP,CMPDR,SAVE,TEMP,TEMP2,CDRG,CNT,NDF2
+5 IF +PSDRUG
Begin DoDot:1
+6 SET SAVE=0
SET TEMP2=""
+7 ;IHS/MSC/MGH Mod for compound meds patch 1011
+8 SET CMP=$PIECE($GET(^PSDRUG(PSDRUG,999999935)),U,1)
+9 IF CMP=1
Begin DoDot:2
+10 SET CMPDR=0
+11 FOR
SET CMPDR=$ORDER(^PSDRUG(PSDRUG,999999936,CMPDR))
IF '+CMPDR
QUIT
Begin DoDot:3
+12 SET CDRG=$PIECE($GET(^PSDRUG(PSDRUG,999999936,CMPDR,0)),U,1)
+13 SET NDF2=$$GET1^DIQ(50,CDRG,20,"I")_"."_$$GET1^DIQ(50,CDRG,22,"I")
+14 SET ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF2,"",1)
+15 IF ORAY=1
SET SAVE=1
+16 DO SETARRY
+17 IF $PIECE(ORAY,U,2)'=""
SET TEMP($PIECE(ORAY,U,2))=""
+18 KILL ORAY
End DoDot:3
+19 ;end MOD for compound meds
End DoDot:2
+20 SET (X,TEMP2)=""
SET CNT=0
+21 FOR
SET X=$ORDER(TEMP(X))
IF X=""
QUIT
Begin DoDot:2
+22 SET CNT=CNT+1
+23 SET TEMP2=TEMP2_" "_CNT_") "_X
End DoDot:2
+24 SET ORAY=SAVE_U_TEMP2
End DoDot:1
+25 ;IHS/MSC/MGH Removed requirement for a NDF match
+26 ;I +NDF D
+27 SET ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF,"",1)
+28 DO SETARRY
+29 QUIT
SETARRY ; Get the data
+1 ;drug ingredient allergy found
IF SRC="DR"
IF ORAY=1
Begin DoDot:1
+2 SET I=1
SET J=0
FOR
SET J=$ORDER(GMRAING(J))
IF J=""
QUIT
Begin DoDot:2
+3 IF I=1
SET ORAY=ORAY_U_GMRAING(J)
+4 IF '$TEST
SET ORAY=ORAY_";"_GMRAING(J)
+5 SET I=I+1
End DoDot:2
+6 NEW K
+7 ;IHS/MSC/MGH added reaction data patch 1010
+8 IF $DATA(GMRAREAC)
Begin DoDot:2
+9 SET K=0
FOR
SET K=$ORDER(GMRAREAC(K))
IF K=""
QUIT
Begin DoDot:3
+10 IF K=1
SET ORAY=ORAY_" Reac: "_GMRAREAC(K)
+11 IF '$TEST
SET ORAY=ORAY_";"_GMRAREAC(K)
End DoDot:3
End DoDot:2
+12 ;END MOD
End DoDot:1
+13 ;drug class allergy found
IF SRC="DR"
IF ORAY=2
Begin DoDot:1
+14 SET CL=""
SET I=1
SET J=0
FOR
SET J=$ORDER(GMRADRCL(J))
IF J=""
QUIT
Begin DoDot:2
+15 ; per test sites 3/17/04 - no oc for pt allergy to entire HERBS class:
+16 IF $PIECE(GMRADRCL(J),U)="HA000"
QUIT
+17 IF I=1
SET ORAY=ORAY_U_$PIECE(GMRADRCL(J),U,2)
+18 IF '$TEST
SET CL=$PIECE(GMRADRCL(J),U,2)
IF ORAY'[CL
SET ORAY=ORAY_";"_CL
+19 ;IHS/MSC/MGH added reaction data patch 1010
+20 IF $DATA(GMRAREAC)
Begin DoDot:3
+21 SET K=0
FOR
SET K=$ORDER(GMRAREAC(K))
IF K=""
QUIT
Begin DoDot:4
+22 IF K=1
SET ORAY=ORAY_" Reac: "_GMRAREAC(K)
+23 IF '$TEST
SET ORAY=ORAY_";"_GMRAREAC(K)
End DoDot:4
End DoDot:3
+24 ;END MOD
+25 SET I=I+1
End DoDot:2
End DoDot:1
+26 IF SRC="DR"
IF (+$GET(ORAY)<1)
DO MEDCLASS(.ORAY,ORPT,PSDRUG)
+27 KILL I,J,GMRADRCL,GMRAING,CL,GMRAREAC
+28 QUIT
MEDCLASS(ORAY,DFN,PSDRUG) ;check for allergens with medications in same VA drug class
+1 NEW ORVACLS,CL,X,I,RET,TYP
+2 SET TYP="DR"
+3 IF +$GET(PSDRUG)<1
QUIT
+4 ;S ORVACLS=$P(^PSDRUG(PSDRUG,0),U,2)
+5 SET ORVACLS=$$CLASS50^ORPEAPI(PSDRUG)
+6 IF $LENGTH(ORVACLS)<4
QUIT
+7 ;don't process herbal drug class for order checks
IF $GET(ORVACLS)="HA000"
QUIT
+8 ;look at 5 chars if ANALGESICS
SET CL=$SELECT($EXTRACT(ORVACLS,1,4)="CN10":5,1:4)
+9 DO GETDATA^GMRAOR(DFN)
+10 IF '$DATA(^TMP("GMRAOC",$JOB,"APC"))
QUIT
+11 SET I=""
FOR
SET I=$ORDER(^TMP("GMRAOC",$JOB,"APC",I))
IF '$LENGTH(I)
QUIT
Begin DoDot:1
+12 IF $EXTRACT(I,1,CL)=$EXTRACT(ORVACLS,1,CL)
SET X=I
End DoDot:1
+13 IF $LENGTH($GET(X))
Begin DoDot:1
+14 NEW IEN,NAME
+15 DO IEN^PSN50P65(,X,"ORQQAL")
+16 SET IEN=$ORDER(^TMP($JOB,"ORQQAL","B",X,0))
+17 IF 'IEN
SET ORAY="2"_U_X
QUIT
+18 SET NAME=$GET(^TMP($JOB,"ORQQAL",IEN,1))
+19 IF '$LENGTH(NAME)
SET ORAY="2"_U_X
QUIT
+20 SET ORAY="2"_U_NAME_": ("_$GET(^TMP("GMRAOC",$JOB,"APC",X))_")"
+21 NEW K
SET K=0
SET K=$ORDER(^TMP("GMRAOC",$JOB,"APC",X,"REAC",K))
IF '+K
QUIT
Begin DoDot:2
+22 IF K=1
SET ORAY=ORAY_"Reac: "_$GET(^TMP("GMRAOC",$JOB,"APC",X,"REAC",K))
+23 IF '$TEST
SET ORAY=ORAY_";"_$GET(^TMP("GMRAOC",$JOB,"APC",X,"REAC",K))
End DoDot:2
End DoDot:1
+24 KILL ^TMP("GMRAOC",$JOB)
+25 QUIT
DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION:
+1 DO EN1^GMRAOR2(ALLR,"GMRACT")
+2 NEW CR,OX,OH
SET CR=$CHAR(13)
SET I=1
+3 SET ORAY(I)=" Causative agent: "_$PIECE(GMRACT,U)
SET I=I+1
+4 ;216
SET ORAY(I)=" Nature of Reaction: "_$SELECT($PIECE(GMRACT,U,6)="ALLERGY":"Allergy",$PIECE(GMRACT,U,6)="PHARMACOLOGIC":"Adverse Reaction",$PIECE(GMRACT,U,6)="UNKNOWN":"Unknown",1:"")
SET I=I+1
+5 SET ORAY(I)=" "
SET I=I+1
+6 IF $DATA(GMRACT("S",1))
DO SYMP
+7 IF $DATA(GMRACT("V",1))
DO CLAS
+8 ;216
SET ORAY(I)=" Originator: "_$PIECE(GMRACT,U,2)_$SELECT($LENGTH($PIECE(GMRACT,U,3)):" ("_$PIECE(GMRACT,U,3)_")",1:"")
SET I=I+1
+9 ;216
SET ORAY(I)=" Originated: "_$PIECE(GMRACT,U,10)
SET I=I+1
+10 IF $DATA(GMRACT("O",1))
DO OBS
+11 ;216
SET ORAY(I)=" Verified: "_$SELECT($PIECE(GMRACT,U,4)="VERIFIED":$PIECE(GMRACT,U,8),1:"No")
SET I=I+1
+12 SET ORAY(I)="Observed/Historical: "_$SELECT($PIECE(GMRACT,U,5)="OBSERVED":"Observed",$PIECE(GMRACT,U,5)="HISTORICAL":"Historical",1:"")
SET I=I+1
+13 IF $DATA(GMRACT("C",1))
DO COM
+14 KILL GMRACT
+15 QUIT
SYMP SET K=0
SET N=0
FOR
SET K=$ORDER(GMRACT("S",K))
IF K'>0
QUIT
Begin DoDot:1
+1 IF N=0
SET ORAY(I)=" Signs/symptoms: "_GMRACT("S",K)
SET I=I+1
+2 IF '$TEST
SET ORAY(I)=" "_GMRACT("S",K)
SET I=I+1
+3 SET N=N+1
End DoDot:1
+4 SET ORAY(I)=" "
SET I=I+1
+5 KILL N,K
+6 QUIT
CLAS SET K=0
SET N=0
FOR
SET K=$ORDER(GMRACT("V",K))
IF K'>0
QUIT
Begin DoDot:1
+1 IF N=0
SET ORAY(I)=" Drug Classes: "_$PIECE(GMRACT("V",K),U,2)
SET I=I+1
+2 IF '$TEST
SET ORAY(I)=" "_$PIECE(GMRACT("V",K),U,2)
SET I=I+1
+3 SET N=N+1
End DoDot:1
+4 SET ORAY(I)=" "
SET I=I+1
+5 KILL N,K
+6 QUIT
OBS SET K=0
SET N=0
FOR
SET K=$ORDER(GMRACT("O",K))
IF K'>0
QUIT
Begin DoDot:1
+1 IF N=0
Begin DoDot:2
+2 SET Y=$PIECE(GMRACT("O",K),U)
DO DD^%DT
+3 SET ORAY(I)=" Obs dates/severity: "_Y_" "_$PIECE(GMRACT("O",K),U,2)
SET I=I+1
End DoDot:2
+4 IF '$TEST
Begin DoDot:2
+5 SET Y=$PIECE(GMRACT("O",K),U)
DO DD^%DT
+6 SET ORAY(I)=" "_Y_" "_$PIECE(GMRACT("O",K),U,2)
SET I=I+1
End DoDot:2
+7 SET N=N+1
End DoDot:1
+8 SET ORAY(I)=" "
SET I=I+1
+9 KILL N,K,Y
+10 QUIT
COM SET K=0
SET N=0
SET ORAY(I)=" "
SET I=I+1
+1 FOR
SET K=$ORDER(GMRACT("C",K))
IF K'>0
QUIT
Begin DoDot:1
+2 IF N=0
SET ORAY(I)="Comments:"
SET I=I+1
+3 SET Y=$PIECE(GMRACT("C",K),U)
DO DD^%DT
+4 SET ORAY(I)=" "_Y_" by "_$PIECE(GMRACT("C",K),U,2)
SET I=I+1
+5 IF $DATA(GMRACT("C",K,1,0))
SET L=0
FOR
SET L=$ORDER(GMRACT("C",K,L))
IF L'>0
QUIT
Begin DoDot:2
+6 SET ORAY(I)=GMRACT("C",K,L,0)
SET I=I+1
End DoDot:2
+7 SET N=N+1
End DoDot:1
+8 SET ORAY(I)=" "
SET I=I+1
+9 KILL N,K,L,Y
+10 QUIT
