GMRAOR9.m

GMRAOR9 ;HIRMFO/RM,WAA,FPT-Stuff Drug Ingredients/Classes ;22-Aug-2013 08:37;DU

 ;;4.0;Adverse Reaction Tracking;**4,13,41,1007**;Mar 29, 1996;Build 18

 ; <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

 N Y

 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

 N N

 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

GMRAOR9   ;HIRMFO/RM,WAA,FPT-Stuff Drug Ingredients/Classes ;22-Aug-2013 08:37;DU

 +1       ;;4.0;Adverse Reaction Tracking;**4,13,41,1007**;Mar 29, 1996;Build 18

 +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       NEW Y

 +11       IF GMRAAR[120.82

               Begin DoDot:1

 +12               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))=""

 +13               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))=""

 +14               QUIT 

               End DoDot:1

 +15      ;I GMRAAR["PSDRUG" D

 +16      ;.N PSODA

 +17      ;.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)=""

 +18      ;.N GMRAX,GMRAY

 +19      ;.;S GMRAX=$P($G(^PSDRUG(+GMRAAR,"ND")),U,6) S:GMRAX>0 GMRADRCL(GMRAX)="" Q

 +20      ;.S GMRAX=$$DRP2CLP^GMRAPENC(GMRAAR) S:GMRAX>0 GMRADRCL(GMRAX)="" Q

 +21      ;.;S GMRAX=$P($G(^PSDRUG(+GMRAAR,0)),U,2) Q:GMRAX=""

 +22      ;.S GMRAX=$$DRP2CODE^GMRAPENC(GMRAAR) Q:GMRAX=""

 +23      ;.;S GMRAY=$O(^PS(50.605,"B",GMRAX,"")) S:GMRAY>0 GMRADRCL(GMRAY)=""

 +24      ;.S GMRAY=$$CODE2CLP^GMRAPENC(GMRAX) S:GMRAY>0 GMRADRCL(GMRAY)=""

 +25      ;.Q

 +26       IF GMRAAR["PSNDF"

               Begin DoDot:1

 +27               NEW PSNDA

 +28               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)=""

 +29      ; all classes for NDF entry returned in GMRADRCL

 +30               NEW CLASS

 +31               SET CLASS=$$CLIST^PSNAPIS(+GMRAAR,.GMRADRCL)

               End DoDot:1

 +32       KILL ^TMP("PSO",$JOB),^TMP("PSN",$JOB),PSODA,PSNID

STING     ;Stuffing Drug Ing & VA Drug Classes into file 120.8

 +1        NEW N

 +2        IF $DATA(GMRAING)

               Begin DoDot:1

 +3                SET DA(1)=+GMRAPA

                   SET DIC="^GMR(120.8,"_+GMRAPA_",2,"

                   SET DLAYGO=120.8

                   SET DIC(0)="L"

                   SET DIC("P")="120.802PA"

 +4                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

 +5                KILL DIC,DLAYGO

 +6                QUIT 

               End DoDot:1

 +7        IF $DATA(GMRADRCL)

               Begin DoDot:1

 +8                SET DA(1)=+GMRAPA

                   SET DIC="^GMR(120.8,"_+GMRAPA_",3,"

                   SET DIC(0)="L"

                   SET DIC("P")="120.803PA"

 +9                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

 +10               KILL DIC

 +11               QUIT 

               End DoDot:1

 +12       KILL GMRADRCL,GMRAING

 +13       QUIT