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