- MAGIPS83 ;WOIFO/EdM,MLH - Post init routine to queue site activity at install. ; 11 Jan 2010 8:41 AM
- ;;3.0;IMAGING;**83**;Mar 19, 2002;Build 1690;Mar 29, 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
- ;
- ;
- POST ;
- ; 1. Add RPCs to Secondary menu(s)
- ; last. Send confirmation message
- ;
- F OPT="MAG WINDOWS","MAG DICOM GATEWAY FULL","MAG DICOM GATEWAY VIEW" D
- . D ADDRPC("MAG NEW SOP INSTANCE UID",OPT)
- . D ADDRPC("MAG DICOM CHECK AE TITLE",OPT)
- . D ADDRPC("MAG DICOM GET GATEWAY INFO",OPT)
- . D ADDRPC("MAG DICOM STORE GATEWAY INFO",OPT)
- . D ADDRPC("MAG DICOM VISTA AE TITLE",OPT)
- . D ADDRPC("MAG DOD GET STUDIES IEN",OPT)
- . D ADDRPC("MAG DOD GET STUDIES UID",OPT)
- . D ADDRPC("MAG GET NETLOC",OPT)
- . D ADDRPC("MAG IMAGE CURRENT INFO",OPT)
- . D ADDRPC("MAG SCAN IMAGE TEXT FILES",OPT)
- . D ADDRPC("MAG STORE TEXT FILE DETAILS",OPT)
- . Q
- ;
- F OPT="MAGJ VISTARAD WINDOWS" D
- . D ADDRPC("MAG IMAGE CURRENT INFO",OPT)
- . D ADDRPC("MAG NEW SOP INSTANCE UID",OPT)
- . Q
- ;
- D ADDRPC("MAGGUSER2","MAG DICOM GATEWAY FULL")
- D ADDRPC("MAGG LOGOFF","MAG DICOM GATEWAY FULL")
- ;
- ; Send confirmation message
- ;
- D ; Confirmation message
- . N CT,CNT,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: "_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:$G(CVT)'="" CNT=CNT+1,MAGMSG(CNT)="Conversion time: "_CVT
- . 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
- 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[HMAGIPS83 3982 printed Apr 23, 2025@18:21:01 Page 2
- MAGIPS83 ;WOIFO/EdM,MLH - Post init routine to queue site activity at install. ; 11 Jan 2010 8:41 AM
- +1 ;;3.0;IMAGING;**83**;Mar 19, 2002;Build 1690;Mar 29, 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
- +18 ;
- +19 ;
- POST ;
- +1 ; 1. Add RPCs to Secondary menu(s)
- +2 ; last. Send confirmation message
- +3 ;
- +4 FOR OPT="MAG WINDOWS","MAG DICOM GATEWAY FULL","MAG DICOM GATEWAY VIEW"
- Begin DoDot:1
- +5 DO ADDRPC("MAG NEW SOP INSTANCE UID",OPT)
- +6 DO ADDRPC("MAG DICOM CHECK AE TITLE",OPT)
- +7 DO ADDRPC("MAG DICOM GET GATEWAY INFO",OPT)
- +8 DO ADDRPC("MAG DICOM STORE GATEWAY INFO",OPT)
- +9 DO ADDRPC("MAG DICOM VISTA AE TITLE",OPT)
- +10 DO ADDRPC("MAG DOD GET STUDIES IEN",OPT)
- +11 DO ADDRPC("MAG DOD GET STUDIES UID",OPT)
- +12 DO ADDRPC("MAG GET NETLOC",OPT)
- +13 DO ADDRPC("MAG IMAGE CURRENT INFO",OPT)
- +14 DO ADDRPC("MAG SCAN IMAGE TEXT FILES",OPT)
- +15 DO ADDRPC("MAG STORE TEXT FILE DETAILS",OPT)
- +16 QUIT
- End DoDot:1
- +17 ;
- +18 FOR OPT="MAGJ VISTARAD WINDOWS"
- Begin DoDot:1
- +19 DO ADDRPC("MAG IMAGE CURRENT INFO",OPT)
- +20 DO ADDRPC("MAG NEW SOP INSTANCE UID",OPT)
- +21 QUIT
- End DoDot:1
- +22 ;
- +23 DO ADDRPC("MAGGUSER2","MAG DICOM GATEWAY FULL")
- +24 DO ADDRPC("MAGG LOGOFF","MAG DICOM GATEWAY FULL")
- +25 ;
- +26 ; Send confirmation message
- +27 ;
- +28 ; Confirmation message
- Begin DoDot:1
- +29 NEW CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
- +30 ;
- +31 DO GETENV^%ZOSV
- +32 SET CNT=0
- +33 SET CNT=CNT+1
- SET MAGMSG(CNT)="PACKAGE INSTALL"
- +34 SET CNT=CNT+1
- SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
- +35 SET CNT=CNT+1
- SET MAGMSG(CNT)="PACKAGE: "_XPDNM
- +36 SET CNT=CNT+1
- SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
- +37 SET ST=$$GET1^DIQ(9.7,XPDA,11,"I")
- +38 SET CNT=CNT+1
- SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
- +39 SET CT=$$GET1^DIQ(9.7,XPDA,17,"I")
- if +CT'=CT
- SET CT=$$NOW^XLFDT()
- +40 SET CNT=CNT+1
- SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
- +41 SET CNT=CNT+1
- SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
- +42 SET CNT=CNT+1
- SET MAGMSG(CNT)="Environment: "_Y
- +43 SET CNT=CNT+1
- SET MAGMSG(CNT)="FILE COMMENT: "_$$GET1^DIQ(9.7,XPDA,6,"I")
- +44 SET CNT=CNT+1
- SET MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
- +45 SET CNT=CNT+1
- SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,XPDA,9,"E")
- +46 SET CNT=CNT+1
- SET MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,XPDA,.01,"E")
- +47 SET DDATE=$$GET1^DIQ(9.7,XPDA,51,"I")
- +48 SET CNT=CNT+1
- SET MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
- +49 if $GET(CVT)'=""
- SET CNT=CNT+1
- SET MAGMSG(CNT)="Conversion time: "_CVT
- +50 SET XMSUB=XPDNM_" INSTALLATION"
- +51 SET XMID=$GET(DUZ)
- if 'XMID
- SET XMID=.5
- +52 SET XMY(XMID)=""
- +53 SET XMY("G.MAG SERVER")=""
- +54 if $GET(MAGDUZ)
- SET XMY(MAGDUZ)=""
- +55 SET XMSUB=$EXTRACT(XMSUB,1,63)
- +56 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
- +57 IF $GET(XMERR)
- MERGE XMERR=^TMP("XMERR",$JOB)
- SET $ECODE=",U13-Cannot send MailMan message,"
- +58 QUIT
- End DoDot:1
- +59 QUIT
- +60 ;
- 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 ;