GMRAPAT.m

GMRAPAT ;HIRMFO/WAA-Select a patient for ART System ;18-Mar-2011 11:46;DU

 ;;4.0;Adverse Reaction Tracking;**5,1002**;Mar 29, 1996;Build 32

 ;IHS/MSC/MGH Remove inactive from list

PAT ;Select a patient from the patient file

 ;    Return list:

 ;           DFN = If DFN is null patient DFN from the patient file

 ;

 S GMRAOUT=0

 N DIC,Y

 W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC

 I +Y'>0 S GMRAOUT=1 Q

 S DFN=+Y,GMRADOD=$P($G(^DPT(DFN,.35)),U)

 ;check if patient is deceased

 I GMRADOD]"" D

 .W !!?5,$C(7),"NOTE: This patient is deceased (",$$FMTE^XLFDT(GMRADOD),").",!!

 .D HANGT^GMRAPEH0

 .Q

 K GMRADOD

 Q

REACT(DFN) ;Select a patient reaction

 ;

 Q:'$D(DFN)

 N GMRAL

 S GMRAOUT=0,GMRAL=""

 D LIST(DFN,.GMRAL)

 I GMRAL D EN1^GMRADSP0(.GMRAL) Q:GMRAOUT

 E  W !?10,"This patient has no allergy/adverse reaction data."

 Q

LIST(DFN,GMRA) ;Get all the reaction for a patient

 N GMRAPA,Z,INACT,REACT,INZ

 S (GMRAPA,GMRA)=0

 F  S GMRAPA=$O(^GMR(120.8,"B",DFN,GMRAPA)) Q:GMRAPA<1  D

 .Q:$G(^GMR(120.8,GMRAPA,0))=""

 .Q:+$G(^GMR(120.8,GMRAPA,"ER"))

 .S INZ=0

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

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

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

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

 .Q:INZ=1

 .D PASS^GMRADPT(GMRAPA,.GMRA)

 .I 'GMRA S GMRA=1

 .Q

 Q

GMRAPAT   ;HIRMFO/WAA-Select a patient for ART System ;18-Mar-2011 11:46;DU

 +1       ;;4.0;Adverse Reaction Tracking;**5,1002**;Mar 29, 1996;Build 32

 +2       ;IHS/MSC/MGH Remove inactive from list

PAT       ;Select a patient from the patient file

 +1       ;    Return list:

 +2       ;           DFN = If DFN is null patient DFN from the patient file

 +3       ;

 +4        SET GMRAOUT=0

 +5        NEW DIC,Y

 +6        WRITE !

           SET DIC="^DPT("

           SET DIC(0)="AEQM"

           DO ^DIC

 +7        IF +Y'>0

               SET GMRAOUT=1

               QUIT 

 +8        SET DFN=+Y

           SET GMRADOD=$PIECE($GET(^DPT(DFN,.35)),U)

 +9       ;check if patient is deceased

 +10       IF GMRADOD]""

               Begin DoDot:1

 +11               WRITE !!?5,$CHAR(7),"NOTE: This patient is deceased (",$$FMTE^XLFDT(GMRADOD),").",!!

 +12               DO HANGT^GMRAPEH0

 +13               QUIT 

               End DoDot:1

 +14       KILL GMRADOD

 +15       QUIT 

REACT(DFN) ;Select a patient reaction

 +1       ;

 +2        IF '$DATA(DFN)

               QUIT 

 +3        NEW GMRAL

 +4        SET GMRAOUT=0

           SET GMRAL=""

 +5        DO LIST(DFN,.GMRAL)

 +6        IF GMRAL

               DO EN1^GMRADSP0(.GMRAL)

               IF GMRAOUT

                   QUIT 

 +7       IF '$TEST

               WRITE !?10,"This patient has no allergy/adverse reaction data."

 +8        QUIT 

LIST(DFN,GMRA) ;Get all the reaction for a patient

 +1        NEW GMRAPA,Z,INACT,REACT,INZ

 +2        SET (GMRAPA,GMRA)=0

 +3        FOR 

               SET GMRAPA=$ORDER(^GMR(120.8,"B",DFN,GMRAPA))

               IF GMRAPA<1

                   QUIT 

               Begin DoDot:1

 +4                IF $GET(^GMR(120.8,GMRAPA,0))=""

                       QUIT 

 +5                IF +$GET(^GMR(120.8,GMRAPA,"ER"))

                       QUIT 

 +6                SET INZ=0

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

                   IF +Z

                       Begin DoDot:2

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

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

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

                               SET INZ=1

                       End DoDot:2

 +11               IF INZ=1

                       QUIT 

 +12               DO PASS^GMRADPT(GMRAPA,.GMRA)

 +13               IF 'GMRA

                       SET GMRA=1

 +14               QUIT 

               End DoDot:1

 +15       QUIT