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
