MAGIPS95 ;Post init routine to queue site activity at install ; 16 Feb 2004 2:41 PM
;;3.0;IMAGING;**95**;August 7, 2008;Build 12
;; 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 ;
; create and send the site installation message
D VERCHKON ; Turn on Version Checking
D REMTASK^MAGQE4
D STTASK^MAGQE4
D INS(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
Q
VERCHKON ; Turn on Version Checking at the Sites.
; We aren't forcing it to stay on, sites can turn it back off.
N MAGIEN,MAGSITE,VERCHK,MSG
S MAGIEN=0
F S MAGIEN=$O(^MAG(2006.1,MAGIEN)) Q:'MAGIEN D
. S MSG="is already ON, no action taken"
. S MAGSITE=$P($G(^MAG(2006.1,MAGIEN,0)),"^",1)
. S VERCHK=$P($G(^MAG(2006.1,MAGIEN,"KEYS")),"^",5)
. I 'VERCHK S $P(^MAG(2006.1,MAGIEN,"KEYS"),"^",5)=1 S MSG="has been turned ON"
. D MES^XPDUTL("Patch 95 is turning Version Checking ON...")
. D MES^XPDUTL("Version Checking "_MSG_" for Site: "_MAGSITE)
Q
INS(XP,DUZ,DATE,IDA) ;
N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
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: "_XP
S CNT=CNT+1,MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XP)
S ST=$$GET1^DIQ(9.7,IDA,11,"I")
S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
S CT=$$GET1^DIQ(9.7,IDA,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 COM=$$GET1^DIQ(9.7,IDA,6,"I")
S CNT=CNT+1,MAGMSG(CNT)="FILE COMMENT: "_COM
S CNT=CNT+1,MAGMSG(CNT)="DATE: "_DATE
S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,IDA,9,"E")
S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,IDA,.01,"E")
S DDATE=$$GET1^DIQ(9.7,IDA,51,"I")
S CNT=CNT+1,MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
S XMSUB=XP_" 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIPS95 3252 printed Nov 22, 2024@17:16:40 Page 2
MAGIPS95 ;Post init routine to queue site activity at install ; 16 Feb 2004 2:41 PM
+1 ;;3.0;IMAGING;**95**;August 7, 2008;Build 12
+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 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 QUIT
POST ;
+1 ; create and send the site installation message
+2 ; Turn on Version Checking
DO VERCHKON
+3 DO REMTASK^MAGQE4
+4 DO STTASK^MAGQE4
+5 DO INS(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
+6 QUIT
VERCHKON ; Turn on Version Checking at the Sites.
+1 ; We aren't forcing it to stay on, sites can turn it back off.
+2 NEW MAGIEN,MAGSITE,VERCHK,MSG
+3 SET MAGIEN=0
+4 FOR
SET MAGIEN=$ORDER(^MAG(2006.1,MAGIEN))
if 'MAGIEN
QUIT
Begin DoDot:1
+5 SET MSG="is already ON, no action taken"
+6 SET MAGSITE=$PIECE($GET(^MAG(2006.1,MAGIEN,0)),"^",1)
+7 SET VERCHK=$PIECE($GET(^MAG(2006.1,MAGIEN,"KEYS")),"^",5)
+8 IF 'VERCHK
SET $PIECE(^MAG(2006.1,MAGIEN,"KEYS"),"^",5)=1
SET MSG="has been turned ON"
+9 DO MES^XPDUTL("Patch 95 is turning Version Checking ON...")
+10 DO MES^XPDUTL("Version Checking "_MSG_" for Site: "_MAGSITE)
End DoDot:1
+11 QUIT
INS(XP,DUZ,DATE,IDA) ;
+1 NEW CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
+2 DO GETENV^%ZOSV
+3 SET CNT=0
+4 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE INSTALL"
+5 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+6 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_XP
+7 SET CNT=CNT+1
SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XP)
+8 SET ST=$$GET1^DIQ(9.7,IDA,11,"I")
+9 SET CNT=CNT+1
SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
+10 SET CT=$$GET1^DIQ(9.7,IDA,17,"I")
if +CT'=CT
SET CT=$$NOW^XLFDT
+11 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+12 SET CNT=CNT+1
SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
+13 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+14 SET COM=$$GET1^DIQ(9.7,IDA,6,"I")
+15 SET CNT=CNT+1
SET MAGMSG(CNT)="FILE COMMENT: "_COM
+16 SET CNT=CNT+1
SET MAGMSG(CNT)="DATE: "_DATE
+17 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,IDA,9,"E")
+18 SET CNT=CNT+1
SET MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,IDA,.01,"E")
+19 SET DDATE=$$GET1^DIQ(9.7,IDA,51,"I")
+20 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
+21 SET XMSUB=XP_" INSTALLATION"
+22 SET XMID=$GET(DUZ)
if 'XMID
SET XMID=.5
+23 SET XMY(XMID)=""
+24 SET XMY("G.MAG SERVER")=""
+25 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+26 SET XMSUB=$EXTRACT(XMSUB,1,63)
+27 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+28 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+29 QUIT
