GMRAY20 ;SLC/DAN Post-install for patch 20 ;6/22/06 10:09
;;4.0;Adverse Reaction Tracking;**20**;Mar 29, 1996;Build 1
;
POST ;Executed following installation of patch 20
N SUB,TOP,DIK,DA
K ^XTMP("GMRAFX") ;Remove existing free text allergy list - switching location and don't need old list
S SUB=0 F S SUB=$O(^GMRD(120.84,SUB)) Q:'+SUB D
.Q:'$D(^GMRD(120.84,SUB,1)) ;Stop if no top 10 list associated with this entry
.S TOP=10 F S TOP=$O(^GMRD(120.84,SUB,1,TOP)) Q:'+TOP D
..S DA(1)=SUB,DA=TOP,DIK="^GMRD(120.84,"_DA(1)_",1," D ^DIK ;Delete any entries in multiple numbered above 10
;
FIXZERO ;Find varible pointers associated with IEN zero
N TMP,IEN,FREE
S FREE=$O(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0)) Q:'FREE S:FREE FREE=FREE_";GMRD(120.82,"
S IEN=0 F S IEN=$O(^GMR(120.8,IEN)) Q:'+IEN D
.I $E($P($G(^GMR(120.8,IEN,0)),U,3),1,2)="0;" D
..S $P(^GMR(120.8,IEN,0),U,3)=FREE ;Update pointer to free text entry
..S TMP($P(^GMR(120.8,IEN,0),U),$P(^GMR(120.8,IEN,0),U,2))=""
;
MAIL ;Send message indicating post install is finished
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,CNT,VADM,DFN,REACTANT,LOOP,DIFROM
S XMDUZ="PATCH GMRA*4*20 POST-INSTALL",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S GMRATXT(1)="The post-install routine for patch GMRA*4*20"
S GMRATXT(2)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
S GMRATXT(3)=""
S CNT=4
I $D(TMP) D
.S GMRATXT(CNT)="The following patients had reactants updated to free text entries",CNT=CNT+1,GMRATXT(CNT)="because of a problem with the pointer data.",CNT=CNT+1
.S GMRATXT(CNT)="",CNT=CNT+1,GMRATXT(CNT)="Please use the Allergy Update Utility to fix these entries.",CNT=CNT+1,GMRATXT(CNT)="",CNT=CNT+1
.S IEN=0 F S IEN=$O(TMP(IEN)) Q:'+IEN S NAME=$$GET1^DIQ(2,IEN,.01)_" ("_$E($$GET1^DIQ(2,IEN,.09),6,9)_")" S REACT="" F S REACT=$O(TMP(IEN,REACT)) Q:REACT="" D
..S GMRATXT(CNT)=NAME_$$REPEAT^XLFSTR(" ",(38-$L(NAME)))_REACT,CNT=CNT+1
S XMTEXT="GMRATXT(",XMSUB="PATCH GMRA*4*20 Post Install COMPLETED"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAY20 2029 printed Sep 23, 2025@19:16:52 Page 2
GMRAY20 ;SLC/DAN Post-install for patch 20 ;6/22/06 10:09
+1 ;;4.0;Adverse Reaction Tracking;**20**;Mar 29, 1996;Build 1
+2 ;
POST ;Executed following installation of patch 20
+1 NEW SUB,TOP,DIK,DA
+2 ;Remove existing free text allergy list - switching location and don't need old list
KILL ^XTMP("GMRAFX")
+3 SET SUB=0
FOR
SET SUB=$ORDER(^GMRD(120.84,SUB))
if '+SUB
QUIT
Begin DoDot:1
+4 ;Stop if no top 10 list associated with this entry
if '$DATA(^GMRD(120.84,SUB,1))
QUIT
+5 SET TOP=10
FOR
SET TOP=$ORDER(^GMRD(120.84,SUB,1,TOP))
if '+TOP
QUIT
Begin DoDot:2
+6 ;Delete any entries in multiple numbered above 10
SET DA(1)=SUB
SET DA=TOP
SET DIK="^GMRD(120.84,"_DA(1)_",1,"
DO ^DIK
End DoDot:2
End DoDot:1
+7 ;
FIXZERO ;Find varible pointers associated with IEN zero
+1 NEW TMP,IEN,FREE
+2 SET FREE=$ORDER(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0))
if 'FREE
QUIT
if FREE
SET FREE=FREE_";GMRD(120.82,"
+3 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.8,IEN))
if '+IEN
QUIT
Begin DoDot:1
+4 IF $EXTRACT($PIECE($GET(^GMR(120.8,IEN,0)),U,3),1,2)="0;"
Begin DoDot:2
+5 ;Update pointer to free text entry
SET $PIECE(^GMR(120.8,IEN,0),U,3)=FREE
+6 SET TMP($PIECE(^GMR(120.8,IEN,0),U),$PIECE(^GMR(120.8,IEN,0),U,2))=""
End DoDot:2
End DoDot:1
+7 ;
MAIL ;Send message indicating post install is finished
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,CNT,VADM,DFN,REACTANT,LOOP,DIFROM
+2 SET XMDUZ="PATCH GMRA*4*20 POST-INSTALL"
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+3 SET GMRATXT(1)="The post-install routine for patch GMRA*4*20"
+4 SET GMRATXT(2)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
+5 SET GMRATXT(3)=""
+6 SET CNT=4
+7 IF $DATA(TMP)
Begin DoDot:1
+8 SET GMRATXT(CNT)="The following patients had reactants updated to free text entries"
SET CNT=CNT+1
SET GMRATXT(CNT)="because of a problem with the pointer data."
SET CNT=CNT+1
+9 SET GMRATXT(CNT)=""
SET CNT=CNT+1
SET GMRATXT(CNT)="Please use the Allergy Update Utility to fix these entries."
SET CNT=CNT+1
SET GMRATXT(CNT)=""
SET CNT=CNT+1
+10 SET IEN=0
FOR
SET IEN=$ORDER(TMP(IEN))
if '+IEN
QUIT
SET NAME=$$GET1^DIQ(2,IEN,.01)_" ("_$EXTRACT($$GET1^DIQ(2,IEN,.09),6,9)_")"
SET REACT=""
FOR
SET REACT=$ORDER(TMP(IEN,REACT))
if REACT=""
QUIT
Begin DoDot:2
+11 SET GMRATXT(CNT)=NAME_$$REPEAT^XLFSTR(" ",(38-$LENGTH(NAME)))_REACT
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+12 SET XMTEXT="GMRATXT("
SET XMSUB="PATCH GMRA*4*20 Post Install COMPLETED"
+13 DO ^XMD
+14 QUIT
