ORQQAL ;SLC/CLA,JFR - FUNCTIONS THAT RETURN PATIENT ADVERSE REACTION DATA ;Oct 14, 2020@10:37:30
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,162,190,216,232,243,269,377,539**;Dec 17, 1997;Build 41
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,GMRARXN,GMRA
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."
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
DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION:
D EN2^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
I $D(GMRACT("H")) D HIST
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
HIST ;Historical Severity and dates
N Y
S Y=$P(GMRACT("H"),U) D DD^%DT
S ORAY(I)=" Hist date/severity: "_$S(Y="":"",1:Y_" ")_$P(GMRACT("H"),U,2),I=I+1
S ORAY(I)=" ",I=I+1
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQAL 4279 printed Apr 09, 2024@21:44:43 Page 2
ORQQAL ;SLC/CLA,JFR - FUNCTIONS THAT RETURN PATIENT ADVERSE REACTION DATA ;Oct 14, 2020@10:37:30
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,162,190,216,232,243,269,377,539**;Dec 17, 1997;Build 41
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,GMRARXN,GMRA
+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 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
DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION:
+1 DO EN2^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 IF $DATA(GMRACT("H"))
DO HIST
+12 ;216
SET ORAY(I)=" Verified: "_$SELECT($PIECE(GMRACT,U,4)="VERIFIED":$PIECE(GMRACT,U,8),1:"No")
SET I=I+1
+13 SET ORAY(I)="Observed/Historical: "_$SELECT($PIECE(GMRACT,U,5)="OBSERVED":"Observed",$PIECE(GMRACT,U,5)="HISTORICAL":"Historical",1:"")
SET I=I+1
+14 IF $DATA(GMRACT("C",1))
DO COM
+15 KILL GMRACT
+16 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
HIST ;Historical Severity and dates
+1 NEW Y
+2 SET Y=$PIECE(GMRACT("H"),U)
DO DD^%DT
+3 SET ORAY(I)=" Hist date/severity: "_$SELECT(Y="":"",1:Y_" ")_$PIECE(GMRACT("H"),U,2)
SET I=I+1
+4 SET ORAY(I)=" "
SET I=I+1
+5 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
