KIDS Distribution saved on Jul 08, 2025@09:35:13
ALLERGIES AND SYMPTOMS
**KIDS**:GMRA*4.0*1012^

**INSTALL NAME**
GMRA*4.0*1012
"BLD",6867,0)
GMRA*4.0*1012^ADVERSE REACTION TRACKING^0^3250708^n
"BLD",6867,4,0)
^9.64PA^^0
"BLD",6867,6.3)
24
"BLD",6867,"ABPKG")
n
"BLD",6867,"INI")

"BLD",6867,"INIT")

"BLD",6867,"KRN",0)
^9.67PA^9002226^21
"BLD",6867,"KRN",.4,0)
.4
"BLD",6867,"KRN",.401,0)
.401
"BLD",6867,"KRN",.402,0)
.402
"BLD",6867,"KRN",.403,0)
.403
"BLD",6867,"KRN",.5,0)
.5
"BLD",6867,"KRN",.84,0)
.84
"BLD",6867,"KRN",3.6,0)
3.6
"BLD",6867,"KRN",3.8,0)
3.8
"BLD",6867,"KRN",9.2,0)
9.2
"BLD",6867,"KRN",9.8,0)
9.8
"BLD",6867,"KRN",9.8,"NM",0)
^9.68A^1^1
"BLD",6867,"KRN",9.8,"NM",1,0)
GMRAOR2^^0^B21901389
"BLD",6867,"KRN",9.8,"NM","B","GMRAOR2",1)

"BLD",6867,"KRN",19,0)
19
"BLD",6867,"KRN",19.1,0)
19.1
"BLD",6867,"KRN",101,0)
101
"BLD",6867,"KRN",409.61,0)
409.61
"BLD",6867,"KRN",771,0)
771
"BLD",6867,"KRN",779.2,0)
779.2
"BLD",6867,"KRN",870,0)
870
"BLD",6867,"KRN",8989.51,0)
8989.51
"BLD",6867,"KRN",8989.52,0)
8989.52
"BLD",6867,"KRN",8994,0)
8994
"BLD",6867,"KRN",9002226,0)
9002226
"BLD",6867,"KRN","B",.4,.4)

"BLD",6867,"KRN","B",.401,.401)

"BLD",6867,"KRN","B",.402,.402)

"BLD",6867,"KRN","B",.403,.403)

"BLD",6867,"KRN","B",.5,.5)

"BLD",6867,"KRN","B",.84,.84)

"BLD",6867,"KRN","B",3.6,3.6)

"BLD",6867,"KRN","B",3.8,3.8)

"BLD",6867,"KRN","B",9.2,9.2)

"BLD",6867,"KRN","B",9.8,9.8)

"BLD",6867,"KRN","B",19,19)

"BLD",6867,"KRN","B",19.1,19.1)

"BLD",6867,"KRN","B",101,101)

"BLD",6867,"KRN","B",409.61,409.61)

"BLD",6867,"KRN","B",771,771)

"BLD",6867,"KRN","B",779.2,779.2)

"BLD",6867,"KRN","B",870,870)

"BLD",6867,"KRN","B",8989.51,8989.51)

"BLD",6867,"KRN","B",8989.52,8989.52)

"BLD",6867,"KRN","B",8994,8994)

"BLD",6867,"KRN","B",9002226,9002226)

"BLD",6867,"PRE")
GMRA1012
"BLD",6867,"PRET")

"BLD",6867,"QUES",0)
^9.62^^
"BLD",6867,"REQB",0)
^9.611^1^1
"BLD",6867,"REQB",1,0)
GMRA*4.0*1011^1
"BLD",6867,"REQB","B","GMRA*4.0*1011",1)

"MBREQ")
0
"PKG",230,-1)
1^1
"PKG",230,0)
ADVERSE REACTION TRACKING^GMRA^Allergy Tracking System
"PKG",230,22,0)
^9.49I^1^1
"PKG",230,22,1,0)
4.0^2960328^3060829^794
"PKG",230,22,1,"PAH",1,0)
1012^3250708
"PRE")
GMRA1012
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
2
"RTN","GMRA1012")
0^^B38006878
"RTN","GMRA1012",1,0)
GMRA1012 ;IHS/MSC/PLS - Patch support;30-Jun-2025 06:48
"RTN","GMRA1012",2,0)
 ;;4.0;Adverse Reaction Tracking;**1012**;Mar 28, 1996;Build 24
"RTN","GMRA1012",3,0)
 ;
"RTN","GMRA1012",4,0)
ENV ;EP -
"RTN","GMRA1012",5,0)
 N PATCH
"RTN","GMRA1012",6,0)
 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
"RTN","GMRA1012",7,0)
 ;
"RTN","GMRA1012",8,0)
 ;Check for the installation of other patches
"RTN","GMRA1012",9,0)
 S PATCH="GMRA*4.0*1011"
"RTN","GMRA1012",10,0)
 I '$$PATCH(PATCH) D  Q
"RTN","GMRA1012",11,0)
 . W !,"You must first install "_PATCH_"." S XPDQUIT=2
"RTN","GMRA1012",12,0)
 Q
"RTN","GMRA1012",13,0)
 ;
"RTN","GMRA1012",14,0)
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
"RTN","GMRA1012",15,0)
 ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
"RTN","GMRA1012",16,0)
 Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
"RTN","GMRA1012",17,0)
 NEW NUM,I,J
"RTN","GMRA1012",18,0)
 S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
"RTN","GMRA1012",19,0)
 S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
"RTN","GMRA1012",20,0)
 ;check if patch is just a number
"RTN","GMRA1012",21,0)
 Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
"RTN","GMRA1012",22,0)
 S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
"RTN","GMRA1012",23,0)
 Q (X=+NUM)
"RTN","GMRA1012",24,0)
PRE ;EP -
"RTN","GMRA1012",25,0)
 Q
"RTN","GMRA1012",26,0)
POST ;EP -
"RTN","GMRA1012",27,0)
 D DATA
"RTN","GMRA1012",28,0)
 D SIGNS
"RTN","GMRA1012",29,0)
 Q
"RTN","GMRA1012",30,0)
 ;
"RTN","GMRA1012",31,0)
DATA ; Import Data
"RTN","GMRA1012",32,0)
 N LP,NAM,F,LNAARY
"RTN","GMRA1012",33,0)
 S F=120.82,XUMF=1
"RTN","GMRA1012",34,0)
 ; Build array of local national allergies
"RTN","GMRA1012",35,0)
 S LP=0 F  S LP=$O(^GMRD(120.82,LP)) Q:'LP  D
"RTN","GMRA1012",36,0)
 .Q:'$P(^GMRD(120.82,LP,0),U,3)  ;Must be a National Allergy
"RTN","GMRA1012",37,0)
 .S LNAARY($P(^GMRD(120.82,LP,0),U),LP)=""
"RTN","GMRA1012",38,0)
 S LP=0 F  S LP=$O(@XPDGREF@("DATA",F,LP)) Q:'LP  D
"RTN","GMRA1012",39,0)
 .Q:'$P(@XPDGREF@("DATA",F,LP,0),U,3)  ; Must be marked as National Allergy
"RTN","GMRA1012",40,0)
 .S NAM=$P($G(@XPDGREF@("DATA",F,LP,0)),U)
"RTN","GMRA1012",41,0)
 .D STOREALG(LP)
"RTN","GMRA1012",42,0)
 Q
"RTN","GMRA1012",43,0)
SIGNS ;  Build array of signs/symptoms
"RTN","GMRA1012",44,0)
 N F,LP,NAM,SNAARY,XUMF
"RTN","GMRA1012",45,0)
 S F=120.83,XUMF=1
"RTN","GMRA1012",46,0)
 S LP=0 F  S LP=$O(^GMRD(120.83,LP)) Q:'LP  D
"RTN","GMRA1012",47,0)
 .Q:'$P(^GMRD(120.83,LP,0),U,2)  ;Must be a National Allergy
"RTN","GMRA1012",48,0)
 .S SNAARY($P(^GMRD(120.83,LP,0),U),LP)=""
"RTN","GMRA1012",49,0)
 S LP=0 F  S LP=$O(@XPDGREF@("DATA",F,LP)) Q:'LP  D
"RTN","GMRA1012",50,0)
 .Q:'$P(@XPDGREF@("DATA",F,LP,0),U,2)  ; Must be marked as National Allergy
"RTN","GMRA1012",51,0)
 .S NAM=$P($G(@XPDGREF@("DATA",F,LP,0)),U)
"RTN","GMRA1012",52,0)
 .D STORSIGN(LP)
"RTN","GMRA1012",53,0)
 Q
"RTN","GMRA1012",54,0)
 ;
"RTN","GMRA1012",55,0)
STOREALG(DATAIEN) ;
"RTN","GMRA1012",56,0)
 N FDA,FDAIEN,ERR,IENS,ARY,LP2,CNT,IEN
"RTN","GMRA1012",57,0)
 Q:'$L(DATAIEN)
"RTN","GMRA1012",58,0)
 M ARY=@XPDGREF@("DATA",120.82,DATAIEN)
"RTN","GMRA1012",59,0)
 S IEN=$$ALGIEN(NAM)
"RTN","GMRA1012",60,0)
 S:'IEN IEN="+1"
"RTN","GMRA1012",61,0)
 S IENS=IEN_",",X=IEN
"RTN","GMRA1012",62,0)
 S CNT=0
"RTN","GMRA1012",63,0)
 I X=+X D  ;EXISTING ENTRY
"RTN","GMRA1012",64,0)
 .S FDA(F,IENS,1)=$P(ARY(0),U,2)
"RTN","GMRA1012",65,0)
 .S FDA(F,IENS,2)=$P(ARY(0),U,3)
"RTN","GMRA1012",66,0)
 .S FDA(F,IENS,99.99)=$P($G(ARY("VUID")),U,1)
"RTN","GMRA1012",67,0)
 .S FDA(F,IENS,99.98)=$P($G(ARY("VUID")),U,2)
"RTN","GMRA1012",68,0)
 .D FILE^DIE("K","FDA","ERR")
"RTN","GMRA1012",69,0)
 .Q:$D(ERR)
"RTN","GMRA1012",70,0)
 .I $D(ARY(1)) D SUBSYS(120.822,IEN)
"RTN","GMRA1012",71,0)
 .D SUBDATA(IEN)
"RTN","GMRA1012",72,0)
 E  D  ;New entry
"RTN","GMRA1012",73,0)
 .S FDA(F,IENS,.01)=$P(ARY(0),U)
"RTN","GMRA1012",74,0)
 .S FDA(F,IENS,1)=$P(ARY(0),U,2)
"RTN","GMRA1012",75,0)
 .S FDA(F,IENS,2)=$P(ARY(0),U,3)
"RTN","GMRA1012",76,0)
 .S FDA(F,IENS,99.99)=$P($G(ARY("VUID")),U,1)
"RTN","GMRA1012",77,0)
 .S FDA(F,IENS,99.98)=$P($G(ARY("VUID")),U,2)
"RTN","GMRA1012",78,0)
 .D UPDATE^DIE("","FDA","IENS","ERR")
"RTN","GMRA1012",79,0)
 .I $D(ERR) W !,IENS W ERR W !! Q
"RTN","GMRA1012",80,0)
 .I $D(ARY(1)) D SUBSYS(120.822,IENS(1))
"RTN","GMRA1012",81,0)
 .D SUBDATA(IENS(1))
"RTN","GMRA1012",82,0)
 Q
"RTN","GMRA1012",83,0)
 ; Add subfile data
"RTN","GMRA1012",84,0)
SUBDATA(DIEN) ;EP-
"RTN","GMRA1012",85,0)
 N IENS
"RTN","GMRA1012",86,0)
 S IENS=DIEN_","
"RTN","GMRA1012",87,0)
 ; KILL EXISTING SUBFILE DATA
"RTN","GMRA1012",88,0)
 ;Synonyms
"RTN","GMRA1012",89,0)
 K ^GMRD(120.82,DIEN,3)
"RTN","GMRA1012",90,0)
 S LP2=0 F  S LP2=$O(ARY(3,LP2)) Q:'LP2  D
"RTN","GMRA1012",91,0)
 .S FDA(120.823,"+"_$$INC()_","_IENS,.01)=$P(ARY(3,LP2,0),U)
"RTN","GMRA1012",92,0)
 ;Drug Class
"RTN","GMRA1012",93,0)
 K ^GMRD(120.82,DIEN,"CLASS")
"RTN","GMRA1012",94,0)
 S LP2=0 F  S LP2=$O(ARY("CLASS",LP2)) Q:'LP2  D
"RTN","GMRA1012",95,0)
 .S FDA(120.8205,"+"_$$INC()_","_IENS,.01)=$P(ARY("CLASS",LP2,0),U)
"RTN","GMRA1012",96,0)
 ;Drug Ingredient
"RTN","GMRA1012",97,0)
 K ^GMRD(120.82,DIEN,"ING")
"RTN","GMRA1012",98,0)
 S LP2=0 F  S LP2=$O(ARY("ING",LP2)) Q:'LP2  D
"RTN","GMRA1012",99,0)
 .S FDA(120.824,"+"_$$INC()_","_IENS,.01)=$P(ARY("ING",LP2,0),U)
"RTN","GMRA1012",100,0)
 ;Effective Date
"RTN","GMRA1012",101,0)
 K ^GMRD(120.82,DIEN,"TERMSTATUS")
"RTN","GMRA1012",102,0)
 S LP2=0 F  S LP2=$O(ARY("TERMSTATUS",LP2)) Q:'LP2  D
"RTN","GMRA1012",103,0)
 .S FDA(120.8299,"+"_$$INC()_","_IENS,.01)=$P(ARY("TERMSTATUS",LP2,0),U)
"RTN","GMRA1012",104,0)
 .S FDA(120.8299,"+"_$$INC(0)_","_IENS,.02)=$P(ARY("TERMSTATUS",LP2,0),U,2)
"RTN","GMRA1012",105,0)
 K ERR
"RTN","GMRA1012",106,0)
 D UPDATE^DIE("","FDA","","ERR")
"RTN","GMRA1012",107,0)
 I $D(ERR) W !,IENS W ERR("DIERR",1,"TEXT",1) W !! Q
"RTN","GMRA1012",108,0)
 Q
"RTN","GMRA1012",109,0)
 ; Increment counter
"RTN","GMRA1012",110,0)
INC(VAL) ;EP-
"RTN","GMRA1012",111,0)
 S VAL=$G(VAL,1)
"RTN","GMRA1012",112,0)
 S CNT=$G(CNT)+VAL
"RTN","GMRA1012",113,0)
 Q CNT
"RTN","GMRA1012",114,0)
DIERR(XPDI) N XPD
"RTN","GMRA1012",115,0)
 D MSG^DIALOG("AE",.XPD) Q:'$D(XPD)
"RTN","GMRA1012",116,0)
 D BMES^XPDUTL(XPDI),MES^XPDUTL(.XPD)
"RTN","GMRA1012",117,0)
 Q
"RTN","GMRA1012",118,0)
 ; Get Allergy IEN from Local National Allergies
"RTN","GMRA1012",119,0)
ALGIEN(NAM) ;EP-
"RTN","GMRA1012",120,0)
 Q $O(LNAARY(NAM,0))
"RTN","GMRA1012",121,0)
SIGNIEN(NAM) ;EP
"RTN","GMRA1012",122,0)
 Q $O(SNAARY(NAM,0))
"RTN","GMRA1012",123,0)
 ;
"RTN","GMRA1012",124,0)
STORSIGN(DATAIEN) ;
"RTN","GMRA1012",125,0)
 N FDA,FDAIEN,ERR,IENS,ARY,LP2,CNT,IEN
"RTN","GMRA1012",126,0)
 Q:'$L(DATAIEN)
"RTN","GMRA1012",127,0)
 M ARY=@XPDGREF@("DATA",120.83,DATAIEN)
"RTN","GMRA1012",128,0)
 S IEN=$$SIGNIEN(NAM)
"RTN","GMRA1012",129,0)
 S:'IEN IEN="+1"
"RTN","GMRA1012",130,0)
 S IENS=IEN_",",X=IEN
"RTN","GMRA1012",131,0)
 S CNT=0
"RTN","GMRA1012",132,0)
 I X=+X D  ;EXISTING ENTRY
"RTN","GMRA1012",133,0)
 .S FDA(F,IENS,1)=$P(ARY(0),U,2)
"RTN","GMRA1012",134,0)
 .S FDA(F,IENS,99.99)=$P($G(ARY("VUID")),U,1)
"RTN","GMRA1012",135,0)
 .S FDA(F,IENS,99.98)=$P($G(ARY("VUID")),U,2)
"RTN","GMRA1012",136,0)
 .D FILE^DIE("K","FDA","ERR")
"RTN","GMRA1012",137,0)
 .Q:$D(ERR)
"RTN","GMRA1012",138,0)
 .I $D(ARY(1)) D SUBSYS(120.833,IEN)
"RTN","GMRA1012",139,0)
 .D SUBSIGN(IEN)
"RTN","GMRA1012",140,0)
 E  D  ;New entry
"RTN","GMRA1012",141,0)
 .S FDA(F,IENS,.01)=$P(ARY(0),U)
"RTN","GMRA1012",142,0)
 .S FDA(F,IENS,1)=$P(ARY(0),U,2)
"RTN","GMRA1012",143,0)
 .S FDA(F,IENS,99.99)=$P($G(ARY("VUID")),U,1)
"RTN","GMRA1012",144,0)
 .S FDA(F,IENS,99.98)=$P($G(ARY("VUID")),U,2)
"RTN","GMRA1012",145,0)
 .D UPDATE^DIE("","FDA","IENS","ERR")
"RTN","GMRA1012",146,0)
 .I $D(ERR) W !,IENS W ERR W !! Q
"RTN","GMRA1012",147,0)
 .I $D(ARY(1)) D SUBSYS(120.833,IENS(1))
"RTN","GMRA1012",148,0)
 .D SUBSIGN(IENS(1))
"RTN","GMRA1012",149,0)
 Q
"RTN","GMRA1012",150,0)
SUBSIGN(DIEN) ;EP-
"RTN","GMRA1012",151,0)
 N IENS
"RTN","GMRA1012",152,0)
 S IENS=DIEN_","
"RTN","GMRA1012",153,0)
 ; KILL EXISTING SUBFILE DATA
"RTN","GMRA1012",154,0)
 ;Synonyms
"RTN","GMRA1012",155,0)
 K ^GMRD(120.83,DIEN,2)
"RTN","GMRA1012",156,0)
 S LP2=0 F  S LP2=$O(ARY(2,LP2)) Q:'LP2  D
"RTN","GMRA1012",157,0)
 .S FDA(120.832,"+"_$$INC()_","_IENS,.01)=$P(ARY(2,LP2,0),U)
"RTN","GMRA1012",158,0)
 ;Effective Date
"RTN","GMRA1012",159,0)
 K ^GMRD(120.83,DIEN,"TERMSTATUS")
"RTN","GMRA1012",160,0)
 S LP2=0 F  S LP2=$O(ARY("TERMSTATUS",LP2)) Q:'LP2  D
"RTN","GMRA1012",161,0)
 .S FDA(120.8399,"+"_$$INC()_","_IENS,.01)=$P(ARY("TERMSTATUS",LP2,0),U)
"RTN","GMRA1012",162,0)
 .S FDA(120.8399,"+"_$$INC(0)_","_IENS,.02)=$P(ARY("TERMSTATUS",LP2,0),U,2)
"RTN","GMRA1012",163,0)
 K ERR
"RTN","GMRA1012",164,0)
 D UPDATE^DIE("","FDA","","ERR")
"RTN","GMRA1012",165,0)
 I $D(ERR) W !,IENS W ERR("DIERR",1,"TEXT",1) W !! Q
"RTN","GMRA1012",166,0)
 Q
"RTN","GMRA1012",167,0)
PRETRAN ;EP -
"RTN","GMRA1012",168,0)
 D PRELOOP(120.82,"GMR ALLERGIES",""),PRELOOP(120.83,"SIGN/SYMPTOMS","")
"RTN","GMRA1012",169,0)
 Q
"RTN","GMRA1012",170,0)
PRELOOP(FILE,FNAM,SCRN) ;EP-
"RTN","GMRA1012",171,0)
 D FIA^DIFROMSU(FILE,"",FNAM,XPDGREF,"n^n^f^^n^^y^m^n","",SCRN,4.0)
"RTN","GMRA1012",172,0)
 D DATAOUT^DIFROMS("","","",XPDGREF)
"RTN","GMRA1012",173,0)
 Q
"RTN","GMRA1012",174,0)
SUBSYS(GRP,DIEN) ; Populate Allergies Coding system and Code
"RTN","GMRA1012",175,0)
  I $D(^GMRD($E(GRP,1,6),DIEN,1)) K ^(1)
"RTN","GMRA1012",176,0)
  N SUB,I S SUB="+1,"_DIEN_","
"RTN","GMRA1012",177,0)
  F I=1:1 Q:'$D(ARY(1,I))  D
"RTN","GMRA1012",178,0)
  .N FDA
"RTN","GMRA1012",179,0)
  .S FDA(GRP,SUB,.01)=$P(ARY(1,I,0),U)
"RTN","GMRA1012",180,0)
  .S FDA(GRP,SUB,.02)=$P(ARY(1,I,0),U,2)
"RTN","GMRA1012",181,0)
  .D UPDATE^DIE("","FDA","IENS")
"RTN","GMRA1012",182,0)
  Q
"RTN","GMRA1012",183,0)
POPULATE(NUM) ; Populate files 120.82 and 120.83 with Coding System and Code
"RTN","GMRA1012",184,0)
 N NUM1,TAB,FL,FL1,I,REC,NAME,CODSYS,CODE
"RTN","GMRA1012",185,0)
 S TAB=$C(9),U="^",NUM1=NUM_$E(NUM,6)
"RTN","GMRA1012",186,0)
 S FL="^GMRD("_NUM_")",FL1="^MIR"_$TR(NUM,".")
"RTN","GMRA1012",187,0)
 F I=1:1 Q:'$D(@FL1@(I))  D
"RTN","GMRA1012",188,0)
 .S REC=@FL1@(I),NAME=$P(REC,TAB),CODSYS=$P(REC,TAB,2),CODE=$P(REC,TAB,3)
"RTN","GMRA1012",189,0)
 .S IEN=$O(@FL@("B",NAME,"")) Q:$D(@FL@(IEN,1,"B",CODSYS))
"RTN","GMRA1012",190,0)
 .N SUB,FDA S SUB="+1,"_IEN_","
"RTN","GMRA1012",191,0)
 .S FDA(NUM1,SUB,.01)=CODSYS
"RTN","GMRA1012",192,0)
 .S FDA(NUM1,SUB,.02)=CODE
"RTN","GMRA1012",193,0)
 .D UPDATE^DIE("","FDA","IENS")
"RTN","GMRA1012",194,0)
 .Q
"RTN","GMRA1012",195,0)
 Q
"RTN","GMRAOR2")
0^1^B21901389
"RTN","GMRAOR2",1,0)
GMRAOR2 ;HIRMFO/RM-OERR UTILITIES ;8-Jul-2025 14:08;DU
"RTN","GMRAOR2",2,0)
 ;;4.0;Adverse Reaction Tracking;**21,1002,1006,1007,1012**;Mar 29, 1996;Build 24
"RTN","GMRAOR2",3,0)
 ;Patch 1012  IHS/MSC/MIR  Changed Signs/Symptoms Feature 75003
"RTN","GMRAOR2",4,0)
EN1(IEN,ARRAY) ; This entry point returns detailed information about a
"RTN","GMRAOR2",5,0)
 ; particular patient allergy/adverse reaction.
"RTN","GMRAOR2",6,0)
 ; Input Variables
"RTN","GMRAOR2",7,0)
 ;       IEN = The internal entry number of the reaction in file 120.8
"RTN","GMRAOR2",8,0)
 ;     ARRAY = The array that the reaction data is to be passed back in.
"RTN","GMRAOR2",9,0)
 ;             (Note: The return array cannot be the GMRAL array.)
"RTN","GMRAOR2",10,0)
 Q:$G(IEN)=""
"RTN","GMRAOR2",11,0)
 S ARRAY=$S($G(ARRAY)'="":ARRAY,1:"GMRACT") Q:ARRAY="GMRAL"
"RTN","GMRAOR2",12,0)
 N GMRAPA,GMRAOTH,GMRAL,GMRAI,GMRASRC,GMRASNO,%
"RTN","GMRAOR2",13,0)
 S GMRAPA=IEN,GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
"RTN","GMRAOR2",14,0)
 ; Set up GMRAL variable
"RTN","GMRAOR2",15,0)
 S GMRAL=$P(GMRAPA(0),U,2)_U
"RTN","GMRAOR2",16,0)
 S GMRAL=GMRAL_$S($P(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",",".01"),1:"<None>")_U ;21
"RTN","GMRAOR2",17,0)
 S %=$S($P(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",","8","I"),1:"") ;21
"RTN","GMRAOR2",18,0)
 S GMRAL=GMRAL_$S(%>1:$P($G(^DIC(3.1,%,0)),U),1:"")_U
"RTN","GMRAOR2",19,0)
 S GMRAL=GMRAL_$S($P(GMRAPA(0),U,16)=1:"",1:"NOT ")_"VERIFIED"_U
"RTN","GMRAOR2",20,0)
 S GMRAL=GMRAL_$S($P(GMRAPA(0),U,6)="o":"OBSERVED",$P(GMRAPA(0),U,6)="h":"HISTORICAL",1:"")_U
"RTN","GMRAOR2",21,0)
 S GMRAL=GMRAL_$S($P(GMRAPA(0),U,14)="A":"ALLERGY",$P(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$P(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")_U
"RTN","GMRAOR2",22,0)
 S GMRAL=GMRAL_$$OUTTYPE^GMRAUTL($P(GMRAPA(0),U,20))_U_$S($P(GMRAPA(0),U,16)&('$P(GMRAPA(0),U,18)):"<auto-verified>",1:$$GET1^DIQ(200,$P(GMRAPA(0),U,18)_",",.01))_U_$P(GMRAPA(0),U,17) ;21
"RTN","GMRAOR2",23,0)
 S GMRAL=GMRAL_U_$$FMTE^XLFDT($P(GMRAPA(0),U,4)) ;21 add orig date/time
"RTN","GMRAOR2",24,0)
 ;IHS/MSC/MGH changes for EHR patch 8 added back in patch 1006
"RTN","GMRAOR2",25,0)
 S GMRASRC=$P($G(^GMR(120.8,GMRAPA,9999999.11)),U,1)
"RTN","GMRAOR2",26,0)
 I +GMRASRC S GMRAL=GMRAL_U_$P($G(^BEHOAR(90460.05,GMRASRC,0)),U,1)  ;Add the source of the data MSC/IHS/MGH
"RTN","GMRAOR2",27,0)
 S GMRASNO=$P($G(^GMR(120.8,GMRAPA,9999999.11)),U,2)
"RTN","GMRAOR2",28,0)
 I +GMRASNO S GMRAL=GMRAL_U_$P($G(^BEHOAR(90460.06,GMRASNO,0)),U,1)_" "_$P($G(^BEHOAR(90460.06,GMRASNO,0)),U,2) ;Add the SNOMED code
"RTN","GMRAOR2",29,0)
 ;IHS/MSC/MGH Set up inactivate data in GMRAL("N", Patch 1006
"RTN","GMRAOR2",30,0)
 N ZZ,X,X4,X2,X3,X5
"RTN","GMRAOR2",31,0)
 S ZZ=0
"RTN","GMRAOR2",32,0)
 S GMRAI=9999999 F  S GMRAI=$O(^GMR(120.8,GMRAPA,9999999.12,GMRAI),-1) Q:'+GMRAI  D
"RTN","GMRAOR2",33,0)
 .N GMRAIN,IIEN,X,X1,X2,X3,X4,X5
"RTN","GMRAOR2",34,0)
 .S GMRAIN=$G(^GMR(120.8,GMRAPA,9999999.12,GMRAI,0))
"RTN","GMRAOR2",35,0)
 .S IIEN=GMRAI_","_GMRAPA_","
"RTN","GMRAOR2",36,0)
 .S X=$$GET1^DIQ(120.899999912,IIEN,.01),X2=$$GET1^DIQ(120.899999912,IIEN,1),X3=$$GET1^DIQ(120.899999912,IIEN,2)
"RTN","GMRAOR2",37,0)
 .S ZZ=ZZ+1
"RTN","GMRAOR2",38,0)
 .S GMRAL("N",ZZ)=X_U_X2_U_X3
"RTN","GMRAOR2",39,0)
 .I $P(GMRAIN,U,4)'="" D
"RTN","GMRAOR2",40,0)
 ..S X4=$$GET1^DIQ(120.899999912,IIEN,3),X5=$$GET1^DIQ(120.899999912,IIEN,4)
"RTN","GMRAOR2",41,0)
 ..S $P(GMRAL("N",ZZ),U,4)=X4,$P(GMRAL("N",ZZ),U,5)=X5
"RTN","GMRAOR2",42,0)
 .Q
"RTN","GMRAOR2",43,0)
 ;end mods
"RTN","GMRAOR2",44,0)
 ;Set up Comments in to GMRAL("C",
"RTN","GMRAOR2",45,0)
 S (GMRAI,%)=0 F  S GMRAI=$O(^GMR(120.8,GMRAPA,26,GMRAI)) Q:GMRAI<1  D
"RTN","GMRAOR2",46,0)
 .N GMRACOM
"RTN","GMRAOR2",47,0)
 .S GMRACOM=$G(^GMR(120.8,GMRAPA,26,GMRAI,0)) Q:GMRACOM=""  S %=%+1
"RTN","GMRAOR2",48,0)
 .S GMRAL("C",%)=$P(GMRACOM,U)_U_$S($P(GMRACOM,U,3)="V":"VERIFIER",$P(GMRACOM,U,3)="O":"ORIGINATOR",1:"")_U_$$GET1^DIQ(200,$P(GMRACOM,U,2)_",",.01) ;21
"RTN","GMRAOR2",49,0)
 .M GMRAL("C",%)=^GMR(120.8,GMRAPA,26,GMRAI,2)
"RTN","GMRAOR2",50,0)
 .Q
"RTN","GMRAOR2",51,0)
 ;Observer information from file 120.85
"RTN","GMRAOR2",52,0)
 S (GMRAI,%)=0 F  S GMRAI=$O(^GMR(120.85,"C",GMRAPA,GMRAI)) Q:GMRAI<1  D
"RTN","GMRAOR2",53,0)
 .N GMRACOM
"RTN","GMRAOR2",54,0)
 .S GMRACOM=$G(^GMR(120.85,GMRAI,0)) Q:GMRACOM=""  S %=%+1
"RTN","GMRAOR2",55,0)
 .S GMRAL("O",%)=$P(GMRACOM,U)_U_$S($P(GMRACOM,U,14)=1:"MILD",$P(GMRACOM,U,14)=2:"MODERATE",$P(GMRACOM,U,14)=3:"SEVERE",1:"")
"RTN","GMRAOR2",56,0)
 .Q
"RTN","GMRAOR2",57,0)
 ;Signs/Symptoms
"RTN","GMRAOR2",58,0)
 S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
"RTN","GMRAOR2",59,0)
 N GMRAIDX S GMRAI=0 F GMRAIDX=1:1 S GMRAI=$O(^GMR(120.8,GMRAPA,10,GMRAI)) Q:GMRAI<1  D
"RTN","GMRAOR2",60,0)
 .N GMRAZ,SSRC,SNO
"RTN","GMRAOR2",61,0)
 .S GMRAZ=$G(^GMR(120.8,GMRAPA,10,GMRAI,0)) Q:GMRAZ=""
"RTN","GMRAOR2",62,0)
 .S GMRAL("S",GMRAIDX)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U),1:$P(GMRAZ,U,2))_$S($P(GMRAZ,U,4)'="":" ("_$$FIXDT($$FMTE^XLFDT($P(GMRAZ,U,4),2))_")",1:"") ;21
"RTN","GMRAOR2",63,0)
 .S SSRC=$P($G(^GMR(120.8,GMRAPA,10,GMRAI,9999999.11)),U),SNO=$P($G(^GMR(120.8,GMRAPA,10,GMRAI,9999999.11)),U,2)
"RTN","GMRAOR2",64,0)
 .I +SSRC S GMRAL("S",GMRAIDX)=GMRAL("S",GMRAIDX)_" Src: "_$P($G(^BEHOAR(90460.05,SSRC,0)),U,1)
"RTN","GMRAOR2",65,0)
 .I SNO S GMRAL("S",GMRAIDX)=$G(GMRAL("S",GMRAIDX))_"; Snomed: "_SNO ;MU patch add source MSC/IHS/MGH/Patch 1007 added SNOMED
"RTN","GMRAOR2",66,0)
 .Q
"RTN","GMRAOR2",67,0)
 ;VA Drug Class
"RTN","GMRAOR2",68,0)
 S (GMRAI,%)=0 F  S GMRAI=$O(^GMR(120.8,GMRAPA,3,GMRAI)) Q:GMRAI<1  D
"RTN","GMRAOR2",69,0)
 .N GMRACOM
"RTN","GMRAOR2",70,0)
 .S GMRACOM=$G(^GMR(120.8,GMRAPA,3,GMRAI,0)) Q:GMRACOM=""
"RTN","GMRAOR2",71,0)
 .S %=%+1,GMRAL("V",%)=$P($G(^PS(50.605,GMRACOM,0)),U,1,2)
"RTN","GMRAOR2",72,0)
 .Q
"RTN","GMRAOR2",73,0)
 ;Drug Ingredients
"RTN","GMRAOR2",74,0)
 S (GMRAI,%)=0 F  S GMRAI=$O(^GMR(120.8,GMRAPA,2,GMRAI)) Q:GMRAI<1  D
"RTN","GMRAOR2",75,0)
 .N GMRACOM,RXN,UNI,TXT,TXT1,TXT2
"RTN","GMRAOR2",76,0)
 .S RXN="",UNI=""
"RTN","GMRAOR2",77,0)
 .S (TXT,TXT1,TXT2)=""
"RTN","GMRAOR2",78,0)
 .S GMRACOM=$G(^GMR(120.8,GMRAPA,2,GMRAI,0)) Q:GMRACOM=""
"RTN","GMRAOR2",79,0)
 .S RXN=$P($G(^GMR(120.8,GMRAPA,2,GMRAI,9999999)),U)
"RTN","GMRAOR2",80,0)
 .S UNI=$P($G(^GMR(120.8,GMRAPA,2,GMRAI,9999999)),U,2)
"RTN","GMRAOR2",81,0)
 .I $L(RXN) S TXT1="; RxNorm: "_RXN_" "
"RTN","GMRAOR2",82,0)
 .I $L(UNI) S TXT2="; UNII: "_UNI
"RTN","GMRAOR2",83,0)
 .S TXT=TXT1_TXT2
"RTN","GMRAOR2",84,0)
 .S %=%+1,GMRAL("I",%)=$P($G(^PS(50.416,GMRACOM,0)),U)_TXT
"RTN","GMRAOR2",85,0)
 .Q
"RTN","GMRAOR2",86,0)
 M @ARRAY=GMRAL
"RTN","GMRAOR2",87,0)
 Q
"RTN","GMRAOR2",88,0)
FIXDT(VAL) ;Change format for imprecise dates
"RTN","GMRAOR2",89,0)
 N RET
"RTN","GMRAOR2",90,0)
 S RET=VAL
"RTN","GMRAOR2",91,0)
 I +$P(VAL,"/",1)=0!(+$P(VAL,"/",2)=0) S RET=$$FMTE^XLFDT($P(GMRAZ,U,4))
"RTN","GMRAOR2",92,0)
 Q RET
"VER")
8.0^22.0
**END**
**END**