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

GMRAOR.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. ORCHK(DFN,TYP,PTR,LOC) ;DETERMINE IF PATIENT HAS ADVERSE REACTION TO AGENT
  1. ;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2378
  1. ;*BD
  1. N GMRAFLG,GMRACM,DA,GMRAV1,GMRAOTH
  1. S GMRAFLG=0,GMRAV1=1,GMRAOTH=+$O(^GMRD(120.83,"B","OTHER REACTION",0))
  1. I $G(DFN)<1!("^CM^DR^IN^CL^"'[("^"_$G(TYP)_"^"))!($G(TYP)'="CM"&($G(PTR)<1)) S GMRAFLG=""
  1. E D
  1. .K GMRAING,GMRADRCL,GMRAIEN
  1. .D GETDATA(DFN)
  1. .I TYP="CM" S GMRAFLG=$$RAD(DFN,+$G(LOC))
  1. .I TYP="DR" S GMRAFLG=$$DRUG(DFN,PTR)
  1. .I TYP="IN" S GMRAFLG=$$ING(DFN,PTR)
  1. .I TYP="CL" S GMRAFLG=$$CLASS(DFN,PTR)
  1. K ^TMP("GMRAOC",$J)
  1. Q GMRAFLG
  1. ;*ED
  1. Q $$ORCHK2(DFN,TYP,PTR,LOC)
  1. ORCHK2(DFN,TYP,PTR,LOC,RETURN) ;DETERMINE IF PATIENT HAS ADVERSE REACTION TO AGENT
  1. ;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2378
  1. ;PARAMETERS: DFN => IEN IN THE PATIENT FILE (#2)
  1. ; TYP => TYPE OF CHECK TO PERFORM
  1. ; "CM": CONTRAST MEDIA
  1. ; "DR": DRUG
  1. ; "IN": DRUG INGREDIENT
  1. ; "CL": DRUG CLASS
  1. ; PTR => AGENT
  1. ; TYP="CM", PTR IS IGNORED
  1. ; TYP="DR", PTR=PSNDA.PSNVPN.LPTR, WHERE
  1. ; PSNDA IS IEN IN VA GENERIC FILE (#50.6),
  1. ; PSNVPN IS IEN IN VA PRODUCT FILE (#50.68), AND
  1. ; LPTR IS IEN IN DRUG FILE (#50)
  1. ; TYP="IN", PTR=IEN IN DRUG INGREDIENTS FILE (#50.416)
  1. ; TYP="CL", PTR=IEN IN VA DRUG CLASS FILE (#50.605)
  1. ; LOC => FOR TYP="CM" ONLY, 1 TO RETURN LOCATION(S) IN SECOND CARET PIECE OF $$ORCHK
  1. ; FOR TYP="CM" ONLY, 0 OR UNDEFINED TO NOT RETURN LOCATION(S) IN SECOND CARET PIECE OF $$ORCHK
  1. ; RETURN => FOR TYP="DR" ONLY, NAME OF ARRAY IN WHICH TO RETURN ORDER CHECK MESSAGES AND REACTION DATA
  1. ;RETURN: -1 => BAD PARAMETERS
  1. ; EMPTY STRING => NO ASSESSMENT
  1. ; 0 => NO REACTION
  1. ; 1 => FOR TYP="CM", PATIENT HAS REACTION
  1. ; FOR TYP="IN" AND TYP="CL", PATIENT HAS REACTION; INGREDIENT(S) RETURNED IN GMRAING() AND
  1. ; DRUG CLASS(ES) IN GMRADRCL()
  1. ; FOR TYP="DR", PATIENT HAS REACTION
  1. I +$G(DFN)<1!("^CM^DR^IN^CL^"'[(U_$G(TYP)_U)) Q -1
  1. I $G(TYP)="DR",PTR'?.N.1".".N.1".".N Q -1
  1. I +$G(PTR)<1,($G(TYP)="IN"!($G(TYP)="CL")) Q -1
  1. I +$G(LOC)>0,($G(TYP)'="CM") Q -1
  1. I $G(TYP)="DR" I $G(RETURN)=""!($G(RETURN)="RETURN") Q -1
  1. K GMRAING,GMRADRCL,GMRAREAC
  1. N GMRAFLG,GMRASESS,IDX,GMRAOTH
  1. S GMRAFLG=0,GMRASESS="",GMRAOTH=+$O(^GMRD(120.83,"B","OTHER REACTION",0))
  1. ;*BD MOVE CODE IN LINETAG TO HERE
  1. D GETDATA(DFN)
  1. ;*ED
  1. S GMRASESS=$$NKA^GMRANKA(DFN)
  1. I +GMRASESS=0,($D(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))>9) D
  1. .S IDX=0 F S IDX=$O(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX)) Q:'IDX D
  1. ..I $P(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX),U,2)="YES" S GMRASESS=1
  1. ..I GMRASESS'=1,($P(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX),U,2)'="YES") S GMRASESS=0
  1. Q:'+GMRASESS GMRASESS
  1. I TYP="CM" S GMRAFLG=$$RAD(DFN,+$G(LOC))
  1. I TYP="DR" S GMRAFLG=$$DRUG(DFN,PTR)
  1. I TYP="IN" S GMRAFLG=$$ING(DFN,PTR)
  1. I TYP="CL" S GMRAFLG=$$CLASS(DFN,PTR)
  1. K ^TMP("GMRAOC",$J)
  1. Q GMRAFLG
  1. RAD(DFN,LOC) ;CONTRAST MEDIA CHECK
  1. ;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
  1. ; LOC => 1 TO RETURN LOCATION(S)
  1. ; 0 OR UNDEFINED TO NOT RETURN LOCATION(S)
  1. ;RETURN: HAS_REACTION^LOCATION(S), WHERE
  1. ; HAS_REACTION IS 0 FOR PATIENT DOES NOT HAVE A REACTION
  1. ; AND 1 IS FOR PATIENT HAS REACTION AND
  1. ; LOCATION(S) IS A SCREEN-PRINTABLE STRING OF ALL THE LOCATIONS DOCUMENTING
  1. ; A REACTION
  1. N FLG,DC,DELIMIT,REACT,SITES,SITE,GMRACM,COUNT
  1. ;*BD
  1. N LOCAL,REMOTE
  1. ;*ED
  1. S FLG=0,DC="DX10" F S DC=$O(^TMP("GMRAOC",$J,"APC",DC)) Q:DC'["DX10" D
  1. .S FLG=1
  1. .I $G(LOC) D
  1. ..;*BD
  1. ..I $G(GMRAV1) D
  1. ...I $G(^TMP("GMRAOC",$J,"APC",DC))["LOCAL" S LOCAL=1
  1. ...I $G(^TMP("GMRAOC",$J,"APC",DC))["REMOTE" S REMOTE=1
  1. ..I '$G(GMRAV1) D
  1. ...;*ED (C U DOTS)
  1. ...S REACT="" F S REACT=$O(^TMP("GMRAOC",$J,"APC",DC,REACT)) Q:REACT="" D
  1. ....Q:$D(SITES(REACT))
  1. ....S SITES=1+$G(SITES),SITES(REACT)=$$GET1^DIQ(4,$P(^TMP("GMRAOC",$J,"APC",DC,REACT),U),.01)
  1. ....S SITES(REACT)=SITES(REACT)_" entered on "_$$FMTE^XLFDT($P(^TMP("GMRAOC",$J,"APC",DC,REACT),U,3))
  1. I $G(LOC) D
  1. .;*BD
  1. .I $G(GMRAV1) D
  1. ..S GMRACM=$S($G(LOCAL)&($G(REMOTE)):"LOCAL AND REMOTE SITE(S)",$G(LOCAL):"LOCAL",$G(REMOTE):"REMOTE SITE(S)",1:"")
  1. .I '$G(GMRAV1) D
  1. ..;*ED (C U DOTS)
  1. ..S DELIMIT=", ",SITE="",COUNT=1
  1. ..F S SITE=$O(SITES(SITE)) Q:SITE="" D
  1. ...S:COUNT=SITES DELIMIT=" and "
  1. ...S GMRACM=$S($G(GMRACM)'="":GMRACM_DELIMIT,1:"")_SITES(SITE),COUNT=COUNT+1
  1. Q FLG_$S($G(GMRACM)'="":U_GMRACM,1:"")
  1. DRUG(DFN,PTR) ;DRUG CHECK
  1. ;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
  1. ; PTR => PSNDA.PSNVPN.LPTR, WHERE
  1. ; PSNDA IS IEN IN VA GENERIC FILE (#50.6),
  1. ; PSNVPN IS IEN IN VA PRODUCT FILE (#50.68), AND
  1. ; LPTR IS IEN IN DRUG FILE (#50)
  1. ;RETURN: 1 => REACTION TO DRUG
  1. ; 0 => NO REACTION TO DRUG
  1. N %,FLG,GMRAC,GMRADR,GMRAI,PSNVPN,PSNDA,LPTR,GMRANVPN,GMRANDA,REACT,CLASS,GMRALIST
  1. N TMPFLG,REACS,NODE
  1. S (FLG,TMPFLG)=0,GMRANDA=$P(PTR,"."),GMRANVPN=$P(PTR,".",2),LPTR=$P(PTR,".",3)
  1. I GMRANDA>0,($G(@($$NDFREF_GMRANDA_",0)"))'="") D
  1. .;INGREDIENT
  1. .S PSNDA=GMRANDA
  1. .I $T(DISPDRG^PSNNGR)]"",GMRANVPN]"" D
  1. ..S NODE="PSNDD",PSNVPN=GMRANVPN
  1. ..K ^TMP(NODE,$J)
  1. ..D DISPDRG^PSNNGR ;ICR #151
  1. .I $T(DISPDRG^PSNNGR)=""!(GMRANVPN="") D
  1. ..S NODE="PSN"
  1. ..K ^TMP(NODE,$J)
  1. ..D ^PSNNGR ;ICR #151
  1. .S GMRAI=0,%=1 F S GMRAI=$O(^TMP(NODE,$J,GMRAI)) Q:GMRAI<1 I $D(^TMP("GMRAOC",$J,"API",GMRAI)) D
  1. ..S FLG=1
  1. ..;*BD (C U % VAR)
  1. ..I $G(GMRAV1) S GMRAING(%)=^TMP(NODE,$J,GMRAI)_$$FAC(^TMP("GMRAOC",$J,"API",GMRAI)),%=%+1
  1. ..I '$G(GMRAV1) D
  1. ...;*ED (C U DOTS)
  1. ...S REACT="" F S REACT=$O(^TMP("GMRAOC",$J,"API",GMRAI,REACT)) Q:REACT="" D
  1. ....S REACS(REACT)=$G(^TMP("GMRAOC",$J,"API",GMRAI,REACT))
  1. ....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
  1. .K ^TMP(NODE,$J)
  1. .;*BD
  1. .I $G(GMRAV1),FLG Q
  1. .;*ED
  1. .;DRUG CLASS
  1. .I GMRANVPN D Q
  1. ..S CLASS=$$DCLCODE^PSNAPIS(GMRANDA,GMRANVPN) ;ICR #2531
  1. ..S TMPFLG=$$PCCHK(CLASS)
  1. ..S:TMPFLG>0 FLG=TMPFLG
  1. .S GMRALIST=$$CLIST^PSNAPIS(GMRANDA,.GMRALIST) Q:'$G(GMRALIST) ;ICR #2574
  1. .S GMRALIST=0 F S GMRALIST=$O(GMRALIST(GMRALIST)) Q:'GMRALIST D
  1. ..S TMPFLG=$$PCCHK($P(GMRALIST(GMRALIST),U,2))
  1. ..S:TMPFLG>0 FLG=TMPFLG
  1. ;*BD
  1. Q:$G(GMRAV1) FLG
  1. ;*ED
  1. I +LPTR>0 D
  1. .;GMR ALLERGY
  1. .N IEN,NAME
  1. .S IEN=0 F S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:'+IEN!(+FLG=3) D
  1. ..I $P($G(^GMR(120.8,IEN,0)),U,3)=(LPTR_";PSDRUG("),('$P($G(^GMR(120.8,IEN,"ER")),U)) D
  1. ...D DATA^PSS50(LPTR,,,,,"GMRALST") ;ICR #4533
  1. ...S NAME=$G(^TMP($J,"GMRALST",LPTR,.01))
  1. ...K ^TMP($J,"GMRALST")
  1. ...D ADDLDATA($NA(REACS(IEN)),IEN)
  1. ...S FLG=3
  1. ...I $G(REACS(IEN,"REC"))'[NAME S REACS(IEN,"REC")=$S($D(REACS(IEN,"REC")):"~",1:"")_NAME_U_LPTR
  1. .;DRUG CLASS
  1. .I 'GMRANDA D
  1. ..S TMPFLG=$$PCCHK($$DRP2VACL^GMRAPENC(LPTR))
  1. ..S:TMPFLG>0 FLG=TMPFLG
  1. S:FLG>0 FLG=1
  1. K @RETURN
  1. N STYPE,IPIECE,OPIECE,FIELDS,FIELDS1,ITEM,FILE,NODE,FIELD,MSGNUM,RINDEX,SITE,SEV
  1. S STYPE("L")="LOCAL",STYPE("R")="REMOTE"
  1. 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"
  1. S FIELDS(2,2)="120.8^^6",FIELDS(2,3)="120.8^^7"
  1. 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"""
  1. S FIELDS(1,4)="120.8^6^8"
  1. S FIELDS1(1.1,1)=""
  1. I $D(REACS)>9 D
  1. .S REACT="" F S REACT=$O(REACS(REACT)) Q:REACT="" D
  1. ..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"
  1. ..S REACT(1)=$S($P(REACS(REACT),U,7)'="":$P(REACS(REACT),U,7),1:$P(REACS(REACT),U,6))
  1. ..S REACT(2)=$P(REACS(REACT),U,8) S:REACT(2)="" REACT(2)="UNKNOWN"
  1. ..S REACT(3)=$P($P(REACS(REACT),U,4),"|",2) S:REACT(3)="" REACT(3)="UNKNOWN"
  1. ..I $D(RINDEX(REACT(1),REACT(2),REACT(3))) S MSGNUM=$O(RINDEX(REACT(1),REACT(2),REACT(3),0))
  1. ..E S MSGNUM(0)=1+$G(MSGNUM(0)),MSGNUM=MSGNUM(0),RINDEX(REACT(1),REACT(2),REACT(3),MSGNUM)=""
  1. ..S @RETURN@(MSGNUM,REACT)=REACS(REACT),SITE=$P(REACS(REACT),U),@RETURN@(MSGNUM,"MESSAGE",1)=1+$G(@RETURN@(MSGNUM,"MESSAGE",1))
  1. ..F NODE="ING","CLS","REC" I $D(REACS(REACT,NODE)) F ITEM=1:1:$L(REACS(REACT,NODE),"~") D
  1. ...S $P(@RETURN@(MSGNUM,"MESSAGE","OFFENDERS",NODE),"~",ITEM)=$P($P(REACS(REACT,NODE),"~",ITEM),U)
  1. ...S $P(@RETURN@(MSGNUM,REACT,NODE),"~",ITEM)=$P($P(REACS(REACT,NODE),"~",ITEM),U,2)
  1. ..S @RETURN@(MSGNUM,"MESSAGE",1,SITE)=$$GET1^DIQ(4,$P(REACS(REACT),U)_",",.01)_U_STYPE($P(REACS(REACT),U,2))_U
  1. ..S NODE=0 F S NODE=$O(FIELDS(NODE)) Q:NODE="" S OPIECE=0 F S OPIECE=$O(FIELDS(NODE,OPIECE)) Q:OPIECE="" D
  1. ...S FILE=$P(FIELDS(NODE,OPIECE),U),FIELD=$P(FIELDS(NODE,OPIECE),U,2),IPIECE=$P(FIELDS(NODE,OPIECE),U,3)
  1. ...I NODE=1 S RETURN=$NA(@RETURN@(MSGNUM,"MESSAGE",NODE,SITE))
  1. ...I $L(NODE,".")=2 S RETURN=$NA(@RETURN@(MSGNUM,"MESSAGE",$P(NODE,"."),SITE,$P(NODE,".",2)))
  1. ...I NODE'=1,NODE'["." S RETURN=$NA(@RETURN@(MSGNUM,"MESSAGE",NODE))
  1. ...I FIELD>0,FIELD'["*",FIELD'["+" S $P(@RETURN,U,OPIECE)=$$EXTERNAL^DILFD(FILE,FIELD,,$P(REACS(REACT),U,IPIECE))
  1. ...I 'FIELD,'$D(FIELDS(NODE,OPIECE,"OTRANSFORM")) S $P(@RETURN,U,OPIECE)=$P(REACS(REACT),U,IPIECE)
  1. ...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
  1. ...I FIELD["*" D
  1. ....N TEXT,DELIMIT,ITEMS,STR,COUNT,NEWIVAL
  1. ....S DELIMIT=", ",COUNT=0,COUNT(1)=1
  1. ....I $L($G(@RETURN)) S @RETURN=$$ADDCOMMA(@RETURN) ;p70
  1. ....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)
  1. ....I $P(REACS(REACT),U,IPIECE)'="" F ITEM=1:1:$L($P(REACS(REACT),U,IPIECE),"~") D
  1. .....S STR=$P($P(REACS(REACT),U,IPIECE),"~",ITEM),$P(NEWIVAL,"~",ITEM)=+STR
  1. .....I STR["-" S STR=$P(STR,"-",2)
  1. .....E S STR=$$EXTERNAL^DILFD(FILE,+FIELD,,STR)
  1. .....I STR'="",'$D(ITEMS(STR)) S ITEMS(STR)="",COUNT=1+$G(COUNT)
  1. ....S ITEM="" F S ITEM=$O(ITEMS(ITEM)) Q:ITEM="" D
  1. .....S:COUNT(1)=COUNT DELIMIT=" and "
  1. .....S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_ITEM,COUNT(1)=1+COUNT(1)
  1. ....S $P(@RETURN,U,OPIECE)=$G(TEXT),RETURN=$P(RETURN,"(")
  1. ....I $G(NEWIVAL)'="",NEWIVAL'=$P(@RETURN@(MSGNUM,REACT),U,IPIECE) S $P(@RETURN@(MSGNUM,REACT),U,IPIECE)=NEWIVAL
  1. ...I FIELD["+" D
  1. ....N FNUM,ITEMS
  1. ....F ITEM=1:1:$L($P(REACS(REACT),U,IPIECE),"~") N STR F FNUM=1:1:$L(FIELD,"|") D S:STR'="" ITEMS(ITEM)=STR
  1. .....;S STR=$S($G(STR)'="":STR_U,1:"")_$$EXTERNAL^DILFD(FILE,+$P(FIELD,"|",FNUM),,$P($P($P(REACS(REACT),U,IPIECE),"~",ITEM),"|",FNUM))
  1. .....S STR=$S(FNUM>1:STR_U,1:"")_$$EXTERNAL^DILFD(FILE,+$P(FIELD,"|",FNUM),,$P($P($P(REACS(REACT),U,IPIECE),"~",ITEM),"|",FNUM))
  1. ....M:$D(ITEMS)>9 @RETURN=ITEMS
  1. ...I $G(FIELDS1(1.1,1))'="" S FIELDS(1.1,1)=$G(FIELDS1(1.1,1)),FIELDS1(1.1,1)=""
  1. ...S RETURN=$P(RETURN,"(")
  1. .S @RETURN=MSGNUM(0)
  1. Q FLG
  1. ;*BD
  1. FAC(NODE) ;
  1. N FAC
  1. S FAC=$S($L(NODE):" ("_NODE_")",1:"")
  1. Q FAC
  1. ;*ED
  1. DRCL(CODE) ;POPULATE GMRADRCL()
  1. ;PARAMTER: CODE => FIVE CHARACTER DRUG CLASS CODE TO ADD
  1. ;RETURN: 0 => CODE NOT ADDED TO ARRAY
  1. ; 2 => CODE ADDED TO THE ARRAY OR ALREADY EXISTS IN ARRAY
  1. I '$L(CODE) Q 0
  1. N CLSFN,REACT,RETURN,IEN
  1. I '$D(^TMP("GMRAOC",$J,"APC",CODE)) S RETURN=$S($D(GMRADRCL):2,1:0)
  1. Q:$D(RETURN) RETURN
  1. Q:$D(GMRADRCL(CODE)) 2
  1. Q:CODE="HA000" 0
  1. S CLSFN=$$CODE2CL^GMRAPENC(CODE)
  1. S IEN=$$CODE2CLP^GMRAPENC(CODE)
  1. ;*BD (C U % VAR)
  1. I $G(GMRAV1) D
  1. .N J
  1. .S J=$S('$D(GMRADRCL):1,1:$O(GMRADRCL(999),-1)+1)
  1. .S GMRADRCL(J)=CODE_U_CLSFN_$$FAC(^TMP("GMRAOC",$J,"APC",CODE))
  1. I '$G(GMRAV1) D
  1. .;*ED (C U DOTS)
  1. .S REACT="" F S REACT=$O(^TMP("GMRAOC",$J,"APC",CODE,REACT)) Q:REACT="" D
  1. ..S REACS(REACT)=$G(^TMP("GMRAOC",$J,"APC",CODE,REACT))
  1. ..I $G(REACS(REACT,"CLS"))'[CODE S REACS(REACT,"CLS")=$S($D(REACS(REACT,"CLS")):REACS(REACT,"CLS")_"~",1:"")_CODE_" "_CLSFN_U_IEN
  1. Q 2
  1. PCCHK(VACLASS) ;PARTIAL DRUG CLASS CHECK
  1. Q:$L($G(VACLASS))<4 0
  1. N CL,I,RETURN
  1. S CL=$S($E(VACLASS,1,4)="CN10":5,1:4),RETURN=0
  1. S I="" F S I=$O(^TMP("GMRAOC",$J,"APC",I)) Q:'$L(I) D
  1. .I $E(I,1,CL)=$E(VACLASS,1,CL) S RETURN=$$DRCL(I)
  1. Q RETURN
  1. ING(DFN,PTR) ;DRUG INGREDIENT CHECK
  1. ;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
  1. ; PTR => IEN IN THE DRUG INGREDIENTS FILE (#50.416)
  1. ;RETURN: 0 => NO REACTION
  1. ; 1 => REACTION
  1. N GMRAX,FLG
  1. S FLG=0,GMRAX=0
  1. ;*BD
  1. I $G(GMRAV1) D
  1. .F S GMRAX=$O(^GMR(120.8,"API",DFN,PTR,GMRAX)) Q:GMRAX<1 S FLG=1,GMRAIEN(GMRAX)=""
  1. I '$G(GMRAV1) D
  1. .;*ED (C U DOTS)
  1. .K ^TMP($J,"GMRALST") D ZERO^PSN50P41(PTR,,,"GMRALST") ;ICR #4531
  1. .F S GMRAX=$O(^TMP("GMRAOC",$J,"API",PTR,GMRAX)) Q:GMRAX="" D
  1. ..S FLG=1,GMRAING(GMRAX)=$G(^TMP($J,"GMRALST",PTR,.01))_"|"_PTR_U_$G(^TMP("GMRAOC",$J,"API",PTR,GMRAX))
  1. .K ^TMP($J,"GMRALST")
  1. Q FLG
  1. CLASS(DFN,PTR) ;DRUG CLASS CHECK
  1. ;PARAMTERS: DFN => IEN IN THE PATIENT FILE (#2)
  1. ; PTR => IEN IN THE VA DRUG CLASS FILE (#50.605)
  1. ;RETURN: 0 => NO REACTION
  1. ; 1 => REACTION
  1. N GMRAC,GMRAX,FLG,CLSFN
  1. S GMRAX=0,FLG=0,GMRAC=$$CLP2CODE^GMRAPENC(PTR),CLSFN=$$CODE2CL^GMRAPENC(GMRAC)
  1. I GMRAC'="" D
  1. .;*BD
  1. .I $G(GMRAV1) D
  1. ..F S GMRAX=$O(^GMR(120.8,"APC",DFN,GMRAC,GMRAX)) Q:GMRAX<1 S FLG=2,GMRAIEN(GMRAX)=""
  1. .I '$G(GMRAV1) D
  1. ..;*ED (C U DOTS)
  1. ..F S GMRAX=$O(^TMP("GMRAOC",$J,"APC",GMRAC,GMRAX)) Q:GMRAX="" D
  1. ...S FLG=2
  1. ...S GMRADRCL(GMRAX)=CLSFN_"|"_PTR_U_$G(^TMP("GMRAOC",$J,"APC",GMRAC,GMRAX))
  1. Q FLG
  1. NDFREF() ;VERSION-DEPENDENT GLOBAL LOCATION OF VA GENERIC FILE (#50.6)
  1. ;RETURN: GLOBAL LOCATION OF VA GENERIC FILE (#50.6)
  1. I $$VERSION^XPDUTL("PSN")<4 Q "^PSNDF("
  1. Q "^PSNDF(50.6,"
  1. GETDATA(DFN) ;OBTAIN ADVERSE REACTION DATA
  1. ;PARAMTER: DFN => IEN IN THE PATIENT (#2) FILE
  1. K ^TMP("GMRAOC",$J)
  1. D REMOTE^GMRAOR0(DFN),LOCAL(DFN)
  1. Q
  1. LOCAL(DFN) ;OBTAIN DATA STORED LOCALLY
  1. ;PARAMTER: DFN => IEN IN THE PATIENT (#2) FILE
  1. N J
  1. S J=0 F S J=$O(^GMR(120.8,"API",DFN,J)) Q:'+J D
  1. .D LDATA("API",DFN,J)
  1. S J="" F S J=$O(^GMR(120.8,"APC",DFN,J)) Q:J="" D
  1. .D LDATA("APC",DFN,J)
  1. Q
  1. LDATA(NODE,DFN,J) ;OBTAIN EACH REACTION'S LOCALLY STORED DATA ELEMENTS
  1. ;PARAMTERS: NODE => CURRENT INDEX IN FILE #120.8
  1. ; EITHER "API" OR "APC".
  1. ; DFN => IEN IN THE PATIENT (#2) FILE
  1. ; J => CURRENT INGREDIENT OR CLASS
  1. N PAIEN
  1. S PAIEN=0 F S PAIEN=$O(^GMR(120.8,NODE,DFN,J,PAIEN)) Q:+$G(PAIEN)=0 D
  1. .Q:$P($G(^GMR(120.8,PAIEN,"ER")),U)
  1. .;*BD
  1. .S ^TMP("GMRAOC",$J,NODE,J)=$$SETNODE^GMRAOR1($G(^TMP("GMRAOC",$J,NODE,J)),"LOCAL")
  1. .Q:+$G(GMRAV1)
  1. .;*ED
  1. .D ADDLDATA($NA(^TMP("GMRAOC",$J,NODE,J,PAIEN)),PAIEN)
  1. Q
  1. ADDLDATA(GLOBAL,PAIEN) ;OBTAIN LOCALLY STORED DATA ELEMENTS FOR ONE REACTION
  1. ;PARAMETERS: GLOBAL => GLOBAL REFERENCE WHERE TO RETURN THE DATA
  1. ; PAIEN => IEN IN FILE #120.8
  1. N SITE
  1. S SITE=$$SITE^VASITE(),SITE=$P(SITE,U)_U_"L"_U
  1. S @GLOBAL=SITE_$P(^GMR(120.8,PAIEN,0),U,4)
  1. N REACT,IEN
  1. S REACT=0 F S REACT=$O(^GMR(120.8,PAIEN,10,REACT)) Q:+$G(REACT)=0 D
  1. .S REACT("VALUE")=$P($G(^GMR(120.8,PAIEN,10,REACT,0)),U)
  1. .I REACT("VALUE")=GMRAOTH D
  1. ..S REACT("VALUE")=REACT("VALUE")_"-"_$P($G(^GMR(120.8,PAIEN,10,REACT,0)),U,2)
  1. ..I $P(REACT("VALUE"),"-",2)="" D
  1. ...I GMRAOTH>0 S $P(REACT("VALUE"),"-",2)=$P($G(^GMRD(120.83,GMRAOTH,0)),U)
  1. ...E K REACT("VALUE")
  1. .S:$D(REACT("VALUE")) $P(@GLOBAL,U,5)=$S($P($G(@GLOBAL),U,5)'="":$P(@GLOBAL,U,5)_"~",1:"")_REACT("VALUE")
  1. S $P(@GLOBAL,U,6)=$P(^GMR(120.8,PAIEN,0),U,2)
  1. S $P(@GLOBAL,U,7)=$P(^GMR(120.8,PAIEN,0),U,3)
  1. S $P(@GLOBAL,U,8)=$P(^GMR(120.8,PAIEN,0),U,6)
  1. S $P(@GLOBAL,U,9)="V"
  1. S $P(@GLOBAL,U,11)=$P(^GMR(120.8,PAIEN,0),U,14)
  1. I $P(@GLOBAL,U,8)="h",+$P($G(^GMR(120.8,PAIEN,0)),U,8)>0 D
  1. . 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)
  1. Q:$D(^GMR(120.85,"C",PAIEN))<10
  1. S IEN=0 F S IEN=$O(^GMR(120.85,"C",PAIEN,IEN)) Q:'+IEN D
  1. .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)
  1. Q
  1. ADDCOMMA(GMRASYMP) ; p70
  1. Q:$L(GMRASYMP)<512 GMRASYMP
  1. N GMRADIV,GMRAMAX,GMRAID,GMRAIDX,GMRAOUT,GMRAITM,GMRACTR,GMRASPC,GMRAFOUT
  1. S GMRAMAX=200,GMRACTR=0,GMRASPC=0,GMRAFOUT=""
  1. S GMRADIV=$L(GMRASYMP)/GMRAMAX,GMRAIDX=$S(GMRADIV[".":$P(GMRADIV,".")+1,1:GMRADIV)
  1. F GMRAID=1:1:GMRAIDX S GMRAOUT(GMRAID)="" D
  1. . S:GMRAID=1 GMRAOUT(GMRAID)=$E(GMRASYMP,1,GMRAMAX)
  1. . S:GMRAID>1 GMRAOUT(GMRAID)=$E(GMRASYMP,(GMRAMAX*(GMRAID-1))+1,GMRAMAX*(GMRAID))
  1. F GMRAIDX=1:1:GMRAID D
  1. . F GMRAITM=1:1:$L(GMRAOUT(GMRAIDX)) S GMRACTR=GMRACTR+1 D
  1. .. S:$E(GMRAOUT(GMRAIDX),GMRAITM)=" " GMRASPC=GMRAITM
  1. . S:GMRASPC GMRAOUT(GMRAIDX)=$E(GMRAOUT(GMRAIDX),1,GMRASPC-1)_","_$E(GMRAOUT(GMRAIDX),GMRASPC+1,$L(GMRAOUT(GMRAIDX)))
  1. . S:'GMRASPC GMRAOUT(GMRAIDX)=GMRAOUT(GMRAIDX)_","
  1. . S GMRAFOUT=GMRAFOUT_GMRAOUT(GMRAIDX)
  1. Q GMRAFOUT