MAGIPS46 ;Post init routine to queue site activity at install. ; 09 May 2006 12:43 PM
;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
;; 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 ;
D ; save filters to guard against deletion during installation
. N FMDTNOW ; -- current date/time in Fileman format
. N FMDTPRG ; -- date & time to purge (1 day from now)
. N XTMP0 ; ---- header node of temporary save location - for purge
. ;
. U IO(0) W !,"Saving image filters..."
. L +^XTMP("MAGIPS46"):1E9 K ^XTMP("MAGIPS46")
. S FMDTNOW=$$NOW^XLFDT
. S FMDTPRG=$$FMADD^XLFDT(FMDTNOW,1,0,0,0)
. S ^XTMP("MAGIPS46",0)=FMDTPRG_"^"_FMDTNOW_"^MAG*3.0*46 FILTER SAVE"
. M ^XTMP("MAGIPS46",1)=^MAG(2006.57)
. L -^XTMP("MAGIPS46")
. U IO(0) W "saved.",!
. Q
Q
POST ;
;
D ; restore filters
. U IO(0) W !,"Restoring filters..."
. L +^MAG(2006.57):1E9
. M ^MAG(2006.57)=^XTMP("MAGIPS46",1)
. L -^MAG(2006.57)
. U IO(0) W "restored."
. Q
;
D DEFAULTS
D XREF
;
D REMTASK^MAGQE4
D STTASK^MAGQE4
;
D ADDRPC("MAG DICOM CON UNREADLIST LOCK","MAG WINDOWS")
D ADDRPC("MAG DICOM CON UNREADLIST GET","MAG WINDOWS")
D ADDRPC("MAG DICOM CON UNREAD ACQ SITES","MAG WINDOWS")
D ADDRPC("MAG DICOM CON GET TELE READER","MAG WINDOWS")
D ADDRPC("MAG DICOM CON SET TELE READER","MAG WINDOWS")
;
D ADDRPC("MAG DICOM CON UNREADLIST LOCK","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG DICOM CON UNREADLIST GET","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG DICOM CON UNREAD ACQ SITES","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG DICOM CON GET TELE READER","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG DICOM CON SET TELE READER","MAG DICOM GATEWAY FULL")
;
D ADDRPC("MAG DICOM CON UNREADLIST LOCK","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG DICOM CON UNREADLIST GET","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG DICOM CON UNREAD ACQ SITES","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG DICOM CON GET TELE READER","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG DICOM CON SET TELE READER","MAG DICOM GATEWAY VIEW")
;
D ; Confirmation message
. ;
. NEW %,CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,X,XMID,XMSUB,XMY,XMZ,Y
. ;
. 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) ;
;
NEW DA,DIC,I,X,Y
;
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
DEFAULTS ; Set default for location of TeleReader Timeout.
;
NEW %,%H,D,D0,DA,DI,DIC,DIE,DQ,DR,X
;
S X=0
F S X=$O(^MAG(2006.1,X)) Q:'+X S DA=X,DIE="^MAG(2006.1,",DR="131///180" D ^DIE
Q
XREF ; Kill then Reset ALL xrefs for ALL entries.
;
NEW DA,DIC,DIK,X
;
Q:'$O(^MAG(2006.5849,0))
;
S DIK="^MAG(2006.5849," D IXALL2^DIK ; KILL
S DIK="^MAG(2006.5849," D IXALL^DIK ; SET
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIPS46 5323 printed Apr 09, 2024@21:09:11 Page 2
MAGIPS46 ;Post init routine to queue site activity at install. ; 09 May 2006 12:43 PM
+1 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
+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 ;
PRE ;
+1 ; save filters to guard against deletion during installation
Begin DoDot:1
+2 ; -- current date/time in Fileman format
NEW FMDTNOW
+3 ; -- date & time to purge (1 day from now)
NEW FMDTPRG
+4 ; ---- header node of temporary save location - for purge
NEW XTMP0
+5 ;
+6 USE IO(0)
WRITE !,"Saving image filters..."
+7 LOCK +^XTMP("MAGIPS46"):1E9
KILL ^XTMP("MAGIPS46")
+8 SET FMDTNOW=$$NOW^XLFDT
+9 SET FMDTPRG=$$FMADD^XLFDT(FMDTNOW,1,0,0,0)
+10 SET ^XTMP("MAGIPS46",0)=FMDTPRG_"^"_FMDTNOW_"^MAG*3.0*46 FILTER SAVE"
+11 MERGE ^XTMP("MAGIPS46",1)=^MAG(2006.57)
+12 LOCK -^XTMP("MAGIPS46")
+13 USE IO(0)
WRITE "saved.",!
+14 QUIT
End DoDot:1
+15 QUIT
POST ;
+1 ;
+2 ; restore filters
Begin DoDot:1
+3 USE IO(0)
WRITE !,"Restoring filters..."
+4 LOCK +^MAG(2006.57):1E9
+5 MERGE ^MAG(2006.57)=^XTMP("MAGIPS46",1)
+6 LOCK -^MAG(2006.57)
+7 USE IO(0)
WRITE "restored."
+8 QUIT
End DoDot:1
+9 ;
+10 DO DEFAULTS
+11 DO XREF
+12 ;
+13 DO REMTASK^MAGQE4
+14 DO STTASK^MAGQE4
+15 ;
+16 DO ADDRPC("MAG DICOM CON UNREADLIST LOCK","MAG WINDOWS")
+17 DO ADDRPC("MAG DICOM CON UNREADLIST GET","MAG WINDOWS")
+18 DO ADDRPC("MAG DICOM CON UNREAD ACQ SITES","MAG WINDOWS")
+19 DO ADDRPC("MAG DICOM CON GET TELE READER","MAG WINDOWS")
+20 DO ADDRPC("MAG DICOM CON SET TELE READER","MAG WINDOWS")
+21 ;
+22 DO ADDRPC("MAG DICOM CON UNREADLIST LOCK","MAG DICOM GATEWAY FULL")
+23 DO ADDRPC("MAG DICOM CON UNREADLIST GET","MAG DICOM GATEWAY FULL")
+24 DO ADDRPC("MAG DICOM CON UNREAD ACQ SITES","MAG DICOM GATEWAY FULL")
+25 DO ADDRPC("MAG DICOM CON GET TELE READER","MAG DICOM GATEWAY FULL")
+26 DO ADDRPC("MAG DICOM CON SET TELE READER","MAG DICOM GATEWAY FULL")
+27 ;
+28 DO ADDRPC("MAG DICOM CON UNREADLIST LOCK","MAG DICOM GATEWAY VIEW")
+29 DO ADDRPC("MAG DICOM CON UNREADLIST GET","MAG DICOM GATEWAY VIEW")
+30 DO ADDRPC("MAG DICOM CON UNREAD ACQ SITES","MAG DICOM GATEWAY VIEW")
+31 DO ADDRPC("MAG DICOM CON GET TELE READER","MAG DICOM GATEWAY VIEW")
+32 DO ADDRPC("MAG DICOM CON SET TELE READER","MAG DICOM GATEWAY VIEW")
+33 ;
+34 ; Confirmation message
Begin DoDot:1
+35 ;
+36 NEW %,CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,X,XMID,XMSUB,XMY,XMZ,Y
+37 ;
+38 DO GETENV^%ZOSV
+39 SET CNT=0
+40 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE INSTALL"
+41 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+42 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_XPDNM
+43 SET CNT=CNT+1
SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
+44 SET ST=$$GET1^DIQ(9.7,XPDA,11,"I")
+45 SET CNT=CNT+1
SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
+46 SET CT=$$GET1^DIQ(9.7,XPDA,17,"I")
if +CT'=CT
SET CT=$$NOW^XLFDT()
+47 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+48 SET CNT=CNT+1
SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
+49 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+50 SET CNT=CNT+1
SET MAGMSG(CNT)="FILE COMMENT: "_$$GET1^DIQ(9.7,XPDA,6,"I")
+51 SET CNT=CNT+1
SET MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
+52 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,XPDA,9,"E")
+53 SET CNT=CNT+1
SET MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,XPDA,.01,"E")
+54 SET DDATE=$$GET1^DIQ(9.7,XPDA,51,"I")
+55 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
+56 if $GET(CVT)'=""
SET CNT=CNT+1
SET MAGMSG(CNT)="Conversion time: "_CVT
+57 SET XMSUB=XPDNM_" INSTALLATION"
+58 SET XMID=$GET(DUZ)
if 'XMID
SET XMID=.5
+59 SET XMY(XMID)=""
+60 SET XMY("G.MAG SERVER")=""
+61 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+62 SET XMSUB=$EXTRACT(XMSUB,1,63)
+63 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+64 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+65 QUIT
End DoDot:1
+66 QUIT
ADDRPC(RPCNAME,OPTNAME) ;
+1 ;
+2 NEW DA,DIC,I,X,Y
+3 ;
+4 SET DIC="^DIC(19,"
SET DIC(0)=""
SET X=OPTNAME
DO ^DIC
+5 IF Y<0
Begin DoDot:1
+6 WRITE !,"Cannot add """_RPCNAME_""" to """_OPTNAME_"""."
+7 WRITE !,"Cannot find """_OPTNAME_"""."
+8 QUIT
End DoDot:1
QUIT
+9 SET DA(1)=+Y
+10 SET DIC=DIC_DA(1)_",""RPC"","
+11 ; LAYGO should be allowed here
SET DIC(0)="L"
+12 SET X=RPCNAME
+13 DO ^DIC
+14 IF Y<0
Begin DoDot:1
+15 WRITE !,"Cannot add """_RPCNAME_""" to """_OPTNAME_"""."
+16 WRITE !,"Cannot find """_RPCNAME_"""."
+17 QUIT
End DoDot:1
QUIT
+18 QUIT
DEFAULTS ; Set default for location of TeleReader Timeout.
+1 ;
+2 NEW %,%H,D,D0,DA,DI,DIC,DIE,DQ,DR,X
+3 ;
+4 SET X=0
+5 FOR
SET X=$ORDER(^MAG(2006.1,X))
if '+X
QUIT
SET DA=X
SET DIE="^MAG(2006.1,"
SET DR="131///180"
DO ^DIE
+6 QUIT
XREF ; Kill then Reset ALL xrefs for ALL entries.
+1 ;
+2 NEW DA,DIC,DIK,X
+3 ;
+4 if '$ORDER(^MAG(2006.5849,0))
QUIT
+5 ;
+6 ; KILL
SET DIK="^MAG(2006.5849,"
DO IXALL2^DIK
+7 ; SET
SET DIK="^MAG(2006.5849,"
DO IXALL^DIK
+8 QUIT
