Routine: GMRAMRG

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAMRG   2335     printed  Apr 09, 2024@20:45                                                                                                                                                                                                        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

GMRAMRG.m