GMRANKA ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT NKA DRIVE ;01-Aug-2013 16:39;DU
;;4.0;Adverse Reaction Tracking;**2,21,36,1007**;Mar 29, 1996;Build 18
NKA(DFN) ;See if patient has reaction on file
; Input Variables:
; DFN = Patient Internal Entry Number
;
; Output Variables:
; GMA = 1 Patient has known reaction
; 0 Patient has No known reaction
; Null Patient has never been asked about reaction
S GMA=""
S GMA=$P($G(^GMR(120.86,DFN,0)),U,2)
Q GMA
;
NKAASK(DFN,GMRAOUT) ; Ask a Patient if patient has any known allergens
; Input Variables
; DFN = Patient Internal entry number
; GMRAOUT = Up Caret or time out flag
;
;Ask if patient has allergies
N DIR,Y,DIROUT,DTOUT,DIRUT,DUOUT,GMAOLD,SNOMED
S GMAOLD=$P($G(^GMR(120.86,DFN,0)),U,2)
S DIR(0)="120.86,1^AO^I Y=0&'$$NKASCR^GMRANKA(DFN) D INFO^GMRANKA K X"
S DIR("A")="Does this patient have any known allergies or adverse reactions? "
S DIR("B")=$S($P($G(^GMR(120.86,DFN,0)),U,2)=1:"Yes",$P($G(^GMR(120.86,DFN,0)),U,2)=0:"No",1:"") K:DIR("B")="" DIR("B")
S DIR("?")=$S(GMAOLD=0:"You may also enter @ to delete a previous NKA assessment and return the patient to a 'not assessed' state. Use this if the NKA assessment was previously incorrectly entered.",1:"") ;21
D ^DIR
I $G(X)="@" D:GMAOLD=0 CLN W:GMAOLD=0 !,"Assessment deleted." Q ;21 Allow removal of NKA
I $D(DTOUT)!$D(DIROUT) S GMRAOUT=1 Q ;36
I $D(DUOUT) S GMRAOUT=2 Q ;36
; User Hits return and doesn't answer question
I Y="",GMAOLD="" Q ;36
I Y'="",GMAOLD'=Y D
. ;Patch 1007 for SNOMED
. N DIE,DA,DR
. I Y=0 S SNOMED=160244002
. I Y=1 S SNOMED="@"
. S DIE="^GMR(120.86,",DA=DFN
. S DR=$S(GMAOLD="":(".01////"_DFN_";"),1:"")_"1////"_Y_";2////"_DUZ_";3///NOW;9999999.01///"_SNOMED ;36
. D ^DIE
. Q
Q
CLN ; Clean out entries that have not been answered.
S DIK="^GMR(120.86,",DA=DFN D ^DIK K DIK,DA
;W !?20,"Patient will still be listed as not being",!?20,"asked about Allergies/Adverse Reactions."
Q
INFO ; Info string
N GMASTR
S GMASTR(1)="Currently this patient has Causative Agents on file."
S GMASTR(2)="You will have to answer YES to this question and then"
S GMASTR(3)="indicate that each of the Causative Agents are incorrect."
S GMASTR(4)="Then you will be reasked this question and will be able"
S GMASTR(5)="to enter NO."
D WRITE^GMRADSP8(1,0,$C(7))
D WRITE^GMRADSP8(1,10,.GMASTR)
Q
NKASCR(DFN) ; Is Patient NKA (No Known Allergy)
; Input Variable:
; DFN = Patient DFN in Patient file
;
; Output Variable:
; GMA = 1 Patient is True NKA
; = 0 Patient has a reaction in file 120.8
;
; This code will screen out Entered in Error entries
S GMA=1
N GMAX
S GMAX=0
F S GMAX=$O(^GMR(120.8,"B",DFN,GMAX)) Q:GMAX<1 D Q:'GMA
.I +$G(^GMR(120.8,GMAX,"ER")) Q
.S GMA=0
.Q
Q GMA
;
DELNKA ;Remove assessment of NKA for a selected patient
N Y,DFN,DIR,DIC
S DIC=120.86,DIC(0)="AEMQZ",DIC("A")="Select PATIENT NAME: " D ^DIC Q:Y=-1
S DFN=+Y
W !
I $$NKA^GMRANKA(DFN)'=0 W !,"This patient doesn't currently have an assessment of NKA." Q
S DIR(0)="Y",DIR("A")="Delete NKA assessment for patient "_$G(Y(0,0)),DIR("B")="NO"
S DIR("?")="Enter Y to delete the NKA assessment and return the patient to a 'not assessed' status. Enter N to cancel this action."
D ^DIR
I Y=1 D CLN^GMRANKA W "...Done"
Q
GMRANKA ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT NKA DRIVE ;01-Aug-2013 16:39;DU
+1 ;;4.0;Adverse Reaction Tracking;**2,21,36,1007**;Mar 29, 1996;Build 18
NKA(DFN) ;See if patient has reaction on file
+1 ; Input Variables:
+2 ; DFN = Patient Internal Entry Number
+3 ;
+4 ; Output Variables:
+5 ; GMA = 1 Patient has known reaction
+6 ; 0 Patient has No known reaction
+7 ; Null Patient has never been asked about reaction
+8 SET GMA=""
+9 SET GMA=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
+10 QUIT GMA
+11 ;
NKAASK(DFN,GMRAOUT) ; Ask a Patient if patient has any known allergens
+1 ; Input Variables
+2 ; DFN = Patient Internal entry number
+3 ; GMRAOUT = Up Caret or time out flag
+4 ;
+5 ;Ask if patient has allergies
+6 NEW DIR,Y,DIROUT,DTOUT,DIRUT,DUOUT,GMAOLD,SNOMED
+7 SET GMAOLD=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
+8 SET DIR(0)="120.86,1^AO^I Y=0&'$$NKASCR^GMRANKA(DFN) D INFO^GMRANKA K X"
+9 SET DIR("A")="Does this patient have any known allergies or adverse reactions? "
+10 SET DIR("B")=$SELECT($PIECE($GET(^GMR(120.86,DFN,0)),U,2)=1:"Yes",$PIECE($GET(^GMR(120.86,DFN,0)),U,2)=0:"No",1:"")
IF DIR("B")=""
KILL DIR("B")
+11 ;21
SET DIR("?")=$SELECT(GMAOLD=0:"You may also enter @ to delete a previous NKA assessment and return the patient to a 'not assessed' state. Use this if the NKA assessment was previously incorrectly entered.",1:"")
+12 DO ^DIR
+13 ;21 Allow removal of NKA
IF $GET(X)="@"
IF GMAOLD=0
DO CLN
IF GMAOLD=0
WRITE !,"Assessment deleted."
QUIT
+14 ;36
IF $DATA(DTOUT)!$DATA(DIROUT)
SET GMRAOUT=1
QUIT
+15 ;36
IF $DATA(DUOUT)
SET GMRAOUT=2
QUIT
+16 ; User Hits return and doesn't answer question
+17 ;36
IF Y=""
IF GMAOLD=""
QUIT
+18 IF Y'=""
IF GMAOLD'=Y
Begin DoDot:1
+19 ;Patch 1007 for SNOMED
+20 NEW DIE,DA,DR
+21 IF Y=0
SET SNOMED=160244002
+22 IF Y=1
SET SNOMED="@"
+23 SET DIE="^GMR(120.86,"
SET DA=DFN
+24 ;36
SET DR=$SELECT(GMAOLD="":(".01////"_DFN_";"),1:"")_"1////"_Y_";2////"_DUZ_";3///NOW;9999999.01///"_SNOMED
+25 DO ^DIE
+26 QUIT
End DoDot:1
+27 QUIT
CLN ; Clean out entries that have not been answered.
+1 SET DIK="^GMR(120.86,"
SET DA=DFN
DO ^DIK
KILL DIK,DA
+2 ;W !?20,"Patient will still be listed as not being",!?20,"asked about Allergies/Adverse Reactions."
+3 QUIT
INFO ; Info string
+1 NEW GMASTR
+2 SET GMASTR(1)="Currently this patient has Causative Agents on file."
+3 SET GMASTR(2)="You will have to answer YES to this question and then"
+4 SET GMASTR(3)="indicate that each of the Causative Agents are incorrect."
+5 SET GMASTR(4)="Then you will be reasked this question and will be able"
+6 SET GMASTR(5)="to enter NO."
+7 DO WRITE^GMRADSP8(1,0,$CHAR(7))
+8 DO WRITE^GMRADSP8(1,10,.GMASTR)
+9 QUIT
NKASCR(DFN) ; Is Patient NKA (No Known Allergy)
+1 ; Input Variable:
+2 ; DFN = Patient DFN in Patient file
+3 ;
+4 ; Output Variable:
+5 ; GMA = 1 Patient is True NKA
+6 ; = 0 Patient has a reaction in file 120.8
+7 ;
+8 ; This code will screen out Entered in Error entries
+9 SET GMA=1
+10 NEW GMAX
+11 SET GMAX=0
+12 FOR
SET GMAX=$ORDER(^GMR(120.8,"B",DFN,GMAX))
IF GMAX<1
QUIT
Begin DoDot:1
+13 IF +$GET(^GMR(120.8,GMAX,"ER"))
QUIT
+14 SET GMA=0
+15 QUIT
End DoDot:1
IF 'GMA
QUIT
+16 QUIT GMA
+17 ;
DELNKA ;Remove assessment of NKA for a selected patient
+1 NEW Y,DFN,DIR,DIC
+2 SET DIC=120.86
SET DIC(0)="AEMQZ"
SET DIC("A")="Select PATIENT NAME: "
DO ^DIC
IF Y=-1
QUIT
+3 SET DFN=+Y
+4 WRITE !
+5 IF $$NKA^GMRANKA(DFN)'=0
WRITE !,"This patient doesn't currently have an assessment of NKA."
QUIT
+6 SET DIR(0)="Y"
SET DIR("A")="Delete NKA assessment for patient "_$GET(Y(0,0))
SET DIR("B")="NO"
+7 SET DIR("?")="Enter Y to delete the NKA assessment and return the patient to a 'not assessed' status. Enter N to cancel this action."
+8 DO ^DIR
+9 IF Y=1
DO CLN^GMRANKA
WRITE "...Done"
+10 QUIT
