GMRAY36.m

GMRAY36 ;SLC/DAN Post-install for patch 36 ;2/1/07  13:46

 ;;4.0;Adverse Reaction Tracking;**36**;Mar 29, 1996;Build 9

 ;DBIA SECTION

 ;10063 - %ZTLOAD

 ; 3744 - $$TESTPAT^VADPT

 ;10018 - DIE

 ;10103 - XLFDT

 ;10070 - XMD

 ;10141 - XPDUTL

 ; 4631 - $$SCREEN^XTID

 ;

Q ;Entry point to queue process during install

 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK

 S ZTRTN="DQ^GMRAY36",ZTDESC="GMRA*4*36 POST INSTALL ROUTINE",ZTIO="",ZTDTH=$H

 D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^GMRA36 AFTER INSTALL FINISHES") Q

 D BMES^XPDUTL("Post-install queued as task # "_$G(ZTSK))

 Q

 ;

DQ ;Dequeue

 N FIX,FTBP

 D ^GMRAY36A ;Set up new style xref in file 120.82

 D POST,MAIL

 Q

 ;

POST ;Post-install for patch 36

 N IEN,GMRA0,DIE,DA,DR,DFN,GMRAFT

 S GMRAFT=$O(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0))

 S IEN=0 F  S IEN=$O(^GMR(120.8,IEN)) Q:'+IEN  D

 .S GMRA0=$G(^GMR(120.8,IEN,0)) ;Set GMRA0 to zero node

 .Q:GMRA0=""  ;Quit if no zero node

 .Q:+$G(^GMR(120.8,IEN,"ER"))  ;Quit if entered in error

 .S DFN=$P(GMRA0,U) Q:'+DFN  ;Quit if no patient identifier

 .Q:$$TESTPAT^VADPT(DFN)  ;Quit if test patient

 .Q:$$DECEASED^GMRAFX(DFN)  ;Quit if patient is deceased

 .I $P(GMRA0,U,3)=(GMRAFT_";GMRD(120.82,") S FTBP=$G(FTBP)+1 ;Count existing free text entries

 .I '+$P(GMRA0,U,12),$P(GMRA0,U,16) S DIE=120.8,DA=IEN,DR="15///1" D ^DIE ;If not signed off and verified then mark signed off

 .I $P(GMRA0,U,3)["GMRD",+$P(GMRA0,U,3)'=GMRAFT D TYPENAME,INACT ;Check allergy type and reactant name of 120.82 entries and then check if inactive

 .I $P(GMRA0,U,3)["PSDRUG" D FILE50 ;If file 50 check for ing/drug class

 .I $D(^GMR(120.8,IEN,10)) D CHKSIGNS ;If reactions exist check for semi-colons in free text entries

 Q

 ;

MAIL ;Send message indicating post install is finished

 N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT

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

 S XMY("DAVID.NABER@DOMAIN.EXT")="",XMY("CATHERINE.HOANG2@DOMAIN.EXT")="",XMY("THOMAS.CAMPBELL2@DOMAIN.EXT")="",XMY("HULET.LEE_ANN@DOMAIN.EXT")=""

 S XMY("VHAOIHSITESHDRIM@DOMAIN.EXT")=""

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

 S GMRATXT(2)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."

 S GMRATXT(3)=""

 S GMRATXT(4)="Number of free text entries before patch 36  : "_+$G(FTBP)

 S GMRATXT(5)="Allergies converted to free text by patch 36 : "_+$G(FIX)

 S GMRATXT(6)="Total number of free text allergies at site  : "_($G(FTBP)+$G(FIX))

 S GMRATXT(7)=""

 S GMRATXT(8)="Please note that patch GMRA*4*29, when installed, will automatically"

 S GMRATXT(9)="convert free text entries to a standardized entry.",GMRATXT(10)="As a result, you do not need to take any action at this point."

 S XMTEXT="GMRATXT(",XMSUB="PATCH GMRA*4*36 Post Install COMPLETED"

 D ^XMD

 Q

 ;

INACT ;If 120.82 is inactive then convert 120.8 entry to free text

 N DA,DIE,DR,GMRAAR,COM

 Q:'$$SCREEN^XTID(120.82,,(+$P(GMRA0,U,3)_","))  ;Stop if term is active

 S GMRAAR=GMRAFT_";GMRD(120.82,"

 S DA=IEN,DIE=120.8,DR="1////^S X=GMRAAR" D ^DIE

 S FIX=$G(FIX)+1 ;Increment counter

 S COM="Changed from "_$P($G(GMRA0),U,2)_" (File 120.82) to free text by patch GMRA*4*36" D ADCOM^GMRAFX(IEN,"O",COM)

 Q

 ;

TYPENAME ;Synch up allergy type

 N DA,DIE,DR

 Q:$$SCREEN^XTID(120.82,,(+$P(GMRA0,U,3)_","))  ;Stop if term is inactive

 I $P($G(^GMRD(120.82,+$P(GMRA0,U,3),0)),U,2)'=$P(GMRA0,U,20) S DR="3.1///"_$P($G(^GMRD(120.82,+$P(GMRA0,U,3),0)),U,2)

 I $P(GMRA0,U,2)'=$P($G(^GMRD(120.82,+$P(GMRA0,U,3),0)),U) S DR=$G(DR)_$S($G(DR)'="":";",1:"")_".02////"_$P($G(^GMRD(120.82,+$P(GMRA0,U,3),0)),U)

 I $D(DR) S DIE=120.8,DA=IEN D ^DIE

 Q

 ;

FILE50 ;Update to free text if no ing/drug class on file

 N DA,DIE,DR,GMRAAR,COM

 I '$O(^GMR(120.8,IEN,2,0))&('$O(^GMR(120.8,IEN,3,0))) D

 .S GMRAAR=GMRAFT_";GMRD(120.82,"

 .S DIE=120.8,DA=IEN,DR="1////^S X=GMRAAR" D ^DIE

 .S FIX=$G(FIX)+1

 .S COM="Changed from "_$P($G(GMRA0),U,2)_" (File 50) to free text by patch GMRA*4*36" D ADCOM^GMRAFX(IEN,"O",COM)

 Q

 ;

CHKSIGNS ;Check free text reactions for semicolons.  If present substitute a comma to avoid display problems

 N SUB,NAME,DR,DA,DIE

 S SUB=0 F  S SUB=$O(^GMR(120.8,IEN,10,SUB)) Q:'+SUB  D

 .I $P($G(^GMR(120.8,IEN,10,SUB,0)),U,2)[";" D

 ..S NAME=$TR($P(^(0),U,2),";",",") ;Replace ; with , naked reference to above line

 ..S DA(1)=IEN,DA=SUB,DIE="^GMR(120.8,DA(1),10,",DR="1////"_NAME D ^DIE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRAY36   4461     printed  Mar 13, 2025@20:45:40                                                                                                                                                                                                     Page 2

GMRAY36   ;SLC/DAN Post-install for patch 36 ;2/1/07  13:46

 +1       ;;4.0;Adverse Reaction Tracking;**36**;Mar 29, 1996;Build 9

 +2       ;DBIA SECTION

 +3       ;10063 - %ZTLOAD

 +4       ; 3744 - $$TESTPAT^VADPT

 +5       ;10018 - DIE

 +6       ;10103 - XLFDT

 +7       ;10070 - XMD

 +8       ;10141 - XPDUTL

 +9       ; 4631 - $$SCREEN^XTID

 +10      ;

Q         ;Entry point to queue process during install

 +1        NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK

 +2        SET ZTRTN="DQ^GMRAY36"

           SET ZTDESC="GMRA*4*36 POST INSTALL ROUTINE"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

 +3        DO ^%ZTLOAD

           IF '$GET(ZTSK)

               DO BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^GMRA36 AFTER INSTALL FINISHES")

               QUIT 

 +4        DO BMES^XPDUTL("Post-install queued as task # "_$GET(ZTSK))

 +5        QUIT 

 +6       ;

DQ        ;Dequeue

 +1        NEW FIX,FTBP

 +2       ;Set up new style xref in file 120.82

           DO ^GMRAY36A

 +3        DO POST

           DO MAIL

 +4        QUIT 

 +5       ;

POST      ;Post-install for patch 36

 +1        NEW IEN,GMRA0,DIE,DA,DR,DFN,GMRAFT

 +2        SET GMRAFT=$ORDER(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0))

 +3        SET IEN=0

           FOR 

               SET IEN=$ORDER(^GMR(120.8,IEN))

               if '+IEN

                   QUIT 

               Begin DoDot:1

 +4       ;Set GMRA0 to zero node

                   SET GMRA0=$GET(^GMR(120.8,IEN,0))

 +5       ;Quit if no zero node

                   if GMRA0=""

                       QUIT 

 +6       ;Quit if entered in error

                   if +$GET(^GMR(120.8,IEN,"ER"))

                       QUIT 

 +7       ;Quit if no patient identifier

                   SET DFN=$PIECE(GMRA0,U)

                   if '+DFN

                       QUIT 

 +8       ;Quit if test patient

                   if $$TESTPAT^VADPT(DFN)

                       QUIT 

 +9       ;Quit if patient is deceased

                   if $$DECEASED^GMRAFX(DFN)

                       QUIT 

 +10      ;Count existing free text entries

                   IF $PIECE(GMRA0,U,3)=(GMRAFT_";GMRD(120.82,")

                       SET FTBP=$GET(FTBP)+1

 +11      ;If not signed off and verified then mark signed off

                   IF '+$PIECE(GMRA0,U,12)

                       IF $PIECE(GMRA0,U,16)

                           SET DIE=120.8

                           SET DA=IEN

                           SET DR="15///1"

                           DO ^DIE

 +12      ;Check allergy type and reactant name of 120.82 entries and then check if inactive

                   IF $PIECE(GMRA0,U,3)["GMRD"

                       IF +$PIECE(GMRA0,U,3)'=GMRAFT

                           DO TYPENAME

                           DO INACT

 +13      ;If file 50 check for ing/drug class

                   IF $PIECE(GMRA0,U,3)["PSDRUG"

                       DO FILE50

 +14      ;If reactions exist check for semi-colons in free text entries

                   IF $DATA(^GMR(120.8,IEN,10))

                       DO CHKSIGNS

               End DoDot:1

 +15       QUIT 

 +16      ;

MAIL      ;Send message indicating post install is finished

 +1        NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT

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

           SET XMY(.5)=""

           if $GET(DUZ)

               SET XMY(DUZ)=""

 +3        SET XMY("DAVID.NABER@DOMAIN.EXT")=""

           SET XMY("CATHERINE.HOANG2@DOMAIN.EXT")=""

           SET XMY("THOMAS.CAMPBELL2@DOMAIN.EXT")=""

           SET XMY("HULET.LEE_ANN@DOMAIN.EXT")=""

 +4        SET XMY("VHAOIHSITESHDRIM@DOMAIN.EXT")=""

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

 +6        SET GMRATXT(2)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."

 +7        SET GMRATXT(3)=""

 +8        SET GMRATXT(4)="Number of free text entries before patch 36  : "_+$GET(FTBP)

 +9        SET GMRATXT(5)="Allergies converted to free text by patch 36 : "_+$GET(FIX)

 +10       SET GMRATXT(6)="Total number of free text allergies at site  : "_($GET(FTBP)+$GET(FIX))

 +11       SET GMRATXT(7)=""

 +12       SET GMRATXT(8)="Please note that patch GMRA*4*29, when installed, will automatically"

 +13       SET GMRATXT(9)="convert free text entries to a standardized entry."

           SET GMRATXT(10)="As a result, you do not need to take any action at this point."

 +14       SET XMTEXT="GMRATXT("

           SET XMSUB="PATCH GMRA*4*36 Post Install COMPLETED"

 +15       DO ^XMD

 +16       QUIT 

 +17      ;

INACT     ;If 120.82 is inactive then convert 120.8 entry to free text

 +1        NEW DA,DIE,DR,GMRAAR,COM

 +2       ;Stop if term is active

           if '$$SCREEN^XTID(120.82,,(+$PIECE(GMRA0,U,3)_","))

               QUIT 

 +3        SET GMRAAR=GMRAFT_";GMRD(120.82,"

 +4        SET DA=IEN

           SET DIE=120.8

           SET DR="1////^S X=GMRAAR"

           DO ^DIE

 +5       ;Increment counter

           SET FIX=$GET(FIX)+1

 +6        SET COM="Changed from "_$PIECE($GET(GMRA0),U,2)_" (File 120.82) to free text by patch GMRA*4*36"

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

 +7        QUIT 

 +8       ;

TYPENAME  ;Synch up allergy type

 +1        NEW DA,DIE,DR

 +2       ;Stop if term is inactive

           if $$SCREEN^XTID(120.82,,(+$PIECE(GMRA0,U,3)_","))

               QUIT 

 +3        IF $PIECE($GET(^GMRD(120.82,+$PIECE(GMRA0,U,3),0)),U,2)'=$PIECE(GMRA0,U,20)

               SET DR="3.1///"_$PIECE($GET(^GMRD(120.82,+$PIECE(GMRA0,U,3),0)),U,2)

 +4        IF $PIECE(GMRA0,U,2)'=$PIECE($GET(^GMRD(120.82,+$PIECE(GMRA0,U,3),0)),U)

               SET DR=$GET(DR)_$SELECT($GET(DR)'="":";",1:"")_".02////"_$PIECE($GET(^GMRD(120.82,+$PIECE(GMRA0,U,3),0)),U)

 +5        IF $DATA(DR)

               SET DIE=120.8

               SET DA=IEN

               DO ^DIE

 +6        QUIT 

 +7       ;

FILE50    ;Update to free text if no ing/drug class on file

 +1        NEW DA,DIE,DR,GMRAAR,COM

 +2        IF '$ORDER(^GMR(120.8,IEN,2,0))&('$ORDER(^GMR(120.8,IEN,3,0)))

               Begin DoDot:1

 +3                SET GMRAAR=GMRAFT_";GMRD(120.82,"

 +4                SET DIE=120.8

                   SET DA=IEN

                   SET DR="1////^S X=GMRAAR"

                   DO ^DIE

 +5                SET FIX=$GET(FIX)+1

 +6                SET COM="Changed from "_$PIECE($GET(GMRA0),U,2)_" (File 50) to free text by patch GMRA*4*36"

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

               End DoDot:1

 +7        QUIT 

 +8       ;

CHKSIGNS  ;Check free text reactions for semicolons.  If present substitute a comma to avoid display problems

 +1        NEW SUB,NAME,DR,DA,DIE

 +2        SET SUB=0

           FOR 

               SET SUB=$ORDER(^GMR(120.8,IEN,10,SUB))

               if '+SUB

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^GMR(120.8,IEN,10,SUB,0)),U,2)[";"

                       Begin DoDot:2

 +4       ;Replace ; with , naked reference to above line

                           SET NAME=$TRANSLATE($PIECE(^(0),U,2),";",",")

 +5                        SET DA(1)=IEN

                           SET DA=SUB

                           SET DIE="^GMR(120.8,DA(1),10,"

                           SET DR="1////"_NAME

                           DO ^DIE

                       End DoDot:2

               End DoDot:1

 +6        QUIT