MAGIPS66 ;Post init routine to queue site activity at install. ; 04 Apr 2008 2:27 PM
;;3.0;IMAGING;**66**;Mar 19, 2002;Build 1836;Sep 02, 2010
;; 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
PRE ;
; Kill File 2006.87 if it happens to exist. This will only be the
; case at P66 test sites.
N DIU
S DIU="^MAG(2006.87,",DIU(0)="D" D EN^DIU2
Q
;
POST ;
N CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,OPT,ST,XMID,XMY
; 1. Add RPCs to secondary menus
; 2. Initialize DICOM root
; 3. Send confirmation message
;
F OPT="MAG DICOM GATEWAY FULL","MAG DICOM GATEWAY VIEW","MAG DICOM QUERY RETRIEVE" D
. D ADDRPC("MAG DICOM CHECK AE TITLE",OPT)
. D ADDRPC("MAG DICOM VISTA AE TITLE",OPT)
. D ADDRPC("MAG DICOM GET GATEWAY INFO",OPT)
. D ADDRPC("MAG DICOM STORE GATEWAY INFO",OPT)
. D ADDRPC("MAG CFIND QUERY",OPT)
. D ADDRPC("MAG STUDY UID QUERY",OPT)
. D ADDRPC("MAG IMAGE CURRENT INFO",OPT)
. D ADDRPC("XUS INTRO MSG",OPT)
. Q
;
D INIT^MAGDRUID
;
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
;
ADDRPC(RPCNAME,OPTNAME) N DA,DIC
S DIC="^DIC(19,",DIC(0)="",X=OPTNAME D ^DIC
I Y<0 D Q
. W !,"Cannot add """_RPCNAME_""" to """_OPTNAME_"""."
. W !,"Cannot find """_OPTNAME_"""."
. Q
S DA(1)=+Y
S DIC=DIC_DA(1)_",""RPC"","
S DIC(0)="L" ; LAYGO should be allowed here
S X=RPCNAME
D ^DIC
I Y<0 D Q
. W !,"Cannot add """_RPCNAME_""" to """_OPTNAME_"""."
. W !,"Cannot find """_RPCNAME_"""."
. Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIPS66 3605 printed Nov 22, 2024@17:16:28 Page 2
MAGIPS66 ;Post init routine to queue site activity at install. ; 04 Apr 2008 2:27 PM
+1 ;;3.0;IMAGING;**66**;Mar 19, 2002;Build 1836;Sep 02, 2010
+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
PRE ;
+1 ; Kill File 2006.87 if it happens to exist. This will only be the
+2 ; case at P66 test sites.
+3 NEW DIU
+4 SET DIU="^MAG(2006.87,"
SET DIU(0)="D"
DO EN^DIU2
+5 QUIT
+6 ;
POST ;
+1 NEW CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,OPT,ST,XMID,XMY
+2 ; 1. Add RPCs to secondary menus
+3 ; 2. Initialize DICOM root
+4 ; 3. Send confirmation message
+5 ;
+6 FOR OPT="MAG DICOM GATEWAY FULL","MAG DICOM GATEWAY VIEW","MAG DICOM QUERY RETRIEVE"
Begin DoDot:1
+7 DO ADDRPC("MAG DICOM CHECK AE TITLE",OPT)
+8 DO ADDRPC("MAG DICOM VISTA AE TITLE",OPT)
+9 DO ADDRPC("MAG DICOM GET GATEWAY INFO",OPT)
+10 DO ADDRPC("MAG DICOM STORE GATEWAY INFO",OPT)
+11 DO ADDRPC("MAG CFIND QUERY",OPT)
+12 DO ADDRPC("MAG STUDY UID QUERY",OPT)
+13 DO ADDRPC("MAG IMAGE CURRENT INFO",OPT)
+14 DO ADDRPC("XUS INTRO MSG",OPT)
+15 QUIT
End DoDot:1
+16 ;
+17 DO INIT^MAGDRUID
+18 ;
+19 DO GETENV^%ZOSV
+20 SET CNT=0
+21 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE INSTALL"
+22 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+23 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_XPDNM
+24 SET CNT=CNT+1
SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
+25 SET ST=$$GET1^DIQ(9.7,XPDA,11,"I")
+26 SET CNT=CNT+1
SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
+27 SET CT=$$GET1^DIQ(9.7,XPDA,17,"I")
if +CT'=CT
SET CT=$$NOW^XLFDT()
+28 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+29 SET CNT=CNT+1
SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
+30 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+31 SET CNT=CNT+1
SET MAGMSG(CNT)="FILE COMMENT: "_$$GET1^DIQ(9.7,XPDA,6,"I")
+32 SET CNT=CNT+1
SET MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
+33 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,XPDA,9,"E")
+34 SET CNT=CNT+1
SET MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,XPDA,.01,"E")
+35 SET DDATE=$$GET1^DIQ(9.7,XPDA,51,"I")
+36 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
+37 SET XMSUB=XPDNM_" INSTALLATION"
+38 SET XMID=$GET(DUZ)
if 'XMID
SET XMID=.5
+39 SET XMY(XMID)=""
+40 SET XMY("G.MAG SERVER")=""
+41 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+42 SET XMSUB=$EXTRACT(XMSUB,1,63)
+43 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+44 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+45 QUIT
+46 ;
ADDRPC(RPCNAME,OPTNAME) NEW DA,DIC
+1 SET DIC="^DIC(19,"
SET DIC(0)=""
SET X=OPTNAME
DO ^DIC
+2 IF Y<0
Begin DoDot:1
+3 WRITE !,"Cannot add """_RPCNAME_""" to """_OPTNAME_"""."
+4 WRITE !,"Cannot find """_OPTNAME_"""."
+5 QUIT
End DoDot:1
QUIT
+6 SET DA(1)=+Y
+7 SET DIC=DIC_DA(1)_",""RPC"","
+8 ; LAYGO should be allowed here
SET DIC(0)="L"
+9 SET X=RPCNAME
+10 DO ^DIC
+11 IF Y<0
Begin DoDot:1
+12 WRITE !,"Cannot add """_RPCNAME_""" to """_OPTNAME_"""."
+13 WRITE !,"Cannot find """_RPCNAME_"""."
+14 QUIT
End DoDot:1
QUIT
+15 QUIT
+16 ;
