Routine: GMRAY38

GMRAY38 ;SLC/DAN Post-install for patch 38 ;5/3/07  14:53

 ;;4.0;Adverse Reaction Tracking;**38**;Mar 29, 1996;Build 2

POST ;Find varible pointers associated with IEN zero

 N TMP,IEN,FREE,REACTANT,FDA,COM

 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 REACTANT=$P(^GMR(120.8,IEN,0),U,2)_" ( FREE TEXT )"

 ..S FDA(120.8,(IEN_","),.02)=REACTANT

 ..D FILE^DIE(,"FDA")

 ..S COM="Updated by patch GMRA*4*38 to free text due to bad pointer value." D ADCOM^GMRAFX(IEN,"O",COM) ;Add comment to record

 ..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,NAME,REACT

 S XMDUZ="PATCH GMRA*4*38 POST-INSTALL",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""

 S GMRATXT(1)="The post-install routine for patch GMRA*4*38"

 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*38 Post Install COMPLETED"

 D ^XMD

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAY38   1818     printed  Apr 23, 2025@17:55:28                                                                                                                                                                                                     Page 2

GMRAY38   ;SLC/DAN Post-install for patch 38 ;5/3/07  14:53

 +1       ;;4.0;Adverse Reaction Tracking;**38**;Mar 29, 1996;Build 2

 +2       ;

POST      ;Find varible pointers associated with IEN zero

 +1        NEW TMP,IEN,FREE,REACTANT,FDA,COM

 +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 REACTANT=$PIECE(^GMR(120.8,IEN,0),U,2)_" ( FREE TEXT )"

 +7                        SET FDA(120.8,(IEN_","),.02)=REACTANT

 +8                        DO FILE^DIE(,"FDA")

 +9       ;Add comment to record

                           SET COM="Updated by patch GMRA*4*38 to free text due to bad pointer value."

                           DO ADCOM^GMRAFX(IEN,"O",COM)

 +10                       SET TMP($PIECE(^GMR(120.8,IEN,0),U),$PIECE(^GMR(120.8,IEN,0),U,2))=""

                       End DoDot:2

               End DoDot:1

 +11      ;

MAIL      ;Send message indicating post install is finished

 +1        NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,CNT,VADM,DFN,REACTANT,LOOP,DIFROM,NAME,REACT

 +2        SET XMDUZ="PATCH GMRA*4*38 POST-INSTALL"

           SET XMY(.5)=""

           if $GET(DUZ)

               SET XMY(DUZ)=""

 +3        SET GMRATXT(1)="The post-install routine for patch GMRA*4*38"

 +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*38 Post Install COMPLETED"

 +13       DO ^XMD

 +14       QUIT

GMRAY38.m