GMRAPEM0 ;HIRMFO/WAA,FT-ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER ; 12 Jul 2016 1:54 PM
;;4.0;Adverse Reaction Tracking;**2,5,17,21,36,50,58**;Mar 29, 1996;Build 5
EN11 ; Entry point for GMRA USER E/E PAT REC DATA option
; GMRAUSER is a flag that indicates that this is a User
; If user has Verifier Key then user will act normal
I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRAUSER=1
EN1 ; Entry for ENTER/EDIT PATIENT REACTION DATA option
; EDIT PATIENT A/AR (DFN UNK.)
S GMRAOUT=0
W @IOF D PAT^GMRAPAT ; Select A Patient
D:'GMRAOUT EN21 G:'GMRAOUT EN1
K DFN,DIC,GMRAOUT,GMRARET,GMA,GMRAUSER
D EXIT,EN1^GMRAKILL
Q
EN21 ; Process patient data and determine if patient is NKA
S GMRAOUT=$G(GMRAOUT,0)
; check patient assessment before enter/edit reaction
I $$NKA^GMRANKA(DFN),$$NKASCR^GMRANKA(DFN) D ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
.N DA,DIK
.S DIK="^GMR(120.86,",DA=DFN D ^DIK
.Q
I '$$NKA^GMRANKA(DFN) D NKAASK^GMRANKA(DFN,.GMRAOUT) Q:GMRAOUT I '$$NKA^GMRANKA(DFN) Q
L +^XTMP("GMRAED",DFN):1 I '$T D MESS^GMRAGUI1 Q ;21
S GMRAOUT=0
D:'GMRAOUT SELECT
I $G(GMRAPA)'>0 S GMRAOUT=0
S GMRARP=1 I 'GMRAOUT D
.D ASK^GMRAUTL("Enter another Causative Agent? ",.GMRAOUT,.GMRARP)
.I 'GMRARP S GMRACNT=$O(^TMP($J,"GMRASF","B"),-1) D
..I GMRACNT D SIGNOFF^GMRASIGN
..I 'GMRAOUT D IDBAND^GMRASIGN
..I GMRAOUT S GMRAOUT=2-GMRAOUT D:GMRAOUT&($D(^TMP($J,"GMRASF"))) ALERT^GMRASIGN K ^TMP($J,"GMRASF"),GMRACNT
..Q
.Q
I GMRARP,'GMRAOUT K GMRARP L -^XTMP("GMRAED",DFN) G EN21 ;21
K GMRARP
; check patient assessment when exiting enter/edit reaction
I $$NKA^GMRANKA(DFN),$$NKASCR^GMRANKA(DFN) D ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
.N DA,DIK
.S DIK="^GMR(120.86,",DA=DFN D ^DIK
.Q
L -^XTMP("GMRAED",DFN) ;21
Q
EN2 ; EDIT PATIENT A/AR (DFN KNOWN)
; Called from the GMRAOR ALLERGY ENTER/EDIT protocol
I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRAUSER=1
N GMRAOUT
D EN21 D
.;N GMRAOUT
.D EXIT,EN1^GMRAKILL
.Q
K GMA,GMRARET,GMRAUSER
Q
ALERT ; PROCESS ALERTS FOR ART
N DFN,GMRAPA,GMRACNT,GMRAOUT,GMRANEW,GMRAUSER
S (GMRACNT,GMRAOUT,GMRANEW)=0 D
. I $G(XQADATA)="" S XQAKILL=0 Q
. S DFN=$P(XQADATA,U),GMRAPA=$P(XQADATA,U,2),GMRAUSER=$P(XQADATA,U,3) Q:'DFN!'GMRAPA
. I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) K GMRAUSER
. S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
. I $P(GMRAPA(0),U,12) D Q
. . W !,"This reaction has been signed off.",$C(7)
. . D HANGT^GMRAPEH0
. . S XQAKILL=0
. . Q
. D EDIT^GMRAPEM4
. D UPDATE^GMRAPEM3
. I '$P(GMRAPA(0),U,12) D SIGNOFF^GMRASIGN
. I GMRAOUT S GMRAOUT=2-GMRAOUT K XQAKILL
. E D
. .I $P(GMRAPA(0),U,12) S XQAKILL=0
. .I '$P(GMRAPA(0),U,12) K XQAKILL
. D EXIT,EN1^GMRAKILL
. Q
Q
SELECT ;Select a patient reaction
S GMRACNT=0 D 1^VADPT
S GMRALOC=$P(VAIN(4),U,2),GMRANAM=VADM(1),GMRASEX=VADM(5),GMRAOUT=0,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0)) D KVAR^VADPT K VA,VAROOT
K GMRADUP S GMRALAGO=1
D REACT^GMRAPAT(DFN) ; Load all reaction for this patient.
D EN1^GMRAPES0
I GMRAPA>0 D TYPE D
.I GMRAOUT D:$G(GMRANEW) DELETE S:'$$MISSREQ&('$P($G(GMRAPA(0)),U,12)) GMRAOUT=0,^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)="",^TMP($J,"GMRASF",GMRACNT,GMRAPA)="" D:GMRAOUT UPOUT^GMRAPEM3 Q ; 21,36
.I GMRAERR D ERR^GMRAPEM3 Q ;The reaction was entered in error
.I $P(GMRAPA(0),U,12) D SIGNED^GMRAPEM3 Q ;The reaction has been signed
.; Reaction is a new reaction or Update data
.I GMRANEW D GMRACHK^GMRAPEM0(GMRAPA)
.D UPDATE^GMRAPEM3
.Q
Q
TYPE ; Select the type of the process to use this reaction
S GMRAERR=0
; If reaction is not new check to see if user want to enter in error
I 'GMRANEW W @IOF N GMRADFN D EN1^GMRAPEE0 I GMRAERR!GMRAOUT Q
;If reaction is observed and signed off
I $P(GMRAPA(0),U,6)="o",$P(GMRAPA(0),U,12) D Q:GMRAOUT
.Q:$G(GMRAUSER,0)
.N GMRARP
.S GMRARP=0 D ASK^GMRAUTL("DO YOU WISH TO EDIT OBSERVED DATA? ",.GMRAOUT,.GMRARP) Q:GMRAOUT
.Q:'GMRARP ;Observed data
.N GMRAOD S GMRAOD=$D(^GMR(120.85,"C",GMRAPA)) ;Existing observation data?
OBSDATE .;
.S GMRALAGO=1 F D EN2^GMRAU85 Q:GMRAPA1>0 Q:GMRAOUT W !,"You must enter a valid date or an Up-arrow to exit",!,$C(7)
.I 'GMRAOUT,GMRAPA1>0 D EN2^GMRAROBS
.I '$D(^GMR(120.85,"C",GMRAPA)),$G(GMRANEW)!('$G(GMRANEW)&($G(GMRAOD))) D OBSPROB S GMRAOUT=0 G OBSDATE
.Q
;Verify data
I 'GMRAERR,$P($G(^GMR(120.8,GMRAPA,0)),U,16)=0,$P(GMRAPA(0),U,12)=1,$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D Q:GMRAOUT
.K GMRAVER S GMRAVER=0
.N GMRAPRNT D EN1^GMRAVFY K GMRALLER,GMRAMEC,GMRAY
.I $P($G(^GMR(120.8,GMRAPA,0)),U,16)=1 S GMRASLL(GMRAPA)=1
.Q
;EDIT Verified data
I 'GMRAERR,$P($G(^GMR(120.8,GMRAPA,0)),U,16)=1,$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D Q:GMRAOUT
.Q:$G(GMRAVER)=1
.N GMRARP
.S GMRARP=0
.D ASK^GMRAUTL("DO YOU WISH TO EDIT VERIFIED DATA? ",.GMRAOUT,.GMRARP) Q:GMRAOUT
.D:GMRARP SITE^GMRAUTL,EN1^GMRAPED0
.Q
;if the reaction is new or not signed off
I '$P(GMRAPA(0),U,12) D
.D EDIT^GMRAPEM4
.I $P($G(^GMR(120.8,GMRAPA,0)),U,16) S GMRASLL(GMRAPA)=1
.Q
Q
EXIT S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRASF","B",GMRAPA)) Q:GMRAPA<1 D UNLOCK^GMRAUTL(120.8,GMRAPA)
K ^TMP($J,"GMRASF")
K ^TMP($J,"GMRALST")
Q
;
DELETE ;Delete entry if required information is not entered - section added in 17
N DA,DIK,GMRAPA1
W !!,"Entry process not completed, deleting entry...",!
S GMRAPA1=$O(^GMR(120.85,"C",GMRAPA,0))
I GMRAPA1,$G(^GMR(120.85,GMRAPA1,0))="" K ^GMR(120.85,"C",GMRAPA,GMRAPA1)
I GMRAPA1 S DIK="^GMR(120.85,",DA=GMRAPA1 D ^DIK D UNLOCK^GMRAUTL(120.85,GMRAPA1)
I GMRAPA S DIK="^GMR(120.8,",DA=GMRAPA D ^DIK D UNLOCK^GMRAUTL(120.8,GMRAPA)
Q
;
OBSPROB ;Display help information for missing observed date/time entry
W !!,"Observed reactions must have at least one observation entry.",!,"If this reaction is incorrect then enter a date and then proceed",!,"to mark it as entered in error.",!
Q
;
MISSREQ() ;Function determines if required data is missing
N GMRA0,TYPE
S GMRA0=$G(^GMR(120.8,+$G(GMRAPA),0)) I GMRA0="" Q 1 ;Entry not found
S TYPE=$P(GMRA0,U,6) ;Get observed/historical
I TYPE="" Q 1 ;Type not entered
I TYPE="h" Q 0 ;Historical has no requirements
I TYPE="o" I '$D(^GMR(120.85,"C",GMRAPA))!('$O(^GMR(120.85,+$O(^GMR(120.85,"C",GMRAPA,0)),2,0)))!('$$REQCOM) Q 1 ;Missing obs date/time or sign/symptom or required comment
Q 0
;
REQCOM() ;Function determines if comments required
I '$D(GMRASITE) D SITE^GMRAUTL
I +$P(^GMRD(120.84,+GMRASITE,0),U,4)=0 Q 1 ;Comments required?
I $O(^GMR(120.8,GMRAPA,26,0)) Q 1
Q 0
;
GMRACHK(GMRAPA) ;
;Send a warning MailMan message if the VA DRUG CLASS field is empty.
;Get the first, if any,VA DRUG CLASS entries for this agent.
N PATALLER,VADRCL1,PATNAME,REAC,REACTS,LINE
N PATIEN,SSN,LAST4
D GETS^DIQ(120.8,GMRAPA_",","**","E","PATALLER")
;mod by CAS - to skip all but "D" Drug type reactions
I $P($G(^GMR(120.8,GMRAPA,0)),"^",20)'["D" Q
S VADRCL1=$G(PATALLER(120.803,"1,"_GMRAPA_",",.01,"E"))
S PATNAME=$G(PATALLER(120.8,GMRAPA_",",.01,"E"))
S PATIEN=$$GET1^DIQ(120.8,GMRAPA,.01,"I")
S SSN=$$GET1^DIQ(2,PATIEN,.09,"E")
S LAST4=$E(PATNAME,1,1)_$E(SSN,6,9)
I '$G(GMRAERR),(VADRCL1=""),(PATNAME'="") D
. K ^XTMP("GMRACHK",$J)
. S LINE=1
. S ^XTMP("GMRACHK",$J,LINE)="The following allergy/adverse reaction may need a VA DRUG CLASS added"
. S LINE=LINE+1
. S ^XTMP("GMRACHK",$J,LINE)="for the following Patient:"
. S LINE=LINE+1
. S ^XTMP("GMRACHK",$J,LINE)=""
. S LINE=LINE+1
. S ^XTMP("GMRACHK",$J,LINE)="Patient: "_PATNAME
. S LINE=LINE+1
. S ^XTMP("GMRACHK",$J,LINE)="LAST4: "_LAST4
. S LINE=LINE+1
. S ^XTMP("GMRACHK",$J,LINE)="Reactant: "_$G(PATALLER(120.8,GMRAPA_",",.02,"E"))
. S LINE=LINE+1
. ;Build a pretty string of reactions
. S REAC=1
. S REACTS=$G(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
. S REAC=REAC+1
. F Q:'$D(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E")) D
. . S REACTS=REACTS_", "_$G(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
. . S REAC=REAC+1
. S ^XTMP("GMRACHK",$J,LINE)="Reactions: "_REACTS
. S LINE=LINE+1
. S ^XTMP("GMRACHK",$J,LINE)="OBS/HIS: "_$G(PATALLER(120.8,GMRAPA_",",6,"E"))
. S LINE=LINE+1
. S ^XTMP("GMRACHK",$J,LINE)="Location: "_$$GET1^DIQ(405,$$GET1^DIQ(2,DFN,.102,"I"),.06,"E")
. S LINE=LINE+1
. S XMDUZ=DUZ
. S XMTEXT="^XTMP(""GMRACHK"","_$J_","
. I $G(DUZ(2))="" S DUZ(2)=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
. S XMSUB="ALLERGY/ADVERSE REACTION WITHOUT VA DRUG CLASS ("
. S XMSUB=XMSUB_$P($$NS^XUAF4(DUZ(2)),U)_")"
. S XMY("G.ADVERSE_ALLERGY_WARNING")=""
. D ^XMD
. K ^XTMP("GMRACHK",$J)
Q
GMRAPEM0 ;HIRMFO/WAA,FT-ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER ; 12 Jul 2016 1:54 PM
+1 ;;4.0;Adverse Reaction Tracking;**2,5,17,21,36,50,58**;Mar 29, 1996;Build 5
EN11 ; Entry point for GMRA USER E/E PAT REC DATA option
+1 ; GMRAUSER is a flag that indicates that this is a User
+2 ; If user has Verifier Key then user will act normal
+3 IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
SET GMRAUSER=1
EN1 ; Entry for ENTER/EDIT PATIENT REACTION DATA option
+1 ; EDIT PATIENT A/AR (DFN UNK.)
+2 SET GMRAOUT=0
+3 ; Select A Patient
WRITE @IOF
DO PAT^GMRAPAT
+4 if 'GMRAOUT
DO EN21
if 'GMRAOUT
GOTO EN1
+5 KILL DFN,DIC,GMRAOUT,GMRARET,GMA,GMRAUSER
+6 DO EXIT
DO EN1^GMRAKILL
+7 QUIT
EN21 ; Process patient data and determine if patient is NKA
+1 SET GMRAOUT=$GET(GMRAOUT,0)
+2 ; check patient assessment before enter/edit reaction
+3 ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
IF $$NKA^GMRANKA(DFN)
IF $$NKASCR^GMRANKA(DFN)
Begin DoDot:1
+4 NEW DA,DIK
+5 SET DIK="^GMR(120.86,"
SET DA=DFN
DO ^DIK
+6 QUIT
End DoDot:1
+7 IF '$$NKA^GMRANKA(DFN)
DO NKAASK^GMRANKA(DFN,.GMRAOUT)
if GMRAOUT
QUIT
IF '$$NKA^GMRANKA(DFN)
QUIT
+8 ;21
LOCK +^XTMP("GMRAED",DFN):1
IF '$TEST
DO MESS^GMRAGUI1
QUIT
+9 SET GMRAOUT=0
+10 if 'GMRAOUT
DO SELECT
+11 IF $GET(GMRAPA)'>0
SET GMRAOUT=0
+12 SET GMRARP=1
IF 'GMRAOUT
Begin DoDot:1
+13 DO ASK^GMRAUTL("Enter another Causative Agent? ",.GMRAOUT,.GMRARP)
+14 IF 'GMRARP
SET GMRACNT=$ORDER(^TMP($JOB,"GMRASF","B"),-1)
Begin DoDot:2
+15 IF GMRACNT
DO SIGNOFF^GMRASIGN
+16 IF 'GMRAOUT
DO IDBAND^GMRASIGN
+17 IF GMRAOUT
SET GMRAOUT=2-GMRAOUT
if GMRAOUT&($DATA(^TMP($JOB,"GMRASF")))
DO ALERT^GMRASIGN
KILL ^TMP($JOB,"GMRASF"),GMRACNT
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 ;21
IF GMRARP
IF 'GMRAOUT
KILL GMRARP
LOCK -^XTMP("GMRAED",DFN)
GOTO EN21
+21 KILL GMRARP
+22 ; check patient assessment when exiting enter/edit reaction
+23 ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
IF $$NKA^GMRANKA(DFN)
IF $$NKASCR^GMRANKA(DFN)
Begin DoDot:1
+24 NEW DA,DIK
+25 SET DIK="^GMR(120.86,"
SET DA=DFN
DO ^DIK
+26 QUIT
End DoDot:1
+27 ;21
LOCK -^XTMP("GMRAED",DFN)
+28 QUIT
EN2 ; EDIT PATIENT A/AR (DFN KNOWN)
+1 ; Called from the GMRAOR ALLERGY ENTER/EDIT protocol
+2 IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
SET GMRAUSER=1
+3 NEW GMRAOUT
+4 DO EN21
Begin DoDot:1
+5 ;N GMRAOUT
+6 DO EXIT
DO EN1^GMRAKILL
+7 QUIT
End DoDot:1
+8 KILL GMA,GMRARET,GMRAUSER
+9 QUIT
ALERT ; PROCESS ALERTS FOR ART
+1 NEW DFN,GMRAPA,GMRACNT,GMRAOUT,GMRANEW,GMRAUSER
+2 SET (GMRACNT,GMRAOUT,GMRANEW)=0
Begin DoDot:1
+3 IF $GET(XQADATA)=""
SET XQAKILL=0
QUIT
+4 SET DFN=$PIECE(XQADATA,U)
SET GMRAPA=$PIECE(XQADATA,U,2)
SET GMRAUSER=$PIECE(XQADATA,U,3)
if 'DFN!'GMRAPA
QUIT
+5 IF $DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
KILL GMRAUSER
+6 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+7 IF $PIECE(GMRAPA(0),U,12)
Begin DoDot:2
+8 WRITE !,"This reaction has been signed off.",$CHAR(7)
+9 DO HANGT^GMRAPEH0
+10 SET XQAKILL=0
+11 QUIT
End DoDot:2
QUIT
+12 DO EDIT^GMRAPEM4
+13 DO UPDATE^GMRAPEM3
+14 IF '$PIECE(GMRAPA(0),U,12)
DO SIGNOFF^GMRASIGN
+15 IF GMRAOUT
SET GMRAOUT=2-GMRAOUT
KILL XQAKILL
+16 IF '$TEST
Begin DoDot:2
+17 IF $PIECE(GMRAPA(0),U,12)
SET XQAKILL=0
+18 IF '$PIECE(GMRAPA(0),U,12)
KILL XQAKILL
End DoDot:2
+19 DO EXIT
DO EN1^GMRAKILL
+20 QUIT
End DoDot:1
+21 QUIT
SELECT ;Select a patient reaction
+1 SET GMRACNT=0
DO 1^VADPT
+2 SET GMRALOC=$PIECE(VAIN(4),U,2)
SET GMRANAM=VADM(1)
SET GMRASEX=VADM(5)
SET GMRAOUT=0
SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
DO KVAR^VADPT
KILL VA,VAROOT
+3 KILL GMRADUP
SET GMRALAGO=1
+4 ; Load all reaction for this patient.
DO REACT^GMRAPAT(DFN)
+5 DO EN1^GMRAPES0
+6 IF GMRAPA>0
DO TYPE
Begin DoDot:1
+7 ; 21,36
IF GMRAOUT
if $GET(GMRANEW)
DO DELETE
if '$$MISSREQ&('$PIECE($GET(GMRAPA(0)),U,12))
SET GMRAOUT=0
SET ^TMP($JOB,"GMRASF","B",GMRAPA,GMRACNT)=""
SET ^TMP($JOB,"GMRASF",GMRACNT,GMRAPA)=""
if GMRAOUT
DO UPOUT^GMRAPEM3
QUIT
+8 ;The reaction was entered in error
IF GMRAERR
DO ERR^GMRAPEM3
QUIT
+9 ;The reaction has been signed
IF $PIECE(GMRAPA(0),U,12)
DO SIGNED^GMRAPEM3
QUIT
+10 ; Reaction is a new reaction or Update data
+11 IF GMRANEW
DO GMRACHK^GMRAPEM0(GMRAPA)
+12 DO UPDATE^GMRAPEM3
+13 QUIT
End DoDot:1
+14 QUIT
TYPE ; Select the type of the process to use this reaction
+1 SET GMRAERR=0
+2 ; If reaction is not new check to see if user want to enter in error
+3 IF 'GMRANEW
WRITE @IOF
NEW GMRADFN
DO EN1^GMRAPEE0
IF GMRAERR!GMRAOUT
QUIT
+4 ;If reaction is observed and signed off
+5 IF $PIECE(GMRAPA(0),U,6)="o"
IF $PIECE(GMRAPA(0),U,12)
Begin DoDot:1
+6 if $GET(GMRAUSER,0)
QUIT
+7 NEW GMRARP
+8 SET GMRARP=0
DO ASK^GMRAUTL("DO YOU WISH TO EDIT OBSERVED DATA? ",.GMRAOUT,.GMRARP)
if GMRAOUT
QUIT
+9 ;Observed data
if 'GMRARP
QUIT
+10 ;Existing observation data?
NEW GMRAOD
SET GMRAOD=$DATA(^GMR(120.85,"C",GMRAPA))
OBSDATE ;
+1 SET GMRALAGO=1
FOR
DO EN2^GMRAU85
if GMRAPA1>0
QUIT
if GMRAOUT
QUIT
WRITE !,"You must enter a valid date or an Up-arrow to exit",!,$CHAR(7)
+2 IF 'GMRAOUT
IF GMRAPA1>0
DO EN2^GMRAROBS
+3 IF '$DATA(^GMR(120.85,"C",GMRAPA))
IF $GET(GMRANEW)!('$GET(GMRANEW)&($GET(GMRAOD)))
DO OBSPROB
SET GMRAOUT=0
GOTO OBSDATE
+4 QUIT
End DoDot:1
if GMRAOUT
QUIT
+5 ;Verify data
+6 IF 'GMRAERR
IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)=0
IF $PIECE(GMRAPA(0),U,12)=1
IF $DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
Begin DoDot:1
+7 KILL GMRAVER
SET GMRAVER=0
+8 NEW GMRAPRNT
DO EN1^GMRAVFY
KILL GMRALLER,GMRAMEC,GMRAY
+9 IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)=1
SET GMRASLL(GMRAPA)=1
+10 QUIT
End DoDot:1
if GMRAOUT
QUIT
+11 ;EDIT Verified data
+12 IF 'GMRAERR
IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)=1
IF $DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
Begin DoDot:1
+13 if $GET(GMRAVER)=1
QUIT
+14 NEW GMRARP
+15 SET GMRARP=0
+16 DO ASK^GMRAUTL("DO YOU WISH TO EDIT VERIFIED DATA? ",.GMRAOUT,.GMRARP)
if GMRAOUT
QUIT
+17 if GMRARP
DO SITE^GMRAUTL
DO EN1^GMRAPED0
+18 QUIT
End DoDot:1
if GMRAOUT
QUIT
+19 ;if the reaction is new or not signed off
+20 IF '$PIECE(GMRAPA(0),U,12)
Begin DoDot:1
+21 DO EDIT^GMRAPEM4
+22 IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)
SET GMRASLL(GMRAPA)=1
+23 QUIT
End DoDot:1
+24 QUIT
EXIT SET GMRAPA=0
FOR
SET GMRAPA=$ORDER(^TMP($JOB,"GMRASF","B",GMRAPA))
if GMRAPA<1
QUIT
DO UNLOCK^GMRAUTL(120.8,GMRAPA)
+1 KILL ^TMP($JOB,"GMRASF")
+2 KILL ^TMP($JOB,"GMRALST")
+3 QUIT
+4 ;
DELETE ;Delete entry if required information is not entered - section added in 17
+1 NEW DA,DIK,GMRAPA1
+2 WRITE !!,"Entry process not completed, deleting entry...",!
+3 SET GMRAPA1=$ORDER(^GMR(120.85,"C",GMRAPA,0))
+4 IF GMRAPA1
IF $GET(^GMR(120.85,GMRAPA1,0))=""
KILL ^GMR(120.85,"C",GMRAPA,GMRAPA1)
+5 IF GMRAPA1
SET DIK="^GMR(120.85,"
SET DA=GMRAPA1
DO ^DIK
DO UNLOCK^GMRAUTL(120.85,GMRAPA1)
+6 IF GMRAPA
SET DIK="^GMR(120.8,"
SET DA=GMRAPA
DO ^DIK
DO UNLOCK^GMRAUTL(120.8,GMRAPA)
+7 QUIT
+8 ;
OBSPROB ;Display help information for missing observed date/time entry
+1 WRITE !!,"Observed reactions must have at least one observation entry.",!,"If this reaction is incorrect then enter a date and then proceed",!,"to mark it as entered in error.",!
+2 QUIT
+3 ;
MISSREQ() ;Function determines if required data is missing
+1 NEW GMRA0,TYPE
+2 ;Entry not found
SET GMRA0=$GET(^GMR(120.8,+$GET(GMRAPA),0))
IF GMRA0=""
QUIT 1
+3 ;Get observed/historical
SET TYPE=$PIECE(GMRA0,U,6)
+4 ;Type not entered
IF TYPE=""
QUIT 1
+5 ;Historical has no requirements
IF TYPE="h"
QUIT 0
+6 ;Missing obs date/time or sign/symptom or required comment
IF TYPE="o"
IF '$DATA(^GMR(120.85,"C",GMRAPA))!('$ORDER(^GMR(120.85,+$ORDER(^GMR(120.85,"C",GMRAPA,0)),2,0)))!('$$REQCOM)
QUIT 1
+7 QUIT 0
+8 ;
REQCOM() ;Function determines if comments required
+1 IF '$DATA(GMRASITE)
DO SITE^GMRAUTL
+2 ;Comments required?
IF +$PIECE(^GMRD(120.84,+GMRASITE,0),U,4)=0
QUIT 1
+3 IF $ORDER(^GMR(120.8,GMRAPA,26,0))
QUIT 1
+4 QUIT 0
+5 ;
GMRACHK(GMRAPA) ;
+1 ;Send a warning MailMan message if the VA DRUG CLASS field is empty.
+2 ;Get the first, if any,VA DRUG CLASS entries for this agent.
+3 NEW PATALLER,VADRCL1,PATNAME,REAC,REACTS,LINE
+4 NEW PATIEN,SSN,LAST4
+5 DO GETS^DIQ(120.8,GMRAPA_",","**","E","PATALLER")
+6 ;mod by CAS - to skip all but "D" Drug type reactions
+7 IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),"^",20)'["D"
QUIT
+8 SET VADRCL1=$GET(PATALLER(120.803,"1,"_GMRAPA_",",.01,"E"))
+9 SET PATNAME=$GET(PATALLER(120.8,GMRAPA_",",.01,"E"))
+10 SET PATIEN=$$GET1^DIQ(120.8,GMRAPA,.01,"I")
+11 SET SSN=$$GET1^DIQ(2,PATIEN,.09,"E")
+12 SET LAST4=$EXTRACT(PATNAME,1,1)_$EXTRACT(SSN,6,9)
+13 IF '$GET(GMRAERR)
IF (VADRCL1="")
IF (PATNAME'="")
Begin DoDot:1
+14 KILL ^XTMP("GMRACHK",$JOB)
+15 SET LINE=1
+16 SET ^XTMP("GMRACHK",$JOB,LINE)="The following allergy/adverse reaction may need a VA DRUG CLASS added"
+17 SET LINE=LINE+1
+18 SET ^XTMP("GMRACHK",$JOB,LINE)="for the following Patient:"
+19 SET LINE=LINE+1
+20 SET ^XTMP("GMRACHK",$JOB,LINE)=""
+21 SET LINE=LINE+1
+22 SET ^XTMP("GMRACHK",$JOB,LINE)="Patient: "_PATNAME
+23 SET LINE=LINE+1
+24 SET ^XTMP("GMRACHK",$JOB,LINE)="LAST4: "_LAST4
+25 SET LINE=LINE+1
+26 SET ^XTMP("GMRACHK",$JOB,LINE)="Reactant: "_$GET(PATALLER(120.8,GMRAPA_",",.02,"E"))
+27 SET LINE=LINE+1
+28 ;Build a pretty string of reactions
+29 SET REAC=1
+30 SET REACTS=$GET(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
+31 SET REAC=REAC+1
+32 FOR
if '$DATA(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
QUIT
Begin DoDot:2
+33 SET REACTS=REACTS_", "_$GET(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
+34 SET REAC=REAC+1
End DoDot:2
+35 SET ^XTMP("GMRACHK",$JOB,LINE)="Reactions: "_REACTS
+36 SET LINE=LINE+1
+37 SET ^XTMP("GMRACHK",$JOB,LINE)="OBS/HIS: "_$GET(PATALLER(120.8,GMRAPA_",",6,"E"))
+38 SET LINE=LINE+1
+39 SET ^XTMP("GMRACHK",$JOB,LINE)="Location: "_$$GET1^DIQ(405,$$GET1^DIQ(2,DFN,.102,"I"),.06,"E")
+40 SET LINE=LINE+1
+41 SET XMDUZ=DUZ
+42 SET XMTEXT="^XTMP(""GMRACHK"","_$JOB_","
+43 IF $GET(DUZ(2))=""
SET DUZ(2)=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
+44 SET XMSUB="ALLERGY/ADVERSE REACTION WITHOUT VA DRUG CLASS ("
+45 SET XMSUB=XMSUB_$PIECE($$NS^XUAF4(DUZ(2)),U)_")"
+46 SET XMY("G.ADVERSE_ALLERGY_WARNING")=""
+47 DO ^XMD
+48 KILL ^XTMP("GMRACHK",$JOB)
End DoDot:1
+49 QUIT
