- 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 Feb 18, 2025@23:05:59 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