GMRA66PI ;BIR/MFR - Clean up for problematic 120.86 records after patient merge ; 05/03/21 13:52
;;4.0;Adverse Reaction Tracking;**66**;Mar 29, 1996;Build 1
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;
EN ; Fix ADVERSE REACTION ASSESSMENT (#120.86) records
N DFN,DFN01,VADM,X,L4SSN
S GMRALINE=0 K ^TMP("GMRA66PI",$J)
D SETTXT("When two patients are merged there is a possibility that the ADVERSE REACTION")
D SETTXT("ASSESSMENT file (#120.86) entry for the 'TO' patient (patient that remains")
D SETTXT("after the merge is complete) is corrupt.")
D SETTXT(" ")
D SETTXT("The patch GMRA*4*66 addressed the problem caused by the Kernel Patient Merge")
D SETTXT("Utility and also fixed all the patients on file that currently have this")
D SETTXT("problem at your site (if any). See list below:")
D SETTXT("-------------------------------------------------------------------------------")
D SETTXT("PATIENT WRONG DFN VALUE CORRECT DFN VALUE")
D SETTXT("-------------------------------------------------------------------------------")
D BMES^XPDUTL(" Starting post-install for GMRA*4*66")
;
S (DFN,FOUND)=0
F S DFN=$O(^GMR(120.86,DFN)) Q:'DFN D
. S DFN01=$P($G(^GMR(120.86,DFN,0)),"^",1) I 'DFN01!(DFN01=DFN) Q
. D BMES^XPDUTL(" Fixing entry #"_DFN_"...")
. S $P(^GMR(120.86,DFN,0),"^",1)=DFN
. S ^GMR(120.86,"B",DFN,DFN)=""
. K ^GMR(120.86,"B",DFN01,DFN)
. K VADM D DEM^VADPT S L4SSN=$P($P(VADM(2),"^",2),"-",3)
. S X=$P(VADM(1),"^")_" ("_L4SSN_")",$E(X,49)=DFN01,$E(X,68)=DFN
. D SETTXT(X) S FOUND=1
;
I FOUND D
. D SETTXT(" ")
. D SETTXT("End of report.")
E D
. D SETTXT("No problem found.")
;
D SETTXT(" "),SETTXT("Please, run the Assessment clean up utility option [GMRA ASSESSMENT UTILITY]")
D SETTXT("and address any remaining entries on the list.")
D MAIL
;
D BMES^XPDUTL(" Mailman message sent.")
D BMES^XPDUTL(" Post-install completed for GMRA*4*66")
;
END ; Exit point
K ^TMP("GMRA66PI",$J)
Q
;
SETTXT(TXT) ; Setting Plain Text
S GMRALINE=$G(GMRALINE)+1,^TMP("GMRA66PI",$J,GMRALINE)=TXT
Q
;
SETRX(RXIEN,DOSE,UNITS,STREN) ; Setting Rx Line
N TXTLN
S $E(TXTLN,3)=$$GET1^DIQ(52,RXIEN,.01),$E(TXTLN,16)=$E($$GET1^DIQ(52,RXIEN,6),1,30)
S $E(TXTLN,48)=$J(DOSE,7),$E(TXTLN,62)=$J(UNITS,4),$E(TXTLN,73)=$J(STREN,5)
S GMRALINE=$G(GMRALINE)+1,^TMP("GMRA66PI",$J,GMRALINE)=TXTLN
Q
;
MAIL ; Sends Mailman message
N II,XMX,XMSUB,XMDUZ,XMTEXT,XMY
S II=0 F S II=$O(^XUSEC("PSNMGR",II)) Q:'II S XMY(II)=""
S XMY(DUZ)="",XMSUB="GMRA*4*66 - ADVERSE REACTION ASSESSMENT file (#120.86) Clean-up"
S XMDUZ=.5,XMTEXT="^TMP(""GMRA66PI"",$J," N DIFROM D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRA66PI 2741 printed Sep 23, 2025@19:14:40 Page 2
GMRA66PI ;BIR/MFR - Clean up for problematic 120.86 records after patient merge ; 05/03/21 13:52
+1 ;;4.0;Adverse Reaction Tracking;**66**;Mar 29, 1996;Build 1
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
EN ; Fix ADVERSE REACTION ASSESSMENT (#120.86) records
+1 NEW DFN,DFN01,VADM,X,L4SSN
+2 SET GMRALINE=0
KILL ^TMP("GMRA66PI",$JOB)
+3 DO SETTXT("When two patients are merged there is a possibility that the ADVERSE REACTION")
+4 DO SETTXT("ASSESSMENT file (#120.86) entry for the 'TO' patient (patient that remains")
+5 DO SETTXT("after the merge is complete) is corrupt.")
+6 DO SETTXT(" ")
+7 DO SETTXT("The patch GMRA*4*66 addressed the problem caused by the Kernel Patient Merge")
+8 DO SETTXT("Utility and also fixed all the patients on file that currently have this")
+9 DO SETTXT("problem at your site (if any). See list below:")
+10 DO SETTXT("-------------------------------------------------------------------------------")
+11 DO SETTXT("PATIENT WRONG DFN VALUE CORRECT DFN VALUE")
+12 DO SETTXT("-------------------------------------------------------------------------------")
+13 DO BMES^XPDUTL(" Starting post-install for GMRA*4*66")
+14 ;
+15 SET (DFN,FOUND)=0
+16 FOR
SET DFN=$ORDER(^GMR(120.86,DFN))
if 'DFN
QUIT
Begin DoDot:1
+17 SET DFN01=$PIECE($GET(^GMR(120.86,DFN,0)),"^",1)
IF 'DFN01!(DFN01=DFN)
QUIT
+18 DO BMES^XPDUTL(" Fixing entry #"_DFN_"...")
+19 SET $PIECE(^GMR(120.86,DFN,0),"^",1)=DFN
+20 SET ^GMR(120.86,"B",DFN,DFN)=""
+21 KILL ^GMR(120.86,"B",DFN01,DFN)
+22 KILL VADM
DO DEM^VADPT
SET L4SSN=$PIECE($PIECE(VADM(2),"^",2),"-",3)
+23 SET X=$PIECE(VADM(1),"^")_" ("_L4SSN_")"
SET $EXTRACT(X,49)=DFN01
SET $EXTRACT(X,68)=DFN
+24 DO SETTXT(X)
SET FOUND=1
End DoDot:1
+25 ;
+26 IF FOUND
Begin DoDot:1
+27 DO SETTXT(" ")
+28 DO SETTXT("End of report.")
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 DO SETTXT("No problem found.")
End DoDot:1
+31 ;
+32 DO SETTXT(" ")
DO SETTXT("Please, run the Assessment clean up utility option [GMRA ASSESSMENT UTILITY]")
+33 DO SETTXT("and address any remaining entries on the list.")
+34 DO MAIL
+35 ;
+36 DO BMES^XPDUTL(" Mailman message sent.")
+37 DO BMES^XPDUTL(" Post-install completed for GMRA*4*66")
+38 ;
END ; Exit point
+1 KILL ^TMP("GMRA66PI",$JOB)
+2 QUIT
+3 ;
SETTXT(TXT) ; Setting Plain Text
+1 SET GMRALINE=$GET(GMRALINE)+1
SET ^TMP("GMRA66PI",$JOB,GMRALINE)=TXT
+2 QUIT
+3 ;
SETRX(RXIEN,DOSE,UNITS,STREN) ; Setting Rx Line
+1 NEW TXTLN
+2 SET $EXTRACT(TXTLN,3)=$$GET1^DIQ(52,RXIEN,.01)
SET $EXTRACT(TXTLN,16)=$EXTRACT($$GET1^DIQ(52,RXIEN,6),1,30)
+3 SET $EXTRACT(TXTLN,48)=$JUSTIFY(DOSE,7)
SET $EXTRACT(TXTLN,62)=$JUSTIFY(UNITS,4)
SET $EXTRACT(TXTLN,73)=$JUSTIFY(STREN,5)
+4 SET GMRALINE=$GET(GMRALINE)+1
SET ^TMP("GMRA66PI",$JOB,GMRALINE)=TXTLN
+5 QUIT
+6 ;
MAIL ; Sends Mailman message
+1 NEW II,XMX,XMSUB,XMDUZ,XMTEXT,XMY
+2 SET II=0
FOR
SET II=$ORDER(^XUSEC("PSNMGR",II))
if 'II
QUIT
SET XMY(II)=""
+3 SET XMY(DUZ)=""
SET XMSUB="GMRA*4*66 - ADVERSE REACTION ASSESSMENT file (#120.86) Clean-up"
+4 SET XMDUZ=.5
SET XMTEXT="^TMP(""GMRA66PI"",$J,"
NEW DIFROM
DO ^XMD
+5 QUIT
