BEHOARCV ;MSC/IND/DKM - Cover Sheet: Adverse Reactions ;29-Apr-2014 18:44;PLS
;;1.1;BEH COMPONENTS;**027002,027003**;Mar 20, 2007;Build 1
;=================================================================
; Return adverse reaction info for a patient
LIST(DATA,DFN,UNRL,NOIN) ;
N CNT,REASON,LP,LP2,RESTA,IN,INACTIVE,REC,ER,RXN,STA,SEV,SGN,X,Y,Z,X1,RTYP,INACT,ALCNT,REACT
N NIEN,INZ,INSTA,INIEN,REA2,REACTBY
S CNT=0
S UNRL=$G(UNRL),IN=$G(IN),NOIN=$G(NOIN),(LP,CNT,ALCNT)=0,DATA=$$TMPGBL^CIAVMRPC
S Y=$O(^GMR(120.86,DFN,9999999.11,$C(0)),-1) I +Y D
.I $P($G(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)="" D
..S X1="Unassessable"
..S INIEN=Y_","_DFN
..S REASON=$$GET1^DIQ(120.869999911,INIEN,1)
..I REASON'="" D
...I REASON="OTHER" S REA2=$$GET1^DIQ(120.869999911,INIEN,5) S REASON=REASON_" "_REA2
...D ADD("-1^Unassessable: "_REASON)
F S LP=$O(^GMR(120.8,"B",DFN,LP)) Q:'LP D
.S INZ=0,REACTBY=""
.S REC=$G(^GMR(120.8,LP,0)),ER=+$G(^("ER"))
.Q:(+REC'=DFN)!(ER=1)
.S Z=$O(^GMR(120.8,LP,9999999.12,$C(0)),-1) I +Z D
..S INACT=$P($G(^GMR(120.8,LP,9999999.12,Z,0)),U,1)
..S REACT=$P($G(^GMR(120.8,LP,9999999.12,Z,0)),U,4)
..I +INACT&(REACT="") S INZ=1
..I REACT'="" S REACTBY=$P($G(^GMR(120.8,LP,9999999.12,Z,0)),U,5)
.S SGN=($P(REC,U,5)=DUZ!(REACTBY=DUZ))&'$P(REC,U,12)
.I ER=2,'UNRL!'SGN Q
.S LP2=0,RXN=""
.F S LP2=$O(^GMR(120.8,LP,10,LP2)) Q:'LP2 S X=$G(^(LP2,0)) D
..S X=$$GET1^DIQ(120.83,+X,.01)
..S:$L(X) RXN=RXN_$S($L(RXN):";",1:"")_X
.S LP2=0,SEV=""
.F S LP2=$O(^GMR(120.85,"C",LP,LP2)) Q:'LP2 D
..S X=$P($G(^GMR(120.85,LP2,0)),U,14)
..S SEV=$S(X>SEV:X,1:SEV)
.S:SEV SEV=$$EXTERNAL^DILFD(120.85,14.5,,SEV)
.S STA=$S($P(REC,U,16):"V",$P(REC,U,12):"S",1:"U")
.S RTYP=$P(REC,U,20)
.S (INSTA,RESTA)=""
.Q:(INZ=1)&(+NOIN)
.I INZ=1 S INSTA=INACT
.S ALCNT=ALCNT+1
.D ADD(LP_U_$P(REC,U,2)_U_SEV_U_RXN_U_SGN_U_STA_U_INSTA_U_RTYP)
I 'ALCNT D
.S CNT=0
.S X=$P($G(^GMR(120.86,DFN,0)),U,2)
.S Y=$O(^GMR(120.86,DFN,9999999.11,$C(0)),-1)
.I +Y D
..I $P($G(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)="" D
...D ADD("^Unassessable "_REASON_" and no "_$S('$L(X):"Allergy Assessment",'X:"Known Allergies",1:"Allergies Found"))
..E D ADD("^No "_$S('$L(X):"Allergy Assessment",'X:"Known Allergies",1:"Allergies Found"))
.E D ADD("^No "_$S('$L(X):"Allergy Assessment",'X:"Known Allergies",1:"Allergies Found"))
Q
; Detail view for adverse reaction
DETAIL(DATA,DFN,ADR) ;
N RXN,LP,LP2,LBL,CNT,Y,INIEN,REASON,X1,CAUSE
S DATA=$$TMPGBL^CIAVMRPC,CNT=0
I '$D(ADR)!(ADR="") S @DATA@(CNT)="No allergy defined" Q
I ADR=-1 D Q
.S Y=$O(^GMR(120.86,DFN,9999999.11,$C(0)),-1) I +Y D
..I $P($G(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)="" D
...S INIEN=Y_","_DFN
...S REASON=$$GET1^DIQ(120.869999911,INIEN,1)
...I REASON'="" D
....I REASON="OTHER" S REA2=$$GET1^DIQ(120.869999911,INIEN,5) S REASON=REASON_" "_REA2
...D ADD("Unassessable: "_REASON)
...D ADD("Date: "_$$GET1^DIQ(120.869999911,INIEN,.01))
...D ADD("User: "_$$GET1^DIQ(120.869999911,INIEN,2))
D EN1^GMRAOR2(ADR,"RXN")
S UNI=$$UNI(ADR) ;Get the UNI code for this agent if its GMR type
I $L(UNI) S CAUSE=$P(RXN,U)_"; UNII: "_UNI
E S CAUSE=$P(RXN,U)
D ADD($P(CAUSE,U),"Causative agent:")
I $P(RXN,U,12)'="" D ADD($P(RXN,U,12),"Event:"),ADD()
D:$D(RXN("S",1)) SYM,ADD()
D:$D(RXN("V",1)) CLS,ADD()
D:$D(RXN("I",1)) ING,ADD()
D ADD($P(RXN,U,2)_" "_$P(RXN,U,3),"Originated:")
S X=$$FMTE^XLFDT($P(RXN,U,10)) D ADD(X,"Origination Date:")
D ADD()
D:$D(RXN("O",1)) OBS,ADD()
S X1="" S X1=$P(RXN,U,9)
I +X1 S X1=" Date: "_$$FMTE^XLFDT(X1)
D ADD($S($P(RXN,U,4)="VERIFIED":"Yes",1:"No")_" "_X1,"Verified:")
I $P(RXN,U,4)="VERIFIED" D ADD($P(RXN,U,8),"Verified by:")
D ADD()
D ADD($S($P(RXN,U,5)="OBSERVED":"Observed",$P(RXN,U,5)="HISTORICAL":"Historical",1:""),"Observed/Historical:")
I $P(RXN,U,11)'="" D ADD($P(RXN,U,11),"Source:"),ADD()
;IHS/MSC/MGH Add inactive data
D:$D(RXN("N",1)) INAC,ADD()
D:$D(RXN("C",1)) COM,ADD()
;IHS/MSC/MGH Add last modified
D LAST
;IHS/MSC/MGH Reconciled
D RECON
Q
SYM S LP=0,LBL="Signs/symptoms:"
F S LP=$O(RXN("S",LP)) Q:'LP D ADD(RXN("S",LP),.LBL)
Q
CLS S LP=0,LBL="Drug Classes:"
F S LP=$O(RXN("V",LP)) Q:'LP D ADD($P(RXN("V",LP),U,2),.LBL)
Q
ING S LP=0,LBL="Ingredients:"
F S LP=$O(RXN("I",LP)) Q:'LP D ADD($P(RXN("I",LP),U,1),.LBL)
Q
OBS S LP=0,LBL="Obs dates/severity:"
F S LP=$O(RXN("O",LP)) Q:'LP D ADD($$DT(+RXN("O",LP))_" "_$P(RXN("O",LP),U,2),.LBL)
Q
INAC ;add inactivity time
S LP=0
F S LP=$O(RXN("N",LP)) Q:'LP D
.D ADD($P(RXN("N",LP),U,1),"Inactivation Date:")
.D ADD($P(RXN("N",LP),U,2),"Inactivation Reason:")
.D ADD($P(RXN("N",LP),U,3),"Inactivated By:")
.I $P(RXN("N",LP),U,6)'="" D ADD($P(RXN("N",LP),U,6),"Comment:")
.I $P(RXN("N",LP),U,4)'="" D
..D ADD($P(RXN("N",LP),U,4),"Reactivation Date:")
..D ADD($P(RXN("N",LP),U,5),"Reactivated By:")
Q
LAST ;Get last modified
N LP,MOD,IIEN,X,Y
S LP=9999999 S LP=$O(^GMR(120.8,ADR,9999999.14,LP),-1) Q:'+LP D
.S MOD=$G(^GMR(120.8,ADR,9999999.14,LP,0))
.S IIEN=LP_","_ADR_","
.S X=$$GET1^DIQ(120.899999914,IIEN,.01),Y=$$GET1^DIQ(120.899999914,IIEN,.02)
.S X=X_" by "_Y
.D ADD(X,"Last Modified:")
Q
RECON ;Get reconciliation data
N REC,IEN,AIEN,WHEN,BY
S REC=""
D ADD()
F S REC=$O(^BEHOCIR("G","A",ADR,REC)) Q:REC="" D
.S IEN="" F S IEN=$O(^BEHOCIR("G","A",ADR,REC,IEN)) Q:IEN="" D
..S AIEN=IEN_","_REC_","
..S WHEN=$$GET1^DIQ(90461.632,AIEN,.01)
..S BY=$$GET1^DIQ(90461.632,AIEN,.02)
..S WHEN=WHEN_" by "_BY
..S FROM=$$GET1^DIQ(90461.63,REC,.03)
..D ADD(WHEN,"Reconciled:")
..D ADD(FROM," Source:")
Q
COM S LP=0,LBL="Comments:"
D ADD()
F S LP=$O(RXN("C",LP)),LP2=0 Q:'LP D
.N X
.D:$L(LBL) ADD(,.LBL)
.S X=$P(RXN("C",LP),U,2)
.S:$L(X) X=" by "_X
.D ADD(" "_$$DT(+RXN("C",LP))_X)
.F S LP2=$O(RXN("C",LP,LP2)) Q:'LP2 D ADD(" "_RXN("C",LP,LP2,0))
Q
UNI(ADR) ;ADD UNI code if its a GMR allergy
N UNI,TYPE
S UNI=""
S TYPE=$P($G(^GMR(120.8,ADR,0)),U,3)
I $P(TYPE,";",2)="GMRD(120.82," D
.S UNI=$$GET1^DIQ(120.8,ADR,9999999.15)
Q UNI
RXNORM(ADR) ;Find and add the RxNorm code
N NDC,RXNORM,TYPE,GEN,DRUG
S RXNORM=0
S TYPE=$P($G(^GMR(120.8,ADR,0)),U,3)
I $P(TYPE,";",2)="PSNDF(50.6," D
.;Its a VA generic drug, now find all the drugs attached and look for
.;RXNorm
.S GEN=$P(TYPE,";",1)
.S DRUG="" F S DRUG=$O(^PSDRUG("AND",GEN,DRUG)) Q:'+DRUG!(+RXNORM) D
..S IENS=DRUG_","
..S NDC=$$GET1^DIQ(50,IENS,31)
..Q:'$L(NDC)
..S NDC=$TR(NDC,"-","")
..S:$L(NDC)=12 NDC=$E(NDC,2,12)
..S RXNORM=+$O(^C0CRXN(176.002,"NDC",NDC,0))
..S RXNORM=$$GET1^DIQ(176.002,RXNORM,.01)
Q RXNORM
; Format date/time
DT(Y) D DD^%DT
Q Y
; Add to output array
ADD(TXT,LBL) ;
S CNT=CNT+1 S @DATA@(CNT)=$S($D(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$G(TXT),LBL=""
Q
; Ingredients and VA drug classes
;
BEHOARCV ;MSC/IND/DKM - Cover Sheet: Adverse Reactions ;29-Apr-2014 18:44;PLS
+1 ;;1.1;BEH COMPONENTS;**027002,027003**;Mar 20, 2007;Build 1
+2 ;=================================================================
+3 ; Return adverse reaction info for a patient
LIST(DATA,DFN,UNRL,NOIN) ;
+1 NEW CNT,REASON,LP,LP2,RESTA,IN,INACTIVE,REC,ER,RXN,STA,SEV,SGN,X,Y,Z,X1,RTYP,INACT,ALCNT,REACT
+2 NEW NIEN,INZ,INSTA,INIEN,REA2,REACTBY
+3 SET CNT=0
+4 SET UNRL=$GET(UNRL)
SET IN=$GET(IN)
SET NOIN=$GET(NOIN)
SET (LP,CNT,ALCNT)=0
SET DATA=$$TMPGBL^CIAVMRPC
+5 SET Y=$ORDER(^GMR(120.86,DFN,9999999.11,$CHAR(0)),-1)
IF +Y
Begin DoDot:1
+6 IF $PIECE($GET(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)=""
Begin DoDot:2
+7 SET X1="Unassessable"
+8 SET INIEN=Y_","_DFN
+9 SET REASON=$$GET1^DIQ(120.869999911,INIEN,1)
+10 IF REASON'=""
Begin DoDot:3
+11 IF REASON="OTHER"
SET REA2=$$GET1^DIQ(120.869999911,INIEN,5)
SET REASON=REASON_" "_REA2
+12 DO ADD("-1^Unassessable: "_REASON)
End DoDot:3
End DoDot:2
End DoDot:1
+13 FOR
SET LP=$ORDER(^GMR(120.8,"B",DFN,LP))
IF 'LP
QUIT
Begin DoDot:1
+14 SET INZ=0
SET REACTBY=""
+15 SET REC=$GET(^GMR(120.8,LP,0))
SET ER=+$GET(^("ER"))
+16 IF (+REC'=DFN)!(ER=1)
QUIT
+17 SET Z=$ORDER(^GMR(120.8,LP,9999999.12,$CHAR(0)),-1)
IF +Z
Begin DoDot:2
+18 SET INACT=$PIECE($GET(^GMR(120.8,LP,9999999.12,Z,0)),U,1)
+19 SET REACT=$PIECE($GET(^GMR(120.8,LP,9999999.12,Z,0)),U,4)
+20 IF +INACT&(REACT="")
SET INZ=1
+21 IF REACT'=""
SET REACTBY=$PIECE($GET(^GMR(120.8,LP,9999999.12,Z,0)),U,5)
End DoDot:2
+22 SET SGN=($PIECE(REC,U,5)=DUZ!(REACTBY=DUZ))&'$PIECE(REC,U,12)
+23 IF ER=2
IF 'UNRL!'SGN
QUIT
+24 SET LP2=0
SET RXN=""
+25 FOR
SET LP2=$ORDER(^GMR(120.8,LP,10,LP2))
IF 'LP2
QUIT
SET X=$GET(^(LP2,0))
Begin DoDot:2
+26 SET X=$$GET1^DIQ(120.83,+X,.01)
+27 IF $LENGTH(X)
SET RXN=RXN_$SELECT($LENGTH(RXN):";",1:"")_X
End DoDot:2
+28 SET LP2=0
SET SEV=""
+29 FOR
SET LP2=$ORDER(^GMR(120.85,"C",LP,LP2))
IF 'LP2
QUIT
Begin DoDot:2
+30 SET X=$PIECE($GET(^GMR(120.85,LP2,0)),U,14)
+31 SET SEV=$SELECT(X>SEV:X,1:SEV)
End DoDot:2
+32 IF SEV
SET SEV=$$EXTERNAL^DILFD(120.85,14.5,,SEV)
+33 SET STA=$SELECT($PIECE(REC,U,16):"V",$PIECE(REC,U,12):"S",1:"U")
+34 SET RTYP=$PIECE(REC,U,20)
+35 SET (INSTA,RESTA)=""
+36 IF (INZ=1)&(+NOIN)
QUIT
+37 IF INZ=1
SET INSTA=INACT
+38 SET ALCNT=ALCNT+1
+39 DO ADD(LP_U_$PIECE(REC,U,2)_U_SEV_U_RXN_U_SGN_U_STA_U_INSTA_U_RTYP)
End DoDot:1
+40 IF 'ALCNT
Begin DoDot:1
+41 SET CNT=0
+42 SET X=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
+43 SET Y=$ORDER(^GMR(120.86,DFN,9999999.11,$CHAR(0)),-1)
+44 IF +Y
Begin DoDot:2
+45 IF $PIECE($GET(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)=""
Begin DoDot:3
+46 DO ADD("^Unassessable "_REASON_" and no "_$SELECT('$LENGTH(X):"Allergy Assessment",'X:"Known Allergies",1:"Allergies Found"))
End DoDot:3
+47 IF '$TEST
DO ADD("^No "_$SELECT('$LENGTH(X):"Allergy Assessment",'X:"Known Allergies",1:"Allergies Found"))
End DoDot:2
+48 IF '$TEST
DO ADD("^No "_$SELECT('$LENGTH(X):"Allergy Assessment",'X:"Known Allergies",1:"Allergies Found"))
End DoDot:1
+49 QUIT
+50 ; Detail view for adverse reaction
DETAIL(DATA,DFN,ADR) ;
+1 NEW RXN,LP,LP2,LBL,CNT,Y,INIEN,REASON,X1,CAUSE
+2 SET DATA=$$TMPGBL^CIAVMRPC
SET CNT=0
+3 IF '$DATA(ADR)!(ADR="")
SET @DATA@(CNT)="No allergy defined"
QUIT
+4 IF ADR=-1
Begin DoDot:1
+5 SET Y=$ORDER(^GMR(120.86,DFN,9999999.11,$CHAR(0)),-1)
IF +Y
Begin DoDot:2
+6 IF $PIECE($GET(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)=""
Begin DoDot:3
+7 SET INIEN=Y_","_DFN
+8 SET REASON=$$GET1^DIQ(120.869999911,INIEN,1)
+9 IF REASON'=""
Begin DoDot:4
+10 IF REASON="OTHER"
SET REA2=$$GET1^DIQ(120.869999911,INIEN,5)
SET REASON=REASON_" "_REA2
End DoDot:4
+11 DO ADD("Unassessable: "_REASON)
+12 DO ADD("Date: "_$$GET1^DIQ(120.869999911,INIEN,.01))
+13 DO ADD("User: "_$$GET1^DIQ(120.869999911,INIEN,2))
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+14 DO EN1^GMRAOR2(ADR,"RXN")
+15 ;Get the UNI code for this agent if its GMR type
SET UNI=$$UNI(ADR)
+16 IF $LENGTH(UNI)
SET CAUSE=$PIECE(RXN,U)_"; UNII: "_UNI
+17 IF '$TEST
SET CAUSE=$PIECE(RXN,U)
+18 DO ADD($PIECE(CAUSE,U),"Causative agent:")
+19 IF $PIECE(RXN,U,12)'=""
DO ADD($PIECE(RXN,U,12),"Event:")
DO ADD()
+20 IF $DATA(RXN("S",1))
DO SYM
DO ADD()
+21 IF $DATA(RXN("V",1))
DO CLS
DO ADD()
+22 IF $DATA(RXN("I",1))
DO ING
DO ADD()
+23 DO ADD($PIECE(RXN,U,2)_" "_$PIECE(RXN,U,3),"Originated:")
+24 SET X=$$FMTE^XLFDT($PIECE(RXN,U,10))
DO ADD(X,"Origination Date:")
+25 DO ADD()
+26 IF $DATA(RXN("O",1))
DO OBS
DO ADD()
+27 SET X1=""
SET X1=$PIECE(RXN,U,9)
+28 IF +X1
SET X1=" Date: "_$$FMTE^XLFDT(X1)
+29 DO ADD($SELECT($PIECE(RXN,U,4)="VERIFIED":"Yes",1:"No")_" "_X1,"Verified:")
+30 IF $PIECE(RXN,U,4)="VERIFIED"
DO ADD($PIECE(RXN,U,8),"Verified by:")
+31 DO ADD()
+32 DO ADD($SELECT($PIECE(RXN,U,5)="OBSERVED":"Observed",$PIECE(RXN,U,5)="HISTORICAL":"Historical",1:""),"Observed/Historical:")
+33 IF $PIECE(RXN,U,11)'=""
DO ADD($PIECE(RXN,U,11),"Source:")
DO ADD()
+34 ;IHS/MSC/MGH Add inactive data
+35 IF $DATA(RXN("N",1))
DO INAC
DO ADD()
+36 IF $DATA(RXN("C",1))
DO COM
DO ADD()
+37 ;IHS/MSC/MGH Add last modified
+38 DO LAST
+39 ;IHS/MSC/MGH Reconciled
+40 DO RECON
+41 QUIT
SYM SET LP=0
SET LBL="Signs/symptoms:"
+1 FOR
SET LP=$ORDER(RXN("S",LP))
IF 'LP
QUIT
DO ADD(RXN("S",LP),.LBL)
+2 QUIT
CLS SET LP=0
SET LBL="Drug Classes:"
+1 FOR
SET LP=$ORDER(RXN("V",LP))
IF 'LP
QUIT
DO ADD($PIECE(RXN("V",LP),U,2),.LBL)
+2 QUIT
ING SET LP=0
SET LBL="Ingredients:"
+1 FOR
SET LP=$ORDER(RXN("I",LP))
IF 'LP
QUIT
DO ADD($PIECE(RXN("I",LP),U,1),.LBL)
+2 QUIT
OBS SET LP=0
SET LBL="Obs dates/severity:"
+1 FOR
SET LP=$ORDER(RXN("O",LP))
IF 'LP
QUIT
DO ADD($$DT(+RXN("O",LP))_" "_$PIECE(RXN("O",LP),U,2),.LBL)
+2 QUIT
INAC ;add inactivity time
+1 SET LP=0
+2 FOR
SET LP=$ORDER(RXN("N",LP))
IF 'LP
QUIT
Begin DoDot:1
+3 DO ADD($PIECE(RXN("N",LP),U,1),"Inactivation Date:")
+4 DO ADD($PIECE(RXN("N",LP),U,2),"Inactivation Reason:")
+5 DO ADD($PIECE(RXN("N",LP),U,3),"Inactivated By:")
+6 IF $PIECE(RXN("N",LP),U,6)'=""
DO ADD($PIECE(RXN("N",LP),U,6),"Comment:")
+7 IF $PIECE(RXN("N",LP),U,4)'=""
Begin DoDot:2
+8 DO ADD($PIECE(RXN("N",LP),U,4),"Reactivation Date:")
+9 DO ADD($PIECE(RXN("N",LP),U,5),"Reactivated By:")
End DoDot:2
End DoDot:1
+10 QUIT
LAST ;Get last modified
+1 NEW LP,MOD,IIEN,X,Y
+2 SET LP=9999999
SET LP=$ORDER(^GMR(120.8,ADR,9999999.14,LP),-1)
IF '+LP
QUIT
Begin DoDot:1
+3 SET MOD=$GET(^GMR(120.8,ADR,9999999.14,LP,0))
+4 SET IIEN=LP_","_ADR_","
+5 SET X=$$GET1^DIQ(120.899999914,IIEN,.01)
SET Y=$$GET1^DIQ(120.899999914,IIEN,.02)
+6 SET X=X_" by "_Y
+7 DO ADD(X,"Last Modified:")
End DoDot:1
+8 QUIT
RECON ;Get reconciliation data
+1 NEW REC,IEN,AIEN,WHEN,BY
+2 SET REC=""
+3 DO ADD()
+4 FOR
SET REC=$ORDER(^BEHOCIR("G","A",ADR,REC))
IF REC=""
QUIT
Begin DoDot:1
+5 SET IEN=""
FOR
SET IEN=$ORDER(^BEHOCIR("G","A",ADR,REC,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+6 SET AIEN=IEN_","_REC_","
+7 SET WHEN=$$GET1^DIQ(90461.632,AIEN,.01)
+8 SET BY=$$GET1^DIQ(90461.632,AIEN,.02)
+9 SET WHEN=WHEN_" by "_BY
+10 SET FROM=$$GET1^DIQ(90461.63,REC,.03)
+11 DO ADD(WHEN,"Reconciled:")
+12 DO ADD(FROM," Source:")
End DoDot:2
End DoDot:1
+13 QUIT
COM SET LP=0
SET LBL="Comments:"
+1 DO ADD()
+2 FOR
SET LP=$ORDER(RXN("C",LP))
SET LP2=0
IF 'LP
QUIT
Begin DoDot:1
+3 NEW X
+4 IF $LENGTH(LBL)
DO ADD(,.LBL)
+5 SET X=$PIECE(RXN("C",LP),U,2)
+6 IF $LENGTH(X)
SET X=" by "_X
+7 DO ADD(" "_$$DT(+RXN("C",LP))_X)
+8 FOR
SET LP2=$ORDER(RXN("C",LP,LP2))
IF 'LP2
QUIT
DO ADD(" "_RXN("C",LP,LP2,0))
End DoDot:1
+9 QUIT
UNI(ADR) ;ADD UNI code if its a GMR allergy
+1 NEW UNI,TYPE
+2 SET UNI=""
+3 SET TYPE=$PIECE($GET(^GMR(120.8,ADR,0)),U,3)
+4 IF $PIECE(TYPE,";",2)="GMRD(120.82,"
Begin DoDot:1
+5 SET UNI=$$GET1^DIQ(120.8,ADR,9999999.15)
End DoDot:1
+6 QUIT UNI
RXNORM(ADR) ;Find and add the RxNorm code
+1 NEW NDC,RXNORM,TYPE,GEN,DRUG
+2 SET RXNORM=0
+3 SET TYPE=$PIECE($GET(^GMR(120.8,ADR,0)),U,3)
+4 IF $PIECE(TYPE,";",2)="PSNDF(50.6,"
Begin DoDot:1
+5 ;Its a VA generic drug, now find all the drugs attached and look for
+6 ;RXNorm
+7 SET GEN=$PIECE(TYPE,";",1)
+8 SET DRUG=""
FOR
SET DRUG=$ORDER(^PSDRUG("AND",GEN,DRUG))
IF '+DRUG!(+RXNORM)
QUIT
Begin DoDot:2
+9 SET IENS=DRUG_","
+10 SET NDC=$$GET1^DIQ(50,IENS,31)
+11 IF '$LENGTH(NDC)
QUIT
+12 SET NDC=$TRANSLATE(NDC,"-","")
+13 IF $LENGTH(NDC)=12
SET NDC=$EXTRACT(NDC,2,12)
+14 SET RXNORM=+$ORDER(^C0CRXN(176.002,"NDC",NDC,0))
+15 SET RXNORM=$$GET1^DIQ(176.002,RXNORM,.01)
End DoDot:2
End DoDot:1
+16 QUIT RXNORM
+17 ; Format date/time
DT(Y) DO DD^%DT
+1 QUIT Y
+2 ; Add to output array
ADD(TXT,LBL) ;
+1 SET CNT=CNT+1
SET @DATA@(CNT)=$SELECT($DATA(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$GET(TXT)
SET LBL=""
+2 QUIT
+3 ; Ingredients and VA drug classes
+4 ;
