GMRAPEM0 ;HIRMFO/WAA,FT-ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER ;22-Aug-2013 08:37;DU
;;4.0;Adverse Reaction Tracking;**2,5,17,21,36,1002,1006,1007**;Mar 29, 1996;Build 18
;IHS/MSC/MGH added data to enter source
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)
;IHS/MSC/MGH Patch 1006
;Check and see if patient is marked unassessable, if so, ask if the user wishes resolve this issue
N GMRCK,VAL,Y,DIR,STOP
S GMRCK=$$INASSESS(DFN)
S STOP=0
I +GMRCK>0 D Q:STOP=1
.D REACT^GMRAPAT(DFN)
.W !,"Patient has been marked as unassessable for allergies"
.W !,"Reason given is "_$P(GMRCK,U,2),!
.S DIR("A")="Can this pt. now be assessed"
.S DIR(0)="Y",DIR("B")="YES",DIR("?")="Enter Y to mark this pt as assesible, N to keep as inasessable"
.D ^DIR I $D(DIRUT) K DIRUT Q
.I Y=1 D CKIN^BEHOARMU(DFN) S STOP=1 Q
.I Y=0 D SET^GMRAOR8(DFN) S STOP=1 Q
;END MOD
; 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
..;IHS/MSC/MGH Add call for interface patch 1002,1006
..N X
..S X=$$FIND1^DIC(101,,"BX","GMRA ALLERGY UPDATE")_";ORD(101,"
..D:X EN^XQOR ;Process protocols hanging off this protocol
..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
.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
;IHS/MSC/MGH Add source of information Patch 1006
I GMRANEW D
.S DA=GMRAPA,DIE=120.8,DR=9999999.11
.D ^DIE
.K DA,DIE,DR
;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
;IHS/MSC/MGH Add the last modified data patch 1006
N MIEN,FDA,IEN,ERR,X
S MIEN="+1,"_GMRAPA_","
S FDA(120.899999914,MIEN,.01)=$$NOW^XLFDT
S FDA(120.899999914,MIEN,.02)=DUZ
D UPDATE^DIE(,"FDA","IEN","ERR")
;IHS/MSC/MGH Patch 13 - check for RxNorm and UNI codes for the allergy
D RXNORM^GMRAZRXU(GMRAPA)
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
INASSESS(DFN) ;Is pt unassessable
N Y,REASON,I,INIEN,REA2
S I=0
S Y=$O(^GMR(120.86,DFN,9999999.11,$C(0)),-1) I +Y D
.I $P($G(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)="" D
..S X1="Unassessable"
..S INIEN=Y_","_DFN
..S REASON=$$GET1^DIQ(120.869999911,INIEN,1)
..I REASON'="" D
...I REASON="OTHER" S REA2=$$GET1^DIQ(120.869999911,INIEN,5) S REASON=REASON_" "_REA2
..S I="1^"_REASON
Q I
GMRAPEM0 ;HIRMFO/WAA,FT-ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER ;22-Aug-2013 08:37;DU
+1 ;;4.0;Adverse Reaction Tracking;**2,5,17,21,36,1002,1006,1007**;Mar 29, 1996;Build 18
+2 ;IHS/MSC/MGH added data to enter source
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 ;IHS/MSC/MGH Patch 1006
+3 ;Check and see if patient is marked unassessable, if so, ask if the user wishes resolve this issue
+4 NEW GMRCK,VAL,Y,DIR,STOP
+5 SET GMRCK=$$INASSESS(DFN)
+6 SET STOP=0
+7 IF +GMRCK>0
Begin DoDot:1
+8 DO REACT^GMRAPAT(DFN)
+9 WRITE !,"Patient has been marked as unassessable for allergies"
+10 WRITE !,"Reason given is "_$PIECE(GMRCK,U,2),!
+11 SET DIR("A")="Can this pt. now be assessed"
+12 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("?")="Enter Y to mark this pt as assesible, N to keep as inasessable"
+13 DO ^DIR
IF $DATA(DIRUT)
KILL DIRUT
QUIT
+14 IF Y=1
DO CKIN^BEHOARMU(DFN)
SET STOP=1
QUIT
+15 IF Y=0
DO SET^GMRAOR8(DFN)
SET STOP=1
QUIT
End DoDot:1
IF STOP=1
QUIT
+16 ;END MOD
+17 ; check patient assessment before enter/edit reaction
+18 ;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
+19 NEW DA,DIK
+20 SET DIK="^GMR(120.86,"
SET DA=DFN
DO ^DIK
+21 QUIT
End DoDot:1
+22 IF '$$NKA^GMRANKA(DFN)
DO NKAASK^GMRANKA(DFN,.GMRAOUT)
IF GMRAOUT
QUIT
IF '$$NKA^GMRANKA(DFN)
QUIT
+23 ;21
LOCK +^XTMP("GMRAED",DFN):1
IF '$TEST
DO MESS^GMRAGUI1
QUIT
+24 SET GMRAOUT=0
+25 IF 'GMRAOUT
DO SELECT
+26 IF $GET(GMRAPA)'>0
SET GMRAOUT=0
+27 SET GMRARP=1
IF 'GMRAOUT
Begin DoDot:1
+28 DO ASK^GMRAUTL("Enter another Causative Agent? ",.GMRAOUT,.GMRARP)
+29 IF 'GMRARP
SET GMRACNT=$ORDER(^TMP($JOB,"GMRASF","B"),-1)
Begin DoDot:2
+30 IF GMRACNT
DO SIGNOFF^GMRASIGN
+31 IF 'GMRAOUT
DO IDBAND^GMRASIGN
+32 ;IHS/MSC/MGH Add call for interface patch 1002,1006
+33 NEW X
+34 SET X=$$FIND1^DIC(101,,"BX","GMRA ALLERGY UPDATE")_";ORD(101,"
+35 ;Process protocols hanging off this protocol
IF X
DO EN^XQOR
+36 IF GMRAOUT
SET GMRAOUT=2-GMRAOUT
IF GMRAOUT&($DATA(^TMP($JOB,"GMRASF")))
DO ALERT^GMRASIGN
KILL ^TMP($JOB,"GMRASF"),GMRACNT
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 ;21
IF GMRARP
IF 'GMRAOUT
KILL GMRARP
LOCK -^XTMP("GMRAED",DFN)
GOTO EN21
+40 KILL GMRARP
+41 ; check patient assessment when exiting enter/edit reaction
+42 ;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
+43 NEW DA,DIK
+44 SET DIK="^GMR(120.86,"
SET DA=DFN
DO ^DIK
+45 QUIT
End DoDot:1
+46 ;21
LOCK -^XTMP("GMRAED",DFN)
+47 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 DO UPDATE^GMRAPEM3
+12 QUIT
End DoDot:1
+13 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 ;IHS/MSC/MGH Add source of information Patch 1006
+5 IF GMRANEW
Begin DoDot:1
+6 SET DA=GMRAPA
SET DIE=120.8
SET DR=9999999.11
+7 DO ^DIE
+8 KILL DA,DIE,DR
End DoDot:1
+9 ;If reaction is observed and signed off
+10 IF $PIECE(GMRAPA(0),U,6)="o"
IF $PIECE(GMRAPA(0),U,12)
Begin DoDot:1
+11 IF $GET(GMRAUSER,0)
QUIT
+12 NEW GMRARP
+13 SET GMRARP=0
DO ASK^GMRAUTL("DO YOU WISH TO EDIT OBSERVED DATA? ",.GMRAOUT,.GMRARP)
IF GMRAOUT
QUIT
+14 ;Observed data
IF 'GMRARP
QUIT
+15 ;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 ;IHS/MSC/MGH Add the last modified data patch 1006
+25 NEW MIEN,FDA,IEN,ERR,X
+26 SET MIEN="+1,"_GMRAPA_","
+27 SET FDA(120.899999914,MIEN,.01)=$$NOW^XLFDT
+28 SET FDA(120.899999914,MIEN,.02)=DUZ
+29 DO UPDATE^DIE(,"FDA","IEN","ERR")
+30 ;IHS/MSC/MGH Patch 13 - check for RxNorm and UNI codes for the allergy
+31 DO RXNORM^GMRAZRXU(GMRAPA)
+32 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
INASSESS(DFN) ;Is pt unassessable
+1 NEW Y,REASON,I,INIEN,REA2
+2 SET I=0
+3 SET Y=$ORDER(^GMR(120.86,DFN,9999999.11,$CHAR(0)),-1)
IF +Y
Begin DoDot:1
+4 IF $PIECE($GET(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)=""
Begin DoDot:2
+5 SET X1="Unassessable"
+6 SET INIEN=Y_","_DFN
+7 SET REASON=$$GET1^DIQ(120.869999911,INIEN,1)
+8 IF REASON'=""
Begin DoDot:3
+9 IF REASON="OTHER"
SET REA2=$$GET1^DIQ(120.869999911,INIEN,5)
SET REASON=REASON_" "_REA2
End DoDot:3
+10 SET I="1^"_REASON
End DoDot:2
End DoDot:1
+11 QUIT I
