GMRAMRG ;ALB/RDK - GMRA*4.0*43; PRE MERGE ALLERGY VALIDATION ; 4/25/13 12:04pm
;;4.0;Adverse Reaction Tracking;**43,66**;Mar 29, 1996;Build 1
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EN(GMRAINPT) ; Entry point
; Called during patient (file #2) merge due to AFFECTS RECORD MERGE
; in PACKAGE (#9.4) file.
; Input
; GMRAINPT - name of array with the PATIENT (#2) From IENs and To IENs
; format: name(ien_from,ien_to,"ien_from;DPT(","ien_to;DPT(")
; example: TEST(1000,500,"1000;DPT(","500;DPT(")=""
;
N GMRAFR,GMRATO,GMRAYES,GMRACHKF,GMRACHKT
; loop thru from ien of patients (file #2) being merged
S GMRAFR=0 F S GMRAFR=$O(@GMRAINPT@(GMRAFR)) Q:GMRAFR'>0 D
. S GMRATO=$O(@GMRAINPT@(GMRAFR,0)) ; to ien
. ; check to see if a patient has allergies and the flag is set
. D ASSESS
Q
;
ASSESS ; File 120.86 ADVERSE REACTION ASSESSMENT -
; The .01 field points to and is dinumed with the PATIENT (#2) file
;
; GMRAFR - ien of patient (files #2,120.86) being merged from
; GMRATO - ien of patient (files #2,120.86) being merged to
;
; Fixing issue wih .01 not converting to GMRATO after merge when TO patient does not have an entry in 120.86 and FROM does
I GMRATO,$D(^GMR(120.86,GMRAFR,0)),'$D(^GMR(120.86,GMRATO,0)) D Q
. N DIC,DA,DR,DINUM,X,Y,DD,DO,DLAYGO
. S DIC="^GMR(120.86,",(DINUM,X)=GMRATO,DIC(0)=""
. S DIC("DR")="1////"_$$GET1^DIQ(120.86,GMRAFR,1,"I")_";2////"_$$GET1^DIQ(120.86,GMRAFR,2,"I")_";3////"_$$GET1^DIQ(120.86,GMRAFR,3,"I")
. S DLAYGO=120.86 K DD,DO D FILE^DICN
;
; if merge FROM or TO has allergies, set the TO assessment to
; 'has allergies' and quit
S GMRACHKF=$$NKASCR^GMRANKA(GMRAFR),GMRACHKT=$$NKASCR^GMRANKA(GMRATO)
I 'GMRACHKF!('GMRACHKT) S $P(^GMR(120.86,GMRATO,0),U,2)=1 Q
;
; if merge FROM or TO does not have allergies and if either has an
; assessment of 'NKA', set TO assessment to NKA and quit
S GMRAYES=0
I GMRACHKF,($P($G(^GMR(120.86,GMRAFR,0)),U,2)=1) S GMRAYES=1
I GMRACHKT,($P($G(^GMR(120.86,GMRATO,0)),U,2)=1) S GMRAYES=1
I GMRAYES S $P(^GMR(120.86,GMRATO,0),U,2)=1 Q
;
; if it falls through here, the patient doesn't have allergies and no
; assessment was set we will not alter any of this since an assessment
; has not been performed
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAMRG 2335 printed Sep 23, 2025@19:15:33 Page 2
GMRAMRG ;ALB/RDK - GMRA*4.0*43; PRE MERGE ALLERGY VALIDATION ; 4/25/13 12:04pm
+1 ;;4.0;Adverse Reaction Tracking;**43,66**;Mar 29, 1996;Build 1
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN(GMRAINPT) ; Entry point
+1 ; Called during patient (file #2) merge due to AFFECTS RECORD MERGE
+2 ; in PACKAGE (#9.4) file.
+3 ; Input
+4 ; GMRAINPT - name of array with the PATIENT (#2) From IENs and To IENs
+5 ; format: name(ien_from,ien_to,"ien_from;DPT(","ien_to;DPT(")
+6 ; example: TEST(1000,500,"1000;DPT(","500;DPT(")=""
+7 ;
+8 NEW GMRAFR,GMRATO,GMRAYES,GMRACHKF,GMRACHKT
+9 ; loop thru from ien of patients (file #2) being merged
+10 SET GMRAFR=0
FOR
SET GMRAFR=$ORDER(@GMRAINPT@(GMRAFR))
if GMRAFR'>0
QUIT
Begin DoDot:1
+11 ; to ien
SET GMRATO=$ORDER(@GMRAINPT@(GMRAFR,0))
+12 ; check to see if a patient has allergies and the flag is set
+13 DO ASSESS
End DoDot:1
+14 QUIT
+15 ;
ASSESS ; File 120.86 ADVERSE REACTION ASSESSMENT -
+1 ; The .01 field points to and is dinumed with the PATIENT (#2) file
+2 ;
+3 ; GMRAFR - ien of patient (files #2,120.86) being merged from
+4 ; GMRATO - ien of patient (files #2,120.86) being merged to
+5 ;
+6 ; Fixing issue wih .01 not converting to GMRATO after merge when TO patient does not have an entry in 120.86 and FROM does
+7 IF GMRATO
IF $DATA(^GMR(120.86,GMRAFR,0))
IF '$DATA(^GMR(120.86,GMRATO,0))
Begin DoDot:1
+8 NEW DIC,DA,DR,DINUM,X,Y,DD,DO,DLAYGO
+9 SET DIC="^GMR(120.86,"
SET (DINUM,X)=GMRATO
SET DIC(0)=""
+10 SET DIC("DR")="1////"_$$GET1^DIQ(120.86,GMRAFR,1,"I")_";2////"_$$GET1^DIQ(120.86,GMRAFR,2,"I")_";3////"_$$GET1^DIQ(120.86,GMRAFR,3,"I")
+11 SET DLAYGO=120.86
KILL DD,DO
DO FILE^DICN
End DoDot:1
QUIT
+12 ;
+13 ; if merge FROM or TO has allergies, set the TO assessment to
+14 ; 'has allergies' and quit
+15 SET GMRACHKF=$$NKASCR^GMRANKA(GMRAFR)
SET GMRACHKT=$$NKASCR^GMRANKA(GMRATO)
+16 IF 'GMRACHKF!('GMRACHKT)
SET $PIECE(^GMR(120.86,GMRATO,0),U,2)=1
QUIT
+17 ;
+18 ; if merge FROM or TO does not have allergies and if either has an
+19 ; assessment of 'NKA', set TO assessment to NKA and quit
+20 SET GMRAYES=0
+21 IF GMRACHKF
IF ($PIECE($GET(^GMR(120.86,GMRAFR,0)),U,2)=1)
SET GMRAYES=1
+22 IF GMRACHKT
IF ($PIECE($GET(^GMR(120.86,GMRATO,0)),U,2)=1)
SET GMRAYES=1
+23 IF GMRAYES
SET $PIECE(^GMR(120.86,GMRATO,0),U,2)=1
QUIT
+24 ;
+25 ; if it falls through here, the patient doesn't have allergies and no
+26 ; assessment was set we will not alter any of this since an assessment
+27 ; has not been performed
+28 QUIT
