- 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 Feb 18, 2025@23:25:06 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