GMTSP129 ; SLC/DJH - Patch 129 post-install routine ;6/6/19 4:00pm
;;2.7;Health Summary;**129**;Oct 20, 1995;Build 8
;Per VHA Directive 2004-038, this routine should not be modified
Q
; This routine is a part of patch GMTS*2.7*129 that is supporting patch SOW*3.0*65 (which will completely
; decommission the Social Work (SOW) package from VistA) and remove all Social Work GMTS code and components
; This routine is marking Health Summary Components for Social Work as inactive by setting the DISABLE FLAG
; field to P (Permanent). This will make the component non-selectable for use, and prevents the component
; from being printed in any Health Summary in which it is included.
;
; DBIA# SUPPORTED
; ----- --------------------------------------
; 10013 ^DIK
;
EN ; Entry point
;
ROUT ; remove routines from ^DIC(9.8
N SPNI,DA,DIK
S SPNI=0 S SPNI=$O(^DIC(9.8,"B","GMTSSOWZ",SPNI)) D
. Q:'SPNI S DA=SPNI,DIK="^DIC(9.8," D ^DIK K DA,DIK
S SPNI=0 S SPNI=$O(^DIC(9.8,"B","GMTSSOWK",SPNI)) D
. Q:'SPNI S DA=SPNI,DIK="^DIC(9.8," D ^DIK K DA,DIK
;
;keep record of deleted records for 60 days
S ^XTMP("GMTSP129",0)=$$FMADD^XLFDT($$NOW^XLFDT,60)_U_$$NOW^XLFDT
;
; Find all HS Component that contain GMTSSOW* in the PRINT ROUTINE
COMP N GMTIEN,CNT,GMTCMP,GMTIEN2
S GMTIEN=0 F S GMTIEN=$O(^GMT(142.1,GMTIEN)) Q:'GMTIEN D
. Q:$G(^GMT(142.1,GMTIEN,0))']""
. Q:($P(^GMT(142.1,GMTIEN,0),U,2)'["GMTSSOW")
. S GMTCMP(GMTIEN)=$P(^GMT(142.1,GMTIEN,0),U)
. M ^XTMP("GMTSP129",142.1,GMTIEN)=^GMT(142.1,GMTIEN)
;
; Generate 0 found msg and quit
I '$O(GMTCMP(0)) D Q
. S CNT=1
. S MSG(CNT)="",CNT=CNT+1
. S MSG(CNT)="PATCH GMTS*2.7*129 completed processing successfully.",CNT=CNT+1
. S MSG(CNT)="",CNT=CNT+1
. S MSG(CNT)="This patch found 0 Health Summary components with field PRINT ROUTINE ",CNT=CNT+1
. S MSG(CNT)="containing GMTSSOWK.",CNT=CNT+1
. S MSG(CNT)=""
. S XMSUB="PATCH GMTS*2.7*129 INSTALL",XMTEXT="MSG(",XMDUZ="Patch GMTS*2.7*129"
. S XMY(DUZ)=""
. D ^XMD
;
S GMTCMP=0 F S GMTCMP=$O(GMTCMP(GMTCMP)) Q:'GMTCMP D
. S GMTIEN=0 F S GMTIEN=$O(^GMT(142,"AE",GMTCMP,GMTIEN)) Q:'GMTIEN D
. . S GMTCMP(GMTCMP,GMTIEN)=$P(^GMT(142,GMTIEN,0),U)
. . S GMTIEN2=0 F S GMTIEN2=$O(^GMT(142,"AE",GMTCMP,GMTIEN,GMTIEN2)) Q:'GMTIEN2 D
. . . S GMTCMP(GMTCMP,GMTIEN,GMTIEN2)=""
. . . M ^XTMP("GMTSP129",142,GMTIEN,GMTIEN2)=^GMT(142,GMTIEN,1,GMTIEN2)
;
; set disabled field
S GMTCMP=0 F S GMTCMP=$O(GMTCMP(GMTCMP)) Q:'GMTCMP D
. N DA,DIE
. S DA=GMTCMP,DIE="^GMT(142.1," S DR="5////P" D ^DIE K DIE
. ; remove from health summary type
. S GMTIEN=0 F S GMTIEN=$O(GMTCMP(GMTCMP,GMTIEN)) Q:'GMTIEN D
. . S GMTIEN2=0 F S GMTIEN2=$O(GMTCMP(GMTCMP,GMTIEN,GMTIEN2)) Q:'GMTIEN2 D
. . . ; GMTCMP = IEN IN #142.1, GMTIEN = IEN IN #142, GMTIEN2 = SUB IEN IN 1 RECORD OF #142
. . . ; DELETE FROM #142
. . . S DA(2)=142,DA(1)=GMTIEN,DA=GMTIEN2,DIK="^GMT("_DA(2)_","_DA(1)_",1," D ^DIK
;
MAIL ;
N XMY,XMDUZ,XMSUB,XMTEXT,DIE,DA,DR,MSG
S CNT=1
S XMY(DUZ)=""
S XMSUB="PATCH GMTS*2.7*129 INSTALL",XMTEXT="MSG(",XMDUZ="Patch GMTS*2.7*129"
S MSG(CNT)="",CNT=CNT+1
S MSG(CNT)="PATCH GMTS*2.7*129 completed processing successfully.",CNT=CNT+1
S MSG(CNT)="",CNT=CNT+1
S MSG(CNT)="These Health Summary Component(s) were marked permanently disabled",CNT=CNT+1
S GMTCMP=0 F S GMTCMP=$O(GMTCMP(GMTCMP)) Q:'GMTCMP D
. S MSG(CNT)=GMTCMP(GMTCMP),CNT=CNT+1
S MSG(CNT)="",CNT=CNT+1
S MSG(CNT)="The above Components were deleted from these Health Summary Types:",CNT=CNT+1
;
S GMTCMP=0 F S GMTCMP=$O(GMTCMP(GMTCMP)) Q:'GMTCMP D
. S GMTIEN=0 F S GMTIEN=$O(GMTCMP(GMTCMP,GMTIEN)) Q:'GMTIEN D
. . S MSG(CNT)=GMTCMP(GMTCMP,GMTIEN),CNT=CNT+1
;SEND MAIL MSG
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSP129 3795 printed Dec 13, 2024@01:58:44 Page 2
GMTSP129 ; SLC/DJH - Patch 129 post-install routine ;6/6/19 4:00pm
+1 ;;2.7;Health Summary;**129**;Oct 20, 1995;Build 8
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ; This routine is a part of patch GMTS*2.7*129 that is supporting patch SOW*3.0*65 (which will completely
+5 ; decommission the Social Work (SOW) package from VistA) and remove all Social Work GMTS code and components
+6 ; This routine is marking Health Summary Components for Social Work as inactive by setting the DISABLE FLAG
+7 ; field to P (Permanent). This will make the component non-selectable for use, and prevents the component
+8 ; from being printed in any Health Summary in which it is included.
+9 ;
+10 ; DBIA# SUPPORTED
+11 ; ----- --------------------------------------
+12 ; 10013 ^DIK
+13 ;
EN ; Entry point
+1 ;
ROUT ; remove routines from ^DIC(9.8
+1 NEW SPNI,DA,DIK
+2 SET SPNI=0
SET SPNI=$ORDER(^DIC(9.8,"B","GMTSSOWZ",SPNI))
Begin DoDot:1
+3 if 'SPNI
QUIT
SET DA=SPNI
SET DIK="^DIC(9.8,"
DO ^DIK
KILL DA,DIK
End DoDot:1
+4 SET SPNI=0
SET SPNI=$ORDER(^DIC(9.8,"B","GMTSSOWK",SPNI))
Begin DoDot:1
+5 if 'SPNI
QUIT
SET DA=SPNI
SET DIK="^DIC(9.8,"
DO ^DIK
KILL DA,DIK
End DoDot:1
+6 ;
+7 ;keep record of deleted records for 60 days
+8 SET ^XTMP("GMTSP129",0)=$$FMADD^XLFDT($$NOW^XLFDT,60)_U_$$NOW^XLFDT
+9 ;
+10 ; Find all HS Component that contain GMTSSOW* in the PRINT ROUTINE
COMP NEW GMTIEN,CNT,GMTCMP,GMTIEN2
+1 SET GMTIEN=0
FOR
SET GMTIEN=$ORDER(^GMT(142.1,GMTIEN))
if 'GMTIEN
QUIT
Begin DoDot:1
+2 if $GET(^GMT(142.1,GMTIEN,0))']""
QUIT
+3 if ($PIECE(^GMT(142.1,GMTIEN,0),U,2)'["GMTSSOW")
QUIT
+4 SET GMTCMP(GMTIEN)=$PIECE(^GMT(142.1,GMTIEN,0),U)
+5 MERGE ^XTMP("GMTSP129",142.1,GMTIEN)=^GMT(142.1,GMTIEN)
End DoDot:1
+6 ;
+7 ; Generate 0 found msg and quit
+8 IF '$ORDER(GMTCMP(0))
Begin DoDot:1
+9 SET CNT=1
+10 SET MSG(CNT)=""
SET CNT=CNT+1
+11 SET MSG(CNT)="PATCH GMTS*2.7*129 completed processing successfully."
SET CNT=CNT+1
+12 SET MSG(CNT)=""
SET CNT=CNT+1
+13 SET MSG(CNT)="This patch found 0 Health Summary components with field PRINT ROUTINE "
SET CNT=CNT+1
+14 SET MSG(CNT)="containing GMTSSOWK."
SET CNT=CNT+1
+15 SET MSG(CNT)=""
+16 SET XMSUB="PATCH GMTS*2.7*129 INSTALL"
SET XMTEXT="MSG("
SET XMDUZ="Patch GMTS*2.7*129"
+17 SET XMY(DUZ)=""
+18 DO ^XMD
End DoDot:1
QUIT
+19 ;
+20 SET GMTCMP=0
FOR
SET GMTCMP=$ORDER(GMTCMP(GMTCMP))
if 'GMTCMP
QUIT
Begin DoDot:1
+21 SET GMTIEN=0
FOR
SET GMTIEN=$ORDER(^GMT(142,"AE",GMTCMP,GMTIEN))
if 'GMTIEN
QUIT
Begin DoDot:2
+22 SET GMTCMP(GMTCMP,GMTIEN)=$PIECE(^GMT(142,GMTIEN,0),U)
+23 SET GMTIEN2=0
FOR
SET GMTIEN2=$ORDER(^GMT(142,"AE",GMTCMP,GMTIEN,GMTIEN2))
if 'GMTIEN2
QUIT
Begin DoDot:3
+24 SET GMTCMP(GMTCMP,GMTIEN,GMTIEN2)=""
+25 MERGE ^XTMP("GMTSP129",142,GMTIEN,GMTIEN2)=^GMT(142,GMTIEN,1,GMTIEN2)
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 ; set disabled field
+28 SET GMTCMP=0
FOR
SET GMTCMP=$ORDER(GMTCMP(GMTCMP))
if 'GMTCMP
QUIT
Begin DoDot:1
+29 NEW DA,DIE
+30 SET DA=GMTCMP
SET DIE="^GMT(142.1,"
SET DR="5////P"
DO ^DIE
KILL DIE
+31 ; remove from health summary type
+32 SET GMTIEN=0
FOR
SET GMTIEN=$ORDER(GMTCMP(GMTCMP,GMTIEN))
if 'GMTIEN
QUIT
Begin DoDot:2
+33 SET GMTIEN2=0
FOR
SET GMTIEN2=$ORDER(GMTCMP(GMTCMP,GMTIEN,GMTIEN2))
if 'GMTIEN2
QUIT
Begin DoDot:3
+34 ; GMTCMP = IEN IN #142.1, GMTIEN = IEN IN #142, GMTIEN2 = SUB IEN IN 1 RECORD OF #142
+35 ; DELETE FROM #142
+36 SET DA(2)=142
SET DA(1)=GMTIEN
SET DA=GMTIEN2
SET DIK="^GMT("_DA(2)_","_DA(1)_",1,"
DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
MAIL ;
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT,DIE,DA,DR,MSG
+2 SET CNT=1
+3 SET XMY(DUZ)=""
+4 SET XMSUB="PATCH GMTS*2.7*129 INSTALL"
SET XMTEXT="MSG("
SET XMDUZ="Patch GMTS*2.7*129"
+5 SET MSG(CNT)=""
SET CNT=CNT+1
+6 SET MSG(CNT)="PATCH GMTS*2.7*129 completed processing successfully."
SET CNT=CNT+1
+7 SET MSG(CNT)=""
SET CNT=CNT+1
+8 SET MSG(CNT)="These Health Summary Component(s) were marked permanently disabled"
SET CNT=CNT+1
+9 SET GMTCMP=0
FOR
SET GMTCMP=$ORDER(GMTCMP(GMTCMP))
if 'GMTCMP
QUIT
Begin DoDot:1
+10 SET MSG(CNT)=GMTCMP(GMTCMP)
SET CNT=CNT+1
End DoDot:1
+11 SET MSG(CNT)=""
SET CNT=CNT+1
+12 SET MSG(CNT)="The above Components were deleted from these Health Summary Types:"
SET CNT=CNT+1
+13 ;
+14 SET GMTCMP=0
FOR
SET GMTCMP=$ORDER(GMTCMP(GMTCMP))
if 'GMTCMP
QUIT
Begin DoDot:1
+15 SET GMTIEN=0
FOR
SET GMTIEN=$ORDER(GMTCMP(GMTCMP,GMTIEN))
if 'GMTIEN
QUIT
Begin DoDot:2
+16 SET MSG(CNT)=GMTCMP(GMTCMP,GMTIEN)
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+17 ;SEND MAIL MSG
+18 DO ^XMD
+19 QUIT
