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@VA.GOV")="",XMY("CATHERINE.HOANG2@VA.GOV")="",XMY("THOMAS.CAMPBELL2@VA.GOV")="",XMY("HULET.LEE_ANN@FORUM.VA.GOV")=""
S XMY("VHAOIHSITESHDRIM@MED.VA.GOV")=""
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
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@VA.GOV")=""
SET XMY("CATHERINE.HOANG2@VA.GOV")=""
SET XMY("THOMAS.CAMPBELL2@VA.GOV")=""
SET XMY("HULET.LEE_ANN@FORUM.VA.GOV")=""
+4 SET XMY("VHAOIHSITESHDRIM@MED.VA.GOV")=""
+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
