GMRAUIX0.m

GMRAUIX0 ;HIRMFO/RM-CROSS REFERENCES FOR FILE 120.8 ;01-May-2012 14:26;DU

 ;;4.0;Adverse Reaction Tracking;**14,41,1006**;Mar 29, 1996;Build 29

 ;DBIA Section

 ;PSN50P65 - 4543

EN1 ; ENTRY FROM THE ADRG01 OR ADRG22 XREF [^DD(120.8,.01 and ^DD(120.8,22]

 ; FOR FURTHER INFO ON THESE XREFS SEE INTERNAL RELATIONS SECTION

 ; OF THE ADVERSE REACTION TRACKING TECHNICAL MANUAL.

 S GMRA("DA")=DA N DA S DA(1)=GMRA("DA")

 S GMRA("ER")=$S(+GMRA=22:X,1:+$G(^GMR(120.8,DA(1),"ER"))),GMRA(1)=$S(+GMRA=.01:X,1:$P($G(^GMR(120.8,DA(1),0)),"^"))

 F GMRA("X")=2,3 F DA=0:0 S DA=$O(^GMR(120.8,DA(1),GMRA("X"),DA)) Q:DA'>0  S GMRA("INCL")=$P($G(^GMR(120.8,DA(1),GMRA("X"),DA,0)),"^") D IX

 K GMRA

 Q

EN2 ; ENTRY FROM THE ADRG2 OR ADRG3 XREF [^DD(120.802,.01 & ^DD(120.803,.01]

 ; FOR FURTHER INFO ON THESE XREFS SEE INTERNAL RELATIONS SECTION

 ; OF THE ADVERSE REACTION TRACKING TECHNICAL MANUAL.

 S GMRA("INCL")=X,GMRA("X")=+GMRA,GMRA("ER")=+$G(^GMR(120.8,DA(1),"ER")),GMRA(1)=$P($G(^GMR(120.8,DA(1),0)),"^") D IX

 K GMRA

 Q

IX ; SET/KILL THE INDEX

 K ^TMP($J,"GMRACLASS") ;41 Clear storage before use

 D C^PSN50P65(+GMRA("INCL"),,"GMRACLASS") ;41 Get drug class data

 S GMRA("INCL")=$S(GMRA("X")=2:GMRA("INCL"),1:$G(^TMP($J,"GMRACLASS",+GMRA("INCL"),.01))) ;41 Get drug class code from ^TMP

 Q:'$L(GMRA("INCL"))!'$L(GMRA(1))

 I $P(GMRA,"^",2)&GMRA("ER")!('$P(GMRA,"^",2)&(+GMRA'=22)) K ^GMR(120.8,$P("API^APC","^",GMRA("X")-1),GMRA(1),GMRA("INCL"),DA(1),DA)

 E  S ^GMR(120.8,$P("API^APC","^",GMRA("X")-1),GMRA(1),GMRA("INCL"),DA(1),DA)=""

 Q

EN3 ; ENTRY FROM THE IHS99 XREF [^DD(9999999.12,.01]

 ; MSC/IHS/MGH PATCH 1006

 S GMRA("DA")=DA(1) N DA S DA(1)=GMRA("DA")

 S GMRA("INAC")=$$ACTIVE(DA(1))

 S GMRA(1)=$S(+GMRA=.01:X,1:$P($G(^GMR(120.8,DA(1),0)),"^"))

 F GMRA("X")=2,3 F DA=0:0 S DA=$O(^GMR(120.8,DA(1),GMRA("X"),DA)) Q:DA'>0  S GMRA("INCL")=$P($G(^GMR(120.8,DA(1),GMRA("X"),DA,0)),"^") D IX2

 K GMRA

 Q

IX2 ; SET/KILL THE INDEX

 K ^TMP($J,"GMRACLASS") ;41 Clear storage before use

 D C^PSN50P65(+GMRA("INCL"),,"GMRACLASS") ;41 Get drug class data

 S GMRA("INCL")=$S(GMRA("X")=2:GMRA("INCL"),1:$G(^TMP($J,"GMRACLASS",+GMRA("INCL"),.01))) ;41 Get drug class code from ^TMP

 Q:'$L(GMRA("INCL"))!'$L(GMRA(1))

 I $P(GMRA,"^",2)&(GMRA("INAC"))!('$P(GMRA,"^",2)&(+GMRA'=99)) K ^GMR(120.8,$P("API^APC","^",GMRA("X")-1),GMRA(1),GMRA("INCL"),DA(1),DA)

 E  S ^GMR(120.8,$P("API^APC","^",GMRA("X")-1),GMRA(1),GMRA("INCL"),DA(1),DA)=""

 Q

ACTIVE(ALL) ;Check allergy to see if it is inactive

 N IN,Z,INACT,REACT

 S IN=1

 I '$D(^GMR(120.8,ALL,9999999.12)) Q IN

 S Z=$O(^GMR(120.8,ALL,9999999.12,$C(0)),-1) I +Z D

 .S INACT=$P($G(^GMR(120.8,ALL,9999999.12,Z,0)),U,1)

 .S REACT=$P($G(^GMR(120.8,ALL,9999999.12,Z,0)),U,4)

 .I +INACT&(REACT="") S IN=1

 Q IN

GMRAUIX0  ;HIRMFO/RM-CROSS REFERENCES FOR FILE 120.8 ;01-May-2012 14:26;DU

 +1       ;;4.0;Adverse Reaction Tracking;**14,41,1006**;Mar 29, 1996;Build 29

 +2       ;DBIA Section

 +3       ;PSN50P65 - 4543

EN1       ; ENTRY FROM THE ADRG01 OR ADRG22 XREF [^DD(120.8,.01 and ^DD(120.8,22]

 +1       ; FOR FURTHER INFO ON THESE XREFS SEE INTERNAL RELATIONS SECTION

 +2       ; OF THE ADVERSE REACTION TRACKING TECHNICAL MANUAL.

 +3        SET GMRA("DA")=DA

           NEW DA

           SET DA(1)=GMRA("DA")

 +4        SET GMRA("ER")=$SELECT(+GMRA=22:X,1:+$GET(^GMR(120.8,DA(1),"ER")))

           SET GMRA(1)=$SELECT(+GMRA=.01:X,1:$PIECE($GET(^GMR(120.8,DA(1),0)),"^"))

 +5        FOR GMRA("X")=2,3

               FOR DA=0:0

                   SET DA=$ORDER(^GMR(120.8,DA(1),GMRA("X"),DA))

                   IF DA'>0

                       QUIT 

                   SET GMRA("INCL")=$PIECE($GET(^GMR(120.8,DA(1),GMRA("X"),DA,0)),"^")

                   DO IX

 +6        KILL GMRA

 +7        QUIT 

EN2       ; ENTRY FROM THE ADRG2 OR ADRG3 XREF [^DD(120.802,.01 & ^DD(120.803,.01]

 +1       ; FOR FURTHER INFO ON THESE XREFS SEE INTERNAL RELATIONS SECTION

 +2       ; OF THE ADVERSE REACTION TRACKING TECHNICAL MANUAL.

 +3        SET GMRA("INCL")=X

           SET GMRA("X")=+GMRA

           SET GMRA("ER")=+$GET(^GMR(120.8,DA(1),"ER"))

           SET GMRA(1)=$PIECE($GET(^GMR(120.8,DA(1),0)),"^")

           DO IX

 +4        KILL GMRA

 +5        QUIT 

IX        ; SET/KILL THE INDEX

 +1       ;41 Clear storage before use

           KILL ^TMP($JOB,"GMRACLASS")

 +2       ;41 Get drug class data

           DO C^PSN50P65(+GMRA("INCL"),,"GMRACLASS")

 +3       ;41 Get drug class code from ^TMP

           SET GMRA("INCL")=$SELECT(GMRA("X")=2:GMRA("INCL"),1:$GET(^TMP($JOB,"GMRACLASS",+GMRA("INCL"),.01)))

 +4        IF '$LENGTH(GMRA("INCL"))!'$LENGTH(GMRA(1))

               QUIT 

 +5        IF $PIECE(GMRA,"^",2)&GMRA("ER")!('$PIECE(GMRA,"^",2)&(+GMRA'=22))

               KILL ^GMR(120.8,$PIECE("API^APC","^",GMRA("X")-1),GMRA(1),GMRA("INCL"),DA(1),DA)

 +6       IF '$TEST

               SET ^GMR(120.8,$PIECE("API^APC","^",GMRA("X")-1),GMRA(1),GMRA("INCL"),DA(1),DA)=""

 +7        QUIT 

EN3       ; ENTRY FROM THE IHS99 XREF [^DD(9999999.12,.01]

 +1       ; MSC/IHS/MGH PATCH 1006

 +2        SET GMRA("DA")=DA(1)

           NEW DA

           SET DA(1)=GMRA("DA")

 +3        SET GMRA("INAC")=$$ACTIVE(DA(1))

 +4        SET GMRA(1)=$SELECT(+GMRA=.01:X,1:$PIECE($GET(^GMR(120.8,DA(1),0)),"^"))

 +5        FOR GMRA("X")=2,3

               FOR DA=0:0

                   SET DA=$ORDER(^GMR(120.8,DA(1),GMRA("X"),DA))

                   IF DA'>0

                       QUIT 

                   SET GMRA("INCL")=$PIECE($GET(^GMR(120.8,DA(1),GMRA("X"),DA,0)),"^")

                   DO IX2

 +6        KILL GMRA

 +7        QUIT 

IX2       ; SET/KILL THE INDEX

 +1       ;41 Clear storage before use

           KILL ^TMP($JOB,"GMRACLASS")

 +2       ;41 Get drug class data

           DO C^PSN50P65(+GMRA("INCL"),,"GMRACLASS")

 +3       ;41 Get drug class code from ^TMP

           SET GMRA("INCL")=$SELECT(GMRA("X")=2:GMRA("INCL"),1:$GET(^TMP($JOB,"GMRACLASS",+GMRA("INCL"),.01)))

 +4        IF '$LENGTH(GMRA("INCL"))!'$LENGTH(GMRA(1))

               QUIT 

 +5        IF $PIECE(GMRA,"^",2)&(GMRA("INAC"))!('$PIECE(GMRA,"^",2)&(+GMRA'=99))

               KILL ^GMR(120.8,$PIECE("API^APC","^",GMRA("X")-1),GMRA(1),GMRA("INCL"),DA(1),DA)

 +6       IF '$TEST

               SET ^GMR(120.8,$PIECE("API^APC","^",GMRA("X")-1),GMRA(1),GMRA("INCL"),DA(1),DA)=""

 +7        QUIT 

ACTIVE(ALL) ;Check allergy to see if it is inactive

 +1        NEW IN,Z,INACT,REACT

 +2        SET IN=1

 +3        IF '$DATA(^GMR(120.8,ALL,9999999.12))

               QUIT IN

 +4        SET Z=$ORDER(^GMR(120.8,ALL,9999999.12,$CHAR(0)),-1)

           IF +Z

               Begin DoDot:1

 +5                SET INACT=$PIECE($GET(^GMR(120.8,ALL,9999999.12,Z,0)),U,1)

 +6                SET REACT=$PIECE($GET(^GMR(120.8,ALL,9999999.12,Z,0)),U,4)

 +7                IF +INACT&(REACT="")

                       SET IN=1

               End DoDot:1

 +8        QUIT IN