GMRAOR0 ;HIRMFO/WAA,FPT - OERR HL7 UTILITY;05/28/2015 09:18 ;Jan 31, 2020@13:06:49
;;4.0;Adverse Reaction Tracking;**4,46,51**;Mar 29, 1996;Build 189
DUPCHK(DFN,GMRALL) ;CHECK FOR DUPS
;Input variable:
; DFN = Patient DFN
; GMRALL = Free text of allergy
;
;return variable:
; GMRAFLG = (0,1,-1)
; 0 Patient has no matching reactions on file
; 1 Patient has a matching reaction.
; -1 Patient has a matching reaction but is E/E
;
;********************************************************************
N GMRAFLG,GMRAPA
S GMRAFLG=0,GMRAPA=0
;Loop through all the patient's reaction and look for matches
F S GMRAPA=$O(^GMR(120.8,"B",DFN,GMRAPA)) Q:GMRAPA<1 D Q:GMRAFLG=1
.Q:GMRALL'=$P($G(^GMR(120.8,GMRAPA,0)),U,2) ;Not a match
.I +$G(^GMR(120.8,GMRAPA,"ER")) S GMRAFLG=-1 Q ;E/E
.S GMRAFLG=1 ;Matching allergy.
.Q
Q GMRAFLG
;********************************************************************
;CONTINUATION FROM GMRAOR
REMOTE(DFN) ;OBTAIN DATA STORED REMOTELY
;PARAMTER: DFN => IEN IN THE PATIENT (#2) FILE
Q:$$HDRDATA^GMRAHDR()<1
N J,GMRAOTH
S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
S J=0 F S J=$O(^XTMP("ORRDI","ART",DFN,J)) Q:'+J D
.N SEVERE,SYMPTOM,AGENT,CLASSES,INGS,DATE,IN,DC,GL,IEN,DD,INDEX,DATA,REACT,IN,OBSHIS
.N VUID,FILE,GMRARAY,DC,GMRAING,GMRADC,K,INGLST,I,PRIM,COMMID,MECH
.S GL=$NA(^XTMP("ORRDI","ART",DFN,J)),DATE=""
.I +$G(@GL@("ORIGINATION DATE/TIME",0))'=0 S DATE=$$HL7TFM^XLFDT(@GL@("ORIGINATION DATE/TIME",0))
.S DATA=$P($G(@GL@("FACILITY",0)),U)_U_"R"_U_DATE
.S REACT=$G(@GL@("GMRALLERGY",0))
.I REACT'="" D
..S VUID=$P(REACT,U,1)
..S FILE=$P($P(REACT,U,3),"99VA",2)
..D GETIREF^XTID(FILE,,VUID,"GMRARAY")
..D FILE^DID(FILE,,"GLOBAL NAME","DD")
..S IEN=0 F S IEN=$O(GMRARAY(FILE,.01,IEN)) Q:+$G(IEN)=0 D
...S AGENT=+IEN_";"_$P(DD("GLOBAL NAME"),U,2)
..K VUID,FILE,GMRARAY,IEN
.I $D(@GL@("SEVERITY"))>9 D
..S SEVERE="|"_$P(@GL@("SEVERITY",0),U)
.I $D(@GL@("SIGNS/SYMPTOMS"))>9 D
..S INDEX=0 F S INDEX=$O(@GL@("SIGNS/SYMPTOMS",INDEX)) Q:+$G(INDEX)=0 D
...I $P($G(@GL@("SIGNS/SYMPTOMS",INDEX)),U,3)="L" D
....S SYMPTOM=$S($G(SYMPTOM)'="":SYMPTOM_"~",1:"")_GMRAOTH
...I $P($G(@GL@("SIGNS/SYMPTOMS",INDEX)),U,3)'="L" D
....S VUID=$P(@GL@("SIGNS/SYMPTOMS",INDEX),U,1)
....S FILE=$P($P(@GL@("SIGNS/SYMPTOMS",INDEX),U,3),"99VA",2)
....D GETIREF^XTID(FILE,,VUID,"GMRARAY")
....S IEN=0 F S IEN=$O(GMRARAY(FILE,.01,IEN)) Q:+$G(IEN)=0 S SYMPTOM=$S($G(SYMPTOM)'="":SYMPTOM_"~",1:"")_+IEN
....K VUID,FILE,GMRARAY,IEN
.I $D(@GL@("OBS/HISTORICAL"))>9 D
..D GETIREF^XTID(120.8,,$P($G(@GL@("OBS/HISTORICAL",0)),U,1),"GMRARAY")
..S OBSHIS=$O(GMRARAY(120.8,6,""))
..K GMRARAY
.S MECH=""
.I $D(@GL@("MECHANISM"))>9 D
..S MECH=$P($G(@GL@("MECHANISM",0)),U,2)
..S MECH=$S(MECH="ALLERGY":"A",MECH="PHARMACOLOGIC":"P",1:"U")
.S DATA=DATA_U_$G(SEVERE)_U_$G(SYMPTOM)_U_$G(@GL@("REACTANT",0))_U_$G(AGENT)_U_$G(OBSHIS)
.S $P(DATA,U,11)=$G(MECH)
.I $D(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS")) D
..S IN=0 F S IN=$O(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS",IN)) Q:'+IN D
...S VUID=$P(@GL@("DRUG INGREDIENTS",IN),U),FILE=$P(^(IN),U,3)
...S FILE=$P(FILE,"99VA",2)
...D GETIREF^XTID(FILE,,VUID,"GMRARAY")
...S IEN=0 F S IEN=$O(GMRARAY(FILE,.01,IEN)) Q:'+IEN D
....;*BD
....S ^TMP("GMRAOC",$J,"API",+IEN)=$$SETNODE^GMRAOR1($G(^TMP("GMRAOC",$J,"API",+IEN)),"REMOTE SITE(S)")
....;*ED
....S:'$D(INGS(+IEN)) INGS(+IEN)=""
...K VUID,FILE,GMRARAY,IEN
.I $D(@GL@("DRUG CLASSES")) D
..S DC=0 F S DC=$O(@GL@("DRUG CLASSES",DC)) Q:'+DC D
...;*BD
...N DCLASS
...S DCLASS=$P(@GL@("DRUG CLASSES",DC),U,4)
...S ^TMP("GMRAOC",$J,"APC",DCLASS)=$$SETNODE^GMRAOR1($G(^TMP("GMRAOC",$J,"APC",DCLASS)),"REMOTE SITE(S)")
...;*ED
...S VUID=$P(@GL@("DRUG CLASSES",DC),U,1),FILE=$P($P(^(DC),U,3),"99VA",2)
...D GETIREF^XTID(FILE,,VUID,"GMRARAY")
...S IEN=0 F S IEN=$O(GMRARAY(FILE,.01,IEN)) Q:'+IEN D
....S:'$D(CLASSES(+IEN)) CLASSES(+IEN)=$P(@GL@("DRUG CLASSES",DC),U,4)
...K GMRARAY
.D FIND(REACT,.GMRAING,.GMRADC) I $D(GMRAING)!($D(GMRADC)) D
..S K=0 F S K=$O(GMRAING(K)) Q:'+K D
...;*BD
...S ^TMP("GMRAOC",$J,"API",K)=$$SETNODE^GMRAOR1($G(^TMP("GMRAOC",$J,"API",K)),"REMOTE SITE(S)")
...;*ED
...S:'$D(INGS(K)) INGS(K)=""
..S K="" F S K=$O(GMRADC(K)) Q:K="" D
...;*BD
...S ^TMP("GMRAOC",$J,"APC",GMRADC(K))=$$SETNODE^GMRAOR1($G(^TMP("GMRAOC",$J,"APC",GMRADC(K))),"REMOTE SITE(S)")
...;*ED
...S:'$D(CLASSES(K)) CLASSES(K)=GMRADC(K)
.S $P(DATA,U,9)="V"
.S COMMID=$O(^GMR(120.88,"PR",DFN_";DPT(",$P(DATA,U)_";"_$P(DATA,U,6),""),-1)
.S $P(DATA,U,10)=$S(COMMID="":"",1:$G(^GMR(120.88,COMMID,1)))
.S IN="" F S IN=$O(INGS(IN)) Q:IN="" S ^TMP("GMRAOC",$J,"API",IN,"R"_J)=$G(DATA)
.S DC="" F S DC=$O(CLASSES(DC)) Q:DC="" S ^TMP("GMRAOC",$J,"APC",CLASSES(DC),"R"_J)=$G(DATA)
I $D(^TMP("GMRAOC",$J,"API")) D
.N I,INGLST
.S I=0 F S I=$O(^TMP("GMRAOC",$J,"API",I)) Q:'I D
..N PRIM
..S PRIM=$$PRIMARY(I)
..I PRIM M INGLST(PRIM)=^TMP("GMRAOC",$J,"API",I) K ^TMP("GMRAOC",$J,"API",I)
.S I=0 F S I=$O(INGLST(I)) Q:'I M ^TMP("GMRAOC",$J,"API",I)=INGLST(I)
Q
FIND(REACT,ING,DC) ;DETERMINE DRUG INGREDIENTS AND CLASSES FOR REACTANT USING LOCAL DATA
;PARAMETERS: REACT => REACTANT TO RETURN DRUG INGREDIENTS AND CLASSES FOR
; FORMAT: VUID^NAME^FILE, WHERE VUID IS UNIQUE ID FOR REACTANT,
; NAME IS THE NAME OF THE REACTANT, AND FILE IS THE FILE
; CONTAINING THE REACTANT, IN THE FORMAT 99VA#
; EX.: 4637287^EGGS^99VA120.82
; ING => ARRAY REFERENCE TO RETURN DRUG INGREDIENTS IN
; DC => ARRAY REFERENCE TO RETRUN DRUG CLASSES IN
Q:$G(REACT)=""
N VUID,FILE,PSNDA,GMRAIEN,LIST,GMRAI,GMRALIST,GMRARAY,J,SUB
S VUID=$P(REACT,U)
S FILE=$P(REACT,U,3)
S FILE=$P(FILE,"99VA",2)
D GETIREF^XTID(,,VUID,"GMRARAY")
S FILE="" F S FILE=$O(GMRARAY(FILE)) Q:FILE="" D
.S GMRAIEN=0 F S GMRAIEN=$O(GMRARAY(FILE,.01,GMRAIEN)) Q:'+GMRAIEN D
..I FILE=50.6 D
...K ^TMP("PSN",$J) S PSNDA=+GMRAIEN D ^PSNNGR
...S GMRAI=0 F S GMRAI=$O(^TMP("PSN",$J,GMRAI)) Q:GMRAI<1 S ING(GMRAI)=""
...K ^TMP("PSN",$J),GMRARAY
...S PSNDA=+GMRAIEN,GMRALIST=$$CLIST^PSNAPIS(PSNDA,.GMRALIST) Q:'$G(GMRALIST)
...S GMRALIST=0 F S GMRALIST=$O(GMRALIST(GMRALIST)) Q:'GMRALIST S DC(GMRALIST)=$P(GMRALIST(GMRALIST),U,2)
..I FILE=120.82 D
...S SUB=0 F S SUB=$O(^GMRD(120.82,+GMRAIEN,"ING",SUB)) Q:'+SUB S ING(+$P($G(^GMRD(120.82,+GMRAIEN,"ING",SUB,0)),U))=""
...S SUB=0 F S SUB=$O(^GMRD(120.82,+GMRAIEN,"CLASS",SUB)) Q:'+SUB S DC(+$P($G(^GMRD(120.82,+GMRAIEN,"CLASS",SUB,0)),U))=$P($$CLASS2^PSNAPIS(+$P($G(^GMRD(120.82,+GMRAIEN,"CLASS",SUB,0)),U)),U)
..I FILE=50.605 D
...S DC(+GMRAIEN)=$P($$CLASS2^PSNAPIS(+GMRAIEN),U)
..I FILE=50.416 D
...S ING(+GMRAIEN)=""
Q
PRIMARY(INGIEN) ;DETERMINE IF AN INGREDIENT IS A PRIMARY INGREDIENT
;PARAMTER: INGIEN => IEN IN THE DRUG INGREDIENTS FILE (#50.416)
;RETURN: 0 => INGIEN IS PRIMARY
; # => IEN IN THE DRUG INGREDIENTS FILE OF INGIEN'S PRIMARY INGREDIENT
N RETURN
K ^TMP($J,"GMRALIST")
D ZERO^PSN50P41(INGIEN,,,"GMRALIST")
S RETURN=+$G(^TMP($J,"GMRALIST",INGIEN,2))
K ^TMP($J,"GMRALIST")
Q RETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR0 7392 printed Apr 09, 2024@20:44:51 Page 2
GMRAOR0 ;HIRMFO/WAA,FPT - OERR HL7 UTILITY;05/28/2015 09:18 ;Jan 31, 2020@13:06:49
+1 ;;4.0;Adverse Reaction Tracking;**4,46,51**;Mar 29, 1996;Build 189
DUPCHK(DFN,GMRALL) ;CHECK FOR DUPS
+1 ;Input variable:
+2 ; DFN = Patient DFN
+3 ; GMRALL = Free text of allergy
+4 ;
+5 ;return variable:
+6 ; GMRAFLG = (0,1,-1)
+7 ; 0 Patient has no matching reactions on file
+8 ; 1 Patient has a matching reaction.
+9 ; -1 Patient has a matching reaction but is E/E
+10 ;
+11 ;********************************************************************
+12 NEW GMRAFLG,GMRAPA
+13 SET GMRAFLG=0
SET GMRAPA=0
+14 ;Loop through all the patient's reaction and look for matches
+15 FOR
SET GMRAPA=$ORDER(^GMR(120.8,"B",DFN,GMRAPA))
if GMRAPA<1
QUIT
Begin DoDot:1
+16 ;Not a match
if GMRALL'=$PIECE($GET(^GMR(120.8,GMRAPA,0)),U,2)
QUIT
+17 ;E/E
IF +$GET(^GMR(120.8,GMRAPA,"ER"))
SET GMRAFLG=-1
QUIT
+18 ;Matching allergy.
SET GMRAFLG=1
+19 QUIT
End DoDot:1
if GMRAFLG=1
QUIT
+20 QUIT GMRAFLG
+21 ;********************************************************************
+22 ;CONTINUATION FROM GMRAOR
REMOTE(DFN) ;OBTAIN DATA STORED REMOTELY
+1 ;PARAMTER: DFN => IEN IN THE PATIENT (#2) FILE
+2 if $$HDRDATA^GMRAHDR()<1
QUIT
+3 NEW J,GMRAOTH
+4 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+5 SET J=0
FOR
SET J=$ORDER(^XTMP("ORRDI","ART",DFN,J))
if '+J
QUIT
Begin DoDot:1
+6 NEW SEVERE,SYMPTOM,AGENT,CLASSES,INGS,DATE,IN,DC,GL,IEN,DD,INDEX,DATA,REACT,IN,OBSHIS
+7 NEW VUID,FILE,GMRARAY,DC,GMRAING,GMRADC,K,INGLST,I,PRIM,COMMID,MECH
+8 SET GL=$NAME(^XTMP("ORRDI","ART",DFN,J))
SET DATE=""
+9 IF +$GET(@GL@("ORIGINATION DATE/TIME",0))'=0
SET DATE=$$HL7TFM^XLFDT(@GL@("ORIGINATION DATE/TIME",0))
+10 SET DATA=$PIECE($GET(@GL@("FACILITY",0)),U)_U_"R"_U_DATE
+11 SET REACT=$GET(@GL@("GMRALLERGY",0))
+12 IF REACT'=""
Begin DoDot:2
+13 SET VUID=$PIECE(REACT,U,1)
+14 SET FILE=$PIECE($PIECE(REACT,U,3),"99VA",2)
+15 DO GETIREF^XTID(FILE,,VUID,"GMRARAY")
+16 DO FILE^DID(FILE,,"GLOBAL NAME","DD")
+17 SET IEN=0
FOR
SET IEN=$ORDER(GMRARAY(FILE,.01,IEN))
if +$GET(IEN)=0
QUIT
Begin DoDot:3
+18 SET AGENT=+IEN_";"_$PIECE(DD("GLOBAL NAME"),U,2)
End DoDot:3
+19 KILL VUID,FILE,GMRARAY,IEN
End DoDot:2
+20 IF $DATA(@GL@("SEVERITY"))>9
Begin DoDot:2
+21 SET SEVERE="|"_$PIECE(@GL@("SEVERITY",0),U)
End DoDot:2
+22 IF $DATA(@GL@("SIGNS/SYMPTOMS"))>9
Begin DoDot:2
+23 SET INDEX=0
FOR
SET INDEX=$ORDER(@GL@("SIGNS/SYMPTOMS",INDEX))
if +$GET(INDEX)=0
QUIT
Begin DoDot:3
+24 IF $PIECE($GET(@GL@("SIGNS/SYMPTOMS",INDEX)),U,3)="L"
Begin DoDot:4
+25 SET SYMPTOM=$SELECT($GET(SYMPTOM)'="":SYMPTOM_"~",1:"")_GMRAOTH
End DoDot:4
+26 IF $PIECE($GET(@GL@("SIGNS/SYMPTOMS",INDEX)),U,3)'="L"
Begin DoDot:4
+27 SET VUID=$PIECE(@GL@("SIGNS/SYMPTOMS",INDEX),U,1)
+28 SET FILE=$PIECE($PIECE(@GL@("SIGNS/SYMPTOMS",INDEX),U,3),"99VA",2)
+29 DO GETIREF^XTID(FILE,,VUID,"GMRARAY")
+30 SET IEN=0
FOR
SET IEN=$ORDER(GMRARAY(FILE,.01,IEN))
if +$GET(IEN)=0
QUIT
SET SYMPTOM=$SELECT($GET(SYMPTOM)'="":SYMPTOM_"~",1:"")_+IEN
+31 KILL VUID,FILE,GMRARAY,IEN
End DoDot:4
End DoDot:3
End DoDot:2
+32 IF $DATA(@GL@("OBS/HISTORICAL"))>9
Begin DoDot:2
+33 DO GETIREF^XTID(120.8,,$PIECE($GET(@GL@("OBS/HISTORICAL",0)),U,1),"GMRARAY")
+34 SET OBSHIS=$ORDER(GMRARAY(120.8,6,""))
+35 KILL GMRARAY
End DoDot:2
+36 SET MECH=""
+37 IF $DATA(@GL@("MECHANISM"))>9
Begin DoDot:2
+38 SET MECH=$PIECE($GET(@GL@("MECHANISM",0)),U,2)
+39 SET MECH=$SELECT(MECH="ALLERGY":"A",MECH="PHARMACOLOGIC":"P",1:"U")
End DoDot:2
+40 SET DATA=DATA_U_$GET(SEVERE)_U_$GET(SYMPTOM)_U_$GET(@GL@("REACTANT",0))_U_$GET(AGENT)_U_$GET(OBSHIS)
+41 SET $PIECE(DATA,U,11)=$GET(MECH)
+42 IF $DATA(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS"))
Begin DoDot:2
+43 SET IN=0
FOR
SET IN=$ORDER(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS",IN))
if '+IN
QUIT
Begin DoDot:3
+44 SET VUID=$PIECE(@GL@("DRUG INGREDIENTS",IN),U)
SET FILE=$PIECE(^(IN),U,3)
+45 SET FILE=$PIECE(FILE,"99VA",2)
+46 DO GETIREF^XTID(FILE,,VUID,"GMRARAY")
+47 SET IEN=0
FOR
SET IEN=$ORDER(GMRARAY(FILE,.01,IEN))
if '+IEN
QUIT
Begin DoDot:4
+48 ;*BD
+49 SET ^TMP("GMRAOC",$JOB,"API",+IEN)=$$SETNODE^GMRAOR1($GET(^TMP("GMRAOC",$JOB,"API",+IEN)),"REMOTE SITE(S)")
+50 ;*ED
+51 if '$DATA(INGS(+IEN))
SET INGS(+IEN)=""
End DoDot:4
+52 KILL VUID,FILE,GMRARAY,IEN
End DoDot:3
End DoDot:2
+53 IF $DATA(@GL@("DRUG CLASSES"))
Begin DoDot:2
+54 SET DC=0
FOR
SET DC=$ORDER(@GL@("DRUG CLASSES",DC))
if '+DC
QUIT
Begin DoDot:3
+55 ;*BD
+56 NEW DCLASS
+57 SET DCLASS=$PIECE(@GL@("DRUG CLASSES",DC),U,4)
+58 SET ^TMP("GMRAOC",$JOB,"APC",DCLASS)=$$SETNODE^GMRAOR1($GET(^TMP("GMRAOC",$JOB,"APC",DCLASS)),"REMOTE SITE(S)")
+59 ;*ED
+60 SET VUID=$PIECE(@GL@("DRUG CLASSES",DC),U,1)
SET FILE=$PIECE($PIECE(^(DC),U,3),"99VA",2)
+61 DO GETIREF^XTID(FILE,,VUID,"GMRARAY")
+62 SET IEN=0
FOR
SET IEN=$ORDER(GMRARAY(FILE,.01,IEN))
if '+IEN
QUIT
Begin DoDot:4
+63 if '$DATA(CLASSES(+IEN))
SET CLASSES(+IEN)=$PIECE(@GL@("DRUG CLASSES",DC),U,4)
End DoDot:4
+64 KILL GMRARAY
End DoDot:3
End DoDot:2
+65 DO FIND(REACT,.GMRAING,.GMRADC)
IF $DATA(GMRAING)!($DATA(GMRADC))
Begin DoDot:2
+66 SET K=0
FOR
SET K=$ORDER(GMRAING(K))
if '+K
QUIT
Begin DoDot:3
+67 ;*BD
+68 SET ^TMP("GMRAOC",$JOB,"API",K)=$$SETNODE^GMRAOR1($GET(^TMP("GMRAOC",$JOB,"API",K)),"REMOTE SITE(S)")
+69 ;*ED
+70 if '$DATA(INGS(K))
SET INGS(K)=""
End DoDot:3
+71 SET K=""
FOR
SET K=$ORDER(GMRADC(K))
if K=""
QUIT
Begin DoDot:3
+72 ;*BD
+73 SET ^TMP("GMRAOC",$JOB,"APC",GMRADC(K))=$$SETNODE^GMRAOR1($GET(^TMP("GMRAOC",$JOB,"APC",GMRADC(K))),"REMOTE SITE(S)")
+74 ;*ED
+75 if '$DATA(CLASSES(K))
SET CLASSES(K)=GMRADC(K)
End DoDot:3
End DoDot:2
+76 SET $PIECE(DATA,U,9)="V"
+77 SET COMMID=$ORDER(^GMR(120.88,"PR",DFN_";DPT(",$PIECE(DATA,U)_";"_$PIECE(DATA,U,6),""),-1)
+78 SET $PIECE(DATA,U,10)=$SELECT(COMMID="":"",1:$GET(^GMR(120.88,COMMID,1)))
+79 SET IN=""
FOR
SET IN=$ORDER(INGS(IN))
if IN=""
QUIT
SET ^TMP("GMRAOC",$JOB,"API",IN,"R"_J)=$GET(DATA)
+80 SET DC=""
FOR
SET DC=$ORDER(CLASSES(DC))
if DC=""
QUIT
SET ^TMP("GMRAOC",$JOB,"APC",CLASSES(DC),"R"_J)=$GET(DATA)
End DoDot:1
+81 IF $DATA(^TMP("GMRAOC",$JOB,"API"))
Begin DoDot:1
+82 NEW I,INGLST
+83 SET I=0
FOR
SET I=$ORDER(^TMP("GMRAOC",$JOB,"API",I))
if 'I
QUIT
Begin DoDot:2
+84 NEW PRIM
+85 SET PRIM=$$PRIMARY(I)
+86 IF PRIM
MERGE INGLST(PRIM)=^TMP("GMRAOC",$JOB,"API",I)
KILL ^TMP("GMRAOC",$JOB,"API",I)
End DoDot:2
+87 SET I=0
FOR
SET I=$ORDER(INGLST(I))
if 'I
QUIT
MERGE ^TMP("GMRAOC",$JOB,"API",I)=INGLST(I)
End DoDot:1
+88 QUIT
FIND(REACT,ING,DC) ;DETERMINE DRUG INGREDIENTS AND CLASSES FOR REACTANT USING LOCAL DATA
+1 ;PARAMETERS: REACT => REACTANT TO RETURN DRUG INGREDIENTS AND CLASSES FOR
+2 ; FORMAT: VUID^NAME^FILE, WHERE VUID IS UNIQUE ID FOR REACTANT,
+3 ; NAME IS THE NAME OF THE REACTANT, AND FILE IS THE FILE
+4 ; CONTAINING THE REACTANT, IN THE FORMAT 99VA#
+5 ; EX.: 4637287^EGGS^99VA120.82
+6 ; ING => ARRAY REFERENCE TO RETURN DRUG INGREDIENTS IN
+7 ; DC => ARRAY REFERENCE TO RETRUN DRUG CLASSES IN
+8 if $GET(REACT)=""
QUIT
+9 NEW VUID,FILE,PSNDA,GMRAIEN,LIST,GMRAI,GMRALIST,GMRARAY,J,SUB
+10 SET VUID=$PIECE(REACT,U)
+11 SET FILE=$PIECE(REACT,U,3)
+12 SET FILE=$PIECE(FILE,"99VA",2)
+13 DO GETIREF^XTID(,,VUID,"GMRARAY")
+14 SET FILE=""
FOR
SET FILE=$ORDER(GMRARAY(FILE))
if FILE=""
QUIT
Begin DoDot:1
+15 SET GMRAIEN=0
FOR
SET GMRAIEN=$ORDER(GMRARAY(FILE,.01,GMRAIEN))
if '+GMRAIEN
QUIT
Begin DoDot:2
+16 IF FILE=50.6
Begin DoDot:3
+17 KILL ^TMP("PSN",$JOB)
SET PSNDA=+GMRAIEN
DO ^PSNNGR
+18 SET GMRAI=0
FOR
SET GMRAI=$ORDER(^TMP("PSN",$JOB,GMRAI))
if GMRAI<1
QUIT
SET ING(GMRAI)=""
+19 KILL ^TMP("PSN",$JOB),GMRARAY
+20 SET PSNDA=+GMRAIEN
SET GMRALIST=$$CLIST^PSNAPIS(PSNDA,.GMRALIST)
if '$GET(GMRALIST)
QUIT
+21 SET GMRALIST=0
FOR
SET GMRALIST=$ORDER(GMRALIST(GMRALIST))
if 'GMRALIST
QUIT
SET DC(GMRALIST)=$PIECE(GMRALIST(GMRALIST),U,2)
End DoDot:3
+22 IF FILE=120.82
Begin DoDot:3
+23 SET SUB=0
FOR
SET SUB=$ORDER(^GMRD(120.82,+GMRAIEN,"ING",SUB))
if '+SUB
QUIT
SET ING(+$PIECE($GET(^GMRD(120.82,+GMRAIEN,"ING",SUB,0)),U))=""
+24 SET SUB=0
FOR
SET SUB=$ORDER(^GMRD(120.82,+GMRAIEN,"CLASS",SUB))
if '+SUB
QUIT
SET DC(+$PIECE($GET(^GMRD(120.82,+GMRAIEN,"CLASS",SUB,0)),U))=$PIECE($$CLASS2^PSNAPIS(+$PIECE($GET(^GMRD(120.82,+GMRAIEN,"CLASS",SUB,0)),U)),U)
End DoDot:3
+25 IF FILE=50.605
Begin DoDot:3
+26 SET DC(+GMRAIEN)=$PIECE($$CLASS2^PSNAPIS(+GMRAIEN),U)
End DoDot:3
+27 IF FILE=50.416
Begin DoDot:3
+28 SET ING(+GMRAIEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
PRIMARY(INGIEN) ;DETERMINE IF AN INGREDIENT IS A PRIMARY INGREDIENT
+1 ;PARAMTER: INGIEN => IEN IN THE DRUG INGREDIENTS FILE (#50.416)
+2 ;RETURN: 0 => INGIEN IS PRIMARY
+3 ; # => IEN IN THE DRUG INGREDIENTS FILE OF INGIEN'S PRIMARY INGREDIENT
+4 NEW RETURN
+5 KILL ^TMP($JOB,"GMRALIST")
+6 DO ZERO^PSN50P41(INGIEN,,,"GMRALIST")
+7 SET RETURN=+$GET(^TMP($JOB,"GMRALIST",INGIEN,2))
+8 KILL ^TMP($JOB,"GMRALIST")
+9 QUIT RETURN
