GMRAOR ; HIRMFO/WAA,RM - ORDER CHECK UTILITY ;May 11, 2021@13:18:40
;;4.0;Adverse Reaction Tracking;**2,13,26,37,41,42,44,46,52,53,63,70**;Mar 29, 1996;Build 5
Q
ORCHK(DFN,TYP,PTR,LOC) ;DETERMINE IF PATIENT HAS ADVERSE REACTION TO AGENT
;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2378
;*BD
N GMRAFLG,GMRACM,DA,GMRAV1,GMRAOTH
S GMRAFLG=0,GMRAV1=1,GMRAOTH=+$O(^GMRD(120.83,"B","OTHER REACTION",0))
I $G(DFN)<1!("^CM^DR^IN^CL^"'[("^"_$G(TYP)_"^"))!($G(TYP)'="CM"&($G(PTR)<1)) S GMRAFLG=""
E D
.K GMRAING,GMRADRCL,GMRAIEN
.D GETDATA(DFN)
.I TYP="CM" S GMRAFLG=$$RAD(DFN,+$G(LOC))
.I TYP="DR" S GMRAFLG=$$DRUG(DFN,PTR)
.I TYP="IN" S GMRAFLG=$$ING(DFN,PTR)
.I TYP="CL" S GMRAFLG=$$CLASS(DFN,PTR)
K ^TMP("GMRAOC",$J)
Q GMRAFLG
;*ED
Q $$ORCHK2(DFN,TYP,PTR,LOC)
ORCHK2(DFN,TYP,PTR,LOC,RETURN) ;DETERMINE IF PATIENT HAS ADVERSE REACTION TO AGENT
;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2378
;PARAMETERS: DFN => IEN IN THE PATIENT FILE (#2)
; TYP => TYPE OF CHECK TO PERFORM
; "CM": CONTRAST MEDIA
; "DR": DRUG
; "IN": DRUG INGREDIENT
; "CL": DRUG CLASS
; PTR => AGENT
; TYP="CM", PTR IS IGNORED
; TYP="DR", PTR=PSNDA.PSNVPN.LPTR, WHERE
; PSNDA IS IEN IN VA GENERIC FILE (#50.6),
; PSNVPN IS IEN IN VA PRODUCT FILE (#50.68), AND
; LPTR IS IEN IN DRUG FILE (#50)
; TYP="IN", PTR=IEN IN DRUG INGREDIENTS FILE (#50.416)
; TYP="CL", PTR=IEN IN VA DRUG CLASS FILE (#50.605)
; LOC => FOR TYP="CM" ONLY, 1 TO RETURN LOCATION(S) IN SECOND CARET PIECE OF $$ORCHK
; FOR TYP="CM" ONLY, 0 OR UNDEFINED TO NOT RETURN LOCATION(S) IN SECOND CARET PIECE OF $$ORCHK
; RETURN => FOR TYP="DR" ONLY, NAME OF ARRAY IN WHICH TO RETURN ORDER CHECK MESSAGES AND REACTION DATA
;RETURN: -1 => BAD PARAMETERS
; EMPTY STRING => NO ASSESSMENT
; 0 => NO REACTION
; 1 => FOR TYP="CM", PATIENT HAS REACTION
; FOR TYP="IN" AND TYP="CL", PATIENT HAS REACTION; INGREDIENT(S) RETURNED IN GMRAING() AND
; DRUG CLASS(ES) IN GMRADRCL()
; FOR TYP="DR", PATIENT HAS REACTION
I +$G(DFN)<1!("^CM^DR^IN^CL^"'[(U_$G(TYP)_U)) Q -1
I $G(TYP)="DR",PTR'?.N.1".".N.1".".N Q -1
I +$G(PTR)<1,($G(TYP)="IN"!($G(TYP)="CL")) Q -1
I +$G(LOC)>0,($G(TYP)'="CM") Q -1
I $G(TYP)="DR" I $G(RETURN)=""!($G(RETURN)="RETURN") Q -1
K GMRAING,GMRADRCL,GMRAREAC
N GMRAFLG,GMRASESS,IDX,GMRAOTH
S GMRAFLG=0,GMRASESS="",GMRAOTH=+$O(^GMRD(120.83,"B","OTHER REACTION",0))
;*BD MOVE CODE IN LINETAG TO HERE
D GETDATA(DFN)
;*ED
S GMRASESS=$$NKA^GMRANKA(DFN)
I +GMRASESS=0,($D(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))>9) D
.S IDX=0 F S IDX=$O(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX)) Q:'IDX D
..I $P(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX),U,2)="YES" S GMRASESS=1
..I GMRASESS'=1,($P(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX),U,2)'="YES") S GMRASESS=0
Q:'+GMRASESS GMRASESS
I TYP="CM" S GMRAFLG=$$RAD(DFN,+$G(LOC))
I TYP="DR" S GMRAFLG=$$DRUG(DFN,PTR)
I TYP="IN" S GMRAFLG=$$ING(DFN,PTR)
I TYP="CL" S GMRAFLG=$$CLASS(DFN,PTR)
K ^TMP("GMRAOC",$J)
Q GMRAFLG
RAD(DFN,LOC) ;CONTRAST MEDIA CHECK
;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
; LOC => 1 TO RETURN LOCATION(S)
; 0 OR UNDEFINED TO NOT RETURN LOCATION(S)
;RETURN: HAS_REACTION^LOCATION(S), WHERE
; HAS_REACTION IS 0 FOR PATIENT DOES NOT HAVE A REACTION
; AND 1 IS FOR PATIENT HAS REACTION AND
; LOCATION(S) IS A SCREEN-PRINTABLE STRING OF ALL THE LOCATIONS DOCUMENTING
; A REACTION
N FLG,DC,DELIMIT,REACT,SITES,SITE,GMRACM,COUNT
;*BD
N LOCAL,REMOTE
;*ED
S FLG=0,DC="DX10" F S DC=$O(^TMP("GMRAOC",$J,"APC",DC)) Q:DC'["DX10" D
.S FLG=1
.I $G(LOC) D
..;*BD
..I $G(GMRAV1) D
...I $G(^TMP("GMRAOC",$J,"APC",DC))["LOCAL" S LOCAL=1
...I $G(^TMP("GMRAOC",$J,"APC",DC))["REMOTE" S REMOTE=1
..I '$G(GMRAV1) D
...;*ED (C U DOTS)
...S REACT="" F S REACT=$O(^TMP("GMRAOC",$J,"APC",DC,REACT)) Q:REACT="" D
....Q:$D(SITES(REACT))
....S SITES=1+$G(SITES),SITES(REACT)=$$GET1^DIQ(4,$P(^TMP("GMRAOC",$J,"APC",DC,REACT),U),.01)
....S SITES(REACT)=SITES(REACT)_" entered on "_$$FMTE^XLFDT($P(^TMP("GMRAOC",$J,"APC",DC,REACT),U,3))
I $G(LOC) D
.;*BD
.I $G(GMRAV1) D
..S GMRACM=$S($G(LOCAL)&($G(REMOTE)):"LOCAL AND REMOTE SITE(S)",$G(LOCAL):"LOCAL",$G(REMOTE):"REMOTE SITE(S)",1:"")
.I '$G(GMRAV1) D
..;*ED (C U DOTS)
..S DELIMIT=", ",SITE="",COUNT=1
..F S SITE=$O(SITES(SITE)) Q:SITE="" D
...S:COUNT=SITES DELIMIT=" and "
...S GMRACM=$S($G(GMRACM)'="":GMRACM_DELIMIT,1:"")_SITES(SITE),COUNT=COUNT+1
Q FLG_$S($G(GMRACM)'="":U_GMRACM,1:"")
DRUG(DFN,PTR) ;DRUG CHECK
;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
; PTR => PSNDA.PSNVPN.LPTR, WHERE
; PSNDA IS IEN IN VA GENERIC FILE (#50.6),
; PSNVPN IS IEN IN VA PRODUCT FILE (#50.68), AND
; LPTR IS IEN IN DRUG FILE (#50)
;RETURN: 1 => REACTION TO DRUG
; 0 => NO REACTION TO DRUG
N %,FLG,GMRAC,GMRADR,GMRAI,PSNVPN,PSNDA,LPTR,GMRANVPN,GMRANDA,REACT,CLASS,GMRALIST
N TMPFLG,REACS,NODE
S (FLG,TMPFLG)=0,GMRANDA=$P(PTR,"."),GMRANVPN=$P(PTR,".",2),LPTR=$P(PTR,".",3)
I GMRANDA>0,($G(@($$NDFREF_GMRANDA_",0)"))'="") D
.;INGREDIENT
.S PSNDA=GMRANDA
.I $T(DISPDRG^PSNNGR)]"",GMRANVPN]"" D
..S NODE="PSNDD",PSNVPN=GMRANVPN
..K ^TMP(NODE,$J)
..D DISPDRG^PSNNGR ;ICR #151
.I $T(DISPDRG^PSNNGR)=""!(GMRANVPN="") D
..S NODE="PSN"
..K ^TMP(NODE,$J)
..D ^PSNNGR ;ICR #151
.S GMRAI=0,%=1 F S GMRAI=$O(^TMP(NODE,$J,GMRAI)) Q:GMRAI<1 I $D(^TMP("GMRAOC",$J,"API",GMRAI)) D
..S FLG=1
..;*BD (C U % VAR)
..I $G(GMRAV1) S GMRAING(%)=^TMP(NODE,$J,GMRAI)_$$FAC(^TMP("GMRAOC",$J,"API",GMRAI)),%=%+1
..I '$G(GMRAV1) D
...;*ED (C U DOTS)
...S REACT="" F S REACT=$O(^TMP("GMRAOC",$J,"API",GMRAI,REACT)) Q:REACT="" D
....S REACS(REACT)=$G(^TMP("GMRAOC",$J,"API",GMRAI,REACT))
....I $G(REACS(REACT,"ING"))'[GMRAI S REACS(REACT,"ING")=$S($D(REACS(REACT,"ING")):REACS(REACT,"ING")_"~",1:"")_^TMP(NODE,$J,GMRAI)_U_GMRAI
.K ^TMP(NODE,$J)
.;*BD
.I $G(GMRAV1),FLG Q
.;*ED
.;DRUG CLASS
.I GMRANVPN D Q
..S CLASS=$$DCLCODE^PSNAPIS(GMRANDA,GMRANVPN) ;ICR #2531
..S TMPFLG=$$PCCHK(CLASS)
..S:TMPFLG>0 FLG=TMPFLG
.S GMRALIST=$$CLIST^PSNAPIS(GMRANDA,.GMRALIST) Q:'$G(GMRALIST) ;ICR #2574
.S GMRALIST=0 F S GMRALIST=$O(GMRALIST(GMRALIST)) Q:'GMRALIST D
..S TMPFLG=$$PCCHK($P(GMRALIST(GMRALIST),U,2))
..S:TMPFLG>0 FLG=TMPFLG
;*BD
Q:$G(GMRAV1) FLG
;*ED
I +LPTR>0 D
.;GMR ALLERGY
.N IEN,NAME
.S IEN=0 F S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:'+IEN!(+FLG=3) D
..I $P($G(^GMR(120.8,IEN,0)),U,3)=(LPTR_";PSDRUG("),('$P($G(^GMR(120.8,IEN,"ER")),U)) D
...D DATA^PSS50(LPTR,,,,,"GMRALST") ;ICR #4533
...S NAME=$G(^TMP($J,"GMRALST",LPTR,.01))
...K ^TMP($J,"GMRALST")
...D ADDLDATA($NA(REACS(IEN)),IEN)
...S FLG=3
...I $G(REACS(IEN,"REC"))'[NAME S REACS(IEN,"REC")=$S($D(REACS(IEN,"REC")):"~",1:"")_NAME_U_LPTR
.;DRUG CLASS
.I 'GMRANDA D
..S TMPFLG=$$PCCHK($$DRP2VACL^GMRAPENC(LPTR))
..S:TMPFLG>0 FLG=TMPFLG
S:FLG>0 FLG=1
K @RETURN
N STYPE,IPIECE,OPIECE,FIELDS,FIELDS1,ITEM,FILE,NODE,FIELD,MSGNUM,RINDEX,SITE,SEV
S STYPE("L")="LOCAL",STYPE("R")="REMOTE"
S FIELDS(1,3)="120.8^4^3",FIELDS(1.1,1)="120.85^.01|14.5+^4",FIELDS(2,1)="120.81^.01*^5"
S FIELDS(2,2)="120.8^^6",FIELDS(2,3)="120.8^^7"
S FIELDS(2,3,"OTRANSFORM")="S Y=$S(Y["";PS(50.605,"":$P($G(^PS(50.605,+Y,0)),U,2),1:$P($G(@(U_$P(Y,"";"",2)_+Y_"",0)"")),U)) S:Y="""" Y=""UNKNOWN"""
S FIELDS(1,4)="120.8^6^8"
S FIELDS1(1.1,1)=""
I $D(REACS)>9 D
.S REACT="" F S REACT=$O(REACS(REACT)) Q:REACT="" D
..I $P(REACS(REACT),U,8)="h" S FIELDS1(1.1,1)=$G(FIELDS(1.1,1)),FIELDS(1.1,1)="120.8^9|8+^4"
..S REACT(1)=$S($P(REACS(REACT),U,7)'="":$P(REACS(REACT),U,7),1:$P(REACS(REACT),U,6))
..S REACT(2)=$P(REACS(REACT),U,8) S:REACT(2)="" REACT(2)="UNKNOWN"
..S REACT(3)=$P($P(REACS(REACT),U,4),"|",2) S:REACT(3)="" REACT(3)="UNKNOWN"
..I $D(RINDEX(REACT(1),REACT(2),REACT(3))) S MSGNUM=$O(RINDEX(REACT(1),REACT(2),REACT(3),0))
..E S MSGNUM(0)=1+$G(MSGNUM(0)),MSGNUM=MSGNUM(0),RINDEX(REACT(1),REACT(2),REACT(3),MSGNUM)=""
..S @RETURN@(MSGNUM,REACT)=REACS(REACT),SITE=$P(REACS(REACT),U),@RETURN@(MSGNUM,"MESSAGE",1)=1+$G(@RETURN@(MSGNUM,"MESSAGE",1))
..F NODE="ING","CLS","REC" I $D(REACS(REACT,NODE)) F ITEM=1:1:$L(REACS(REACT,NODE),"~") D
...S $P(@RETURN@(MSGNUM,"MESSAGE","OFFENDERS",NODE),"~",ITEM)=$P($P(REACS(REACT,NODE),"~",ITEM),U)
...S $P(@RETURN@(MSGNUM,REACT,NODE),"~",ITEM)=$P($P(REACS(REACT,NODE),"~",ITEM),U,2)
..S @RETURN@(MSGNUM,"MESSAGE",1,SITE)=$$GET1^DIQ(4,$P(REACS(REACT),U)_",",.01)_U_STYPE($P(REACS(REACT),U,2))_U
..S NODE=0 F S NODE=$O(FIELDS(NODE)) Q:NODE="" S OPIECE=0 F S OPIECE=$O(FIELDS(NODE,OPIECE)) Q:OPIECE="" D
...S FILE=$P(FIELDS(NODE,OPIECE),U),FIELD=$P(FIELDS(NODE,OPIECE),U,2),IPIECE=$P(FIELDS(NODE,OPIECE),U,3)
...I NODE=1 S RETURN=$NA(@RETURN@(MSGNUM,"MESSAGE",NODE,SITE))
...I $L(NODE,".")=2 S RETURN=$NA(@RETURN@(MSGNUM,"MESSAGE",$P(NODE,"."),SITE,$P(NODE,".",2)))
...I NODE'=1,NODE'["." S RETURN=$NA(@RETURN@(MSGNUM,"MESSAGE",NODE))
...I FIELD>0,FIELD'["*",FIELD'["+" S $P(@RETURN,U,OPIECE)=$$EXTERNAL^DILFD(FILE,FIELD,,$P(REACS(REACT),U,IPIECE))
...I 'FIELD,'$D(FIELDS(NODE,OPIECE,"OTRANSFORM")) S $P(@RETURN,U,OPIECE)=$P(REACS(REACT),U,IPIECE)
...I $D(FIELDS(NODE,OPIECE,"OTRANSFORM")) N Y S Y=$P(REACS(REACT),U,IPIECE) X:Y'="" FIELDS(NODE,OPIECE,"OTRANSFORM") S $P(@RETURN,U,OPIECE)=Y
...I FIELD["*" D
....N TEXT,DELIMIT,ITEMS,STR,COUNT,NEWIVAL
....S DELIMIT=", ",COUNT=0,COUNT(1)=1
....I $L($G(@RETURN)) S @RETURN=$$ADDCOMMA(@RETURN) ;p70
....I $P($G(@RETURN),U,OPIECE)'="" F ITEM=1:1:$L($P(@RETURN,U,OPIECE),",") S STR=$P($P(@RETURN,U,OPIECE),",",ITEM) S:$E(STR,1,5)=" and " STR=$E(STR,6,*) I STR'="" S ITEMS(STR)="",COUNT=1+$G(COUNT)
....I $P(REACS(REACT),U,IPIECE)'="" F ITEM=1:1:$L($P(REACS(REACT),U,IPIECE),"~") D
.....S STR=$P($P(REACS(REACT),U,IPIECE),"~",ITEM),$P(NEWIVAL,"~",ITEM)=+STR
.....I STR["-" S STR=$P(STR,"-",2)
.....E S STR=$$EXTERNAL^DILFD(FILE,+FIELD,,STR)
.....I STR'="",'$D(ITEMS(STR)) S ITEMS(STR)="",COUNT=1+$G(COUNT)
....S ITEM="" F S ITEM=$O(ITEMS(ITEM)) Q:ITEM="" D
.....S:COUNT(1)=COUNT DELIMIT=" and "
.....S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_ITEM,COUNT(1)=1+COUNT(1)
....S $P(@RETURN,U,OPIECE)=$G(TEXT),RETURN=$P(RETURN,"(")
....I $G(NEWIVAL)'="",NEWIVAL'=$P(@RETURN@(MSGNUM,REACT),U,IPIECE) S $P(@RETURN@(MSGNUM,REACT),U,IPIECE)=NEWIVAL
...I FIELD["+" D
....N FNUM,ITEMS
....F ITEM=1:1:$L($P(REACS(REACT),U,IPIECE),"~") N STR F FNUM=1:1:$L(FIELD,"|") D S:STR'="" ITEMS(ITEM)=STR
.....;S STR=$S($G(STR)'="":STR_U,1:"")_$$EXTERNAL^DILFD(FILE,+$P(FIELD,"|",FNUM),,$P($P($P(REACS(REACT),U,IPIECE),"~",ITEM),"|",FNUM))
.....S STR=$S(FNUM>1:STR_U,1:"")_$$EXTERNAL^DILFD(FILE,+$P(FIELD,"|",FNUM),,$P($P($P(REACS(REACT),U,IPIECE),"~",ITEM),"|",FNUM))
....M:$D(ITEMS)>9 @RETURN=ITEMS
...I $G(FIELDS1(1.1,1))'="" S FIELDS(1.1,1)=$G(FIELDS1(1.1,1)),FIELDS1(1.1,1)=""
...S RETURN=$P(RETURN,"(")
.S @RETURN=MSGNUM(0)
Q FLG
;*BD
FAC(NODE) ;
N FAC
S FAC=$S($L(NODE):" ("_NODE_")",1:"")
Q FAC
;*ED
DRCL(CODE) ;POPULATE GMRADRCL()
;PARAMTER: CODE => FIVE CHARACTER DRUG CLASS CODE TO ADD
;RETURN: 0 => CODE NOT ADDED TO ARRAY
; 2 => CODE ADDED TO THE ARRAY OR ALREADY EXISTS IN ARRAY
I '$L(CODE) Q 0
N CLSFN,REACT,RETURN,IEN
I '$D(^TMP("GMRAOC",$J,"APC",CODE)) S RETURN=$S($D(GMRADRCL):2,1:0)
Q:$D(RETURN) RETURN
Q:$D(GMRADRCL(CODE)) 2
Q:CODE="HA000" 0
S CLSFN=$$CODE2CL^GMRAPENC(CODE)
S IEN=$$CODE2CLP^GMRAPENC(CODE)
;*BD (C U % VAR)
I $G(GMRAV1) D
.N J
.S J=$S('$D(GMRADRCL):1,1:$O(GMRADRCL(999),-1)+1)
.S GMRADRCL(J)=CODE_U_CLSFN_$$FAC(^TMP("GMRAOC",$J,"APC",CODE))
I '$G(GMRAV1) D
.;*ED (C U DOTS)
.S REACT="" F S REACT=$O(^TMP("GMRAOC",$J,"APC",CODE,REACT)) Q:REACT="" D
..S REACS(REACT)=$G(^TMP("GMRAOC",$J,"APC",CODE,REACT))
..I $G(REACS(REACT,"CLS"))'[CODE S REACS(REACT,"CLS")=$S($D(REACS(REACT,"CLS")):REACS(REACT,"CLS")_"~",1:"")_CODE_" "_CLSFN_U_IEN
Q 2
PCCHK(VACLASS) ;PARTIAL DRUG CLASS CHECK
Q:$L($G(VACLASS))<4 0
N CL,I,RETURN
S CL=$S($E(VACLASS,1,4)="CN10":5,1:4),RETURN=0
S I="" F S I=$O(^TMP("GMRAOC",$J,"APC",I)) Q:'$L(I) D
.I $E(I,1,CL)=$E(VACLASS,1,CL) S RETURN=$$DRCL(I)
Q RETURN
ING(DFN,PTR) ;DRUG INGREDIENT CHECK
;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
; PTR => IEN IN THE DRUG INGREDIENTS FILE (#50.416)
;RETURN: 0 => NO REACTION
; 1 => REACTION
N GMRAX,FLG
S FLG=0,GMRAX=0
;*BD
I $G(GMRAV1) D
.F S GMRAX=$O(^GMR(120.8,"API",DFN,PTR,GMRAX)) Q:GMRAX<1 S FLG=1,GMRAIEN(GMRAX)=""
I '$G(GMRAV1) D
.;*ED (C U DOTS)
.K ^TMP($J,"GMRALST") D ZERO^PSN50P41(PTR,,,"GMRALST") ;ICR #4531
.F S GMRAX=$O(^TMP("GMRAOC",$J,"API",PTR,GMRAX)) Q:GMRAX="" D
..S FLG=1,GMRAING(GMRAX)=$G(^TMP($J,"GMRALST",PTR,.01))_"|"_PTR_U_$G(^TMP("GMRAOC",$J,"API",PTR,GMRAX))
.K ^TMP($J,"GMRALST")
Q FLG
CLASS(DFN,PTR) ;DRUG CLASS CHECK
;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
; PTR => IEN IN THE VA DRUG CLASS FILE (#50.605)
;RETURN: 0 => NO REACTION
; 1 => REACTION
N GMRAC,GMRAX,FLG,CLSFN
S GMRAX=0,FLG=0,GMRAC=$$CLP2CODE^GMRAPENC(PTR),CLSFN=$$CODE2CL^GMRAPENC(GMRAC)
I GMRAC'="" D
.;*BD
.I $G(GMRAV1) D
..F S GMRAX=$O(^GMR(120.8,"APC",DFN,GMRAC,GMRAX)) Q:GMRAX<1 S FLG=2,GMRAIEN(GMRAX)=""
.I '$G(GMRAV1) D
..;*ED (C U DOTS)
..F S GMRAX=$O(^TMP("GMRAOC",$J,"APC",GMRAC,GMRAX)) Q:GMRAX="" D
...S FLG=2
...S GMRADRCL(GMRAX)=CLSFN_"|"_PTR_U_$G(^TMP("GMRAOC",$J,"APC",GMRAC,GMRAX))
Q FLG
NDFREF() ;VERSION-DEPENDENT GLOBAL LOCATION OF VA GENERIC FILE (#50.6)
;RETURN: GLOBAL LOCATION OF VA GENERIC FILE (#50.6)
I $$VERSION^XPDUTL("PSN")<4 Q "^PSNDF("
Q "^PSNDF(50.6,"
GETDATA(DFN) ;OBTAIN ADVERSE REACTION DATA
;PARAMTER: DFN => IEN IN THE PATIENT (#2) FILE
K ^TMP("GMRAOC",$J)
D REMOTE^GMRAOR0(DFN),LOCAL(DFN)
Q
LOCAL(DFN) ;OBTAIN DATA STORED LOCALLY
;PARAMTER: DFN => IEN IN THE PATIENT (#2) FILE
N J
S J=0 F S J=$O(^GMR(120.8,"API",DFN,J)) Q:'+J D
.D LDATA("API",DFN,J)
S J="" F S J=$O(^GMR(120.8,"APC",DFN,J)) Q:J="" D
.D LDATA("APC",DFN,J)
Q
LDATA(NODE,DFN,J) ;OBTAIN EACH REACTION'S LOCALLY STORED DATA ELEMENTS
;PARAMTERS: NODE => CURRENT INDEX IN FILE #120.8
; EITHER "API" OR "APC".
; DFN => IEN IN THE PATIENT (#2) FILE
; J => CURRENT INGREDIENT OR CLASS
N PAIEN
S PAIEN=0 F S PAIEN=$O(^GMR(120.8,NODE,DFN,J,PAIEN)) Q:+$G(PAIEN)=0 D
.Q:$P($G(^GMR(120.8,PAIEN,"ER")),U)
.;*BD
.S ^TMP("GMRAOC",$J,NODE,J)=$$SETNODE^GMRAOR1($G(^TMP("GMRAOC",$J,NODE,J)),"LOCAL")
.Q:+$G(GMRAV1)
.;*ED
.D ADDLDATA($NA(^TMP("GMRAOC",$J,NODE,J,PAIEN)),PAIEN)
Q
ADDLDATA(GLOBAL,PAIEN) ;OBTAIN LOCALLY STORED DATA ELEMENTS FOR ONE REACTION
;PARAMETERS: GLOBAL => GLOBAL REFERENCE WHERE TO RETURN THE DATA
; PAIEN => IEN IN FILE #120.8
N SITE
S SITE=$$SITE^VASITE(),SITE=$P(SITE,U)_U_"L"_U
S @GLOBAL=SITE_$P(^GMR(120.8,PAIEN,0),U,4)
N REACT,IEN
S REACT=0 F S REACT=$O(^GMR(120.8,PAIEN,10,REACT)) Q:+$G(REACT)=0 D
.S REACT("VALUE")=$P($G(^GMR(120.8,PAIEN,10,REACT,0)),U)
.I REACT("VALUE")=GMRAOTH D
..S REACT("VALUE")=REACT("VALUE")_"-"_$P($G(^GMR(120.8,PAIEN,10,REACT,0)),U,2)
..I $P(REACT("VALUE"),"-",2)="" D
...I GMRAOTH>0 S $P(REACT("VALUE"),"-",2)=$P($G(^GMRD(120.83,GMRAOTH,0)),U)
...E K REACT("VALUE")
.S:$D(REACT("VALUE")) $P(@GLOBAL,U,5)=$S($P($G(@GLOBAL),U,5)'="":$P(@GLOBAL,U,5)_"~",1:"")_REACT("VALUE")
S $P(@GLOBAL,U,6)=$P(^GMR(120.8,PAIEN,0),U,2)
S $P(@GLOBAL,U,7)=$P(^GMR(120.8,PAIEN,0),U,3)
S $P(@GLOBAL,U,8)=$P(^GMR(120.8,PAIEN,0),U,6)
S $P(@GLOBAL,U,9)="V"
S $P(@GLOBAL,U,11)=$P(^GMR(120.8,PAIEN,0),U,14)
I $P(@GLOBAL,U,8)="h",+$P($G(^GMR(120.8,PAIEN,0)),U,8)>0 D
. S $P(@GLOBAL,U,4)=$S($P($G(@GLOBAL),U,4)'="":$P(@GLOBAL,U,4)_"~",1:"")_$P($G(^GMR(120.8,PAIEN,0)),U,9)_"|"_$P($G(^(0)),U,8)
Q:$D(^GMR(120.85,"C",PAIEN))<10
S IEN=0 F S IEN=$O(^GMR(120.85,"C",PAIEN,IEN)) Q:'+IEN D
.S $P(@GLOBAL,U,4)=$S($P($G(@GLOBAL),U,4)'="":$P(@GLOBAL,U,4)_"~",1:"")_$P($G(^GMR(120.85,IEN,0)),U)_"|"_$P($G(^(0)),U,14)
Q
ADDCOMMA(GMRASYMP) ; p70
Q:$L(GMRASYMP)<512 GMRASYMP
N GMRADIV,GMRAMAX,GMRAID,GMRAIDX,GMRAOUT,GMRAITM,GMRACTR,GMRASPC,GMRAFOUT
S GMRAMAX=200,GMRACTR=0,GMRASPC=0,GMRAFOUT=""
S GMRADIV=$L(GMRASYMP)/GMRAMAX,GMRAIDX=$S(GMRADIV[".":$P(GMRADIV,".")+1,1:GMRADIV)
F GMRAID=1:1:GMRAIDX S GMRAOUT(GMRAID)="" D
. S:GMRAID=1 GMRAOUT(GMRAID)=$E(GMRASYMP,1,GMRAMAX)
. S:GMRAID>1 GMRAOUT(GMRAID)=$E(GMRASYMP,(GMRAMAX*(GMRAID-1))+1,GMRAMAX*(GMRAID))
F GMRAIDX=1:1:GMRAID D
. F GMRAITM=1:1:$L(GMRAOUT(GMRAIDX)) S GMRACTR=GMRACTR+1 D
.. S:$E(GMRAOUT(GMRAIDX),GMRAITM)=" " GMRASPC=GMRAITM
. S:GMRASPC GMRAOUT(GMRAIDX)=$E(GMRAOUT(GMRAIDX),1,GMRASPC-1)_","_$E(GMRAOUT(GMRAIDX),GMRASPC+1,$L(GMRAOUT(GMRAIDX)))
. S:'GMRASPC GMRAOUT(GMRAIDX)=GMRAOUT(GMRAIDX)_","
. S GMRAFOUT=GMRAFOUT_GMRAOUT(GMRAIDX)
Q GMRAFOUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR 17429 printed Apr 09, 2024@20:44:57 Page 2
GMRAOR ; HIRMFO/WAA,RM - ORDER CHECK UTILITY ;May 11, 2021@13:18:40
+1 ;;4.0;Adverse Reaction Tracking;**2,13,26,37,41,42,44,46,52,53,63,70**;Mar 29, 1996;Build 5
+2 QUIT
ORCHK(DFN,TYP,PTR,LOC) ;DETERMINE IF PATIENT HAS ADVERSE REACTION TO AGENT
+1 ;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2378
+2 ;*BD
+3 NEW GMRAFLG,GMRACM,DA,GMRAV1,GMRAOTH
+4 SET GMRAFLG=0
SET GMRAV1=1
SET GMRAOTH=+$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+5 IF $GET(DFN)<1!("^CM^DR^IN^CL^"'[("^"_$GET(TYP)_"^"))!($GET(TYP)'="CM"&($GET(PTR)<1))
SET GMRAFLG=""
+6 IF '$TEST
Begin DoDot:1
+7 KILL GMRAING,GMRADRCL,GMRAIEN
+8 DO GETDATA(DFN)
+9 IF TYP="CM"
SET GMRAFLG=$$RAD(DFN,+$GET(LOC))
+10 IF TYP="DR"
SET GMRAFLG=$$DRUG(DFN,PTR)
+11 IF TYP="IN"
SET GMRAFLG=$$ING(DFN,PTR)
+12 IF TYP="CL"
SET GMRAFLG=$$CLASS(DFN,PTR)
End DoDot:1
+13 KILL ^TMP("GMRAOC",$JOB)
+14 QUIT GMRAFLG
+15 ;*ED
+16 QUIT $$ORCHK2(DFN,TYP,PTR,LOC)
ORCHK2(DFN,TYP,PTR,LOC,RETURN) ;DETERMINE IF PATIENT HAS ADVERSE REACTION TO AGENT
+1 ;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2378
+2 ;PARAMETERS: DFN => IEN IN THE PATIENT FILE (#2)
+3 ; TYP => TYPE OF CHECK TO PERFORM
+4 ; "CM": CONTRAST MEDIA
+5 ; "DR": DRUG
+6 ; "IN": DRUG INGREDIENT
+7 ; "CL": DRUG CLASS
+8 ; PTR => AGENT
+9 ; TYP="CM", PTR IS IGNORED
+10 ; TYP="DR", PTR=PSNDA.PSNVPN.LPTR, WHERE
+11 ; PSNDA IS IEN IN VA GENERIC FILE (#50.6),
+12 ; PSNVPN IS IEN IN VA PRODUCT FILE (#50.68), AND
+13 ; LPTR IS IEN IN DRUG FILE (#50)
+14 ; TYP="IN", PTR=IEN IN DRUG INGREDIENTS FILE (#50.416)
+15 ; TYP="CL", PTR=IEN IN VA DRUG CLASS FILE (#50.605)
+16 ; LOC => FOR TYP="CM" ONLY, 1 TO RETURN LOCATION(S) IN SECOND CARET PIECE OF $$ORCHK
+17 ; FOR TYP="CM" ONLY, 0 OR UNDEFINED TO NOT RETURN LOCATION(S) IN SECOND CARET PIECE OF $$ORCHK
+18 ; RETURN => FOR TYP="DR" ONLY, NAME OF ARRAY IN WHICH TO RETURN ORDER CHECK MESSAGES AND REACTION DATA
+19 ;RETURN: -1 => BAD PARAMETERS
+20 ; EMPTY STRING => NO ASSESSMENT
+21 ; 0 => NO REACTION
+22 ; 1 => FOR TYP="CM", PATIENT HAS REACTION
+23 ; FOR TYP="IN" AND TYP="CL", PATIENT HAS REACTION; INGREDIENT(S) RETURNED IN GMRAING() AND
+24 ; DRUG CLASS(ES) IN GMRADRCL()
+25 ; FOR TYP="DR", PATIENT HAS REACTION
+26 IF +$GET(DFN)<1!("^CM^DR^IN^CL^"'[(U_$GET(TYP)_U))
QUIT -1
+27 IF $GET(TYP)="DR"
IF PTR'?.N.1".".N.1".".N
QUIT -1
+28 IF +$GET(PTR)<1
IF ($GET(TYP)="IN"!($GET(TYP)="CL"))
QUIT -1
+29 IF +$GET(LOC)>0
IF ($GET(TYP)'="CM")
QUIT -1
+30 IF $GET(TYP)="DR"
IF $GET(RETURN)=""!($GET(RETURN)="RETURN")
QUIT -1
+31 KILL GMRAING,GMRADRCL,GMRAREAC
+32 NEW GMRAFLG,GMRASESS,IDX,GMRAOTH
+33 SET GMRAFLG=0
SET GMRASESS=""
SET GMRAOTH=+$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+34 ;*BD MOVE CODE IN LINETAG TO HERE
+35 DO GETDATA(DFN)
+36 ;*ED
+37 SET GMRASESS=$$NKA^GMRANKA(DFN)
+38 IF +GMRASESS=0
IF ($DATA(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))>9)
Begin DoDot:1
+39 SET IDX=0
FOR
SET IDX=$ORDER(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX))
if 'IDX
QUIT
Begin DoDot:2
+40 IF $PIECE(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX),U,2)="YES"
SET GMRASESS=1
+41 IF GMRASESS'=1
IF ($PIECE(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX),U,2)'="YES")
SET GMRASESS=0
End DoDot:2
End DoDot:1
+42 if '+GMRASESS
QUIT GMRASESS
+43 IF TYP="CM"
SET GMRAFLG=$$RAD(DFN,+$GET(LOC))
+44 IF TYP="DR"
SET GMRAFLG=$$DRUG(DFN,PTR)
+45 IF TYP="IN"
SET GMRAFLG=$$ING(DFN,PTR)
+46 IF TYP="CL"
SET GMRAFLG=$$CLASS(DFN,PTR)
+47 KILL ^TMP("GMRAOC",$JOB)
+48 QUIT GMRAFLG
RAD(DFN,LOC) ;CONTRAST MEDIA CHECK
+1 ;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
+2 ; LOC => 1 TO RETURN LOCATION(S)
+3 ; 0 OR UNDEFINED TO NOT RETURN LOCATION(S)
+4 ;RETURN: HAS_REACTION^LOCATION(S), WHERE
+5 ; HAS_REACTION IS 0 FOR PATIENT DOES NOT HAVE A REACTION
+6 ; AND 1 IS FOR PATIENT HAS REACTION AND
+7 ; LOCATION(S) IS A SCREEN-PRINTABLE STRING OF ALL THE LOCATIONS DOCUMENTING
+8 ; A REACTION
+9 NEW FLG,DC,DELIMIT,REACT,SITES,SITE,GMRACM,COUNT
+10 ;*BD
+11 NEW LOCAL,REMOTE
+12 ;*ED
+13 SET FLG=0
SET DC="DX10"
FOR
SET DC=$ORDER(^TMP("GMRAOC",$JOB,"APC",DC))
if DC'["DX10"
QUIT
Begin DoDot:1
+14 SET FLG=1
+15 IF $GET(LOC)
Begin DoDot:2
+16 ;*BD
+17 IF $GET(GMRAV1)
Begin DoDot:3
+18 IF $GET(^TMP("GMRAOC",$JOB,"APC",DC))["LOCAL"
SET LOCAL=1
+19 IF $GET(^TMP("GMRAOC",$JOB,"APC",DC))["REMOTE"
SET REMOTE=1
End DoDot:3
+20 IF '$GET(GMRAV1)
Begin DoDot:3
+21 ;*ED (C U DOTS)
+22 SET REACT=""
FOR
SET REACT=$ORDER(^TMP("GMRAOC",$JOB,"APC",DC,REACT))
if REACT=""
QUIT
Begin DoDot:4
+23 if $DATA(SITES(REACT))
QUIT
+24 SET SITES=1+$GET(SITES)
SET SITES(REACT)=$$GET1^DIQ(4,$PIECE(^TMP("GMRAOC",$JOB,"APC",DC,REACT),U),.01)
+25 SET SITES(REACT)=SITES(REACT)_" entered on "_$$FMTE^XLFDT($PIECE(^TMP("GMRAOC",$JOB,"APC",DC,REACT),U,3))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 IF $GET(LOC)
Begin DoDot:1
+27 ;*BD
+28 IF $GET(GMRAV1)
Begin DoDot:2
+29 SET GMRACM=$SELECT($GET(LOCAL)&($GET(REMOTE)):"LOCAL AND REMOTE SITE(S)",$GET(LOCAL):"LOCAL",$GET(REMOTE):"REMOTE SITE(S)",1:"")
End DoDot:2
+30 IF '$GET(GMRAV1)
Begin DoDot:2
+31 ;*ED (C U DOTS)
+32 SET DELIMIT=", "
SET SITE=""
SET COUNT=1
+33 FOR
SET SITE=$ORDER(SITES(SITE))
if SITE=""
QUIT
Begin DoDot:3
+34 if COUNT=SITES
SET DELIMIT=" and "
+35 SET GMRACM=$SELECT($GET(GMRACM)'="":GMRACM_DELIMIT,1:"")_SITES(SITE)
SET COUNT=COUNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+36 QUIT FLG_$SELECT($GET(GMRACM)'="":U_GMRACM,1:"")
DRUG(DFN,PTR) ;DRUG CHECK
+1 ;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
+2 ; PTR => PSNDA.PSNVPN.LPTR, WHERE
+3 ; PSNDA IS IEN IN VA GENERIC FILE (#50.6),
+4 ; PSNVPN IS IEN IN VA PRODUCT FILE (#50.68), AND
+5 ; LPTR IS IEN IN DRUG FILE (#50)
+6 ;RETURN: 1 => REACTION TO DRUG
+7 ; 0 => NO REACTION TO DRUG
+8 NEW %,FLG,GMRAC,GMRADR,GMRAI,PSNVPN,PSNDA,LPTR,GMRANVPN,GMRANDA,REACT,CLASS,GMRALIST
+9 NEW TMPFLG,REACS,NODE
+10 SET (FLG,TMPFLG)=0
SET GMRANDA=$PIECE(PTR,".")
SET GMRANVPN=$PIECE(PTR,".",2)
SET LPTR=$PIECE(PTR,".",3)
+11 IF GMRANDA>0
IF ($GET(@($$NDFREF_GMRANDA_",0)"))'="")
Begin DoDot:1
+12 ;INGREDIENT
+13 SET PSNDA=GMRANDA
+14 IF $TEXT(DISPDRG^PSNNGR)]""
IF GMRANVPN]""
Begin DoDot:2
+15 SET NODE="PSNDD"
SET PSNVPN=GMRANVPN
+16 KILL ^TMP(NODE,$JOB)
+17 ;ICR #151
DO DISPDRG^PSNNGR
End DoDot:2
+18 IF $TEXT(DISPDRG^PSNNGR)=""!(GMRANVPN="")
Begin DoDot:2
+19 SET NODE="PSN"
+20 KILL ^TMP(NODE,$JOB)
+21 ;ICR #151
DO ^PSNNGR
End DoDot:2
+22 SET GMRAI=0
SET %=1
FOR
SET GMRAI=$ORDER(^TMP(NODE,$JOB,GMRAI))
if GMRAI<1
QUIT
IF $DATA(^TMP("GMRAOC",$JOB,"API",GMRAI))
Begin DoDot:2
+23 SET FLG=1
+24 ;*BD (C U % VAR)
+25 IF $GET(GMRAV1)
SET GMRAING(%)=^TMP(NODE,$JOB,GMRAI)_$$FAC(^TMP("GMRAOC",$JOB,"API",GMRAI))
SET %=%+1
+26 IF '$GET(GMRAV1)
Begin DoDot:3
+27 ;*ED (C U DOTS)
+28 SET REACT=""
FOR
SET REACT=$ORDER(^TMP("GMRAOC",$JOB,"API",GMRAI,REACT))
if REACT=""
QUIT
Begin DoDot:4
+29 SET REACS(REACT)=$GET(^TMP("GMRAOC",$JOB,"API",GMRAI,REACT))
+30 IF $GET(REACS(REACT,"ING"))'[GMRAI
SET REACS(REACT,"ING")=$SELECT($DATA(REACS(REACT,"ING")):REACS(REACT,"ING")_"~",1:"")_^TMP(NODE,$JOB,GMRAI)_U_GMRAI
End DoDot:4
End DoDot:3
End DoDot:2
+31 KILL ^TMP(NODE,$JOB)
+32 ;*BD
+33 IF $GET(GMRAV1)
IF FLG
QUIT
+34 ;*ED
+35 ;DRUG CLASS
+36 IF GMRANVPN
Begin DoDot:2
+37 ;ICR #2531
SET CLASS=$$DCLCODE^PSNAPIS(GMRANDA,GMRANVPN)
+38 SET TMPFLG=$$PCCHK(CLASS)
+39 if TMPFLG>0
SET FLG=TMPFLG
End DoDot:2
QUIT
+40 ;ICR #2574
SET GMRALIST=$$CLIST^PSNAPIS(GMRANDA,.GMRALIST)
if '$GET(GMRALIST)
QUIT
+41 SET GMRALIST=0
FOR
SET GMRALIST=$ORDER(GMRALIST(GMRALIST))
if 'GMRALIST
QUIT
Begin DoDot:2
+42 SET TMPFLG=$$PCCHK($PIECE(GMRALIST(GMRALIST),U,2))
+43 if TMPFLG>0
SET FLG=TMPFLG
End DoDot:2
End DoDot:1
+44 ;*BD
+45 if $GET(GMRAV1)
QUIT FLG
+46 ;*ED
+47 IF +LPTR>0
Begin DoDot:1
+48 ;GMR ALLERGY
+49 NEW IEN,NAME
+50 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.8,"B",DFN,IEN))
if '+IEN!(+FLG=3)
QUIT
Begin DoDot:2
+51 IF $PIECE($GET(^GMR(120.8,IEN,0)),U,3)=(LPTR_";PSDRUG(")
IF ('$PIECE($GET(^GMR(120.8,IEN,"ER")),U))
Begin DoDot:3
+52 ;ICR #4533
DO DATA^PSS50(LPTR,,,,,"GMRALST")
+53 SET NAME=$GET(^TMP($JOB,"GMRALST",LPTR,.01))
+54 KILL ^TMP($JOB,"GMRALST")
+55 DO ADDLDATA($NAME(REACS(IEN)),IEN)
+56 SET FLG=3
+57 IF $GET(REACS(IEN,"REC"))'[NAME
SET REACS(IEN,"REC")=$SELECT($DATA(REACS(IEN,"REC")):"~",1:"")_NAME_U_LPTR
End DoDot:3
End DoDot:2
+58 ;DRUG CLASS
+59 IF 'GMRANDA
Begin DoDot:2
+60 SET TMPFLG=$$PCCHK($$DRP2VACL^GMRAPENC(LPTR))
+61 if TMPFLG>0
SET FLG=TMPFLG
End DoDot:2
End DoDot:1
+62 if FLG>0
SET FLG=1
+63 KILL @RETURN
+64 NEW STYPE,IPIECE,OPIECE,FIELDS,FIELDS1,ITEM,FILE,NODE,FIELD,MSGNUM,RINDEX,SITE,SEV
+65 SET STYPE("L")="LOCAL"
SET STYPE("R")="REMOTE"
+66 SET FIELDS(1,3)="120.8^4^3"
SET FIELDS(1.1,1)="120.85^.01|14.5+^4"
SET FIELDS(2,1)="120.81^.01*^5"
+67 SET FIELDS(2,2)="120.8^^6"
SET FIELDS(2,3)="120.8^^7"
+68 SET FIELDS(2,3,"OTRANSFORM")="S Y=$S(Y["";PS(50.605,"":$P($G(^PS(50.605,+Y,0)),U,2),1:$P($G(@(U_$P(Y,"";"",2)_+Y_"",0)"")),U)) S:Y="""" Y=""UNKNOWN"""
+69 SET FIELDS(1,4)="120.8^6^8"
+70 SET FIELDS1(1.1,1)=""
+71 IF $DATA(REACS)>9
Begin DoDot:1
+72 SET REACT=""
FOR
SET REACT=$ORDER(REACS(REACT))
if REACT=""
QUIT
Begin DoDot:2
+73 IF $PIECE(REACS(REACT),U,8)="h"
SET FIELDS1(1.1,1)=$GET(FIELDS(1.1,1))
SET FIELDS(1.1,1)="120.8^9|8+^4"
+74 SET REACT(1)=$SELECT($PIECE(REACS(REACT),U,7)'="":$PIECE(REACS(REACT),U,7),1:$PIECE(REACS(REACT),U,6))
+75 SET REACT(2)=$PIECE(REACS(REACT),U,8)
if REACT(2)=""
SET REACT(2)="UNKNOWN"
+76 SET REACT(3)=$PIECE($PIECE(REACS(REACT),U,4),"|",2)
if REACT(3)=""
SET REACT(3)="UNKNOWN"
+77 IF $DATA(RINDEX(REACT(1),REACT(2),REACT(3)))
SET MSGNUM=$ORDER(RINDEX(REACT(1),REACT(2),REACT(3),0))
+78 IF '$TEST
SET MSGNUM(0)=1+$GET(MSGNUM(0))
SET MSGNUM=MSGNUM(0)
SET RINDEX(REACT(1),REACT(2),REACT(3),MSGNUM)=""
+79 SET @RETURN@(MSGNUM,REACT)=REACS(REACT)
SET SITE=$PIECE(REACS(REACT),U)
SET @RETURN@(MSGNUM,"MESSAGE",1)=1+$GET(@RETURN@(MSGNUM,"MESSAGE",1))
+80 FOR NODE="ING","CLS","REC"
IF $DATA(REACS(REACT,NODE))
FOR ITEM=1:1:$LENGTH(REACS(REACT,NODE),"~")
Begin DoDot:3
+81 SET $PIECE(@RETURN@(MSGNUM,"MESSAGE","OFFENDERS",NODE),"~",ITEM)=$PIECE($PIECE(REACS(REACT,NODE),"~",ITEM),U)
+82 SET $PIECE(@RETURN@(MSGNUM,REACT,NODE),"~",ITEM)=$PIECE($PIECE(REACS(REACT,NODE),"~",ITEM),U,2)
End DoDot:3
+83 SET @RETURN@(MSGNUM,"MESSAGE",1,SITE)=$$GET1^DIQ(4,$PIECE(REACS(REACT),U)_",",.01)_U_STYPE($PIECE(REACS(REACT),U,2))_U
+84 SET NODE=0
FOR
SET NODE=$ORDER(FIELDS(NODE))
if NODE=""
QUIT
SET OPIECE=0
FOR
SET OPIECE=$ORDER(FIELDS(NODE,OPIECE))
if OPIECE=""
QUIT
Begin DoDot:3
+85 SET FILE=$PIECE(FIELDS(NODE,OPIECE),U)
SET FIELD=$PIECE(FIELDS(NODE,OPIECE),U,2)
SET IPIECE=$PIECE(FIELDS(NODE,OPIECE),U,3)
+86 IF NODE=1
SET RETURN=$NAME(@RETURN@(MSGNUM,"MESSAGE",NODE,SITE))
+87 IF $LENGTH(NODE,".")=2
SET RETURN=$NAME(@RETURN@(MSGNUM,"MESSAGE",$PIECE(NODE,"."),SITE,$PIECE(NODE,".",2)))
+88 IF NODE'=1
IF NODE'["."
SET RETURN=$NAME(@RETURN@(MSGNUM,"MESSAGE",NODE))
+89 IF FIELD>0
IF FIELD'["*"
IF FIELD'["+"
SET $PIECE(@RETURN,U,OPIECE)=$$EXTERNAL^DILFD(FILE,FIELD,,$PIECE(REACS(REACT),U,IPIECE))
+90 IF 'FIELD
IF '$DATA(FIELDS(NODE,OPIECE,"OTRANSFORM"))
SET $PIECE(@RETURN,U,OPIECE)=$PIECE(REACS(REACT),U,IPIECE)
+91 IF $DATA(FIELDS(NODE,OPIECE,"OTRANSFORM"))
NEW Y
SET Y=$PIECE(REACS(REACT),U,IPIECE)
if Y'=""
XECUTE FIELDS(NODE,OPIECE,"OTRANSFORM")
SET $PIECE(@RETURN,U,OPIECE)=Y
+92 IF FIELD["*"
Begin DoDot:4
+93 NEW TEXT,DELIMIT,ITEMS,STR,COUNT,NEWIVAL
+94 SET DELIMIT=", "
SET COUNT=0
SET COUNT(1)=1
+95 ;p70
IF $LENGTH($GET(@RETURN))
SET @RETURN=$$ADDCOMMA(@RETURN)
+96 IF $PIECE($GET(@RETURN),U,OPIECE)'=""
FOR ITEM=1:1:$LENGTH($PIECE(@RETURN,U,OPIECE),",")
SET STR=$PIECE($PIECE(@RETURN,U,OPIECE),",",ITEM)
if $EXTRACT(STR,1,5)=" and "
SET STR=$EXTRACT(STR,6,*)
IF STR'=""
SET ITEMS(STR)=""
SET COUNT=1+$GET(COUNT)
+97 IF $PIECE(REACS(REACT),U,IPIECE)'=""
FOR ITEM=1:1:$LENGTH($PIECE(REACS(REACT),U,IPIECE),"~")
Begin DoDot:5
+98 SET STR=$PIECE($PIECE(REACS(REACT),U,IPIECE),"~",ITEM)
SET $PIECE(NEWIVAL,"~",ITEM)=+STR
+99 IF STR["-"
SET STR=$PIECE(STR,"-",2)
+100 IF '$TEST
SET STR=$$EXTERNAL^DILFD(FILE,+FIELD,,STR)
+101 IF STR'=""
IF '$DATA(ITEMS(STR))
SET ITEMS(STR)=""
SET COUNT=1+$GET(COUNT)
End DoDot:5
+102 SET ITEM=""
FOR
SET ITEM=$ORDER(ITEMS(ITEM))
if ITEM=""
QUIT
Begin DoDot:5
+103 if COUNT(1)=COUNT
SET DELIMIT=" and "
+104 SET TEXT=$SELECT($GET(TEXT)'="":TEXT_DELIMIT,1:"")_ITEM
SET COUNT(1)=1+COUNT(1)
End DoDot:5
+105 SET $PIECE(@RETURN,U,OPIECE)=$GET(TEXT)
SET RETURN=$PIECE(RETURN,"(")
+106 IF $GET(NEWIVAL)'=""
IF NEWIVAL'=$PIECE(@RETURN@(MSGNUM,REACT),U,IPIECE)
SET $PIECE(@RETURN@(MSGNUM,REACT),U,IPIECE)=NEWIVAL
End DoDot:4
+107 IF FIELD["+"
Begin DoDot:4
+108 NEW FNUM,ITEMS
+109 FOR ITEM=1:1:$LENGTH($PIECE(REACS(REACT),U,IPIECE),"~")
NEW STR
FOR FNUM=1:1:$LENGTH(FIELD,"|")
Begin DoDot:5
+110 ;S STR=$S($G(STR)'="":STR_U,1:"")_$$EXTERNAL^DILFD(FILE,+$P(FIELD,"|",FNUM),,$P($P($P(REACS(REACT),U,IPIECE),"~",ITEM),"|",FNUM))
+111 SET STR=$SELECT(FNUM>1:STR_U,1:"")_$$EXTERNAL^DILFD(FILE,+$PIECE(FIELD,"|",FNUM),,$PIECE($PIECE($PIECE(REACS(REACT),U,IPIECE),"~",ITEM),"|",FNUM))
End DoDot:5
if STR'=""
SET ITEMS(ITEM)=STR
+112 if $DATA(ITEMS)>9
MERGE @RETURN=ITEMS
End DoDot:4
+113 IF $GET(FIELDS1(1.1,1))'=""
SET FIELDS(1.1,1)=$GET(FIELDS1(1.1,1))
SET FIELDS1(1.1,1)=""
+114 SET RETURN=$PIECE(RETURN,"(")
End DoDot:3
End DoDot:2
+115 SET @RETURN=MSGNUM(0)
End DoDot:1
+116 QUIT FLG
+117 ;*BD
FAC(NODE) ;
+1 NEW FAC
+2 SET FAC=$SELECT($LENGTH(NODE):" ("_NODE_")",1:"")
+3 QUIT FAC
+4 ;*ED
DRCL(CODE) ;POPULATE GMRADRCL()
+1 ;PARAMTER: CODE => FIVE CHARACTER DRUG CLASS CODE TO ADD
+2 ;RETURN: 0 => CODE NOT ADDED TO ARRAY
+3 ; 2 => CODE ADDED TO THE ARRAY OR ALREADY EXISTS IN ARRAY
+4 IF '$LENGTH(CODE)
QUIT 0
+5 NEW CLSFN,REACT,RETURN,IEN
+6 IF '$DATA(^TMP("GMRAOC",$JOB,"APC",CODE))
SET RETURN=$SELECT($DATA(GMRADRCL):2,1:0)
+7 if $DATA(RETURN)
QUIT RETURN
+8 if $DATA(GMRADRCL(CODE))
QUIT 2
+9 if CODE="HA000"
QUIT 0
+10 SET CLSFN=$$CODE2CL^GMRAPENC(CODE)
+11 SET IEN=$$CODE2CLP^GMRAPENC(CODE)
+12 ;*BD (C U % VAR)
+13 IF $GET(GMRAV1)
Begin DoDot:1
+14 NEW J
+15 SET J=$SELECT('$DATA(GMRADRCL):1,1:$ORDER(GMRADRCL(999),-1)+1)
+16 SET GMRADRCL(J)=CODE_U_CLSFN_$$FAC(^TMP("GMRAOC",$JOB,"APC",CODE))
End DoDot:1
+17 IF '$GET(GMRAV1)
Begin DoDot:1
+18 ;*ED (C U DOTS)
+19 SET REACT=""
FOR
SET REACT=$ORDER(^TMP("GMRAOC",$JOB,"APC",CODE,REACT))
if REACT=""
QUIT
Begin DoDot:2
+20 SET REACS(REACT)=$GET(^TMP("GMRAOC",$JOB,"APC",CODE,REACT))
+21 IF $GET(REACS(REACT,"CLS"))'[CODE
SET REACS(REACT,"CLS")=$SELECT($DATA(REACS(REACT,"CLS")):REACS(REACT,"CLS")_"~",1:"")_CODE_" "_CLSFN_U_IEN
End DoDot:2
End DoDot:1
+22 QUIT 2
PCCHK(VACLASS) ;PARTIAL DRUG CLASS CHECK
+1 if $LENGTH($GET(VACLASS))<4
QUIT 0
+2 NEW CL,I,RETURN
+3 SET CL=$SELECT($EXTRACT(VACLASS,1,4)="CN10":5,1:4)
SET RETURN=0
+4 SET I=""
FOR
SET I=$ORDER(^TMP("GMRAOC",$JOB,"APC",I))
if '$LENGTH(I)
QUIT
Begin DoDot:1
+5 IF $EXTRACT(I,1,CL)=$EXTRACT(VACLASS,1,CL)
SET RETURN=$$DRCL(I)
End DoDot:1
+6 QUIT RETURN
ING(DFN,PTR) ;DRUG INGREDIENT CHECK
+1 ;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
+2 ; PTR => IEN IN THE DRUG INGREDIENTS FILE (#50.416)
+3 ;RETURN: 0 => NO REACTION
+4 ; 1 => REACTION
+5 NEW GMRAX,FLG
+6 SET FLG=0
SET GMRAX=0
+7 ;*BD
+8 IF $GET(GMRAV1)
Begin DoDot:1
+9 FOR
SET GMRAX=$ORDER(^GMR(120.8,"API",DFN,PTR,GMRAX))
if GMRAX<1
QUIT
SET FLG=1
SET GMRAIEN(GMRAX)=""
End DoDot:1
+10 IF '$GET(GMRAV1)
Begin DoDot:1
+11 ;*ED (C U DOTS)
+12 ;ICR #4531
KILL ^TMP($JOB,"GMRALST")
DO ZERO^PSN50P41(PTR,,,"GMRALST")
+13 FOR
SET GMRAX=$ORDER(^TMP("GMRAOC",$JOB,"API",PTR,GMRAX))
if GMRAX=""
QUIT
Begin DoDot:2
+14 SET FLG=1
SET GMRAING(GMRAX)=$GET(^TMP($JOB,"GMRALST",PTR,.01))_"|"_PTR_U_$GET(^TMP("GMRAOC",$JOB,"API",PTR,GMRAX))
End DoDot:2
+15 KILL ^TMP($JOB,"GMRALST")
End DoDot:1
+16 QUIT FLG
CLASS(DFN,PTR) ;DRUG CLASS CHECK
+1 ;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
+2 ; PTR => IEN IN THE VA DRUG CLASS FILE (#50.605)
+3 ;RETURN: 0 => NO REACTION
+4 ; 1 => REACTION
+5 NEW GMRAC,GMRAX,FLG,CLSFN
+6 SET GMRAX=0
SET FLG=0
SET GMRAC=$$CLP2CODE^GMRAPENC(PTR)
SET CLSFN=$$CODE2CL^GMRAPENC(GMRAC)
+7 IF GMRAC'=""
Begin DoDot:1
+8 ;*BD
+9 IF $GET(GMRAV1)
Begin DoDot:2
+10 FOR
SET GMRAX=$ORDER(^GMR(120.8,"APC",DFN,GMRAC,GMRAX))
if GMRAX<1
QUIT
SET FLG=2
SET GMRAIEN(GMRAX)=""
End DoDot:2
+11 IF '$GET(GMRAV1)
Begin DoDot:2
+12 ;*ED (C U DOTS)
+13 FOR
SET GMRAX=$ORDER(^TMP("GMRAOC",$JOB,"APC",GMRAC,GMRAX))
if GMRAX=""
QUIT
Begin DoDot:3
+14 SET FLG=2
+15 SET GMRADRCL(GMRAX)=CLSFN_"|"_PTR_U_$GET(^TMP("GMRAOC",$JOB,"APC",GMRAC,GMRAX))
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT FLG
NDFREF() ;VERSION-DEPENDENT GLOBAL LOCATION OF VA GENERIC FILE (#50.6)
+1 ;RETURN: GLOBAL LOCATION OF VA GENERIC FILE (#50.6)
+2 IF $$VERSION^XPDUTL("PSN")<4
QUIT "^PSNDF("
+3 QUIT "^PSNDF(50.6,"
GETDATA(DFN) ;OBTAIN ADVERSE REACTION DATA
+1 ;PARAMTER: DFN => IEN IN THE PATIENT (#2) FILE
+2 KILL ^TMP("GMRAOC",$JOB)
+3 DO REMOTE^GMRAOR0(DFN)
DO LOCAL(DFN)
+4 QUIT
LOCAL(DFN) ;OBTAIN DATA STORED LOCALLY
+1 ;PARAMTER: DFN => IEN IN THE PATIENT (#2) FILE
+2 NEW J
+3 SET J=0
FOR
SET J=$ORDER(^GMR(120.8,"API",DFN,J))
if '+J
QUIT
Begin DoDot:1
+4 DO LDATA("API",DFN,J)
End DoDot:1
+5 SET J=""
FOR
SET J=$ORDER(^GMR(120.8,"APC",DFN,J))
if J=""
QUIT
Begin DoDot:1
+6 DO LDATA("APC",DFN,J)
End DoDot:1
+7 QUIT
LDATA(NODE,DFN,J) ;OBTAIN EACH REACTION'S LOCALLY STORED DATA ELEMENTS
+1 ;PARAMTERS: NODE => CURRENT INDEX IN FILE #120.8
+2 ; EITHER "API" OR "APC".
+3 ; DFN => IEN IN THE PATIENT (#2) FILE
+4 ; J => CURRENT INGREDIENT OR CLASS
+5 NEW PAIEN
+6 SET PAIEN=0
FOR
SET PAIEN=$ORDER(^GMR(120.8,NODE,DFN,J,PAIEN))
if +$GET(PAIEN)=0
QUIT
Begin DoDot:1
+7 if $PIECE($GET(^GMR(120.8,PAIEN,"ER")),U)
QUIT
+8 ;*BD
+9 SET ^TMP("GMRAOC",$JOB,NODE,J)=$$SETNODE^GMRAOR1($GET(^TMP("GMRAOC",$JOB,NODE,J)),"LOCAL")
+10 if +$GET(GMRAV1)
QUIT
+11 ;*ED
+12 DO ADDLDATA($NAME(^TMP("GMRAOC",$JOB,NODE,J,PAIEN)),PAIEN)
End DoDot:1
+13 QUIT
ADDLDATA(GLOBAL,PAIEN) ;OBTAIN LOCALLY STORED DATA ELEMENTS FOR ONE REACTION
+1 ;PARAMETERS: GLOBAL => GLOBAL REFERENCE WHERE TO RETURN THE DATA
+2 ; PAIEN => IEN IN FILE #120.8
+3 NEW SITE
+4 SET SITE=$$SITE^VASITE()
SET SITE=$PIECE(SITE,U)_U_"L"_U
+5 SET @GLOBAL=SITE_$PIECE(^GMR(120.8,PAIEN,0),U,4)
+6 NEW REACT,IEN
+7 SET REACT=0
FOR
SET REACT=$ORDER(^GMR(120.8,PAIEN,10,REACT))
if +$GET(REACT)=0
QUIT
Begin DoDot:1
+8 SET REACT("VALUE")=$PIECE($GET(^GMR(120.8,PAIEN,10,REACT,0)),U)
+9 IF REACT("VALUE")=GMRAOTH
Begin DoDot:2
+10 SET REACT("VALUE")=REACT("VALUE")_"-"_$PIECE($GET(^GMR(120.8,PAIEN,10,REACT,0)),U,2)
+11 IF $PIECE(REACT("VALUE"),"-",2)=""
Begin DoDot:3
+12 IF GMRAOTH>0
SET $PIECE(REACT("VALUE"),"-",2)=$PIECE($GET(^GMRD(120.83,GMRAOTH,0)),U)
+13 IF '$TEST
KILL REACT("VALUE")
End DoDot:3
End DoDot:2
+14 if $DATA(REACT("VALUE"))
SET $PIECE(@GLOBAL,U,5)=$SELECT($PIECE($GET(@GLOBAL),U,5)'="":$PIECE(@GLOBAL,U,5)_"~",1:"")_REACT("VALUE")
End DoDot:1
+15 SET $PIECE(@GLOBAL,U,6)=$PIECE(^GMR(120.8,PAIEN,0),U,2)
+16 SET $PIECE(@GLOBAL,U,7)=$PIECE(^GMR(120.8,PAIEN,0),U,3)
+17 SET $PIECE(@GLOBAL,U,8)=$PIECE(^GMR(120.8,PAIEN,0),U,6)
+18 SET $PIECE(@GLOBAL,U,9)="V"
+19 SET $PIECE(@GLOBAL,U,11)=$PIECE(^GMR(120.8,PAIEN,0),U,14)
+20 IF $PIECE(@GLOBAL,U,8)="h"
IF +$PIECE($GET(^GMR(120.8,PAIEN,0)),U,8)>0
Begin DoDot:1
+21 SET $PIECE(@GLOBAL,U,4)=$SELECT($PIECE($GET(@GLOBAL),U,4)'="":$PIECE(@GLOBAL,U,4)_"~",1:"")_$PIECE($GET(^GMR(120.8,PAIEN,0)),U,9)_"|"_$PIECE($GET(^(0)),U,8)
End DoDot:1
+22 if $DATA(^GMR(120.85,"C",PAIEN))<10
QUIT
+23 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.85,"C",PAIEN,IEN))
if '+IEN
QUIT
Begin DoDot:1
+24 SET $PIECE(@GLOBAL,U,4)=$SELECT($PIECE($GET(@GLOBAL),U,4)'="":$PIECE(@GLOBAL,U,4)_"~",1:"")_$PIECE($GET(^GMR(120.85,IEN,0)),U)_"|"_$PIECE($GET(^(0)),U,14)
End DoDot:1
+25 QUIT
ADDCOMMA(GMRASYMP) ; p70
+1 if $LENGTH(GMRASYMP)<512
QUIT GMRASYMP
+2 NEW GMRADIV,GMRAMAX,GMRAID,GMRAIDX,GMRAOUT,GMRAITM,GMRACTR,GMRASPC,GMRAFOUT
+3 SET GMRAMAX=200
SET GMRACTR=0
SET GMRASPC=0
SET GMRAFOUT=""
+4 SET GMRADIV=$LENGTH(GMRASYMP)/GMRAMAX
SET GMRAIDX=$SELECT(GMRADIV[".":$PIECE(GMRADIV,".")+1,1:GMRADIV)
+5 FOR GMRAID=1:1:GMRAIDX
SET GMRAOUT(GMRAID)=""
Begin DoDot:1
+6 if GMRAID=1
SET GMRAOUT(GMRAID)=$EXTRACT(GMRASYMP,1,GMRAMAX)
+7 if GMRAID>1
SET GMRAOUT(GMRAID)=$EXTRACT(GMRASYMP,(GMRAMAX*(GMRAID-1))+1,GMRAMAX*(GMRAID))
End DoDot:1
+8 FOR GMRAIDX=1:1:GMRAID
Begin DoDot:1
+9 FOR GMRAITM=1:1:$LENGTH(GMRAOUT(GMRAIDX))
SET GMRACTR=GMRACTR+1
Begin DoDot:2
+10 if $EXTRACT(GMRAOUT(GMRAIDX),GMRAITM)=" "
SET GMRASPC=GMRAITM
End DoDot:2
+11 if GMRASPC
SET GMRAOUT(GMRAIDX)=$EXTRACT(GMRAOUT(GMRAIDX),1,GMRASPC-1)_","_$EXTRACT(GMRAOUT(GMRAIDX),GMRASPC+1,$LENGTH(GMRAOUT(GMRAIDX)))
+12 if 'GMRASPC
SET GMRAOUT(GMRAIDX)=GMRAOUT(GMRAIDX)_","
+13 SET GMRAFOUT=GMRAFOUT_GMRAOUT(GMRAIDX)
End DoDot:1
+14 QUIT GMRAFOUT
