GMRAOR9 ;HIRMFO/RM,WAA,FPT-Stuff Drug Ingredients/Classes ; 1/9/08 5:18am
;;4.0;Adverse Reaction Tracking;**4,13,41**;Mar 29, 1996;Build 8
; <Copied from GMRAPES1>
EN1 ; Auto stuff Ingredients and VA Drug Classes
; GMRAING() will have all the ingredients for the reaction
; GMRADRCL() will have all the drug classes for the reaction.
;
K GMRADRCL,GMRAING
; If the Reactant is a Drug Ingredient
I GMRAAR[50.416 S GMRAING(+GMRAAR)="" G STING
;If the Reactant is a Drug Class
I GMRAAR[50.605 S GMRADRCL(+GMRAAR)=""
;If the Reactant is an entry in the GMR ALLERGY file
I GMRAAR[120.82 D
.S Y=0 F S Y=$O(^GMRD(120.82,+GMRAAR,"ING",Y)) Q:Y'>0 I $D(^GMRD(120.82,+GMRAAR,"ING",Y,0)),+^(0)>0 S GMRAING(+^(0))=""
.S Y=0 F S Y=$O(^GMRD(120.82,+GMRAAR,"CLASS",Y)) Q:Y'>0 I $D(^GMRD(120.82,+GMRAAR,"CLASS",Y,0)),+^(0)>0 S GMRADRCL(+^(0))=""
.Q
;I GMRAAR["PSDRUG" D
;.N PSODA
;.S PSODA=+GMRAAR K ^TMP("PSO",$J) D ^PSONGR F Y=0:0 S Y=$O(^TMP("PSO",$J,Y)) Q:Y'>0 S GMRAING(Y)=""
;.N GMRAX,GMRAY
;.;S GMRAX=$P($G(^PSDRUG(+GMRAAR,"ND")),U,6) S:GMRAX>0 GMRADRCL(GMRAX)="" Q
;.S GMRAX=$$DRP2CLP^GMRAPENC(GMRAAR) S:GMRAX>0 GMRADRCL(GMRAX)="" Q
;.;S GMRAX=$P($G(^PSDRUG(+GMRAAR,0)),U,2) Q:GMRAX=""
;.S GMRAX=$$DRP2CODE^GMRAPENC(GMRAAR) Q:GMRAX=""
;.;S GMRAY=$O(^PS(50.605,"B",GMRAX,"")) S:GMRAY>0 GMRADRCL(GMRAY)=""
;.S GMRAY=$$CODE2CLP^GMRAPENC(GMRAX) S:GMRAY>0 GMRADRCL(GMRAY)=""
;.Q
I GMRAAR["PSNDF" D
.N PSNDA
.S PSNDA=+GMRAAR K ^TMP("PSN",$J) D ^PSNNGR F Y=0:0 S Y=$O(^TMP("PSN",$J,Y)) Q:Y'>0 S GMRAING(Y)=""
.; all classes for NDF entry returned in GMRADRCL
.N CLASS
.S CLASS=$$CLIST^PSNAPIS(+GMRAAR,.GMRADRCL)
K ^TMP("PSO",$J),^TMP("PSN",$J),PSODA,PSNID
STING ;Stuffing Drug Ing & VA Drug Classes into file 120.8
I $D(GMRAING) D
.S DA(1)=+GMRAPA,DIC="^GMR(120.8,"_+GMRAPA_",2,",DLAYGO=120.8,DIC(0)="L",DIC("P")="120.802PA"
.F X=0:0 S X=$O(GMRAING(X)) Q:X'>0 I '$D(^GMR(120.8,GMRAPA,2,"B",X)) K DD,DO,DINUM D FILE^DICN
.K DIC,DLAYGO
.Q
I $D(GMRADRCL) D
.S DA(1)=+GMRAPA,DIC="^GMR(120.8,"_+GMRAPA_",3,",DIC(0)="L",DIC("P")="120.803PA"
.F X=0:0 S X=$O(GMRADRCL(X)) Q:X'>0 I '$D(^GMR(120.8,GMRAPA,3,"B",X)) K DD,DO,DINUM D FILE^DICN
.K DIC
.Q
K GMRADRCL,GMRAING
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR9 2246 printed Nov 22, 2024@16:49:59 Page 2
GMRAOR9 ;HIRMFO/RM,WAA,FPT-Stuff Drug Ingredients/Classes ; 1/9/08 5:18am
+1 ;;4.0;Adverse Reaction Tracking;**4,13,41**;Mar 29, 1996;Build 8
+2 ; <Copied from GMRAPES1>
EN1 ; Auto stuff Ingredients and VA Drug Classes
+1 ; GMRAING() will have all the ingredients for the reaction
+2 ; GMRADRCL() will have all the drug classes for the reaction.
+3 ;
+4 KILL GMRADRCL,GMRAING
+5 ; If the Reactant is a Drug Ingredient
+6 IF GMRAAR[50.416
SET GMRAING(+GMRAAR)=""
GOTO STING
+7 ;If the Reactant is a Drug Class
+8 IF GMRAAR[50.605
SET GMRADRCL(+GMRAAR)=""
+9 ;If the Reactant is an entry in the GMR ALLERGY file
+10 IF GMRAAR[120.82
Begin DoDot:1
+11 SET Y=0
FOR
SET Y=$ORDER(^GMRD(120.82,+GMRAAR,"ING",Y))
if Y'>0
QUIT
IF $DATA(^GMRD(120.82,+GMRAAR,"ING",Y,0))
IF +^(0)>0
SET GMRAING(+^(0))=""
+12 SET Y=0
FOR
SET Y=$ORDER(^GMRD(120.82,+GMRAAR,"CLASS",Y))
if Y'>0
QUIT
IF $DATA(^GMRD(120.82,+GMRAAR,"CLASS",Y,0))
IF +^(0)>0
SET GMRADRCL(+^(0))=""
+13 QUIT
End DoDot:1
+14 ;I GMRAAR["PSDRUG" D
+15 ;.N PSODA
+16 ;.S PSODA=+GMRAAR K ^TMP("PSO",$J) D ^PSONGR F Y=0:0 S Y=$O(^TMP("PSO",$J,Y)) Q:Y'>0 S GMRAING(Y)=""
+17 ;.N GMRAX,GMRAY
+18 ;.;S GMRAX=$P($G(^PSDRUG(+GMRAAR,"ND")),U,6) S:GMRAX>0 GMRADRCL(GMRAX)="" Q
+19 ;.S GMRAX=$$DRP2CLP^GMRAPENC(GMRAAR) S:GMRAX>0 GMRADRCL(GMRAX)="" Q
+20 ;.;S GMRAX=$P($G(^PSDRUG(+GMRAAR,0)),U,2) Q:GMRAX=""
+21 ;.S GMRAX=$$DRP2CODE^GMRAPENC(GMRAAR) Q:GMRAX=""
+22 ;.;S GMRAY=$O(^PS(50.605,"B",GMRAX,"")) S:GMRAY>0 GMRADRCL(GMRAY)=""
+23 ;.S GMRAY=$$CODE2CLP^GMRAPENC(GMRAX) S:GMRAY>0 GMRADRCL(GMRAY)=""
+24 ;.Q
+25 IF GMRAAR["PSNDF"
Begin DoDot:1
+26 NEW PSNDA
+27 SET PSNDA=+GMRAAR
KILL ^TMP("PSN",$JOB)
DO ^PSNNGR
FOR Y=0:0
SET Y=$ORDER(^TMP("PSN",$JOB,Y))
if Y'>0
QUIT
SET GMRAING(Y)=""
+28 ; all classes for NDF entry returned in GMRADRCL
+29 NEW CLASS
+30 SET CLASS=$$CLIST^PSNAPIS(+GMRAAR,.GMRADRCL)
End DoDot:1
+31 KILL ^TMP("PSO",$JOB),^TMP("PSN",$JOB),PSODA,PSNID
STING ;Stuffing Drug Ing & VA Drug Classes into file 120.8
+1 IF $DATA(GMRAING)
Begin DoDot:1
+2 SET DA(1)=+GMRAPA
SET DIC="^GMR(120.8,"_+GMRAPA_",2,"
SET DLAYGO=120.8
SET DIC(0)="L"
SET DIC("P")="120.802PA"
+3 FOR X=0:0
SET X=$ORDER(GMRAING(X))
if X'>0
QUIT
IF '$DATA(^GMR(120.8,GMRAPA,2,"B",X))
KILL DD,DO,DINUM
DO FILE^DICN
+4 KILL DIC,DLAYGO
+5 QUIT
End DoDot:1
+6 IF $DATA(GMRADRCL)
Begin DoDot:1
+7 SET DA(1)=+GMRAPA
SET DIC="^GMR(120.8,"_+GMRAPA_",3,"
SET DIC(0)="L"
SET DIC("P")="120.803PA"
+8 FOR X=0:0
SET X=$ORDER(GMRADRCL(X))
if X'>0
QUIT
IF '$DATA(^GMR(120.8,GMRAPA,3,"B",X))
KILL DD,DO,DINUM
DO FILE^DICN
+9 KILL DIC
+10 QUIT
End DoDot:1
+11 KILL GMRADRCL,GMRAING
+12 QUIT
