GMRAOR ;HIRMFO/WAA,RM-OERR UTILITIES ;31-Dec-2012 12:12;DU
;;4.0;Adverse Reaction Tracking;**2,13,26,37,41,42,1006**;Mar 29, 1996;Build 29
ORCHK(DFN,TYP,PTR,LOC,REAC,COMM) ; Given a patient IEN (DFN), this function will
; return 1 (true) if the patient has an allergy to an agent defined
; by TYP and PTR, else it returns 0 (false). See table below.
; The Contrast Media Reaction check will return a null if the patient
; is not in the ART database. Contrast Media checks will also
; return whether the check is from local or remote data as the second
; piece of the flag if LOC is defined as a positive integer
;
; Contrast Media Reaction: TYP="CM", PTR (undefined)
; Drug Reaction: TYP="DR", PTR=IEN in ^PSNDF(.
; Drug Ingredients: TYP="IN", PTR=IEN in ^PS(50.416,
; Drug Class: TYP="CL", PTR=IEN in ^PS(50.605,
;Patch 1006 modified for reactions and comments
;Patch 1006 modified to fix multiple ingredients
N GMRAFLG,GMRACM,DA ;37
S GMRAFLG=0
S REAC=$G(REAC),COMM=$G(COMM)
I $G(DFN)<1!("^CM^DR^IN^CL^"'[("^"_$G(TYP)_"^"))!($G(TYP)'="CM"&($G(PTR)<1)) S GMRAFLG=""
E D
.D GETDATA(DFN) ;26 Retreive local/remote allergy data for order checking
.I TYP="CM" S GMRAFLG=$$RAD(DFN)_$S($G(LOC)&($G(GMRACM)'=""):("^"_$G(GMRACM)),1:"") ;37 check for Contrast Media Reaction, return location if requested
.I TYP="DR" S GMRAFLG=$$DRUG(DFN,PTR,REAC,COMM) ; check for Drug Reaction
.I TYP="IN" S GMRAFLG=$$ING(DFN,PTR,REAC,COMM) ; Check for Drug Ingredients
.I TYP="CL" S GMRAFLG=$$CLASS(DFN,PTR,REAC,COMM) ; Check for Drug Class
.Q
Q GMRAFLG
RAD(DFN) ; Subroutine checks for Contrast Media Reaction, returns 1 or 0.
N FLG,DC,LOCAL,REMOTE ;37 entire section added
S FLG=$P($G(^GMR(120.86,DFN,0)),U,2) S:FLG=1 FLG=0 S DC="DX10" F S DC=$O(^TMP("GMRAOC",$J,"APC",DC)) Q:DC'["DX10" D
.S FLG=1
.I $G(^TMP("GMRAOC",$J,"APC",DC))["LOCAL" S LOCAL=1
.I $G(^TMP("GMRAOC",$J,"APC",DC))["REMOTE" S REMOTE=1
S GMRACM=$S($G(LOCAL)&($G(REMOTE)):"LOCAL AND REMOTE SITE(S)",$G(LOCAL):"LOCAL",$G(REMOTE):"REMOTE SITE(S)",1:"")
;D EN1^GMRADPT S FLG=GMRAL
;I GMRAL S GMRAPA=0 F S GMRAPA=$O(GMRAL(GMRAPA)) Q:GMRAPA<1 D Q:FLG
;.S FLG=$$RALLG^GMRARAD(GMRAPA)
;.Q
Q FLG
DRUG(DFN,PTR,REAC,COMM) ; Subroutine checks for Drug Reaction, returns 1 or 0.
N %,J,FLG,GMRAC,GMRADR,GMRAI,PSNVPN,PSNDA,X1 S FLG=0
K GMRAING,GMRADRCL,GMRAREAC,GMRACOM
S PSNDA=$P(PTR,"."),PSNVPN=$P(PTR,".",2)
I $G(@($$NDFREF_PSNDA_",0)"))'="" D
.; Check for rxn to ingredients.
.; If use the new entry point if there.
.I $T(DISPDRG^PSNNGR)]"",PSNVPN]"" D
..K ^TMP("PSNDD",$J) D DISPDRG^PSNNGR ; get ingredients
..S GMRAI=0,%=1 F S GMRAI=$O(^TMP("PSNDD",$J,GMRAI)) Q:GMRAI<1 I $D(^TMP("GMRAOC",$J,"API",GMRAI)) D
...;IHS/MSC/MGH Mod for active
...S X1="" S X1=$O(^GMR(120.8,"API",DFN,GMRAI,X1)) Q:X1="" D
....I $$ACTIVE(X1) D
.....S FLG=1,GMRAING(%)=^TMP("PSNDD",$J,GMRAI)_$$FAC(^TMP("GMRAOC",$J,"API",GMRAI)),%=%+1 ;26
.....I REAC=1 D GETREAC(X1,.GMRAREAC)
.....I COMM=1 D GETCOM(X1,.GMRACOM)
..K ^TMP("PSNDD",$J)
..Q
.E D ; get ingredients
..K ^TMP("PSN",$J) D ^PSNNGR
..S GMRAI=0,%=1 F S GMRAI=$O(^TMP("PSN",$J,GMRAI)) Q:GMRAI<1 I $D(^TMP("GMRAOC",$J,"API",GMRAI)) D
...;IHS/MSC/MGH mod for active
...S X1="" S X1=$O(^GMR(120.8,"API",DFN,GMRAI,X1)) Q:X1="" D
....I $$ACTIVE(X1) D
.....S FLG=1,GMRAING(%)=^TMP("PSN",$J,GMRAI)_$$FAC(^TMP("GMRAOC",$J,"API",GMRAI)),%=%+1 ;26
.....I REAC=1 D GETREAC(X1,.GMRAREAC)
.....I COMM=1 D GETCOM(X1,.GMRACOM)
..K ^TMP("PSN",$J)
..Q
.Q:FLG ; Rxn to ingredient, quit now.
.; Check for rxn to VA Drug Class
.S PSNDA=$P(PTR,"."),PSNVPN=$P(PTR,".",2)
.N CLASS
.I PSNVPN S CLASS=$$DCLCODE^PSNAPIS(PSNDA,PSNVPN) D DRCL(CLASS,REAC,COMM) Q
.N CLASS,GMRALIST
.S GMRALIST=$$CLIST^PSNAPIS(PSNDA,.GMRALIST) Q:'$G(GMRALIST)
.S GMRALIST=0 F S GMRALIST=$O(GMRALIST(GMRALIST)) Q:'GMRALIST D DRCL($P(GMRALIST(GMRALIST),U,2),REAC,COMM)
.Q
Q FLG
FAC(NODE) ;
N FAC
S FAC=$S($L(NODE):" ("_NODE_")",1:"")
Q FAC
DRCL(CODE,REAC,COMM) ;return any rxn's in GMRADRCL(
N X1
I '$D(^TMP("GMRAOC",$J,"APC",CODE)) Q
;IHS/MSC/MGH Check for active
S X1="" S X1=$O(^GMR(120.8,"APC",DFN,CODE,X1)) Q:X1="" D
.I $$ACTIVE(X1) D
..N J S J=$S('$D(GMRADRCL):1,1:$O(GMRADRCL(999),-1)+1)
..;S GMRADRCL(J)=$$CLASS2^PSNAPIS(CODE)
..N CLSFN
..;S CLSFN=$P(^PS(50.605,+$O(^PS(50.605,"B",CODE,0)),0),U,2)
..S CLSFN=$$CODE2CL^GMRAPENC(CODE)
..S GMRADRCL(J)=CODE_"^"_CLSFN_$$FAC(^TMP("GMRAOC",$J,"APC",CODE))
..I REAC=1 D GETREAC(X1)
..I COMM=1 D GETCOM(X1)
..S FLG=2
Q
ING(DFN,PTR,REAC,COMM) ; Subroutine checks for Drug Ingredients, returns:
; If found FLG= 1 with GMRAIEN Array Drug Ingredients
; Not found FLG= 0
N GMRAX K GMRAIEN,GMRAREAC
S FLG=0
S GMRAX=0
;IHS/MSC/MGH added check for inactive entries
F S GMRAX=$O(^GMR(120.8,"API",DFN,PTR,GMRAX)) Q:GMRAX<1 D
.S X1="" S X1=$O(^GMR(120.8,"API",DFN,GMRAI,X1)) Q:X1="" D
..I $$ACTIVE(X1) D
...S FLG=1,GMRAIEN(GMRAX)=""
...I REAC=1 D GETREAC(GMRAX,.GMRAREAC)
...I COMM=1 D GETCOM(GMRAX,.GMRACOM)
.;END MOD
Q FLG
CLASS(DFN,PTR,REAC,COMM) ; Subroutine checks for Drug Class, returns:
; If found FLG= 1 with GMRAIEN Array Drug Class
; Not found FLG= 0
N GMRAC,GMRAX K GMRAIEN
;S GMRAX=0,FLG=0,GMRAC=$P($G(^PS(50.605,PTR,0)),U)
S GMRAX=0,FLG=0,GMRAC=$$CLP2CODE^GMRAPENC(PTR)
I GMRAC'="" F S GMRAX=$O(^GMR(120.8,"APC",DFN,GMRAC,GMRAX)) Q:GMRAX<1 D
.;IHS/MSC/MGH Check for active
.I $$ACTIVE(GMRAX) D
..S FLG=1,GMRAIEN(GMRAX)=""
..I REAC=1 D GETREAC(GMRAX,.GMRAREAC)
..I COMM=1 D GETCOM(GMRAX,.GMRACOM)
Q FLG
NDFREF() ;get version dependent NDF reference
I $$VERSION^XPDUTL("PSN")<4 Q "^PSNDF("
Q "^PSNDF(50.6," ; new reference for ver 4.0
;
GETDATA(DFN) ;Obtain local and HDR related allergy data for use in order checking. Section added in patch 26
;Output from call will be stored in ^TMP as follows:
;^TMP("GMRAOC",$J,"API",J)="" where J is the ingredient IEN
;^TMP("GMRAOC",$J,"APC",K)="" where K is the drug class classification (e.g. MS105)
;
F L +^XTMP("GMRAOC",DFN):1 Q:$T
N GMRRECDT,GMRCACHE,GMRFRESH,GMRNEW,GMRXTMP
S (GMRFRESH,GMRNEW,GMRXTMP)=0
S GMRRECDT=$P($G(^XTMP("ORRDI","ART",DFN,0)),U)
S GMRCACHE=$$GET^XPAR("SYS","OR RDI CACHE TIME")
I $$FMDIFF^XLFDT($$NOW^XLFDT,GMRRECDT,2)<(60*GMRCACHE),$P(^XTMP("ORRDI","ART",DFN,0),U,3)>-1 S GMRFRESH=1
S GMRXTMP=$D(^XTMP("GMRAOC",DFN))
S GMRNEW=$S($D(^XTMP("GMRAOC",DFN,"ERROR")):2,$D(^XTMP("GMRAOC",DFN,"NEW")):1,1:0)
I GMRFRESH&GMRXTMP&(GMRNEW=1) K ^XTMP("GMRAOC",DFN,"NEW") D LOCAL(DFN)
I 'GMRFRESH!'GMRXTMP!(GMRNEW=2) K ^XTMP("GMRAOC",DFN) D REMOTE(DFN),LOCAL(DFN)
K ^TMP("GMRAOC",$J)
M ^TMP("GMRAOC",$J)=^XTMP("GMRAOC",DFN)
S ^XTMP("GMRAOC",DFN,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT ;42
L -^XTMP("GMRAOC",DFN)
Q
;
LOCAL(DFN) ;
N J,K,L,M,NAREAC,X1,ACOM
S J=0 F S J=$O(^GMR(120.8,"API",DFN,J)) Q:'+J D
.S X1="" S X1=$O(^GMR(120.8,"API",DFN,J,X1)) Q:X1="" D
..I $$ACTIVE(X1) D
...S ^XTMP("GMRAOC",DFN,"API",J)=$$SETNODE^GMRAOR1($G(^XTMP("GMRAOC",DFN,"API",J)),"LOCAL")
...S K=0 F S K=$O(^GMR(120.8,"API",DFN,J,K)) Q:'+K D
....K AREAC D GETREAC(K,.AREAC)
....K ACOM D GETCOM(K,.ACOM)
....S L=0 F S L=$O(AREAC(L)) Q:'+L D
.....S ^XTMP("GMRAOC",DFN,"API",J,"REAC",L)=$G(AREAC(L))
....S L=0 F S L=$O(ACOM(L)) Q:'+L D
.....S M=0 F S M=$O(ACOM(L,M)) Q:'+M D
......S ^XTMP("GMRAOC",DFN,"API",J,"COM",M)=$G(ACOM(L,M,0))
S J="" F S J=$O(^GMR(120.8,"APC",DFN,J)) Q:J="" D
.S X1="" S X1=$O(^GMR(120.8,"APC",DFN,J,X1)) Q:X1="" D
..I $$ACTIVE(X1) D
...S ^XTMP("GMRAOC",DFN,"APC",J)=$$SETNODE^GMRAOR1($G(^XTMP("GMRAOC",DFN,"APC",J)),"LOCAL")
...S K=0 F S K=$O(^GMR(120.8,"APC",DFN,J,K)) Q:'+K D
....K AREAC D GETREAC(K,.AREAC)
....K ACOM D GETCOM(K,.ACOM)
....S L=0 F S L=$O(AREAC(L)) Q:'+L D
.....S ^XTMP("GMRAOC",DFN,"APC",J,"REAC",L)=$G(AREAC(L))
....S L=0 F S L=$O(ACOM(L)) Q:'+L D
.....S M=0 F S M=$O(ACOM(L,M)) Q:'+M D
......S ^XTMP("GMRAOC",DFN,"APC",J,"COM",M)=$G(ACOM(L,M,0))
Q
;
REMOTE(DFN) ;
N J,FLG,REACT,IN,VUID,FILE,GMRARAY,DC,DCLASS,GMRAING,GMRADC,K,INGLST,I,PRIM,IEN
;Check for HDR data
Q:'$L($T(HAVEHDR^ORRDI1)) Q:'$$HAVEHDR^ORRDI1 ;Quit if call doesn't exist or if the HDR isn't available
Q:'$$GET^ORRDI1(DFN,"ART") ;Quit if no HDR data for selected patient
S J=0 F S J=$O(^XTMP("ORRDI","ART",DFN,J)) Q:'+J D
.S FLG=0
.S REACT=$G(^XTMP("ORRDI","ART",DFN,J,"REACTANT",0)) ;Reaction VUID
.I $D(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS")) D ;Ingredient data exists
..S FLG=1 ;Have ingredient data so REACT is ok
..S IN=0 F S IN=$O(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS",IN)) Q:'+IN D
...S VUID=$P(^(IN),U),FILE=$P(^(IN),U,3) ;Naked from above line
...S FILE=$P(FILE,"99VA",2)
...D GETIREF^XTID(FILE,,VUID,"GMRARAY") ;Get IENs related to VUID
...S IEN=0 F S IEN=$O(GMRARAY(FILE,.01,IEN)) Q:'+IEN S ^XTMP("GMRAOC",DFN,"API",+IEN)=$$SETNODE^GMRAOR1($G(^XTMP("GMRAOC",DFN,"API",+IEN)),"REMOTE SITE(S)")
...K GMRARAY
.I $D(^XTMP("ORRDI","ART",DFN,J,"DRUG CLASSES")) D ;Drug class data exists
..S FLG=1
..S DC=0 F S DC=$O(^XTMP("ORRDI","ART",DFN,J,"DRUG CLASSES",DC)) Q:'+DC D
...S DCLASS=$P(^(DC),U,2) ;Naked from above, gets drug class (e.g.MS105)
...S ^XTMP("GMRAOC",DFN,"APC",DCLASS)=$$SETNODE^GMRAOR1($G(^XTMP("GMRAOC",DFN,"APC",DCLASS)),"REMOTE SITE(S)")
.D FIND(REACT,.GMRAING,.GMRADC) I $D(GMRAING)!($D(GMRADC)) D
..S K=0 F S K=$O(GMRAING(K)) Q:'+K S ^XTMP("GMRAOC",DFN,"API",K)=$$SETNODE^GMRAOR1($G(^XTMP("GMRAOC",DFN,"API",K)),"REMOTE SITE(S)")
..S K="" F S K=$O(GMRADC(K)) Q:K="" S ^XTMP("GMRAOC",DFN,"APC",K)=$$SETNODE^GMRAOR1($G(^XTMP("GMRAOC",DFN,"APC",K)),"REMOTE SITE(S)")
I $D(^XTMP("GMRAOC",DFN,"API")) D
.N I,INGLST
.S I=0 F S I=$O(^XTMP("GMRAOC",DFN,"API",I)) Q:'I D
..N PRIM
..S PRIM=$$PRIMARY(I)
..I PRIM S INGLST(PRIM)=^XTMP("GMRAOC",DFN,"API",I) K ^XTMP("GMRAOC",DFN,"API",I)
.S I=0 F S I=$O(INGLST(I)) Q:'I S ^XTMP("GMRAOC",DFN,"API",I)=INGLST(I)
Q
;
FIND(REACT,ING,DC) ;If reactant didn't include drug classes and/or ingredients, try and find them locally. Section added in patch 26
N VUID,FILE,PSNDA,GMRAIEN,LIST,GMRAI,GMRALIST,GMRARAY,J,SUB,FLAG
S FLAG=0
S VUID=$P(REACT,U)
S FILE=$P(REACT,U,3)
S FILE=$P(FILE,"99VA",2)
D GETIREF^XTID(,,VUID,"GMRARAY")
S FILE="" F S FILE=$O(GMRARAY(FILE)) Q:FILE="" D
.S GMRAIEN=0 F S GMRAIEN=$O(GMRARAY(FILE,.01,GMRAIEN)) Q:'+GMRAIEN D
..I FILE=50.6 D
...K ^TMP("PSN",$J) S PSNDA=+GMRAIEN D ^PSNNGR
...S GMRAI=0 F S GMRAI=$O(^TMP("PSN",$J,GMRAI)) Q:GMRAI<1 S ING(GMRAI)=""
...K ^TMP("PSN",$J),GMRARAY
...S PSNDA=+GMRAIEN,GMRALIST=$$CLIST^PSNAPIS(PSNDA,.GMRALIST) Q:'$G(GMRALIST)
...S GMRALIST=0 F S GMRALIST=$O(GMRALIST(GMRALIST)) Q:'GMRALIST S DC($P(GMRALIST(GMRALIST),U,2))=""
..I FILE=120.82 D
...S SUB=0 F S SUB=$O(^GMRD(120.82,+GMRAIEN,"ING",SUB)) Q:'+SUB S ING(+$P($G(^GMRD(120.82,+GMRAIEN,"ING",SUB,0)),U))="" ;record ingredients
...S SUB=0 F S SUB=$O(^GMRD(120.82,+GMRAIEN,"CLASS",SUB)) Q:'+SUB S DC($P($$CLASS2^PSNAPIS(+$P($G(^GMRD(120.82,+GMRAIEN,"CLASS",SUB,0)),U)),U))="" ;Get drug classes
..I FILE=50.605 D
...S DC($P($$CLASS2^PSNAPIS(+GMRAIEN),U))=""
..I FILE=50.416 D
...S ING(+GMRAIEN)=""
Q
PRIMARY(INGIEN) ;check if INGIEN is a primary ingredient
;returns 0 if INGIEN is primary
;returns the IEN of INGIEN's primary ingredient if INGIEN is not primary
N RETURN
K ^TMP($J,"GMRALIST")
D ZERO^PSN50P41(INGIEN,,,"GMRALIST")
S RETURN=+$G(^TMP($J,"GMRALIST",INGIEN,2))
Q RETURN
ACTIVE(ALL) ;Check allergy to see if it is inactive
N IN,Z,INACT,REACT
S IN=1
I '$D(^GMR(120.8,ALL,9999999.12)) Q IN
S Z=$O(^GMR(120.8,ALL,9999999.12,$C(0)),-1) I +Z D
.S INACT=$P($G(^GMR(120.8,ALL,9999999.12,Z,0)),U,1)
.S REACT=$P($G(^GMR(120.8,ALL,9999999.12,Z,0)),U,4)
.I +INACT&(REACT="") S IN=0
Q IN
GETREAC(ALG,GMRAREAC) ;IHS/MSC/MGH for reactions Patch 1006
K GMRAREAC,GMRAII,GMRAOTH,CNT
;Signs/Symptoms
S CNT=0
S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
S GMRAII=0 F %=1:1 S GMRAII=$O(^GMR(120.8,ALG,10,GMRAII)) Q:GMRAII<1 D
.N GMRAZ,SSRC
.S CNT=CNT+1
.S GMRAZ=$G(^GMR(120.8,ALG,10,GMRAII,0)) Q:GMRAZ=""
.S GMRAREAC(CNT)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U),1:$P(GMRAZ,U,2))_$S($P(GMRAZ,U,4)'="":" ("_$$FMTE^XLFDT($P(GMRAZ,U,4),2)_")",1:"")
.S SSRC=$P($G(^GMR(120.8,ALG,10,GMRAII,9999999.11)),U)
.I +SSRC S GMRAREAC(CNT)=GMRAREAC(CNT)_" Src: "_$P($G(^BEHOAR(90460.05,SSRC,0)),U,1) ;MU patch add source MSC/IHS/MGH
Q
GETCOM(ALG,GMRACOM) ;IHS/MSC/MGH for comments Patch 1006
K GMRACOM,GMRAIC,CNT
S CNT=0
S GMRAIC=0 F %=1:1 S GMRAIC=$O(^GMR(120.8,ALG,26,GMRAIC)) Q:GMRAIC<1 D
.N GMRAZ
.S CNT=CNT+1
.S GMRAZ=$G(^GMR(120.8,ALG,26,GMRAIC,0)) Q:GMRAZ=""
.M GMRACOM(CNT)=^GMR(120.8,ALG,26,GMRAIC,2)
Q
GMRAOR ;HIRMFO/WAA,RM-OERR UTILITIES ;31-Dec-2012 12:12;DU
+1 ;;4.0;Adverse Reaction Tracking;**2,13,26,37,41,42,1006**;Mar 29, 1996;Build 29
ORCHK(DFN,TYP,PTR,LOC,REAC,COMM) ; Given a patient IEN (DFN), this function will
+1 ; return 1 (true) if the patient has an allergy to an agent defined
+2 ; by TYP and PTR, else it returns 0 (false). See table below.
+3 ; The Contrast Media Reaction check will return a null if the patient
+4 ; is not in the ART database. Contrast Media checks will also
+5 ; return whether the check is from local or remote data as the second
+6 ; piece of the flag if LOC is defined as a positive integer
+7 ;
+8 ; Contrast Media Reaction: TYP="CM", PTR (undefined)
+9 ; Drug Reaction: TYP="DR", PTR=IEN in ^PSNDF(.
+10 ; Drug Ingredients: TYP="IN", PTR=IEN in ^PS(50.416,
+11 ; Drug Class: TYP="CL", PTR=IEN in ^PS(50.605,
+12 ;Patch 1006 modified for reactions and comments
+13 ;Patch 1006 modified to fix multiple ingredients
+14 ;37
NEW GMRAFLG,GMRACM,DA
+15 SET GMRAFLG=0
+16 SET REAC=$GET(REAC)
SET COMM=$GET(COMM)
+17 IF $GET(DFN)<1!("^CM^DR^IN^CL^"'[("^"_$GET(TYP)_"^"))!($GET(TYP)'="CM"&($GET(PTR)<1))
SET GMRAFLG=""
+18 IF '$TEST
Begin DoDot:1
+19 ;26 Retreive local/remote allergy data for order checking
DO GETDATA(DFN)
+20 ;37 check for Contrast Media Reaction, return location if requested
IF TYP="CM"
SET GMRAFLG=$$RAD(DFN)_$SELECT($GET(LOC)&($GET(GMRACM)'=""):("^"_$GET(GMRACM)),1:"")
+21 ; check for Drug Reaction
IF TYP="DR"
SET GMRAFLG=$$DRUG(DFN,PTR,REAC,COMM)
+22 ; Check for Drug Ingredients
IF TYP="IN"
SET GMRAFLG=$$ING(DFN,PTR,REAC,COMM)
+23 ; Check for Drug Class
IF TYP="CL"
SET GMRAFLG=$$CLASS(DFN,PTR,REAC,COMM)
+24 QUIT
End DoDot:1
+25 QUIT GMRAFLG
RAD(DFN) ; Subroutine checks for Contrast Media Reaction, returns 1 or 0.
+1 ;37 entire section added
NEW FLG,DC,LOCAL,REMOTE
+2 SET FLG=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
IF FLG=1
SET FLG=0
SET DC="DX10"
FOR
SET DC=$ORDER(^TMP("GMRAOC",$JOB,"APC",DC))
IF DC'["DX10"
QUIT
Begin DoDot:1
+3 SET FLG=1
+4 IF $GET(^TMP("GMRAOC",$JOB,"APC",DC))["LOCAL"
SET LOCAL=1
+5 IF $GET(^TMP("GMRAOC",$JOB,"APC",DC))["REMOTE"
SET REMOTE=1
End DoDot:1
+6 SET GMRACM=$SELECT($GET(LOCAL)&($GET(REMOTE)):"LOCAL AND REMOTE SITE(S)",$GET(LOCAL):"LOCAL",$GET(REMOTE):"REMOTE SITE(S)",1:"")
+7 ;D EN1^GMRADPT S FLG=GMRAL
+8 ;I GMRAL S GMRAPA=0 F S GMRAPA=$O(GMRAL(GMRAPA)) Q:GMRAPA<1 D Q:FLG
+9 ;.S FLG=$$RALLG^GMRARAD(GMRAPA)
+10 ;.Q
+11 QUIT FLG
DRUG(DFN,PTR,REAC,COMM) ; Subroutine checks for Drug Reaction, returns 1 or 0.
+1 NEW %,J,FLG,GMRAC,GMRADR,GMRAI,PSNVPN,PSNDA,X1
SET FLG=0
+2 KILL GMRAING,GMRADRCL,GMRAREAC,GMRACOM
+3 SET PSNDA=$PIECE(PTR,".")
SET PSNVPN=$PIECE(PTR,".",2)
+4 IF $GET(@($$NDFREF_PSNDA_",0)"))'=""
Begin DoDot:1
+5 ; Check for rxn to ingredients.
+6 ; If use the new entry point if there.
+7 IF $TEXT(DISPDRG^PSNNGR)]""
IF PSNVPN]""
Begin DoDot:2
+8 ; get ingredients
KILL ^TMP("PSNDD",$JOB)
DO DISPDRG^PSNNGR
+9 SET GMRAI=0
SET %=1
FOR
SET GMRAI=$ORDER(^TMP("PSNDD",$JOB,GMRAI))
IF GMRAI<1
QUIT
IF $DATA(^TMP("GMRAOC",$JOB,"API",GMRAI))
Begin DoDot:3
+10 ;IHS/MSC/MGH Mod for active
+11 SET X1=""
SET X1=$ORDER(^GMR(120.8,"API",DFN,GMRAI,X1))
IF X1=""
QUIT
Begin DoDot:4
+12 IF $$ACTIVE(X1)
Begin DoDot:5
+13 ;26
SET FLG=1
SET GMRAING(%)=^TMP("PSNDD",$JOB,GMRAI)_$$FAC(^TMP("GMRAOC",$JOB,"API",GMRAI))
SET %=%+1
+14 IF REAC=1
DO GETREAC(X1,.GMRAREAC)
+15 IF COMM=1
DO GETCOM(X1,.GMRACOM)
End DoDot:5
End DoDot:4
End DoDot:3
+16 KILL ^TMP("PSNDD",$JOB)
+17 QUIT
End DoDot:2
+18 ; get ingredients
IF '$TEST
Begin DoDot:2
+19 KILL ^TMP("PSN",$JOB)
DO ^PSNNGR
+20 SET GMRAI=0
SET %=1
FOR
SET GMRAI=$ORDER(^TMP("PSN",$JOB,GMRAI))
IF GMRAI<1
QUIT
IF $DATA(^TMP("GMRAOC",$JOB,"API",GMRAI))
Begin DoDot:3
+21 ;IHS/MSC/MGH mod for active
+22 SET X1=""
SET X1=$ORDER(^GMR(120.8,"API",DFN,GMRAI,X1))
IF X1=""
QUIT
Begin DoDot:4
+23 IF $$ACTIVE(X1)
Begin DoDot:5
+24 ;26
SET FLG=1
SET GMRAING(%)=^TMP("PSN",$JOB,GMRAI)_$$FAC(^TMP("GMRAOC",$JOB,"API",GMRAI))
SET %=%+1
+25 IF REAC=1
DO GETREAC(X1,.GMRAREAC)
+26 IF COMM=1
DO GETCOM(X1,.GMRACOM)
End DoDot:5
End DoDot:4
End DoDot:3
+27 KILL ^TMP("PSN",$JOB)
+28 QUIT
End DoDot:2
+29 ; Rxn to ingredient, quit now.
IF FLG
QUIT
+30 ; Check for rxn to VA Drug Class
+31 SET PSNDA=$PIECE(PTR,".")
SET PSNVPN=$PIECE(PTR,".",2)
+32 NEW CLASS
+33 IF PSNVPN
SET CLASS=$$DCLCODE^PSNAPIS(PSNDA,PSNVPN)
DO DRCL(CLASS,REAC,COMM)
QUIT
+34 NEW CLASS,GMRALIST
+35 SET GMRALIST=$$CLIST^PSNAPIS(PSNDA,.GMRALIST)
IF '$GET(GMRALIST)
QUIT
+36 SET GMRALIST=0
FOR
SET GMRALIST=$ORDER(GMRALIST(GMRALIST))
IF 'GMRALIST
QUIT
DO DRCL($PIECE(GMRALIST(GMRALIST),U,2),REAC,COMM)
+37 QUIT
End DoDot:1
+38 QUIT FLG
FAC(NODE) ;
+1 NEW FAC
+2 SET FAC=$SELECT($LENGTH(NODE):" ("_NODE_")",1:"")
+3 QUIT FAC
DRCL(CODE,REAC,COMM) ;return any rxn's in GMRADRCL(
+1 NEW X1
+2 IF '$DATA(^TMP("GMRAOC",$JOB,"APC",CODE))
QUIT
+3 ;IHS/MSC/MGH Check for active
+4 SET X1=""
SET X1=$ORDER(^GMR(120.8,"APC",DFN,CODE,X1))
IF X1=""
QUIT
Begin DoDot:1
+5 IF $$ACTIVE(X1)
Begin DoDot:2
+6 NEW J
SET J=$SELECT('$DATA(GMRADRCL):1,1:$ORDER(GMRADRCL(999),-1)+1)
+7 ;S GMRADRCL(J)=$$CLASS2^PSNAPIS(CODE)
+8 NEW CLSFN
+9 ;S CLSFN=$P(^PS(50.605,+$O(^PS(50.605,"B",CODE,0)),0),U,2)
+10 SET CLSFN=$$CODE2CL^GMRAPENC(CODE)
+11 SET GMRADRCL(J)=CODE_"^"_CLSFN_$$FAC(^TMP("GMRAOC",$JOB,"APC",CODE))
+12 IF REAC=1
DO GETREAC(X1)
+13 IF COMM=1
DO GETCOM(X1)
+14 SET FLG=2
End DoDot:2
End DoDot:1
+15 QUIT
ING(DFN,PTR,REAC,COMM) ; Subroutine checks for Drug Ingredients, returns:
+1 ; If found FLG= 1 with GMRAIEN Array Drug Ingredients
+2 ; Not found FLG= 0
+3 NEW GMRAX
KILL GMRAIEN,GMRAREAC
+4 SET FLG=0
+5 SET GMRAX=0
+6 ;IHS/MSC/MGH added check for inactive entries
+7 FOR
SET GMRAX=$ORDER(^GMR(120.8,"API",DFN,PTR,GMRAX))
IF GMRAX<1
QUIT
Begin DoDot:1
+8 SET X1=""
SET X1=$ORDER(^GMR(120.8,"API",DFN,GMRAI,X1))
IF X1=""
QUIT
Begin DoDot:2
+9 IF $$ACTIVE(X1)
Begin DoDot:3
+10 SET FLG=1
SET GMRAIEN(GMRAX)=""
+11 IF REAC=1
DO GETREAC(GMRAX,.GMRAREAC)
+12 IF COMM=1
DO GETCOM(GMRAX,.GMRACOM)
End DoDot:3
End DoDot:2
+13 ;END MOD
End DoDot:1
+14 QUIT FLG
CLASS(DFN,PTR,REAC,COMM) ; Subroutine checks for Drug Class, returns:
+1 ; If found FLG= 1 with GMRAIEN Array Drug Class
+2 ; Not found FLG= 0
+3 NEW GMRAC,GMRAX
KILL GMRAIEN
+4 ;S GMRAX=0,FLG=0,GMRAC=$P($G(^PS(50.605,PTR,0)),U)
+5 SET GMRAX=0
SET FLG=0
SET GMRAC=$$CLP2CODE^GMRAPENC(PTR)
+6 IF GMRAC'=""
FOR
SET GMRAX=$ORDER(^GMR(120.8,"APC",DFN,GMRAC,GMRAX))
IF GMRAX<1
QUIT
Begin DoDot:1
+7 ;IHS/MSC/MGH Check for active
+8 IF $$ACTIVE(GMRAX)
Begin DoDot:2
+9 SET FLG=1
SET GMRAIEN(GMRAX)=""
+10 IF REAC=1
DO GETREAC(GMRAX,.GMRAREAC)
+11 IF COMM=1
DO GETCOM(GMRAX,.GMRACOM)
End DoDot:2
End DoDot:1
+12 QUIT FLG
NDFREF() ;get version dependent NDF reference
+1 IF $$VERSION^XPDUTL("PSN")<4
QUIT "^PSNDF("
+2 ; new reference for ver 4.0
QUIT "^PSNDF(50.6,"
+3 ;
GETDATA(DFN) ;Obtain local and HDR related allergy data for use in order checking. Section added in patch 26
+1 ;Output from call will be stored in ^TMP as follows:
+2 ;^TMP("GMRAOC",$J,"API",J)="" where J is the ingredient IEN
+3 ;^TMP("GMRAOC",$J,"APC",K)="" where K is the drug class classification (e.g. MS105)
+4 ;
+5 FOR
LOCK +^XTMP("GMRAOC",DFN):1
IF $TEST
QUIT
+6 NEW GMRRECDT,GMRCACHE,GMRFRESH,GMRNEW,GMRXTMP
+7 SET (GMRFRESH,GMRNEW,GMRXTMP)=0
+8 SET GMRRECDT=$PIECE($GET(^XTMP("ORRDI","ART",DFN,0)),U)
+9 SET GMRCACHE=$$GET^XPAR("SYS","OR RDI CACHE TIME")
+10 IF $$FMDIFF^XLFDT($$NOW^XLFDT,GMRRECDT,2)<(60*GMRCACHE)
IF $PIECE(^XTMP("ORRDI","ART",DFN,0),U,3)>-1
SET GMRFRESH=1
+11 SET GMRXTMP=$DATA(^XTMP("GMRAOC",DFN))
+12 SET GMRNEW=$SELECT($DATA(^XTMP("GMRAOC",DFN,"ERROR")):2,$DATA(^XTMP("GMRAOC",DFN,"NEW")):1,1:0)
+13 IF GMRFRESH&GMRXTMP&(GMRNEW=1)
KILL ^XTMP("GMRAOC",DFN,"NEW")
DO LOCAL(DFN)
+14 IF 'GMRFRESH!'GMRXTMP!(GMRNEW=2)
KILL ^XTMP("GMRAOC",DFN)
DO REMOTE(DFN)
DO LOCAL(DFN)
+15 KILL ^TMP("GMRAOC",$JOB)
+16 MERGE ^TMP("GMRAOC",$JOB)=^XTMP("GMRAOC",DFN)
+17 ;42
SET ^XTMP("GMRAOC",DFN,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
+18 LOCK -^XTMP("GMRAOC",DFN)
+19 QUIT
+20 ;
LOCAL(DFN) ;
+1 NEW J,K,L,M,NAREAC,X1,ACOM
+2 SET J=0
FOR
SET J=$ORDER(^GMR(120.8,"API",DFN,J))
IF '+J
QUIT
Begin DoDot:1
+3 SET X1=""
SET X1=$ORDER(^GMR(120.8,"API",DFN,J,X1))
IF X1=""
QUIT
Begin DoDot:2
+4 IF $$ACTIVE(X1)
Begin DoDot:3
+5 SET ^XTMP("GMRAOC",DFN,"API",J)=$$SETNODE^GMRAOR1($GET(^XTMP("GMRAOC",DFN,"API",J)),"LOCAL")
+6 SET K=0
FOR
SET K=$ORDER(^GMR(120.8,"API",DFN,J,K))
IF '+K
QUIT
Begin DoDot:4
+7 KILL AREAC
DO GETREAC(K,.AREAC)
+8 KILL ACOM
DO GETCOM(K,.ACOM)
+9 SET L=0
FOR
SET L=$ORDER(AREAC(L))
IF '+L
QUIT
Begin DoDot:5
+10 SET ^XTMP("GMRAOC",DFN,"API",J,"REAC",L)=$GET(AREAC(L))
End DoDot:5
+11 SET L=0
FOR
SET L=$ORDER(ACOM(L))
IF '+L
QUIT
Begin DoDot:5
+12 SET M=0
FOR
SET M=$ORDER(ACOM(L,M))
IF '+M
QUIT
Begin DoDot:6
+13 SET ^XTMP("GMRAOC",DFN,"API",J,"COM",M)=$GET(ACOM(L,M,0))
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET J=""
FOR
SET J=$ORDER(^GMR(120.8,"APC",DFN,J))
IF J=""
QUIT
Begin DoDot:1
+15 SET X1=""
SET X1=$ORDER(^GMR(120.8,"APC",DFN,J,X1))
IF X1=""
QUIT
Begin DoDot:2
+16 IF $$ACTIVE(X1)
Begin DoDot:3
+17 SET ^XTMP("GMRAOC",DFN,"APC",J)=$$SETNODE^GMRAOR1($GET(^XTMP("GMRAOC",DFN,"APC",J)),"LOCAL")
+18 SET K=0
FOR
SET K=$ORDER(^GMR(120.8,"APC",DFN,J,K))
IF '+K
QUIT
Begin DoDot:4
+19 KILL AREAC
DO GETREAC(K,.AREAC)
+20 KILL ACOM
DO GETCOM(K,.ACOM)
+21 SET L=0
FOR
SET L=$ORDER(AREAC(L))
IF '+L
QUIT
Begin DoDot:5
+22 SET ^XTMP("GMRAOC",DFN,"APC",J,"REAC",L)=$GET(AREAC(L))
End DoDot:5
+23 SET L=0
FOR
SET L=$ORDER(ACOM(L))
IF '+L
QUIT
Begin DoDot:5
+24 SET M=0
FOR
SET M=$ORDER(ACOM(L,M))
IF '+M
QUIT
Begin DoDot:6
+25 SET ^XTMP("GMRAOC",DFN,"APC",J,"COM",M)=$GET(ACOM(L,M,0))
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
REMOTE(DFN) ;
+1 NEW J,FLG,REACT,IN,VUID,FILE,GMRARAY,DC,DCLASS,GMRAING,GMRADC,K,INGLST,I,PRIM,IEN
+2 ;Check for HDR data
+3 ;Quit if call doesn't exist or if the HDR isn't available
IF '$LENGTH($TEXT(HAVEHDR^ORRDI1))
QUIT
IF '$$HAVEHDR^ORRDI1
QUIT
+4 ;Quit if no HDR data for selected patient
IF '$$GET^ORRDI1(DFN,"ART")
QUIT
+5 SET J=0
FOR
SET J=$ORDER(^XTMP("ORRDI","ART",DFN,J))
IF '+J
QUIT
Begin DoDot:1
+6 SET FLG=0
+7 ;Reaction VUID
SET REACT=$GET(^XTMP("ORRDI","ART",DFN,J,"REACTANT",0))
+8 ;Ingredient data exists
IF $DATA(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS"))
Begin DoDot:2
+9 ;Have ingredient data so REACT is ok
SET FLG=1
+10 SET IN=0
FOR
SET IN=$ORDER(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS",IN))
IF '+IN
QUIT
Begin DoDot:3
+11 ;Naked from above line
SET VUID=$PIECE(^(IN),U)
SET FILE=$PIECE(^(IN),U,3)
+12 SET FILE=$PIECE(FILE,"99VA",2)
+13 ;Get IENs related to VUID
DO GETIREF^XTID(FILE,,VUID,"GMRARAY")
+14 SET IEN=0
FOR
SET IEN=$ORDER(GMRARAY(FILE,.01,IEN))
IF '+IEN
QUIT
SET ^XTMP("GMRAOC",DFN,"API",+IEN)=$$SETNODE^GMRAOR1($GET(^XTMP("GMRAOC",DFN,"API",+IEN)),"REMOTE SITE(S)")
+15 KILL GMRARAY
End DoDot:3
End DoDot:2
+16 ;Drug class data exists
IF $DATA(^XTMP("ORRDI","ART",DFN,J,"DRUG CLASSES"))
Begin DoDot:2
+17 SET FLG=1
+18 SET DC=0
FOR
SET DC=$ORDER(^XTMP("ORRDI","ART",DFN,J,"DRUG CLASSES",DC))
IF '+DC
QUIT
Begin DoDot:3
+19 ;Naked from above, gets drug class (e.g.MS105)
SET DCLASS=$PIECE(^(DC),U,2)
+20 SET ^XTMP("GMRAOC",DFN,"APC",DCLASS)=$$SETNODE^GMRAOR1($GET(^XTMP("GMRAOC",DFN,"APC",DCLASS)),"REMOTE SITE(S)")
End DoDot:3
End DoDot:2
+21 DO FIND(REACT,.GMRAING,.GMRADC)
IF $DATA(GMRAING)!($DATA(GMRADC))
Begin DoDot:2
+22 SET K=0
FOR
SET K=$ORDER(GMRAING(K))
IF '+K
QUIT
SET ^XTMP("GMRAOC",DFN,"API",K)=$$SETNODE^GMRAOR1($GET(^XTMP("GMRAOC",DFN,"API",K)),"REMOTE SITE(S)")
+23 SET K=""
FOR
SET K=$ORDER(GMRADC(K))
IF K=""
QUIT
SET ^XTMP("GMRAOC",DFN,"APC",K)=$$SETNODE^GMRAOR1($GET(^XTMP("GMRAOC",DFN,"APC",K)),"REMOTE SITE(S)")
End DoDot:2
End DoDot:1
+24 IF $DATA(^XTMP("GMRAOC",DFN,"API"))
Begin DoDot:1
+25 NEW I,INGLST
+26 SET I=0
FOR
SET I=$ORDER(^XTMP("GMRAOC",DFN,"API",I))
IF 'I
QUIT
Begin DoDot:2
+27 NEW PRIM
+28 SET PRIM=$$PRIMARY(I)
+29 IF PRIM
SET INGLST(PRIM)=^XTMP("GMRAOC",DFN,"API",I)
KILL ^XTMP("GMRAOC",DFN,"API",I)
End DoDot:2
+30 SET I=0
FOR
SET I=$ORDER(INGLST(I))
IF 'I
QUIT
SET ^XTMP("GMRAOC",DFN,"API",I)=INGLST(I)
End DoDot:1
+31 QUIT
+32 ;
FIND(REACT,ING,DC) ;If reactant didn't include drug classes and/or ingredients, try and find them locally. Section added in patch 26
+1 NEW VUID,FILE,PSNDA,GMRAIEN,LIST,GMRAI,GMRALIST,GMRARAY,J,SUB,FLAG
+2 SET FLAG=0
+3 SET VUID=$PIECE(REACT,U)
+4 SET FILE=$PIECE(REACT,U,3)
+5 SET FILE=$PIECE(FILE,"99VA",2)
+6 DO GETIREF^XTID(,,VUID,"GMRARAY")
+7 SET FILE=""
FOR
SET FILE=$ORDER(GMRARAY(FILE))
IF FILE=""
QUIT
Begin DoDot:1
+8 SET GMRAIEN=0
FOR
SET GMRAIEN=$ORDER(GMRARAY(FILE,.01,GMRAIEN))
IF '+GMRAIEN
QUIT
Begin DoDot:2
+9 IF FILE=50.6
Begin DoDot:3
+10 KILL ^TMP("PSN",$JOB)
SET PSNDA=+GMRAIEN
DO ^PSNNGR
+11 SET GMRAI=0
FOR
SET GMRAI=$ORDER(^TMP("PSN",$JOB,GMRAI))
IF GMRAI<1
QUIT
SET ING(GMRAI)=""
+12 KILL ^TMP("PSN",$JOB),GMRARAY
+13 SET PSNDA=+GMRAIEN
SET GMRALIST=$$CLIST^PSNAPIS(PSNDA,.GMRALIST)
IF '$GET(GMRALIST)
QUIT
+14 SET GMRALIST=0
FOR
SET GMRALIST=$ORDER(GMRALIST(GMRALIST))
IF 'GMRALIST
QUIT
SET DC($PIECE(GMRALIST(GMRALIST),U,2))=""
End DoDot:3
+15 IF FILE=120.82
Begin DoDot:3
+16 ;record ingredients
SET SUB=0
FOR
SET SUB=$ORDER(^GMRD(120.82,+GMRAIEN,"ING",SUB))
IF '+SUB
QUIT
SET ING(+$PIECE($GET(^GMRD(120.82,+GMRAIEN,"ING",SUB,0)),U))=""
+17 ;Get drug classes
SET SUB=0
FOR
SET SUB=$ORDER(^GMRD(120.82,+GMRAIEN,"CLASS",SUB))
IF '+SUB
QUIT
SET DC($PIECE($$CLASS2^PSNAPIS(+$PIECE($GET(^GMRD(120.82,+GMRAIEN,"CLASS",SUB,0)),U)),U))=""
End DoDot:3
+18 IF FILE=50.605
Begin DoDot:3
+19 SET DC($PIECE($$CLASS2^PSNAPIS(+GMRAIEN),U))=""
End DoDot:3
+20 IF FILE=50.416
Begin DoDot:3
+21 SET ING(+GMRAIEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
PRIMARY(INGIEN) ;check if INGIEN is a primary ingredient
+1 ;returns 0 if INGIEN is primary
+2 ;returns the IEN of INGIEN's primary ingredient if INGIEN is not primary
+3 NEW RETURN
+4 KILL ^TMP($JOB,"GMRALIST")
+5 DO ZERO^PSN50P41(INGIEN,,,"GMRALIST")
+6 SET RETURN=+$GET(^TMP($JOB,"GMRALIST",INGIEN,2))
+7 QUIT RETURN
ACTIVE(ALL) ;Check allergy to see if it is inactive
+1 NEW IN,Z,INACT,REACT
+2 SET IN=1
+3 IF '$DATA(^GMR(120.8,ALL,9999999.12))
QUIT IN
+4 SET Z=$ORDER(^GMR(120.8,ALL,9999999.12,$CHAR(0)),-1)
IF +Z
Begin DoDot:1
+5 SET INACT=$PIECE($GET(^GMR(120.8,ALL,9999999.12,Z,0)),U,1)
+6 SET REACT=$PIECE($GET(^GMR(120.8,ALL,9999999.12,Z,0)),U,4)
+7 IF +INACT&(REACT="")
SET IN=0
End DoDot:1
+8 QUIT IN
GETREAC(ALG,GMRAREAC) ;IHS/MSC/MGH for reactions Patch 1006
+1 KILL GMRAREAC,GMRAII,GMRAOTH,CNT
+2 ;Signs/Symptoms
+3 SET CNT=0
+4 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+5 SET GMRAII=0
FOR %=1:1
SET GMRAII=$ORDER(^GMR(120.8,ALG,10,GMRAII))
IF GMRAII<1
QUIT
Begin DoDot:1
+6 NEW GMRAZ,SSRC
+7 SET CNT=CNT+1
+8 SET GMRAZ=$GET(^GMR(120.8,ALG,10,GMRAII,0))
IF GMRAZ=""
QUIT
+9 SET GMRAREAC(CNT)=$SELECT(+GMRAZ'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+GMRAZ,0)),U),1:$PIECE(GMRAZ,U,2))_$SELECT($PIECE(GMRAZ,U,4)'="":" ("_$$FMTE^XLFDT($PIECE(GMRAZ,U,4),2)_")",1:"")
+10 SET SSRC=$PIECE($GET(^GMR(120.8,ALG,10,GMRAII,9999999.11)),U)
+11 ;MU patch add source MSC/IHS/MGH
IF +SSRC
SET GMRAREAC(CNT)=GMRAREAC(CNT)_" Src: "_$PIECE($GET(^BEHOAR(90460.05,SSRC,0)),U,1)
End DoDot:1
+12 QUIT
GETCOM(ALG,GMRACOM) ;IHS/MSC/MGH for comments Patch 1006
+1 KILL GMRACOM,GMRAIC,CNT
+2 SET CNT=0
+3 SET GMRAIC=0
FOR %=1:1
SET GMRAIC=$ORDER(^GMR(120.8,ALG,26,GMRAIC))
IF GMRAIC<1
QUIT
Begin DoDot:1
+4 NEW GMRAZ
+5 SET CNT=CNT+1
+6 SET GMRAZ=$GET(^GMR(120.8,ALG,26,GMRAIC,0))
IF GMRAZ=""
QUIT
+7 MERGE GMRACOM(CNT)=^GMR(120.8,ALG,26,GMRAIC,2)
End DoDot:1
+8 QUIT
