GMRANKA ;HIRMFO/WAA - ALLERGY/ADVERSE REACTION PATIENT NKA DRIVE ;04/13/2017 13:21
;;4.0;Adverse Reaction Tracking;**2,21,36,48,54,60**;Mar 29, 1996;Build 13
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
N GMRAIEN
S GMA="",GMRAIEN=+$O(^GMR(120.86,"B",DFN,0))
S:GMRAIEN>0 GMA=$P($G(^GMR(120.86,GMRAIEN,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,GMRAIEN
S GMRAIEN=+$O(^GMR(120.86,"B",DFN,0))
S GMAOLD=$S(GMRAIEN>0:$P($G(^GMR(120.86,GMRAIEN,0)),U,2),1:"")
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(GMAOLD=1:"Yes",GMAOLD=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
; P60 update GMRAIEN,GMAOLD as record may have been added durring read
S GMRAIEN=+$O(^GMR(120.86,"B",DFN,0))
S GMAOLD=$S(GMRAIEN>0:$P($G(^GMR(120.86,GMRAIEN,0)),U,2),1:"")
; User Hits return and doesn't answer question
I Y="",GMAOLD="" Q ;36
I Y'="",GMAOLD'=Y D
. N DIE,DA,DR,DO,DIC,X,DINUM
. I 'GMRAIEN D
. . S DIC="^GMR(120.86,",DIC(0)="",X=DFN,DIC("DR")="1////"_Y_";2////"_DUZ_";3///NOW"
. . S DA=DFN,DINUM=DFN
. . D FILE^DICN
. I GMRAIEN>0 D
. . S DIE="^GMR(120.86,",DA=GMRAIEN,DR=$S(GMAOLD=""&($P($G(^GMR(120.86,GMRAIEN,0)),"^")'=GMRAIEN):(".01////"_DFN_";"),1:"")_"1////"_Y_";2////"_DUZ_";3///NOW" ;36,54
. . D ^DIE
. Q
Q
CLN ; Clean out entries that have not been answered.
S DIK="^GMR(120.86,",DA=$S($G(GMRAIEN)>0:GMRAIEN,1:DFN) D ^DIK K DIK,DA
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRANKA 3756 printed Nov 22, 2024@16:49:48 Page 2
GMRANKA ;HIRMFO/WAA - ALLERGY/ADVERSE REACTION PATIENT NKA DRIVE ;04/13/2017 13:21
+1 ;;4.0;Adverse Reaction Tracking;**2,21,36,48,54,60**;Mar 29, 1996;Build 13
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 NEW GMRAIEN
+9 SET GMA=""
SET GMRAIEN=+$ORDER(^GMR(120.86,"B",DFN,0))
+10 if GMRAIEN>0
SET GMA=$PIECE($GET(^GMR(120.86,GMRAIEN,0)),U,2)
+11 QUIT GMA
+12 ;
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,GMRAIEN
+7 SET GMRAIEN=+$ORDER(^GMR(120.86,"B",DFN,0))
+8 SET GMAOLD=$SELECT(GMRAIEN>0:$PIECE($GET(^GMR(120.86,GMRAIEN,0)),U,2),1:"")
+9 SET DIR(0)="120.86,1^AO^I Y=0&'$$NKASCR^GMRANKA(DFN) D INFO^GMRANKA K X"
+10 SET DIR("A")="Does this patient have any known allergies or adverse reactions? "
+11 SET DIR("B")=$SELECT(GMAOLD=1:"Yes",GMAOLD=0:"No",1:"")
if DIR("B")=""
KILL DIR("B")
+12 ;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:"")
+13 DO ^DIR
+14 ;21 Allow removal of NKA
IF $GET(X)="@"
if GMAOLD=0
DO CLN
if GMAOLD=0
WRITE !,"Assessment deleted."
QUIT
+15 ;36
IF $DATA(DTOUT)!$DATA(DIROUT)
SET GMRAOUT=1
QUIT
+16 ;36
IF $DATA(DUOUT)
SET GMRAOUT=2
QUIT
+17 ; P60 update GMRAIEN,GMAOLD as record may have been added durring read
+18 SET GMRAIEN=+$ORDER(^GMR(120.86,"B",DFN,0))
+19 SET GMAOLD=$SELECT(GMRAIEN>0:$PIECE($GET(^GMR(120.86,GMRAIEN,0)),U,2),1:"")
+20 ; User Hits return and doesn't answer question
+21 ;36
IF Y=""
IF GMAOLD=""
QUIT
+22 IF Y'=""
IF GMAOLD'=Y
Begin DoDot:1
+23 NEW DIE,DA,DR,DO,DIC,X,DINUM
+24 IF 'GMRAIEN
Begin DoDot:2
+25 SET DIC="^GMR(120.86,"
SET DIC(0)=""
SET X=DFN
SET DIC("DR")="1////"_Y_";2////"_DUZ_";3///NOW"
+26 SET DA=DFN
SET DINUM=DFN
+27 DO FILE^DICN
End DoDot:2
+28 IF GMRAIEN>0
Begin DoDot:2
+29 ;36,54
SET DIE="^GMR(120.86,"
SET DA=GMRAIEN
SET DR=$SELECT(GMAOLD=""&($PIECE($GET(^GMR(120.86,GMRAIEN,0)),"^")'=GMRAIEN):(".01////"_DFN_";"),1:"")_"1////"_Y_";2////"_DUZ_";3///NOW"
+30 DO ^DIE
End DoDot:2
+31 QUIT
End DoDot:1
+32 QUIT
CLN ; Clean out entries that have not been answered.
+1 SET DIK="^GMR(120.86,"
SET DA=$SELECT($GET(GMRAIEN)>0:GMRAIEN,1:DFN)
DO ^DIK
KILL DIK,DA
+2 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
