- 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 Feb 18, 2025@23:07:15 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