GMRAPED3.m

GMRAPED3 ;HIRMFO/YMP,RM-VALIDATE ENTRY FOR .02 FIELD IN FILE 120.8 ;16-Mar-2011 09:16;DU

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

EN1 ; GIVEN DFN, SELECT PATIENT ALLERGY

 K GMRAAR S GMRAAR=""

 W !!,"CAUSATIVE AGENT: "_$P(GMRAPA(0),"^",2)_"//  (Uneditable)"

 Q

REAC ;EP Called to reactivate an inactive entry

 N GMRAOUT,GMRA,DFN

 S GMRAOUT=0

 W @IOF D PAT^GMRAPAT ; Select A Patient

 D:'GMRAOUT EN21

 ;G:'GMRAOUT REAC

 K DFN,DIC,GMRAOUT,GMRARET,GMA,GMRAUSER

 D EN1^GMRAKILL

 Q

EN21 ;Load the inactive allergies and ask user to select one

 N GMRAIEN,GMALAR,GMRAOUT,GMRACNT,VADM,GMRALOC,GMRANAM,GMRASEX,X

 S GMRACNT=0 D 1^VADPT

 S GMRALOC=$P(VAIN(4),U,2),GMRANAM=VADM(1),GMRASEX=VADM(5)

 D LIST(DFN,.GMRAL)

 I GMRAL=0  W !,"This patient has no inactive allergies" Q

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

 R !!,"Enter Item to Reactivate: ",GMRALAR:DTIME S:'$T GMRALAR="^^" S:GMRALAR="" GMRARET=1 I "^^"[GMRALAR S GMRAOUT='$L(GMRALAR)+1 G REAC

 I GMRALAR?1P.E!($L(GMRALAR)<3)!($L(GMRALAR)>30) S GMRAHLP=1 D EN1^GMRAHLP0 G EN1:'GMRAOUT

 I GMRALAR?.E1L.E S GMRALAR=$$UP^XLFSTR(GMRALAR)

 K Y,DTOUT,DUOUT S DGSENFLG="",DIC="^GMR(120.8,",DIC(0)="SEZ",X=GMRANAM,DIC("S")="I '+$G(^(""ER"")),$P(^(0),U,2)?@(""1""""""_GMRALAR_"""""".E""),$D(^GMR(120.8,""B"",DFN,+Y))",DIC("W")="W $P(^(0),U,2)"

 W !!,"Checking existing PATIENT ALLERGIES (#120.8) file for matches..."

 D ^DIC S X=$P($G(Y(0)),"^",2) K DIC,DGSENFLG,DTOUT,DUOUT D DIC I GMRAOUT S GMRAOUT=GMRAOUT-1 G:GMRAOUT Q1 G REAC

 S:+Y>0 GMRAPA=+Y G Q1:+Y<1!GMRAOUT

 I +GMRAPA D

 .D REACT(DFN,GMRAPA)

 .S X=$$FIND1^DIC(101,,"BX","GMRA ALLERGY UPDATE")_";ORD(101,"

 .D:X EN^XQOR ;Process protocols hanging off this protocol

 Q

REACT(DFN,GMRAPA) ;Find the entry to inactivate

 N Z,INACT,REACT,VAL,DATA

 S Z=9999999 S Z=$O(^GMR(120.8,GMRAPA,9999999.12,Z),-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="") D

 ..S VAL("GMRAINACT")=INACT

 ..D RESET(.DATA,GMRAPA,DFN,.VAL)

 ..I DATA=GMRAPA W !,"Reaction has been reactivated" D HANGT^GMRAPEH0 G REAC

 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=9999999 S Z=$O(^GMR(120.8,GMRAPA,9999999.12,Z),-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

 .I INZ=1 D

 ..D PASS^GMRADPT(GMRAPA,.GMRA)

 ..I 'GMRA S GMRA=1

 .Q

 Q

Q1 ;

 S:GMRAPA>0 GMRAPA(0)=$S($D(^GMR(120.8,+GMRAPA,0)):^(0),1:"")

 K %,D,DA,DIC,DTOUT,DUOUT,GMRAAR,GMRAHLP,GMRAING,GMRALAGO,GMRALAR,PSNDA,PSODA,X,Y

 Q

DIC ; VALIDATE LOOKUP FOR A/AR

 S:$D(DTOUT) X="^^" I X="^^" S GMRAOUT=1 Q

 S:$D(DUOUT) Y=0 Q:+Y'>0

YNOK W !?3,X,"   OK" S %=1 D YN^DICN S:%=-1 GMRAOUT=1,Y=-1 Q:GMRAOUT

 S:%=2 Y=-1 Q:Y=-1  I % W ! Q  ;19

 W !?5,$C(7),"ANSWER YES IF THIS IS THE CORRECT ALLERGY/ADVERSE REACTION,",!?5,"ELSE ANSWER NO."

 G YNOK

 ;reactivate allergy

RESET(DATA,GMRAPA,DFN,VAL) ;Reactivate

 N X,Y,STOP,FNUM,AIEN,BIEN,ERR,SIEN,SIEN,MIEN,IEN,CANVER,VER

 I GMRAPA="" S DATA="-1^Missing entry to reactivate" Q

 D CKIN^BEHOARMU(DFN)

 S STOP=0,FNUM=120.899999912,BIEN=GMRAPA

 S SIEN=$O(^GMR(120.8,GMRAPA,9999999.12,$C(0)),-1)

 I STOP!'SIEN S DATA="-1^Unable to find entry to reactivate" Q

 S AIEN=SIEN_","_GMRAPA_","

 I $G(VAL("GMRAINREBY"))="" S VAL("GMRAINREBY")=DUZ

 I $G(VAL("GMRAINRE"))="" S VAL("GMRAINRE")=$$NOW^XLFDT

 S FDA(120.899999912,AIEN,3)=$G(VAL("GMRAINRE"))

 S FDA(120.899999912,AIEN,4)=$G(VAL("GMRAINREBY"))

 D UPDATE^DIE(,"FDA","IEN","ERR")

 I $G(ERR("DIERR",1)) S DATA=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1) Q

 S DATA=GMRAPA

 K FDA,ERR

 ;Remove the verification, must be redone

 S AIEN=BIEN_","

 S FDA(120.8,AIEN,19)="@"

 S FDA(120.8,AIEN,20)="@"

 S FDA(120.8,AIEN,21)="@"

 D FILE^DIE("","FDA","ERR")

 S CANVER=$$HASKEY^BEHOUSCX("GMRA-ALLERGY VERIFY")

 I $$CANVERIF^BEHOART(GMRAPA,.VER)!(CANVER=1) D

 .S AIEN=BIEN_","

 .S FDA(120.8,AIEN,19)=1

 .S FDA(120.8,AIEN,20)=$$NOW^XLFDT

 .S FDA(120.8,AIEN,21)=DUZ

 .D UPDATE^DIE(,"FDA","IEN","ERR")

 D FIREEVT^BEHOART(DFN,1,GMRAPA)

 K FDA,ERR

 Q

GMRAPED3  ;HIRMFO/YMP,RM-VALIDATE ENTRY FOR .02 FIELD IN FILE 120.8 ;16-Mar-2011 09:16;DU

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

EN1       ; GIVEN DFN, SELECT PATIENT ALLERGY

 +1        KILL GMRAAR

           SET GMRAAR=""

 +2        WRITE !!,"CAUSATIVE AGENT: "_$PIECE(GMRAPA(0),"^",2)_"//  (Uneditable)"

 +3        QUIT 

REAC      ;EP Called to reactivate an inactive entry

 +1        NEW GMRAOUT,GMRA,DFN

 +2        SET GMRAOUT=0

 +3       ; Select A Patient

           WRITE @IOF

           DO PAT^GMRAPAT

 +4        IF 'GMRAOUT

               DO EN21

 +5       ;G:'GMRAOUT REAC

 +6        KILL DFN,DIC,GMRAOUT,GMRARET,GMA,GMRAUSER

 +7        DO EN1^GMRAKILL

 +8        QUIT 

EN21      ;Load the inactive allergies and ask user to select one

 +1        NEW GMRAIEN,GMALAR,GMRAOUT,GMRACNT,VADM,GMRALOC,GMRANAM,GMRASEX,X

 +2        SET GMRACNT=0

           DO 1^VADPT

 +3        SET GMRALOC=$PIECE(VAIN(4),U,2)

           SET GMRANAM=VADM(1)

           SET GMRASEX=VADM(5)

 +4        DO LIST(DFN,.GMRAL)

 +5        IF GMRAL=0

               WRITE !,"This patient has no inactive allergies"

               QUIT 

 +6        IF GMRAL

               DO EN1^GMRADSP0(.GMRAL)

               IF GMRAOUT

                   QUIT 

 +7        READ !!,"Enter Item to Reactivate: ",GMRALAR:DTIME

           IF '$TEST

               SET GMRALAR="^^"

           IF GMRALAR=""

               SET GMRARET=1

           IF "^^"[GMRALAR

               SET GMRAOUT='$LENGTH(GMRALAR)+1

               GOTO REAC

 +8        IF GMRALAR?1P.E!($LENGTH(GMRALAR)<3)!($LENGTH(GMRALAR)>30)

               SET GMRAHLP=1

               DO EN1^GMRAHLP0

               IF 'GMRAOUT

                   GOTO EN1

 +9        IF GMRALAR?.E1L.E

               SET GMRALAR=$$UP^XLFSTR(GMRALAR)

 +10       KILL Y,DTOUT,DUOUT

           SET DGSENFLG=""

           SET DIC="^GMR(120.8,"

           SET DIC(0)="SEZ"

           SET X=GMRANAM

           SET DIC("S")="I '+$G(^(""ER"")),$P(^(0),U,2)?@(""1""""""_GMRALAR_"""""".E""),$D(^GMR(120.8,""B"",DFN,+Y))"

           SET DIC("W")="W $P(^(0),U,2)"

 +11       WRITE !!,"Checking existing PATIENT ALLERGIES (#120.8) file for matches..."

 +12       DO ^DIC

           SET X=$PIECE($GET(Y(0)),"^",2)

           KILL DIC,DGSENFLG,DTOUT,DUOUT

           DO DIC

           IF GMRAOUT

               SET GMRAOUT=GMRAOUT-1

               IF GMRAOUT

                   GOTO Q1

               GOTO REAC

 +13       IF +Y>0

               SET GMRAPA=+Y

           IF +Y<1!GMRAOUT

               GOTO Q1

 +14       IF +GMRAPA

               Begin DoDot:1

 +15               DO REACT(DFN,GMRAPA)

 +16               SET X=$$FIND1^DIC(101,,"BX","GMRA ALLERGY UPDATE")_";ORD(101,"

 +17      ;Process protocols hanging off this protocol

                   IF X

                       DO EN^XQOR

               End DoDot:1

 +18       QUIT 

REACT(DFN,GMRAPA) ;Find the entry to inactivate

 +1        NEW Z,INACT,REACT,VAL,DATA

 +2        SET Z=9999999

           SET Z=$ORDER(^GMR(120.8,GMRAPA,9999999.12,Z),-1)

           IF +Z

               Begin DoDot:1

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

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

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

                       Begin DoDot:2

 +6                        SET VAL("GMRAINACT")=INACT

 +7                        DO RESET(.DATA,GMRAPA,DFN,.VAL)

 +8                        IF DATA=GMRAPA

                               WRITE !,"Reaction has been reactivated"

                               DO HANGT^GMRAPEH0

                               GOTO REAC

                       End DoDot:2

               End DoDot:1

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

                   SET Z=$ORDER(^GMR(120.8,GMRAPA,9999999.12,Z),-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

                       Begin DoDot:2

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

 +13                       IF 'GMRA

                               SET GMRA=1

                       End DoDot:2

 +14               QUIT 

               End DoDot:1

 +15       QUIT 

Q1        ;

 +1        IF GMRAPA>0

               SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,+GMRAPA,0)):^(0),1:"")

 +2        KILL %,D,DA,DIC,DTOUT,DUOUT,GMRAAR,GMRAHLP,GMRAING,GMRALAGO,GMRALAR,PSNDA,PSODA,X,Y

 +3        QUIT 

DIC       ; VALIDATE LOOKUP FOR A/AR

 +1        IF $DATA(DTOUT)

               SET X="^^"

           IF X="^^"

               SET GMRAOUT=1

               QUIT 

 +2        IF $DATA(DUOUT)

               SET Y=0

           IF +Y'>0

               QUIT 

YNOK       WRITE !?3,X,"   OK"

           SET %=1

           DO YN^DICN

           IF %=-1

               SET GMRAOUT=1

               SET Y=-1

           IF GMRAOUT

               QUIT 

 +1       ;19

           IF %=2

               SET Y=-1

           IF Y=-1

               QUIT 

           IF %

               WRITE !

               QUIT 

 +2        WRITE !?5,$CHAR(7),"ANSWER YES IF THIS IS THE CORRECT ALLERGY/ADVERSE REACTION,",!?5,"ELSE ANSWER NO."

 +3        GOTO YNOK

 +4       ;reactivate allergy

RESET(DATA,GMRAPA,DFN,VAL) ;Reactivate

 +1        NEW X,Y,STOP,FNUM,AIEN,BIEN,ERR,SIEN,SIEN,MIEN,IEN,CANVER,VER

 +2        IF GMRAPA=""

               SET DATA="-1^Missing entry to reactivate"

               QUIT 

 +3        DO CKIN^BEHOARMU(DFN)

 +4        SET STOP=0

           SET FNUM=120.899999912

           SET BIEN=GMRAPA

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

 +6        IF STOP!'SIEN

               SET DATA="-1^Unable to find entry to reactivate"

               QUIT 

 +7        SET AIEN=SIEN_","_GMRAPA_","

 +8        IF $GET(VAL("GMRAINREBY"))=""

               SET VAL("GMRAINREBY")=DUZ

 +9        IF $GET(VAL("GMRAINRE"))=""

               SET VAL("GMRAINRE")=$$NOW^XLFDT

 +10       SET FDA(120.899999912,AIEN,3)=$GET(VAL("GMRAINRE"))

 +11       SET FDA(120.899999912,AIEN,4)=$GET(VAL("GMRAINREBY"))

 +12       DO UPDATE^DIE(,"FDA","IEN","ERR")

 +13       IF $GET(ERR("DIERR",1))

               SET DATA=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1)

               QUIT 

 +14       SET DATA=GMRAPA

 +15       KILL FDA,ERR

 +16      ;Remove the verification, must be redone

 +17       SET AIEN=BIEN_","

 +18       SET FDA(120.8,AIEN,19)="@"

 +19       SET FDA(120.8,AIEN,20)="@"

 +20       SET FDA(120.8,AIEN,21)="@"

 +21       DO FILE^DIE("","FDA","ERR")

 +22       SET CANVER=$$HASKEY^BEHOUSCX("GMRA-ALLERGY VERIFY")

 +23       IF $$CANVERIF^BEHOART(GMRAPA,.VER)!(CANVER=1)

               Begin DoDot:1

 +24               SET AIEN=BIEN_","

 +25               SET FDA(120.8,AIEN,19)=1

 +26               SET FDA(120.8,AIEN,20)=$$NOW^XLFDT

 +27               SET FDA(120.8,AIEN,21)=DUZ

 +28               DO UPDATE^DIE(,"FDA","IEN","ERR")

               End DoDot:1

 +29       DO FIREEVT^BEHOART(DFN,1,GMRAPA)

 +30       KILL FDA,ERR

 +31       QUIT