GMRAY40 ;SLC/DAN Installation Utilities ;7/10/07 12:38
;;4.0;Adverse Reaction Tracking;**40**;Mar 29, 1996;Build 2
;
;DBIA SECTION
;3744 - $$TESTPAT^VADPT
;10061 - VADPT
;10013 - DIK
;2056 - DIQ
;10018 - DIE
;10070 - XMD
;10103 - XLFDT
;2051 - DIC
;
PRETRAN ;Load conversion table into KIDS build
M @XPDGREF@("GMRAFIX40")=^XTMP("GMRAFIX40")
Q
;
POST ;Post installation processes
K ^XTMP("GMRAFIX40")
M ^XTMP("GMRAFIX40")=@XPDGREF@("GMRAFIX40")
I '$D(^XTMP("GMRAFIX40")) W !,"Conversion table not loaded - INSTALLATION ABORTED" S XPDQUIT=2 Q
D Q Q ;Queue clean up to background
;
Q ;
N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
S ZTRTN="DQ^GMRAY40",ZTDESC="GMRA*4*40 POST INSTALL ROUTINE",ZTIO="",ZTDTH=$H
D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^GMRAY40 AFTER INSTALL FINISHES") Q
D BMES^XPDUTL("Post-install queued as task # "_$G(ZTSK))
Q
;
DQ ;Process begins here
N ERR,TU,TE,TF
D FIXB
D FIXALG
D MAIL
S ^XTMP("GMRAFIX40",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^Patch GMRA*4*40 conversion table"
K ^XTMP("GMRAFX","FREE") ;Kill free text list so it forces rebuild
Q
;
FIXB ;Kill and reset "B" xref on file 120.8 to be sure it's correct
N DIK
K ^GMR(120.8,"B")
S DIK="^GMR(120.8,"
S DIK(1)=".01^B"
D ENALL^DIK ;Resets B xref
Q
;
FIXALG ;Loop through 120.8 update existing free text entries
N GMRAI,FREE,REACTANT,ENTRY,GMRAR
S GMRAI=0 F S GMRAI=$O(^GMR(120.8,GMRAI)) Q:'+GMRAI D
.I '$D(^GMR(120.8,GMRAI,0))!($L($G(^GMR(120.8,GMRAI,0)),"^")=1) D DEL Q
.Q:+$G(^GMR(120.8,GMRAI,"ER"))!($$TESTPAT^VADPT($P(^GMR(120.8,GMRAI,0),U)))!($$DECEASED^GMRAFX($P(^GMR(120.8,GMRAI,0),U))) ;stop if entered in error, test patient or deceased patient
.S REACTANT=$P(^GMR(120.8,GMRAI,0),U,2)
.I REACTANT["ANGIOTEN"&(REACTANT["( FREE TEXT )") D Q
..S GMRAR=$$UP^XLFSTR($E($P(REACTANT," ( FREE TEXT )"),1,30)) ;Get just term
..S ENTRY=$G(^XTMP("GMRAFIX40",GMRAR)) ;Is entry in the table
..I ENTRY="" Q ;Entry not found or designated free text - leave alone
..D UPDATE ;Update entry from table
.I REACTANT="ACE INHIBITORS" S GMRAR=REACTANT I $$CHANGED(.GMRAR) D
..S GMRAR=$E(GMRAR,1,30) ;Get 1st 30 chars of term
..S ENTRY=$G(^XTMP("GMRAFIX40",GMRAR))
..I ENTRY="",$D(^XTMP("GMRAFIX40",GMRAR)) S REACTANT=GMRAR D UPDATEF Q ;Convert term to FREE TEXT as it should have been
..I $D(^XTMP("GMRAFIX40",GMRAR)) D UPDATE
Q
;
DEL ;No zero node, remove entry
N DIK,DA,GMRADONT
S GMRADONT=1 ;Stop HDR from receiving update as it's not needed
S DIK="^GMR(120.8,",DA=GMRAI
D ^DIK
Q
;
UPDATEF ;Update reactant to say free text so users know it isn't a standardized entry
N FDA,COM,FREE
S FREE=$O(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0)),FREE=FREE_";GMRD(120.82,"
Q:$G(REACTANT)["FREE TEXT" ;Already updated to free text, can skip.
S REACTANT=REACTANT_" ( FREE TEXT )"
S FDA(120.8,(GMRAI_","),.02)=REACTANT
S FDA(120.8,(GMRAI_","),1)=FREE
D FILE^DIE(,"FDA")
S TF=$G(TF)+1 ;Increment total free text updated counter
S COM="Updated using the auto clean up process from GMRA*4*40. Changed reactant from ACE INIHIBITORS (file - 50.605) to "_REACTANT
D ADCOM^GMRAFX(GMRAI,"O",COM)
Q
;
UPDATEE ;Mark as entered in error, check for NKA
N DIE,DA,DR,DFN,USER,TIME
S DFN=$P(^GMR(120.8,GMRAI,0),U) ;Patient's IEN
S USER=$P(^GMR(120.8,GMRAI,0),U,5),TIME=$P(^(0),U,4)
S DIE="^GMR(120.8,",DA=GMRAI,DR="22///1;23///NOW;24////"_$G(DUZ,.5)
D ^DIE ;Entry is now entered in error
D ADCOM^GMRAFX(GMRAI,"E","Marked entered in error by auto-update in patch GMRA*4*40") ;Adds comment to allergy record
I $$NKASCR^GMRANKA(DFN) D
.I $P(ENTRY,U,2)="NKDA" S DA=DFN,DIE="^GMR(120.86,",DR="1////0;2////"_$G(USER,DUZ)_";3////"_$G(TIME,$$NOW^XLFDT) D ^DIE Q ;Set assessment to NKA
.D CLN^GMRANKA ;Delete assessment
S TE=$G(TE)+1 ;Increment total entered in error counter
Q
;
UPDATE ;Update free text entry to data found in table
N DFN,DIE,DA,DR,AIFN,COM,SIEN,FILE,NAME,IEN,GMRAAR,GMRAPA,GMRASCR,ERRCODE
S DFN=$P(^GMR(120.8,GMRAI,0),U)
S GMRAPA=GMRAI
S FILE=$P(ENTRY,U),NAME=$P(ENTRY,U,2)
S IEN=$$FIND1^DIC(FILE,"",$S(FILE=120.82:"X",1:"MX"),NAME,$S(FILE=120.82:"B",1:""),,"ERRCODE")
I '+IEN S IEN=$$FIND1^DIC(FILE,"","MX",NAME_" ","",,"ERRCODE")
I '+IEN,NAME="ANTIMUSCARINICS/ANTISPASMODICS" S IEN=$$FIND1^DIC(FILE,"","MX","GA801","",,"ERRCODE")
I '+IEN,$L($T(SCREEN^XTID)) S GMRASCR="I '$$SCREEN^XTID(FILE,,Y_"","")" S IEN=$$FIND1^DIC(FILE,"","MX",NAME,"",$G(GMRASCR),"ERRCODE")
I '+IEN S ERR(2,DFN,REACTANT)=ENTRY D UPDATEF Q
S GMRAAR=IEN_";"_$S(FILE=50:"PSDRUG(",FILE=50.416:"PS(50.416,",FILE=50.605:"PS(50.605,",FILE=120.82:"GMRD(120.82,",1:"PSNDF(50.6,")
S GMRAAR(0)=NAME
S GMRAAR("O")=$S(FILE=120.82:$P(^GMRD(120.82,IEN,0),U,2),1:"D")
I $$DUP^GMRAFX3 S ERR(3,DFN,REACTANT)=ENTRY D UPDATEF Q ;Would create a duplicate if update occur
;Update reactant, allergy and signed off fields
S DIE="^GMR(120.8,",DA=GMRAPA,DR=".02////"_GMRAAR(0)_";1////^S X=GMRAAR"_";3.1////"_GMRAAR("O")_";15///1" D ^DIE
I $D(^GMR(120.85,"C",GMRAPA)) D ;Observed reaction, need to update data
.S AIFN=0
.F S AIFN=$O(^GMR(120.85,"C",GMRAPA,AIFN)) Q:'+AIFN D
..S SIEN=$O(^GMR(120.85,AIFN,3,"B",REACTANT,0)) Q:'+SIEN ;Was previous reactant stored as "suspected agent"
..S DA(1)=AIFN,DA=SIEN
..S DIE="^GMR(120.85,DA(1),3,",DR=".01////^S X=GMRAAR(0)" D ^DIE ;Update suspected agent to new value
D DELMUL^GMRAFX3(2),DELMUL^GMRAFX3(3) ;Delete drug ingredient/drug classes multiples
I GMRAAR("O")["D" D UPDATE^GMRAPES1 K LIST ;If reactant type is Drug then add appropriate ingredients and classes
S COM="Updated using auto clean up process from GMRA*4*40. Changed reactant from ACE INHIBITORS (file - 50.605) to "_GMRAAR(0)_" (file - "_$P(GMRAAR,";",2)_")"
D ADCOM^GMRAFX(GMRAPA,"O",COM) ;Add a comment for this update
S TU=$G(TU)+1 ;Increment total updated counter
Q
;
MAIL ;Send message indicating post install is finished
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,CNT,VADM,DFN,REACTANT,LOOP,DIFROM,EXTRA
S XMDUZ="PATCH GMRA*4*40 POST-INSTALL"
S XMY("DAVID.NABER@DOMAIN.EXT")="",XMY("CATHERINE.HOANG2@DOMAIN.EXT")=""
S XMY("HULET.LEE_ANN@DOMAIN.EXT")="",XMY("KEN.BARLOW@DOMAIN.EXT")=""
S EXTRA=($D(ERR(2))!($D(ERR(3))))
I 'EXTRA S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S CNT=1
S GMRATXT(CNT)="The post-install routine for patch GMRA*4*40",CNT=CNT+1
S GMRATXT(CNT)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_".",CNT=CNT+1
S GMRATXT(CNT)="",CNT=CNT+1
I $G(ERR)=1 D
.S GMRATXT(CNT)="**NOTE: There was a problem with the installation!",CNT=CNT+1
.S GMRATXT(CNT)="Required entry missing from file 120.82 - CONVERSION ABORTED.",CNT=CNT+1
.S GMRATXT(CNT)="Contact the National Help Desk for Immediate assistance.",CNT=CNT+1
I $G(TU)!($G(TE))!($G(TF)) D
.S GMRATXT(CNT)="Here are the results of the update:",CNT=CNT+1
.S GMRATXT(CNT)="",CNT=CNT+1
.F LOOP="TU","TF","TE" D
..S GMRATXT(CNT)=$S(+$G(@LOOP)=0:"No entries were",$G(@LOOP)=1:"One entry was",1:$G(@LOOP)_" entries were")_" "
..S GMRATXT(CNT)=GMRATXT(CNT)_$S(LOOP="TU":"updated to new terms",LOOP="TF":"updated to have (FREE TEXT) appended to the term",1:"marked entered in error")_".",CNT=CNT+1
.S GMRATXT(CNT)="",CNT=CNT+1
S XMTEXT="GMRATXT(",XMSUB="PATCH GMRA*4*40 Post Install COMPLETED"
D ^XMD ;Send totals to OI reps, include local if no problems
F LOOP=2,3 D
.I $D(ERR(LOOP)) D
..S GMRATXT(CNT)="The following patients have allergies that couldn't be converted",CNT=CNT+1
..S GMRATXT(CNT)=$S(LOOP=2:"because the term to update them to couldn't be found in the local files.",1:"because it would create a duplicate entry."),CNT=CNT+1
..S GMRATXT(CNT)="",CNT=CNT+1
..S DFN=0 F S DFN=$O(ERR(LOOP,DFN)) Q:'+DFN D
...K VADM D DEM^VADPT
...S GMRATXT(CNT)="PATIENT: "_VADM(1)_" ("_$E(VADM(2),6,9)_")",CNT=CNT+1
...S REACTANT="" F S REACTANT=$O(ERR(LOOP,DFN,REACTANT)) Q:REACTANT="" D
....S GMRATXT(CNT)="Can't convert "_REACTANT_" to "_$P(ERR(LOOP,DFN,REACTANT),U,2)_" (file: "_$P(ERR(LOOP,DFN,REACTANT),U)_")",CNT=CNT+1
...S GMRATXT(CNT)="",CNT=CNT+1
..S $P(GMRATXT(CNT),"*",70)="*",CNT=CNT+1,GMRATXT(CNT)="",CNT=CNT+1
I EXTRA D
.K XMY S XMY(.5)="" S:$G(DUZ) XMY(DUZ)="" ;Send full report to local site only
.S XMTEXT="GMRATXT(",XMSUB="PATCH GMRA*4*40 Post Install COMPLETED"
.D ^XMD
Q
;
CHANGED(GMRAR) ;Was entry changed by patch 29?
N CHANGED,SUB
S CHANGED=0
S SUB=0 F S SUB=$O(^GMR(120.8,GMRAI,26,SUB)) Q:'+SUB!(CHANGED) D
.I $G(^GMR(120.8,GMRAI,26,SUB,2,1,0))["GMRA*4*29" S GMRAR=$$UP^XLFSTR($P($P(^GMR(120.8,GMRAI,26,SUB,2,1,0),"reactant from ",2)," (free text)",1)) ;get term and upper case it
.I $G(^GMR(120.8,GMRAI,26,SUB,2,1,0))["GMRA*4*29",$G(GMRAR)["ANGIOTEN" S CHANGED=1
Q CHANGED
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAY40 8826 printed Sep 23, 2025@19:17:02 Page 2
GMRAY40 ;SLC/DAN Installation Utilities ;7/10/07 12:38
+1 ;;4.0;Adverse Reaction Tracking;**40**;Mar 29, 1996;Build 2
+2 ;
+3 ;DBIA SECTION
+4 ;3744 - $$TESTPAT^VADPT
+5 ;10061 - VADPT
+6 ;10013 - DIK
+7 ;2056 - DIQ
+8 ;10018 - DIE
+9 ;10070 - XMD
+10 ;10103 - XLFDT
+11 ;2051 - DIC
+12 ;
PRETRAN ;Load conversion table into KIDS build
+1 MERGE @XPDGREF@("GMRAFIX40")=^XTMP("GMRAFIX40")
+2 QUIT
+3 ;
POST ;Post installation processes
+1 KILL ^XTMP("GMRAFIX40")
+2 MERGE ^XTMP("GMRAFIX40")=@XPDGREF@("GMRAFIX40")
+3 IF '$DATA(^XTMP("GMRAFIX40"))
WRITE !,"Conversion table not loaded - INSTALLATION ABORTED"
SET XPDQUIT=2
QUIT
+4 ;Queue clean up to background
DO Q
QUIT
+5 ;
Q ;
+1 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+2 SET ZTRTN="DQ^GMRAY40"
SET ZTDESC="GMRA*4*40 POST INSTALL ROUTINE"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+3 DO ^%ZTLOAD
IF '$GET(ZTSK)
DO BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^GMRAY40 AFTER INSTALL FINISHES")
QUIT
+4 DO BMES^XPDUTL("Post-install queued as task # "_$GET(ZTSK))
+5 QUIT
+6 ;
DQ ;Process begins here
+1 NEW ERR,TU,TE,TF
+2 DO FIXB
+3 DO FIXALG
+4 DO MAIL
+5 SET ^XTMP("GMRAFIX40",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^Patch GMRA*4*40 conversion table"
+6 ;Kill free text list so it forces rebuild
KILL ^XTMP("GMRAFX","FREE")
+7 QUIT
+8 ;
FIXB ;Kill and reset "B" xref on file 120.8 to be sure it's correct
+1 NEW DIK
+2 KILL ^GMR(120.8,"B")
+3 SET DIK="^GMR(120.8,"
+4 SET DIK(1)=".01^B"
+5 ;Resets B xref
DO ENALL^DIK
+6 QUIT
+7 ;
FIXALG ;Loop through 120.8 update existing free text entries
+1 NEW GMRAI,FREE,REACTANT,ENTRY,GMRAR
+2 SET GMRAI=0
FOR
SET GMRAI=$ORDER(^GMR(120.8,GMRAI))
if '+GMRAI
QUIT
Begin DoDot:1
+3 IF '$DATA(^GMR(120.8,GMRAI,0))!($LENGTH($GET(^GMR(120.8,GMRAI,0)),"^")=1)
DO DEL
QUIT
+4 ;stop if entered in error, test patient or deceased patient
if +$GET(^GMR(120.8,GMRAI,"ER"))!($$TESTPAT^VADPT($PIECE(^GMR(120.8,GMRAI,0),U)))!($$DECEASED^GMRAFX($PIECE(^GMR(120.8,GMRAI,0),U)))
QUIT
+5 SET REACTANT=$PIECE(^GMR(120.8,GMRAI,0),U,2)
+6 IF REACTANT["ANGIOTEN"&(REACTANT["( FREE TEXT )")
Begin DoDot:2
+7 ;Get just term
SET GMRAR=$$UP^XLFSTR($EXTRACT($PIECE(REACTANT," ( FREE TEXT )"),1,30))
+8 ;Is entry in the table
SET ENTRY=$GET(^XTMP("GMRAFIX40",GMRAR))
+9 ;Entry not found or designated free text - leave alone
IF ENTRY=""
QUIT
+10 ;Update entry from table
DO UPDATE
End DoDot:2
QUIT
+11 IF REACTANT="ACE INHIBITORS"
SET GMRAR=REACTANT
IF $$CHANGED(.GMRAR)
Begin DoDot:2
+12 ;Get 1st 30 chars of term
SET GMRAR=$EXTRACT(GMRAR,1,30)
+13 SET ENTRY=$GET(^XTMP("GMRAFIX40",GMRAR))
+14 ;Convert term to FREE TEXT as it should have been
IF ENTRY=""
IF $DATA(^XTMP("GMRAFIX40",GMRAR))
SET REACTANT=GMRAR
DO UPDATEF
QUIT
+15 IF $DATA(^XTMP("GMRAFIX40",GMRAR))
DO UPDATE
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
DEL ;No zero node, remove entry
+1 NEW DIK,DA,GMRADONT
+2 ;Stop HDR from receiving update as it's not needed
SET GMRADONT=1
+3 SET DIK="^GMR(120.8,"
SET DA=GMRAI
+4 DO ^DIK
+5 QUIT
+6 ;
UPDATEF ;Update reactant to say free text so users know it isn't a standardized entry
+1 NEW FDA,COM,FREE
+2 SET FREE=$ORDER(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0))
SET FREE=FREE_";GMRD(120.82,"
+3 ;Already updated to free text, can skip.
if $GET(REACTANT)["FREE TEXT"
QUIT
+4 SET REACTANT=REACTANT_" ( FREE TEXT )"
+5 SET FDA(120.8,(GMRAI_","),.02)=REACTANT
+6 SET FDA(120.8,(GMRAI_","),1)=FREE
+7 DO FILE^DIE(,"FDA")
+8 ;Increment total free text updated counter
SET TF=$GET(TF)+1
+9 SET COM="Updated using the auto clean up process from GMRA*4*40. Changed reactant from ACE INIHIBITORS (file - 50.605) to "_REACTANT
+10 DO ADCOM^GMRAFX(GMRAI,"O",COM)
+11 QUIT
+12 ;
UPDATEE ;Mark as entered in error, check for NKA
+1 NEW DIE,DA,DR,DFN,USER,TIME
+2 ;Patient's IEN
SET DFN=$PIECE(^GMR(120.8,GMRAI,0),U)
+3 SET USER=$PIECE(^GMR(120.8,GMRAI,0),U,5)
SET TIME=$PIECE(^(0),U,4)
+4 SET DIE="^GMR(120.8,"
SET DA=GMRAI
SET DR="22///1;23///NOW;24////"_$GET(DUZ,.5)
+5 ;Entry is now entered in error
DO ^DIE
+6 ;Adds comment to allergy record
DO ADCOM^GMRAFX(GMRAI,"E","Marked entered in error by auto-update in patch GMRA*4*40")
+7 IF $$NKASCR^GMRANKA(DFN)
Begin DoDot:1
+8 ;Set assessment to NKA
IF $PIECE(ENTRY,U,2)="NKDA"
SET DA=DFN
SET DIE="^GMR(120.86,"
SET DR="1////0;2////"_$GET(USER,DUZ)_";3////"_$GET(TIME,$$NOW^XLFDT)
DO ^DIE
QUIT
+9 ;Delete assessment
DO CLN^GMRANKA
End DoDot:1
+10 ;Increment total entered in error counter
SET TE=$GET(TE)+1
+11 QUIT
+12 ;
UPDATE ;Update free text entry to data found in table
+1 NEW DFN,DIE,DA,DR,AIFN,COM,SIEN,FILE,NAME,IEN,GMRAAR,GMRAPA,GMRASCR,ERRCODE
+2 SET DFN=$PIECE(^GMR(120.8,GMRAI,0),U)
+3 SET GMRAPA=GMRAI
+4 SET FILE=$PIECE(ENTRY,U)
SET NAME=$PIECE(ENTRY,U,2)
+5 SET IEN=$$FIND1^DIC(FILE,"",$SELECT(FILE=120.82:"X",1:"MX"),NAME,$SELECT(FILE=120.82:"B",1:""),,"ERRCODE")
+6 IF '+IEN
SET IEN=$$FIND1^DIC(FILE,"","MX",NAME_" ","",,"ERRCODE")
+7 IF '+IEN
IF NAME="ANTIMUSCARINICS/ANTISPASMODICS"
SET IEN=$$FIND1^DIC(FILE,"","MX","GA801","",,"ERRCODE")
+8 IF '+IEN
IF $LENGTH($TEXT(SCREEN^XTID))
SET GMRASCR="I '$$SCREEN^XTID(FILE,,Y_"","")"
SET IEN=$$FIND1^DIC(FILE,"","MX",NAME,"",$GET(GMRASCR),"ERRCODE")
+9 IF '+IEN
SET ERR(2,DFN,REACTANT)=ENTRY
DO UPDATEF
QUIT
+10 SET GMRAAR=IEN_";"_$SELECT(FILE=50:"PSDRUG(",FILE=50.416:"PS(50.416,",FILE=50.605:"PS(50.605,",FILE=120.82:"GMRD(120.82,",1:"PSNDF(50.6,")
+11 SET GMRAAR(0)=NAME
+12 SET GMRAAR("O")=$SELECT(FILE=120.82:$PIECE(^GMRD(120.82,IEN,0),U,2),1:"D")
+13 ;Would create a duplicate if update occur
IF $$DUP^GMRAFX3
SET ERR(3,DFN,REACTANT)=ENTRY
DO UPDATEF
QUIT
+14 ;Update reactant, allergy and signed off fields
+15 SET DIE="^GMR(120.8,"
SET DA=GMRAPA
SET DR=".02////"_GMRAAR(0)_";1////^S X=GMRAAR"_";3.1////"_GMRAAR("O")_";15///1"
DO ^DIE
+16 ;Observed reaction, need to update data
IF $DATA(^GMR(120.85,"C",GMRAPA))
Begin DoDot:1
+17 SET AIFN=0
+18 FOR
SET AIFN=$ORDER(^GMR(120.85,"C",GMRAPA,AIFN))
if '+AIFN
QUIT
Begin DoDot:2
+19 ;Was previous reactant stored as "suspected agent"
SET SIEN=$ORDER(^GMR(120.85,AIFN,3,"B",REACTANT,0))
if '+SIEN
QUIT
+20 SET DA(1)=AIFN
SET DA=SIEN
+21 ;Update suspected agent to new value
SET DIE="^GMR(120.85,DA(1),3,"
SET DR=".01////^S X=GMRAAR(0)"
DO ^DIE
End DoDot:2
End DoDot:1
+22 ;Delete drug ingredient/drug classes multiples
DO DELMUL^GMRAFX3(2)
DO DELMUL^GMRAFX3(3)
+23 ;If reactant type is Drug then add appropriate ingredients and classes
IF GMRAAR("O")["D"
DO UPDATE^GMRAPES1
KILL LIST
+24 SET COM="Updated using auto clean up process from GMRA*4*40. Changed reactant from ACE INHIBITORS (file - 50.605) to "_GMRAAR(0)_" (file - "_$PIECE(GMRAAR,";",2)_")"
+25 ;Add a comment for this update
DO ADCOM^GMRAFX(GMRAPA,"O",COM)
+26 ;Increment total updated counter
SET TU=$GET(TU)+1
+27 QUIT
+28 ;
MAIL ;Send message indicating post install is finished
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,CNT,VADM,DFN,REACTANT,LOOP,DIFROM,EXTRA
+2 SET XMDUZ="PATCH GMRA*4*40 POST-INSTALL"
+3 SET XMY("DAVID.NABER@DOMAIN.EXT")=""
SET XMY("CATHERINE.HOANG2@DOMAIN.EXT")=""
+4 SET XMY("HULET.LEE_ANN@DOMAIN.EXT")=""
SET XMY("KEN.BARLOW@DOMAIN.EXT")=""
+5 SET EXTRA=($DATA(ERR(2))!($DATA(ERR(3))))
+6 IF 'EXTRA
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+7 SET CNT=1
+8 SET GMRATXT(CNT)="The post-install routine for patch GMRA*4*40"
SET CNT=CNT+1
+9 SET GMRATXT(CNT)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
SET CNT=CNT+1
+10 SET GMRATXT(CNT)=""
SET CNT=CNT+1
+11 IF $GET(ERR)=1
Begin DoDot:1
+12 SET GMRATXT(CNT)="**NOTE: There was a problem with the installation!"
SET CNT=CNT+1
+13 SET GMRATXT(CNT)="Required entry missing from file 120.82 - CONVERSION ABORTED."
SET CNT=CNT+1
+14 SET GMRATXT(CNT)="Contact the National Help Desk for Immediate assistance."
SET CNT=CNT+1
End DoDot:1
+15 IF $GET(TU)!($GET(TE))!($GET(TF))
Begin DoDot:1
+16 SET GMRATXT(CNT)="Here are the results of the update:"
SET CNT=CNT+1
+17 SET GMRATXT(CNT)=""
SET CNT=CNT+1
+18 FOR LOOP="TU","TF","TE"
Begin DoDot:2
+19 SET GMRATXT(CNT)=$SELECT(+$GET(@LOOP)=0:"No entries were",$GET(@LOOP)=1:"One entry was",1:$GET(@LOOP)_" entries were")_" "
+20 SET GMRATXT(CNT)=GMRATXT(CNT)_$SELECT(LOOP="TU":"updated to new terms",LOOP="TF":"updated to have (FREE TEXT) appended to the term",1:"marked entered in error")_"."
SET CNT=CNT+1
End DoDot:2
+21 SET GMRATXT(CNT)=""
SET CNT=CNT+1
End DoDot:1
+22 SET XMTEXT="GMRATXT("
SET XMSUB="PATCH GMRA*4*40 Post Install COMPLETED"
+23 ;Send totals to OI reps, include local if no problems
DO ^XMD
+24 FOR LOOP=2,3
Begin DoDot:1
+25 IF $DATA(ERR(LOOP))
Begin DoDot:2
+26 SET GMRATXT(CNT)="The following patients have allergies that couldn't be converted"
SET CNT=CNT+1
+27 SET GMRATXT(CNT)=$SELECT(LOOP=2:"because the term to update them to couldn't be found in the local files.",1:"because it would create a duplicate entry.")
SET CNT=CNT+1
+28 SET GMRATXT(CNT)=""
SET CNT=CNT+1
+29 SET DFN=0
FOR
SET DFN=$ORDER(ERR(LOOP,DFN))
if '+DFN
QUIT
Begin DoDot:3
+30 KILL VADM
DO DEM^VADPT
+31 SET GMRATXT(CNT)="PATIENT: "_VADM(1)_" ("_$EXTRACT(VADM(2),6,9)_")"
SET CNT=CNT+1
+32 SET REACTANT=""
FOR
SET REACTANT=$ORDER(ERR(LOOP,DFN,REACTANT))
if REACTANT=""
QUIT
Begin DoDot:4
+33 SET GMRATXT(CNT)="Can't convert "_REACTANT_" to "_$PIECE(ERR(LOOP,DFN,REACTANT),U,2)_" (file: "_$PIECE(ERR(LOOP,DFN,REACTANT),U)_")"
SET CNT=CNT+1
End DoDot:4
+34 SET GMRATXT(CNT)=""
SET CNT=CNT+1
End DoDot:3
+35 SET $PIECE(GMRATXT(CNT),"*",70)="*"
SET CNT=CNT+1
SET GMRATXT(CNT)=""
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+36 IF EXTRA
Begin DoDot:1
+37 ;Send full report to local site only
KILL XMY
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+38 SET XMTEXT="GMRATXT("
SET XMSUB="PATCH GMRA*4*40 Post Install COMPLETED"
+39 DO ^XMD
End DoDot:1
+40 QUIT
+41 ;
CHANGED(GMRAR) ;Was entry changed by patch 29?
+1 NEW CHANGED,SUB
+2 SET CHANGED=0
+3 SET SUB=0
FOR
SET SUB=$ORDER(^GMR(120.8,GMRAI,26,SUB))
if '+SUB!(CHANGED)
QUIT
Begin DoDot:1
+4 ;get term and upper case it
IF $GET(^GMR(120.8,GMRAI,26,SUB,2,1,0))["GMRA*4*29"
SET GMRAR=$$UP^XLFSTR($PIECE($PIECE(^GMR(120.8,GMRAI,26,SUB,2,1,0),"reactant from ",2)," (free text)",1))
+5 IF $GET(^GMR(120.8,GMRAI,26,SUB,2,1,0))["GMRA*4*29"
IF $GET(GMRAR)["ANGIOTEN"
SET CHANGED=1
End DoDot:1
+6 QUIT CHANGED
