Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BEHOART

BEHOART.m

Go to the documentation of this file. 
  1. BEHOART ;MSC/IND/DKM - ART Package Interface ;18-Sep-2014 13:46;DU
  1.  ;;1.1;BEH COMPONENTS;**045003,045004,045005,045007,045008**;Sep 18, 2007;Build 1
  1.  ;=================================================================
  1.  ; RPC: Lock entry for edit
  1. LOCK(DATA,IEN) ;
  1.  D:IEN LOCK^CIANBRPC(.DATA,$NA(^GMR(120.8,IEN)),0)
  1.  Q
  1.  ; RPC: Unlock entry
  1. UNLOCK(DATA,IEN) ;
  1.  D:IEN LOCK^CIANBRPC(.DATA,$NA(^GMR(120.8,IEN)))
  1.  Q
  1.  ; RPC: Check for duplicate
  1. DUPCHK(DATA,DFN,AGT) ;
  1.  S DATA=$$DUPCHK^GMRAOR0(DFN,AGT)>0
  1.  Q
  1.  ; RPC: Sign/verify adverse reaction
  1. SIGN(DATA,IEN,VER) ;
  1.  N FDA,ER,ERR,DFN,AGT,N0
  1.  I IEN<0 D  Q
  1.  .S DFN=-IEN
  1.  .D FIREEVT(DFN,3,"")
  1.  .S DATA=$$HASNKA(DFN)
  1.  S N0=$G(^GMR(120.8,IEN,0)),ER=+$G(^("ER")),DFN=+N0,AGT=$P(N0,U,2),DATA="",FDA=$NA(FDA(120.8,IEN_","))
  1.  I '$L(N0) S DATA="-1^An unsigned entry for "_AGT_" no longer exists" Q
  1.  I ER=1 S DATA="-2^Entry "_AGT_" has been marked as entered in error and cannot be signed" Q
  1.  I ER=2,$$DUPCHK^GMRAOR0(DFN,AGT)>0 D  Q
  1.  .D DEL(.DATA,IEN)
  1.  .S:'DATA DATA="-3^A signed entry for "_AGT_" already exists - your entry will be deleted"
  1.  I $$CANSIGN(IEN) D
  1.  .S @FDA@(15)=1
  1.  .S @FDA@(19)=+$P(N0,U,16)
  1.  .S:ER @FDA@(22)="@"
  1.  I $$CANVERIF(IEN,.VER) D
  1.  .S @FDA@(19)=1
  1.  .S @FDA@(20)=$$NOW^XLFDT
  1.  .S @FDA@(21)=DUZ
  1.  .S:ER @FDA@(22)="@"
  1.  I $D(FDA)<10 S DATA="-3^You may not sign the "_AGT_" entry" Q
  1.  D UPDATE^DIE(,"FDA",,"ERR")
  1.  I $G(ERR("DIERR",1)) S DATA=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1) Q
  1.  K ^GMR(120.8,IEN,"ER")  ; Remove entered in error node
  1.  D FIREEVT(DFN,3,IEN)
  1.  ;D:'$P(^GMR(120.8,IEN,0),U,16) SENDBULL(IEN)
  1.  Q
  1.  ; RPC: Return list of entries to be signed/verified
  1. SIGNLIST(DATA,DFN,VER) ;
  1.  N FLG,IEN,PFX,X,Y
  1.  S (FLG,IEN)=0,VER=$G(VER)
  1.  F  S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:'IEN  D
  1.  .S X=$G(^GMR(120.8,IEN,0)),Y=+$G(^("ER"))
  1.  .Q:+X'=DFN
  1.  .Q:Y=1
  1.  .S FLG=1
  1.  .I $$CANSIGN(IEN) S PFX=""
  1.  .E  I '$P(X,U,12)!'$$CANVERIF(IEN,VER) Q
  1.  .E  S PFX="Verify "
  1.  .S DATA(IEN)=IEN_U_PFX_"Adverse Reaction to "_$P(X,U,2)
  1.  I 'FLG D
  1.  .S X=$G(^GMR(120.86,DFN,0))
  1.  .Q:$P(X,U,3)'=DUZ
  1.  .Q:$P(X,U,4)
  1.  .S DATA(0)=-DFN_U_"No Known Allergies"
  1.  Q
  1.  ; RPC: Load specified ART entry for editing
  1. LOAD(DATA,IEN,NOLCK) ;
  1.  N X,X0,LP,LP2,IN,IIEN,X1,IENS,DC,ZZ,Z1
  1.  K DATA
  1.  I IEN<0 D  Q
  1.  .S DATA(0)=0_U_$$HASNKA(-IEN)
  1.  I IEN>0 D  Q:$D(DATA(-1))
  1.  .I '$D(^GMR(120.8,IEN,0)) S DATA(-1)="-1^This entry no longer exists." Q
  1.  .Q:$G(NOLCK)
  1.  .D LOCK(.X,IEN)
  1.  .S:'X DATA(-1)="-1^Another user is editing this entry."
  1.  S X0=$G(^GMR(120.8,IEN,0))
  1.  S DATA(1)=1_U_$P(X0,U,16)
  1.  S DC=0,ZZ="" S DC=$O(^GMR(120.8,IEN,3,DC))
  1.  I +DC D
  1.  .S Z1=$P($G(^GMR(120.8,IEN,3,DC,0)),U,1)
  1.  .S ZZ=$P($G(^PS(50.605,+Z1,0)),U,1)
  1.  S X=$P(X0,U,3),DATA(2)=2_U_+X_U_$P(X0,U,2)_U_$P(X,";",2)_U_ZZ
  1.  S DATA(3)=3_U_$P(X0,U,20)
  1.  S DATA(10)=10_U_$P(X0,U,14)
  1.  S DATA(14)=14_U_$P(X0,U,12)
  1.  S X=$O(^GMR(120.85,"C",IEN,0))
  1.  I X D
  1.  .S X0=^GMR(120.85,X,0)
  1.  .S DATA(4)=4_U_1
  1.  .S DATA(5)=5_U_$P(X0,U,13)_U_$$GET1^DIQ(200,$P(X0,U,13),.01)
  1.  .S DATA(6)=6_U_+X0
  1.  .S DATA(7)=7_U_$P(X0,U,14)
  1.  I $P($G(^GMR(120.8,IEN,9999999.11)),U,1)'="" D
  1.  .S DATA(11)=11_U_$P($G(^GMR(120.8,IEN,9999999.11)),U,1)
  1.  .S DATA(11)=DATA(11)_U_$P($G(^BEHOAR(90460.05,$P(DATA(11),U,2),0)),U,1)
  1.  I $P($G(^GMR(120.8,IEN,9999999.11)),U,2)'="" D
  1.  .S DATA(13)=13_U_$P($G(^GMR(120.8,IEN,9999999.11)),U,2)
  1.  .S DATA(13)=DATA(13)_U_$P($G(^BEHOAR(90460.06,$P(DATA(13),U,2),0)),U,1)
  1.  S LP=0
  1.  F  S LP=$O(^GMR(120.8,IEN,10,LP)) Q:'LP  S X=+^(LP,0) D
  1.  .S IENS=LP_","_IEN
  1.  .S DATA(8,LP)=8_U_X_U_$$GET1^DIQ(120.83,X,.01)_U_$P($G(^GMR(120.8,IEN,10,LP,0)),U,4)_U_$$GET1^DIQ(120.81,IENS,3)_U_$P($G(^GMR(120.8,IEN,10,LP,9999999.11)),U,1)_U_$$GET1^DIQ(120.81,IENS,9999999.11)
  1.  ;IHS/MSC/MGH Check for inactive data
  1.  S IN=9999999 S IN=$O(^GMR(120.8,IEN,9999999.12,IN),-1) Q:IN=""  D
  1.  .S X1=$G(^GMR(120.8,IEN,9999999.12,IN,0))
  1.  .S DATA(12)=12_U_$P(X1,U,1)_U_$P(X1,U,2)_U_$P(X1,U,3)_U_$P(X1,U,4)_U_$P(X1,U,5)
  1.  S LP=$$GETCMNT(IEN),LP2=0
  1.  F  S LP2=$O(^GMR(120.8,IEN,26,LP,2,LP2)) Q:'LP2  S DATA(9,LP2)=9_U_^(LP2,0)
  1.  Q
  1.  ; RPC: Delete ART entry
  1. DEL(DATA,IEN) ;
  1.  N GMR0,DIK,DA
  1.  S GMR0=$G(^GMR(120.8,IEN,0)),DATA=""
  1.  I '$L(GMR0) S DATA="-1^Entry not found" Q
  1.  I $P(GMR0,U,16) S DATA="-1^Cannot delete a verified entry" Q
  1.  I $P(GMR0,U,12) S DATA="-1^Cannot delete a signed entry" Q
  1.  S DIK=$$ROOT^DILFD(120.8),DA=IEN
  1.  D ^DIK
  1.  D FIREEVT(+GMR0,2,IEN)
  1.  Q
  1.  ; RPC: Save ART entry
  1. SAVE(DATA,IEN,DFN,VAL,ACTION) ;
  1.  N FDA,FDA2,TAG,FLD,ERR,RIEN,NEW,AGNT,NOW,NKA,MIEN,SIG,CANVER
  1.  S NOW=$$NOW^XLFDT
  1.  S ACTION=$G(ACTION)
  1.  S NKA=0
  1.  I ACTION="E" D EIE^BEHOARMU(.DATA,IEN,DFN,.VAL) Q
  1.  I ACTION="I" D INACT^BEHOARMU(.DATA,IEN,DFN,.VAL) Q
  1.  I ACTION="R" D REACT^BEHOARMU(.DATA,IEN,DFN,.VAL) Q
  1.  I ACTION="A" D ASSESS^BEHOARMU(.DATA,IEN,DFN,.VAL) Q
  1.  I ACTION="U" D REASSESS^BEHOARMU(.DATA,IEN,DFN,.VAL) Q
  1.  S:$G(IEN) RIEN=$O(^GMR(120.85,"C",IEN,0))
  1.  S RIEN=$S($G(RIEN):RIEN_",",1:"+3,")
  1.  S NEW='$G(IEN),IEN=$S(NEW:"+1,",1:IEN_",")
  1.  S TAG=""
  1.  F  S TAG=$O(VAL(TAG)) Q:'$L(TAG)  D
  1.  .S VAL=VAL(TAG)
  1.  .D @TAG
  1.  ;I FDA(120.8,IEN,1)="" S DATA="-1^Free text entries can no longer be stored"
  1.  I $D(FDA(120.8)) D
  1.  .S:NEW FDA(120.8,IEN,.01)=DFN
  1.  .S:NEW FDA(120.8,IEN,4)=$$NOW^XLFDT
  1.  .S:NEW FDA(120.8,IEN,5)=DUZ
  1.  .S:NEW FDA(120.8,IEN,15)=0
  1.  .S:NEW FDA(120.8,IEN,22)=2
  1.  D UPDATE^DIE(,"FDA","IEN","ERR")
  1.  S DATA=$S(NKA:$G(IEN(2)),NEW:$G(IEN(1)),1:+IEN)
  1.  Q:'DATA
  1.  ;Add the last modified data patch 8
  1.  ;p11 - rearranged calls to prevent UPDSF from being called for NKA
  1.  I 'NKA D
  1.  .S MIEN="+1,"_DATA_","
  1.  .S FDA(120.899999914,MIEN,.01)=$$NOW^XLFDT
  1.  .S FDA(120.899999914,MIEN,.02)=DUZ
  1.  .D UPDATE^DIE(,"FDA","IEN","ERR")
  1.  .I $D(FDA2) D
  1.  ..S FDA2(120.85,RIEN,.02)=DFN
  1.  ..S FDA2(120.85,RIEN,.03)=DATA
  1.  .E  S:$E(RIEN)'="+" FDA2(120.85,RIEN,.01)="@"
  1.  .D:$D(FDA2) UPDATE^DIE(,"FDA2")
  1.  .D UPDSF(DATA,.AGNT)
  1.  .;Patch 13 add RxNorm and UNI codes if available
  1.  .D RXNORM^GMRAZRXU(DATA)
  1.  D CKIN^BEHOARMU(DFN)
  1.  D FIREEVT(DFN,'NEW,DATA)
  1.  Q:NKA
  1.  S CANVER=$$HASKEY^BEHOUSCX("GMRA-ALLERGY VERIFY")
  1.  ;D:$$CANSIGN(DATA) SNDALR(DATA,1)  ;EHR P10
  1.  D:$$CANSIGN(DATA) SIGN(.SIG,DATA,CANVER)  ;AUTOSIGN
  1.  Q
  1. GMRAAGNT N X
  1.  S AGNT=$$CODE(VAL)
  1.  I '$L(AGNT) D
  1.  .S AGNT=$P($P(VAL,U,3),",")
  1.  .I AGNT[$C(34) S AGNT=$P(AGNT,$C(34))
  1.  .S:$L(AGNT) AGNT=+VAL_";"_AGNT_","
  1.  S FDA(120.8,IEN,.02)=$P(VAL,U,2)
  1.  S FDA(120.8,IEN,1)=AGNT
  1.  Q
  1. GMRACMTS N CMNT
  1.  S CMNT=$S(NEW:0,1:$$GETCMNT(+IEN))
  1.  S:'CMNT CMNT="+4"
  1.  S CMNT=CMNT_","_IEN
  1.  S FDA(120.826,CMNT,.01)=NOW
  1.  S FDA(120.826,CMNT,1)=DUZ
  1.  S FDA(120.826,CMNT,2)=$NA(VAL(TAG))
  1.  Q
  1. GMRANATR S FDA(120.8,IEN,3.1)=$P(VAL,U)
  1.  Q
  1. GMRAMECH ; no longer used
  1.  Q
  1. GMRANKA N AIEN
  1.  S NKA=1
  1.  I $D(^GMR(120.86,DFN,0)) S AIEN=DFN_","
  1.  E  S AIEN="+2,",FDA(120.86,AIEN,.01)=DFN
  1.  S IEN(2)=DFN
  1.  S FDA(120.86,AIEN,1)=0
  1.  S FDA(120.86,AIEN,2)=DUZ
  1.  S FDA(120.86,AIEN,3)=NOW
  1.  S FDA(120.86,AIEN,9999999.01)=160244002
  1.  Q
  1. GMRAOBHX S FDA(120.8,IEN,6)=$S(VAL:"o",1:"h")
  1.  Q
  1.  ;Source of information added MSC/IHS/MGH
  1. GMRASRC N SRC,GMRASRC
  1.  S GMRASRC=$G(VAL("GMRASRC"))
  1.  I '$P(GMRASRC,U) S SRC=$O(^BEHOAR(90460.05,"B",$P(GMRASRC,U,2),"")) Q:SRC=""  D
  1.  .S FDA(120.8,IEN,9999999.11)=SRC
  1.  E  S FDA(120.8,IEN,9999999.11)=+GMRASRC
  1.  Q
  1. GMRASNO ;Snomed event type added MSC/IHS/MGH
  1.  N SNOMED,SNO,MECH,SNOTXT
  1.  S SNOMED=$G(VAL("GMRASNO"))
  1.  I '$P(SNOMED,U) S SNO=$O(^BEHOAR(90460.06,"B",$P(SNOMED,U,2),"")) Q:SNO=""  D
  1.  .S FDA(120.8,IEN,9999999.13)=SNO,SNOMED=SNO
  1.  E  S FDA(120.8,IEN,9999999.13)=+SNOMED
  1.  S SNOTXT=$P($G(^BEHOAR(90460.06,+SNOMED,0)),U,1)
  1.  S MECH=$S(SNOTXT="DRUG ALLERGY":"A",SNOTXT="FOOD ALLERGY":"A",SNOTXT="DRUG INTOLERANCE":"P",1:"U")
  1.  S FDA(120.8,IEN,17)=MECH
  1.  Q
  1. GMRAOBSV S FDA2(120.85,RIEN,.5)=$P(VAL,U)
  1.  Q
  1. GMRARDAT S FDA2(120.85,RIEN,.01)=+VAL
  1.  Q
  1. GMRASEVR S FDA2(120.85,RIEN,14.5)=VAL
  1.  Q
  1. GMRASYMP N LP,IEN2,X,XCL,SRC,SRIEN,V
  1.  F LP=0:0 S LP=$O(VAL(TAG,LP)) Q:'LP  D
  1.  .S V=VAL(TAG,LP)
  1.  .S X=+V
  1.  .I 'NEW D  Q:IEN2
  1.  ..S IEN2=$O(^GMR(120.8,+IEN,10,"B",X,0))
  1.  ..S:IEN2 XCL(IEN2)=""
  1.  .S IEN2="+"_(LP+10)_","_IEN
  1.  .S FDA(120.81,IEN2,.01)=X
  1.  .S FDA(120.81,IEN2,2)=DUZ
  1.  .S FDA(120.81,IEN2,3)=$P(V,U,3)  ;Sign/Symptom date/time
  1.  .S SRC=$P(V,U,5)
  1.  .I +SRC>0 S FDA(120.81,IEN2,9999999.11)=SRC
  1.  .E  I SRC'="" D
  1.  ..S SRIEN=$O(^BEHOAR(90460.05,"B",SRC,"")) Q:SRIEN=""  D
  1.  ...S FDA(120.81,IEN2,9999999.11)=SRIEN
  1.  D DELSF(120.81,IEN,.XCL)
  1.  Q
  1. DELSF(SFN,IEN,XCL) ;
  1.  N DIK,DA,LP,GBL,IEN2
  1.  S IEN2=","_IEN,DIK=$$ROOT^DILFD(SFN,IEN2),GBL=$$ROOT^DILFD(SFN,IEN2,1),DA=0
  1.  F  S DA=$O(@GBL@(DA)),DA(1)=+IEN Q:'DA  D:'$D(XCL(DA)) ^DIK
  1.  Q
  1.  ; Check NKA/Update status
  1. HASNKA(DFN,CREATE) ;
  1.  N LP,AL,FDA,IEN
  1.  S (AL,LP)=0
  1.  F  S LP=$O(^GMR(120.8,"B",DFN,LP)) Q:'LP  D  Q:AL
  1.  .S:'$G(^GMR(120.8,LP,"ER")) AL=1
  1.  I $D(^GMR(120.86,DFN,0)) Q:$P(^(0),U,2)=AL 'AL S IEN=DFN_","
  1.  E  I '$G(CREATE) Q 'AL
  1.  E  D
  1.  .S IEN="+1,",IEN(1)=DFN
  1.  .S FDA(120.86,IEN,.01)=DFN
  1.  .S FDA(120.86,IEN,2)=DUZ
  1.  .S FDA(120.86,IEN,3)=$$NOW^XLFDT
  1.  S FDA(120.86,IEN,1)=AL
  1.  I AL=1 S FDA(120.86,IEN,9999999.01)="@"
  1.  I AL=0 S FDA(120.86,IEN,9999999.01)=160244002
  1.  D UPDATE^DIE(,"FDA","IEN")
  1.  Q 'AL
  1.  ; Return last subfile entry for user comment
  1. GETCMNT(IEN) ;
  1.  N LP
  1.  S LP=$C(1)
  1.  F  S LP=$O(^GMR(120.8,IEN,26,LP),-1) Q:'LP  Q:$P(^(LP,0),U,2)=DUZ
  1.  Q +LP
  1.  ; Update ingredient and class subfiles
  1. UPDSF(GMRAPA,GMRAAR) ;
  1.  I $G(GMRAAR) D
  1.  .F X=120.802,120.803 D DELSF(X,+GMRAPA_",")
  1.  .D:$G(GMRAAR) EN1^GMRAOR9
  1.  Q
  1.  ; Send a verification request bulletin
  1. SENDBULL(GMRAPA) ;
  1.  N GMRANAM,GMRALOC,GMRASSN,GMRAREC,GMRAOTH,GMRATXT,GMRACNT
  1.  N XMB,XMY,XMTEXT,DFN,APSPHRN,X
  1.  S GMRAPA(0)=$G(^GMR(120.8,+GMRAPA,0))
  1.  D:$L(GMRAPA(0)) EN1^GMRAVAB
  1.  Q
  1.  ; Check if user can sign entry
  1. CANSIGN(IEN) ;
  1.  N X,SIGN,Z,REACT
  1.  S REACT=""
  1.  S X=$G(^GMR(120.8,+IEN,0))
  1.  ;I $P(X,U,5)=DUZ&'$P(X,U,12)
  1.  S Z=$O(^GMR(120.8,IEN,9999999.12,$C(0)),-1) I +Z D
  1.  .S REACT=$P($G(^GMR(120.8,IEN,9999999.12,Z,0)),U,5)
  1.  Q ($P(X,U,5)=DUZ!(REACT=DUZ))&('$P(X,U,12))
  1.  ; Check if entry is candidate for autoverification
  1. CANVERIF(IEN,VER) ;
  1.  N GMRASITE
  1.  S IEN=+IEN,IEN(0)=$G(^GMR(120.8,IEN,0))
  1.  Q:$P(IEN(0),U,16) 0
  1.  Q:$G(VER) 1
  1.  Q $$VFY^GMRASIGN(.IEN)
  1.  ; Fire a GMRA event
  1.  ;  ACTION = 0: New entry; 1: Edit; 2: Delete; 3: Sign
  1. FIREEVT(DFN,ACTION,DATA) ;
  1.  N X
  1.  I $$HASNKA(DFN,ACTION=3)
  1.  D QUEUE^CIANBEVT("GMRA."_DFN,ACTION_U_DATA)
  1.  S X=$$FIND1^DIC(101,,"BX","GMRA ALLERGY UPDATE")_";ORD(101,"
  1.  D:X EN^XQOR ;Process protocols hanging off this protocol
  1.  Q
  1.  ; Returns agent text as variable pointer if found
  1.  ; EHR 13 added drug ingredient to the list
  1. CODE(X) N D,DIC,TRD,Y
  1.  N AGNT
  1.  S AGNT=$P($P(X,U,3),",")
  1.  I AGNT="GMRD(120.82" Q +X_";"_AGNT_","
  1.  I AGNT="PSNDF(50.6" Q +X_";"_AGNT_","
  1.  I AGNT="PS(50.605" Q +X_";"_AGNT_","
  1.  I AGNT="PS(50.416" Q +X_";"_AGNT_","
  1.  S TRD=$$TTOG^PSNAPIS($P(X,U,2),.TRD)
  1.  Q:TRD $O(TRD(0))_$TR($$NDFREF^GMRAOR,U,";")
  1.  Q ""
  1.  ; Update alerts for current user
  1. UPDALR N AID,GMRAIEN,DFN,CANVER,MGRP,TYP,SGN,DEL,N0
  1.  S AID="BEHOAR",CANVER=$$HASKEY^BEHOUSCX("GMRA-ALLERGY VERIFY")
  1.  I CANVER F TYP="DRUG","FOOD","OTHER" S:$$ISMBR^BEHOXQ("GMRA VERIFY "_TYP_" ALLERGY",DUZ) TYP($E(TYP))=""
  1.  ; Remove alerts no longer applicable
  1.  F  S AID=$O(^XTV(8992,"AXQA",AID)) Q:$E(AID,1,6)'="BEHOAR"  D
  1.  .N EIE
  1.  .S GMRAIEN=+$P(AID,",",2),N0=$G(^GMR(120.8,GMRAIEN,0)),TYP=$P(N0,U,20),SGN=AID["SIGN"
  1.  .S EIE=$P($G(^GMR(120.8,GMRAIEN,"ER")),U,1)=1
  1.  .S DEL=$S(AID'[".":2,'$L(N0):2,$P(N0,U,16):2,EIE:2,'$D(^XTV(8992,"AXQA",AID,DUZ)):0,$$RCVALR(GMRAIEN,SGN,.TYP):0,1:1)
  1.  .D BEHDEL^BEHOXQ(AID):DEL=2,BEHDEL^BEHOXQ(AID,1):DEL=1
  1.  ; Add verification alerts for this user
  1.  Q:$D(TYP)<10
  1.  S DFN=0
  1.  F  S DFN=$O(^GMR(120.8,"AVER",DFN)) Q:'DFN  D
  1.  .S GMRAIEN=0
  1.  .F  S GMRAIEN=$O(^GMR(120.8,"AVER",DFN,GMRAIEN)) Q:'GMRAIEN  D
  1.  ..S TYP=$P($G(^GMR(120.8,GMRAIEN,0)),U,20)
  1.  ..D:$$RCVALR(GMRAIEN,0,.TYP) SNDALR(GMRAIEN,0)
  1.  Q
  1.  ; Send alert for user
  1. SNDALR(GMRAIEN,SGN) ;
  1.  N N0,AID,XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLG,XQAARCH,XQASURO,XQASUPV,XQATEXT
  1.  S AID="BEHOAR."_$S(SGN:"SIGN",1:"VERIFY")_","_GMRAIEN,N0=$G(^GMR(120.8,GMRAIEN,0))
  1.  Q:'$L(N0)
  1.  Q:$D(^XTV(8992,"AXQAN",AID,DUZ))
  1.  S XQAMSG="Adverse reaction "_$S(SGN:"signature",1:"verification")_" required for "_$P(N0,U,2)
  1.  S XQADATA="DFN="_DFN_"^PRI=2^INF=0^TYP="_$S(SGN:"SIGN",1:"VERIFY")_"^SRV=BEHARTENTRY.ARTENTRY"
  1.  S XQAID=AID
  1.  S XQA(DUZ)=""
  1.  D SETUP^XQALERT
  1.  Q
  1.  ; Return true if user should receive alert for this allergy
  1. RCVALR(GMRAIEN,SGN,TYP) ;
  1.  N LP,OK
  1.  I SGN S OK=$$CANSIGN(GMRAIEN)
  1.  E  D
  1.  .Q:$D(TYP)<10
  1.  .F LP=1:1:$L(TYP) I $D(TYP($E(TYP,LP))) S OK=1 Q
  1.  Q $G(OK)
  1. ING(DATA,GMRAPA) ;Return
  1.  N GMRAINGR,GMRACLAS,X,Y,CNT,CNT2
  1.  S DATA=$$TMPGBL^CIAVMRPC,CNT=0
  1.  F GMRAINGR=0:0 S GMRAINGR=$O(^GMR(120.8,GMRAPA,2,GMRAINGR)) Q:'+GMRAINGR  D
  1.  .S X=$S($D(^GMR(120.8,GMRAPA,2,GMRAINGR,0)):^(0),1:"")
  1.  .I +X>0 S Y=$S($D(^PS(50.416,+X,0)):^(0),1:"") I $P(Y,U)'="" S GMRAINGR($P(Y,U),+X)=Y
  1.  F GMRACLAS=0:0 S GMRACLAS=$O(^GMR(120.8,GMRAPA,3,GMRACLAS)) Q:'+GMRACLAS  D
  1.  .S X=$S($D(^GMR(120.8,GMRAPA,3,GMRACLAS,0)):^(0),1:"")
  1.  .I +X>0 S Y=$S($D(^PS(50.605,+X,0)):^(0),1:"") I $P(Y,U)'="" S GMRACLAS($P(Y,U),+X)=Y
  1.  S CNT=0
  1.  I $D(GMRACLAS)>10 D
  1.  .S Y="" F  S Y=$O(GMRACLAS(Y)) Q:Y=""  D
  1.  ..F X=0:0 S X=$O(GMRACLAS(Y,X)) Q:X'>0  D
  1.  ...S CNT=CNT+1
  1.  ...I CNT=1 S @DATA@(CNT)="DRUG CLASSES: "_$P(GMRACLAS(Y,X),U,2)
  1.  ...E  S @DATA@(CNT)="              "_$P(GMRACLAS(Y,X),U,2)
  1.  I $D(GMRAINGR)>10 D
  1.  .S CNT=CNT+1 S @DATA@(CNT)=""
  1.  .S CNT2=0
  1.  .S Y="" F  S Y=$O(GMRAINGR(Y)) Q:Y=""  D
  1.  ..F X=0:0 S X=$O(GMRAINGR(Y,X)) Q:X'>0  D
  1.  ...S CNT=CNT+1,CNT2=CNT2+1
  1.  ...I CNT2=1 S @DATA@(CNT)=" INGREDIENTS: "_$P(GMRAINGR(Y,X),U,1)
  1.  ...E  S @DATA@(CNT)="              "_$P(GMRAINGR(Y,X),U,1)
  1.  Q
  1.  ;Return status of EIE Comment prompt
  1. AEIECMT(DATA) ;EP-
  1.  N SITE,IEN
  1.  S SITE=$O(^GMRD(120.84,"B",""))
  1.  I SITE="" S DATA=0 Q
  1.  S IEN=$O(^GMRD(120.84,"B",SITE,0))
  1.  I 'IEN S DATA=0 Q
  1.  S DATA=+$P($G(^GMRD(120.84,IEN,0)),U,11)
  1.  Q