MAGIPS99 ;Post init routine to queue site activity at install. ; 24 Jun 2008 3:12 PM
;;3.0;IMAGING;**99**;Mar 19, 2002;Build 2057;Apr 19, 2011
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
POST ;
N CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
N MERGE
;
S MERGE=$$CODEMERGE()
;
D GETENV^%ZOSV
S CNT=0
S CNT=CNT+1,MAGMSG(CNT)="PACKAGE INSTALL"
S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_XPDNM
S CNT=CNT+1,MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
S ST=$$GET1^DIQ(9.7,XPDA,11,"I")
S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
S CT=$$GET1^DIQ(9.7,XPDA,17,"I") S:+CT'=CT CT=$$NOW^XLFDT()
S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
S CNT=CNT+1,MAGMSG(CNT)="FILE COMMENT: "_$$GET1^DIQ(9.7,XPDA,6,"I")
S CNT=CNT+1,MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,XPDA,9,"E")
S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,XPDA,.01,"E")
S DDATE=$$GET1^DIQ(9.7,XPDA,51,"I")
S CNT=CNT+1,MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
S XMSUB=XPDNM_" INSTALLATION"
S XMID=$G(DUZ) S:'XMID XMID=.5
S XMY(XMID)=""
S XMY("G.MAG SERVER")=""
S:$G(MAGDUZ) XMY(MAGDUZ)=""
S XMSUB=$E(XMSUB,1,63)
D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message,"
Q
;
CODEMERGE() ;
;P99 post-install code merge fixer
; MAGGTIA as installed in KIDS assumes no previous installs of 106/117
; MAGZTEMP1 routine has the MAGGTIA with 106/117 code merge
; MAGZTEMP2 routine has the MAGGTIA with 106 code merge
; Both MAGZTEMP1 & MAGZTEMP2 will be deleted after install
;
N SCENARIO,SECLIN
S SCENARIO=0
I $$PATCH^XPDUTL("MAG*3.0*117") S SCENARIO=1
I 'SCENARIO I $$PATCH^XPDUTL("MAG*3.0*106") S SCENARIO=2
I SCENARIO=1 D SCEN1
I SCENARIO=2 D SCEN2
D CLEANUP
; Check the 2nd lines of MAGGTIA to confirm success
S SECLINE=$P($T(+2^@"MAGGTIA"),";",5)
I (SCENARIO=0&(SECLINE="**8,48,99")) Q 1
I (SCENARIO=1&(SECLINE="**8,48,106,99**")) Q 1
I (SCENARIO=2&(SECLINE="**8,48,106,99,117**")) Q 1
Q -1
;
SCEN1 ;
S X=$$DEL("MAGGTIA")
D COPY("MAGZTEMP1","MAGGTIA")
Q
SCEN2 ;
S X=$$DEL("MAGGTIA")
D COPY("MAGZTEMP2","MAGGTIA")
Q
CLEANUP ;
S X=$$DEL("MAGZTEMP1")
S X=$$DEL("MAGZTEMP2")
Q
;
COPY(FROM,TO) ;
;Cribbed & modified slightly from COPY^ZTMGRSET
N ZTOS
S ZTOS=$$OSNUM^ZTMGRSET() ;Determine local OS
I ZTOS'=7,ZTOS'=8 X "ZL @FROM ZS @TO" Q
;For GT.M below
N PATH,COPY,CMD S PATH=$$R
S FROM=PATH_FROM_".m"
S TO=PATH_$TR(TO,"%","_")_".m"
S COPY=$S(ZTOS=7:"COPY",1:"cp")
S CMD=COPY_" "_FROM_" "_TO
X "ZSYSTEM CMD"
Q
;
R() ; routine directory for GT.M
;Cribbed from R^ZTMGRSET
N ZRO X "S ZRO=$ZRO"
I ZTOS=7 D Q $S(ZRO["(":$P($P(ZRO,"(",2),")"),1:ZRO)
. S ZRO=$P(ZRO,",")
. I ZRO["/SRC=" S ZRO=$P(ZRO,"=",2) Q ;Source dir
. S ZRO=$S(ZRO["/":$P(ZRO,"/"),1:ZRO) Q ;Source and Obj in same dir
I ZTOS=8 Q $P($S(ZRO["(":$P($P(ZRO,"(",2),")"),1:ZRO)," ")_"/" ;Use first source dir.
E Q ""
;
DEL(ROUTINE) ;
N X
S X=ROUTINE
Q:X=-1 I $T(^@X)="" Q 0
X ^%ZOSF("DEL")
I $T(^@X)="" Q 1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIPS99 4310 printed Dec 13, 2024@02:06:36 Page 2
MAGIPS99 ;Post init routine to queue site activity at install. ; 24 Jun 2008 3:12 PM
+1 ;;3.0;IMAGING;**99**;Mar 19, 2002;Build 2057;Apr 19, 2011
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
POST ;
+1 NEW CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
+2 NEW MERGE
+3 ;
+4 SET MERGE=$$CODEMERGE()
+5 ;
+6 DO GETENV^%ZOSV
+7 SET CNT=0
+8 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE INSTALL"
+9 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+10 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_XPDNM
+11 SET CNT=CNT+1
SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
+12 SET ST=$$GET1^DIQ(9.7,XPDA,11,"I")
+13 SET CNT=CNT+1
SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
+14 SET CT=$$GET1^DIQ(9.7,XPDA,17,"I")
if +CT'=CT
SET CT=$$NOW^XLFDT()
+15 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+16 SET CNT=CNT+1
SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
+17 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+18 SET CNT=CNT+1
SET MAGMSG(CNT)="FILE COMMENT: "_$$GET1^DIQ(9.7,XPDA,6,"I")
+19 SET CNT=CNT+1
SET MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
+20 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,XPDA,9,"E")
+21 SET CNT=CNT+1
SET MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,XPDA,.01,"E")
+22 SET DDATE=$$GET1^DIQ(9.7,XPDA,51,"I")
+23 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
+24 SET XMSUB=XPDNM_" INSTALLATION"
+25 SET XMID=$GET(DUZ)
if 'XMID
SET XMID=.5
+26 SET XMY(XMID)=""
+27 SET XMY("G.MAG SERVER")=""
+28 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+29 SET XMSUB=$EXTRACT(XMSUB,1,63)
+30 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+31 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+32 QUIT
+33 ;
CODEMERGE() ;
+1 ;P99 post-install code merge fixer
+2 ; MAGGTIA as installed in KIDS assumes no previous installs of 106/117
+3 ; MAGZTEMP1 routine has the MAGGTIA with 106/117 code merge
+4 ; MAGZTEMP2 routine has the MAGGTIA with 106 code merge
+5 ; Both MAGZTEMP1 & MAGZTEMP2 will be deleted after install
+6 ;
+7 NEW SCENARIO,SECLIN
+8 SET SCENARIO=0
+9 IF $$PATCH^XPDUTL("MAG*3.0*117")
SET SCENARIO=1
+10 IF 'SCENARIO
IF $$PATCH^XPDUTL("MAG*3.0*106")
SET SCENARIO=2
+11 IF SCENARIO=1
DO SCEN1
+12 IF SCENARIO=2
DO SCEN2
+13 DO CLEANUP
+14 ; Check the 2nd lines of MAGGTIA to confirm success
+15 SET SECLINE=$PIECE($TEXT(+2^@"MAGGTIA"),";",5)
+16 IF (SCENARIO=0&(SECLINE="**8,48,99"))
QUIT 1
+17 IF (SCENARIO=1&(SECLINE="**8,48,106,99**"))
QUIT 1
+18 IF (SCENARIO=2&(SECLINE="**8,48,106,99,117**"))
QUIT 1
+19 QUIT -1
+20 ;
SCEN1 ;
+1 SET X=$$DEL("MAGGTIA")
+2 DO COPY("MAGZTEMP1","MAGGTIA")
+3 QUIT
SCEN2 ;
+1 SET X=$$DEL("MAGGTIA")
+2 DO COPY("MAGZTEMP2","MAGGTIA")
+3 QUIT
CLEANUP ;
+1 SET X=$$DEL("MAGZTEMP1")
+2 SET X=$$DEL("MAGZTEMP2")
+3 QUIT
+4 ;
COPY(FROM,TO) ;
+1 ;Cribbed & modified slightly from COPY^ZTMGRSET
+2 NEW ZTOS
+3 ;Determine local OS
SET ZTOS=$$OSNUM^ZTMGRSET()
+4 IF ZTOS'=7
IF ZTOS'=8
XECUTE "ZL @FROM ZS @TO"
QUIT
+5 ;For GT.M below
+6 NEW PATH,COPY,CMD
SET PATH=$$R
+7 SET FROM=PATH_FROM_".m"
+8 SET TO=PATH_$TRANSLATE(TO,"%","_")_".m"
+9 SET COPY=$SELECT(ZTOS=7:"COPY",1:"cp")
+10 SET CMD=COPY_" "_FROM_" "_TO
+11 XECUTE "ZSYSTEM CMD"
+12 QUIT
+13 ;
R() ; routine directory for GT.M
+1 ;Cribbed from R^ZTMGRSET
+2 NEW ZRO
XECUTE "S ZRO=$ZRO"
+3 IF ZTOS=7
Begin DoDot:1
+4 SET ZRO=$PIECE(ZRO,",")
+5 ;Source dir
IF ZRO["/SRC="
SET ZRO=$PIECE(ZRO,"=",2)
QUIT
+6 ;Source and Obj in same dir
SET ZRO=$SELECT(ZRO["/":$PIECE(ZRO,"/"),1:ZRO)
QUIT
End DoDot:1
QUIT $SELECT(ZRO["(":$PIECE($PIECE(ZRO,"(",2),")"),1:ZRO)
+7 ;Use first source dir.
IF ZTOS=8
QUIT $PIECE($SELECT(ZRO["(":$PIECE($PIECE(ZRO,"(",2),")"),1:ZRO)," ")_"/"
+8 IF '$TEST
QUIT ""
+9 ;
DEL(ROUTINE) ;
+1 NEW X
+2 SET X=ROUTINE
+3 if X=-1
QUIT
IF $TEXT(^@X)=""
QUIT 0
+4 XECUTE ^%ZOSF("DEL")
+5 IF $TEXT(^@X)=""
QUIT 1
+6 QUIT
