- MAGIP108 ;WOIFO/NST - INSTALL CODE FOR MAG*3.0*108 ; 15 Apr 2010 2:53 PM
- ;;3.0;IMAGING;**108**;Mar 19, 2002;Build 1738;May 20, 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. |
- ;; +---------------------------------------------------------------+
- ;;
- ; There are no environment checks here but the MAGIP108 has to be
- ; referenced by the "Environment Check Routine" field of the KIDS
- ; build so that entry points of the routine are available to the
- ; KIDS during all installation phases.
- Q
- PRE ;
- Q
- ;
- POS ;
- D ADDRPC() ; Link new remote procedures to the Broker context option
- D RPTSKCP() ; Restart the Imaging Utilization Report task
- D NOTIFY() ; Send the notification e-mail
- Q
- ;
- ADDRPC() ;
- N RPCNAMES,NAME,RPCIEN,IENS,OPTIEN,I,GET,DIERR,MAGFDA
- ; 1. Add RPCs to Secondary menu(s)
- ;
- S OPTIEN=$$LKOPT^XPDMENU("MAG WINDOWS")
- I OPTIEN'>0 W !,"Error getting ""MAG WINDOWS"" context" Q
- ;
- S RPCNAMES="RPCLST^"_$T(+0)
- ;--- Get the list from the source code
- S GET=$P(RPCNAMES,"^")_"+I^"_$P(RPCNAMES,"^",2)
- S GET="S NAME=$$TRIM^XLFSTR($P($T("_GET_"),"";;"",2))"
- F I=1:1 X GET Q:NAME="" S RPCNAMES(NAME)=""
- ;
- S NAME=""
- F S NAME=$O(RPCNAMES(NAME)) Q:NAME="" D
- . ;--- Check if the remote procedure exists
- . S RPCIEN=$$FIND1^DIC(8994,,,NAME,"B",,"MAGMSG")
- . I $G(DIERR) Q
- . I RPCIEN'>0 Q
- . ;--- Add the remote procedure to the multiple
- . S IENS="?+1,"_OPTIEN_","
- . S MAGFDA(19.05,IENS,.01)=RPCIEN
- . D UPDATE^DIE(,"MAGFDA",,"MAGMSG")
- . I $G(DIERR) W !,"Error updating ""MAG WINDOWS"" context RPC="_NAME
- . ;---
- . Q
- Q
- ;
- NOTIFY() ;
- N CNT,CT,IENS,MAGBUF,MAGERR,MAGMSG,MAGRC,ST,Y
- S MAGRC=0,IENS=XPDA_","
- ;
- ;--- Load the build properties from the BUILD file (#9.7)
- D GETS^DIQ(9.7,IENS,".01;6;9;11;17;51","EI","MAGBUF","MAGERR")
- I $G(DIERR) W !,"Error loading the build properties" Q
- ;
- ;--- Compile the message text
- 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=$G(MAGBUF(9.7,IENS,11,"I"))
- S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
- S CT=$G(MAGBUF(9.7,IENS,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)
- D GETENV^%ZOSV
- S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
- S CNT=CNT+1,MAGMSG(CNT)="FILE COMMENT: "_$G(MAGBUF(9.7,IENS,6,"I"))
- S CNT=CNT+1,MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
- S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$G(MAGBUF(9.7,IENS,9,"E"))
- S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_$G(MAGBUF(9.7,IENS,.01,"E"))
- S Y=$G(MAGBUF(9.7,IENS,51,"E"))
- S CNT=CNT+1,MAGMSG(CNT)="Distribution Date: "_Y
- ;
- ;--- Send the e-mail notification
- D
- . N DIFROM,XMERR,XMID,XMSUB,XMY,XMZ
- . S XMSUB=$E(XPDNM_" INSTALLATION",1,63)
- . S XMID=$G(DUZ) S:XMID'>0 XMID=.5
- . S (XMY(XMID),XMY("G.MAG SERVER"))=""
- . D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ)
- . Q:'$G(XMERR)
- . K MAGERR M MAGERR=^TMP("XMERR",$J)
- . Q
- ;
- ;---
- Q
- ;
- ;+++++ LIST OF NEW REMOTE PROCEDURES
- RPCLST ;
- ;;MAG4 INDEX GET ORIGIN
- ;;MAGN PATIENT HAS PHOTO
- Q 0
- ;
- ;+++++ RESTARTS THE IMAGING UTILIZATION REPORT TASK
- RPTSKCP() ;
- D REMTASK^MAGQE4,STTASK^MAGQE4
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIP108 4242 printed Feb 18, 2025@23:30:14 Page 2
- MAGIP108 ;WOIFO/NST - INSTALL CODE FOR MAG*3.0*108 ; 15 Apr 2010 2:53 PM
- +1 ;;3.0;IMAGING;**108**;Mar 19, 2002;Build 1738;May 20, 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 ; There are no environment checks here but the MAGIP108 has to be
- +18 ; referenced by the "Environment Check Routine" field of the KIDS
- +19 ; build so that entry points of the routine are available to the
- +20 ; KIDS during all installation phases.
- +21 QUIT
- PRE ;
- +1 QUIT
- +2 ;
- POS ;
- +1 ; Link new remote procedures to the Broker context option
- DO ADDRPC()
- +2 ; Restart the Imaging Utilization Report task
- DO RPTSKCP()
- +3 ; Send the notification e-mail
- DO NOTIFY()
- +4 QUIT
- +5 ;
- ADDRPC() ;
- +1 NEW RPCNAMES,NAME,RPCIEN,IENS,OPTIEN,I,GET,DIERR,MAGFDA
- +2 ; 1. Add RPCs to Secondary menu(s)
- +3 ;
- +4 SET OPTIEN=$$LKOPT^XPDMENU("MAG WINDOWS")
- +5 IF OPTIEN'>0
- WRITE !,"Error getting ""MAG WINDOWS"" context"
- QUIT
- +6 ;
- +7 SET RPCNAMES="RPCLST^"_$TEXT(+0)
- +8 ;--- Get the list from the source code
- +9 SET GET=$PIECE(RPCNAMES,"^")_"+I^"_$PIECE(RPCNAMES,"^",2)
- +10 SET GET="S NAME=$$TRIM^XLFSTR($P($T("_GET_"),"";;"",2))"
- +11 FOR I=1:1
- XECUTE GET
- if NAME=""
- QUIT
- SET RPCNAMES(NAME)=""
- +12 ;
- +13 SET NAME=""
- +14 FOR
- SET NAME=$ORDER(RPCNAMES(NAME))
- if NAME=""
- QUIT
- Begin DoDot:1
- +15 ;--- Check if the remote procedure exists
- +16 SET RPCIEN=$$FIND1^DIC(8994,,,NAME,"B",,"MAGMSG")
- +17 IF $GET(DIERR)
- QUIT
- +18 IF RPCIEN'>0
- QUIT
- +19 ;--- Add the remote procedure to the multiple
- +20 SET IENS="?+1,"_OPTIEN_","
- +21 SET MAGFDA(19.05,IENS,.01)=RPCIEN
- +22 DO UPDATE^DIE(,"MAGFDA",,"MAGMSG")
- +23 IF $GET(DIERR)
- WRITE !,"Error updating ""MAG WINDOWS"" context RPC="_NAME
- +24 ;---
- +25 QUIT
- End DoDot:1
- +26 QUIT
- +27 ;
- NOTIFY() ;
- +1 NEW CNT,CT,IENS,MAGBUF,MAGERR,MAGMSG,MAGRC,ST,Y
- +2 SET MAGRC=0
- SET IENS=XPDA_","
- +3 ;
- +4 ;--- Load the build properties from the BUILD file (#9.7)
- +5 DO GETS^DIQ(9.7,IENS,".01;6;9;11;17;51","EI","MAGBUF","MAGERR")
- +6 IF $GET(DIERR)
- WRITE !,"Error loading the build properties"
- QUIT
- +7 ;
- +8 ;--- Compile the message text
- +9 SET CNT=0
- +10 SET CNT=CNT+1
- SET MAGMSG(CNT)="PACKAGE INSTALL"
- +11 SET CNT=CNT+1
- SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
- +12 SET CNT=CNT+1
- SET MAGMSG(CNT)="PACKAGE: "_XPDNM
- +13 SET CNT=CNT+1
- SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
- +14 SET ST=$GET(MAGBUF(9.7,IENS,11,"I"))
- +15 SET CNT=CNT+1
- SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
- +16 SET CT=$GET(MAGBUF(9.7,IENS,17,"I"))
- if +CT'=CT
- SET CT=$$NOW^XLFDT()
- +17 SET CNT=CNT+1
- SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
- +18 SET CNT=CNT+1
- SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
- +19 DO GETENV^%ZOSV
- +20 SET CNT=CNT+1
- SET MAGMSG(CNT)="Environment: "_Y
- +21 SET CNT=CNT+1
- SET MAGMSG(CNT)="FILE COMMENT: "_$GET(MAGBUF(9.7,IENS,6,"I"))
- +22 SET CNT=CNT+1
- SET MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
- +23 SET CNT=CNT+1
- SET MAGMSG(CNT)="Installed by: "_$GET(MAGBUF(9.7,IENS,9,"E"))
- +24 SET CNT=CNT+1
- SET MAGMSG(CNT)="Install Name: "_$GET(MAGBUF(9.7,IENS,.01,"E"))
- +25 SET Y=$GET(MAGBUF(9.7,IENS,51,"E"))
- +26 SET CNT=CNT+1
- SET MAGMSG(CNT)="Distribution Date: "_Y
- +27 ;
- +28 ;--- Send the e-mail notification
- +29 Begin DoDot:1
- +30 NEW DIFROM,XMERR,XMID,XMSUB,XMY,XMZ
- +31 SET XMSUB=$EXTRACT(XPDNM_" INSTALLATION",1,63)
- +32 SET XMID=$GET(DUZ)
- if XMID'>0
- SET XMID=.5
- +33 SET (XMY(XMID),XMY("G.MAG SERVER"))=""
- +34 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ)
- +35 if '$GET(XMERR)
- QUIT
- +36 KILL MAGERR
- MERGE MAGERR=^TMP("XMERR",$JOB)
- +37 QUIT
- End DoDot:1
- +38 ;
- +39 ;---
- +40 QUIT
- +41 ;
- +42 ;+++++ LIST OF NEW REMOTE PROCEDURES
- RPCLST ;
- +1 ;;MAG4 INDEX GET ORIGIN
- +2 ;;MAGN PATIENT HAS PHOTO
- +3 QUIT 0
- +4 ;
- +5 ;+++++ RESTARTS THE IMAGING UTILIZATION REPORT TASK
- RPTSKCP() ;
- +1 DO REMTASK^MAGQE4
- DO STTASK^MAGQE4
- +2 QUIT 0