MAGIPS50 ;Post init routine to queue site activity at install. ; 10/25/2005 10:01
;;3.0;IMAGING;**50**;26-May-2006
;; +---------------------------------------------------------------+
;; | 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 ;
; 1. Remove mis-numbered field from ^DD
;
S DIK="^DD(2005,",DA=112,DA(1)=2005 D ^DIK
Q
;
POST N CVT
; 1. Add RPCs to secondary menus
; 2. Re-cross-reference file # 2006.574
; 3. Send confirmation message
;
;
D ADDRPC("MAG DICOM GET ICN","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG NEW SOP INSTANCE UID","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG RAD GET NEXT RPT BY DATE","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG RAD GET NEXT RPT BY PT","MAG DICOM GATEWAY FULL")
;
D ADDRPC("MAG DICOM GET ICN","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG NEW SOP INSTANCE UID","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG RAD GET NEXT RPT BY DATE","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG RAD GET NEXT RPT BY PT","MAG DICOM GATEWAY VIEW")
;
D ; Re-cross-reference
. N D0,D1,LOC,PRI,STS,X
. K ^MAGDOUTP(2006.574,"STS")
. S D0=0 F S D0=$O(^MAGDOUTP(2006.574,D0)) Q:'D0 D
. . S X=$G(^MAGDOUTP(2006.574,D0,0)),LOC=$P(X,"^",4),PRI=$P(X,"^",5)
. . S:'PRI PRI=500
. . S D1=0 F S D1=$O(^MAGDOUTP(2006.574,D0,1,D1)) Q:'D1 D
. . . S STS=$P($G(^MAGDOUTP(2006.574,D0,1,D1,0)),"^",2)
. . . I LOC'="",STS'="" S ^MAGDOUTP(2006.574,"STS",LOC,PRI,STS,D0,D1)=""
. . . Q
. . Q
. Q
;
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[HMAGIPS50 4213 printed Apr 09, 2024@21:00:47 Page 2
MAGIPS50 ;Post init routine to queue site activity at install. ; 10/25/2005 10:01
+1 ;;3.0;IMAGING;**50**;26-May-2006
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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 ; 1. Remove mis-numbered field from ^DD
+2 ;
+3 SET DIK="^DD(2005,"
SET DA=112
SET DA(1)=2005
DO ^DIK
+4 QUIT
+5 ;
POST NEW CVT
+1 ; 1. Add RPCs to secondary menus
+2 ; 2. Re-cross-reference file # 2006.574
+3 ; 3. Send confirmation message
+4 ;
+5 ;
+6 DO ADDRPC("MAG DICOM GET ICN","MAG DICOM GATEWAY FULL")
+7 DO ADDRPC("MAG NEW SOP INSTANCE UID","MAG DICOM GATEWAY FULL")
+8 DO ADDRPC("MAG RAD GET NEXT RPT BY DATE","MAG DICOM GATEWAY FULL")
+9 DO ADDRPC("MAG RAD GET NEXT RPT BY PT","MAG DICOM GATEWAY FULL")
+10 ;
+11 DO ADDRPC("MAG DICOM GET ICN","MAG DICOM GATEWAY VIEW")
+12 DO ADDRPC("MAG NEW SOP INSTANCE UID","MAG DICOM GATEWAY VIEW")
+13 DO ADDRPC("MAG RAD GET NEXT RPT BY DATE","MAG DICOM GATEWAY VIEW")
+14 DO ADDRPC("MAG RAD GET NEXT RPT BY PT","MAG DICOM GATEWAY VIEW")
+15 ;
+16 ; Re-cross-reference
Begin DoDot:1
+17 NEW D0,D1,LOC,PRI,STS,X
+18 KILL ^MAGDOUTP(2006.574,"STS")
+19 SET D0=0
FOR
SET D0=$ORDER(^MAGDOUTP(2006.574,D0))
if 'D0
QUIT
Begin DoDot:2
+20 SET X=$GET(^MAGDOUTP(2006.574,D0,0))
SET LOC=$PIECE(X,"^",4)
SET PRI=$PIECE(X,"^",5)
+21 if 'PRI
SET PRI=500
+22 SET D1=0
FOR
SET D1=$ORDER(^MAGDOUTP(2006.574,D0,1,D1))
if 'D1
QUIT
Begin DoDot:3
+23 SET STS=$PIECE($GET(^MAGDOUTP(2006.574,D0,1,D1,0)),"^",2)
+24 IF LOC'=""
IF STS'=""
SET ^MAGDOUTP(2006.574,"STS",LOC,PRI,STS,D0,D1)=""
+25 QUIT
End DoDot:3
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 ;
+29 ; Confirmation message
Begin DoDot:1
+30 NEW CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
+31 ;
+32 DO GETENV^%ZOSV
+33 SET CNT=0
+34 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE INSTALL"
+35 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+36 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_XPDNM
+37 SET CNT=CNT+1
SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
+38 SET ST=$$GET1^DIQ(9.7,XPDA,11,"I")
+39 SET CNT=CNT+1
SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
+40 SET CT=$$GET1^DIQ(9.7,XPDA,17,"I")
if +CT'=CT
SET CT=$$NOW^XLFDT()
+41 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+42 SET CNT=CNT+1
SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
+43 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+44 SET CNT=CNT+1
SET MAGMSG(CNT)="FILE COMMENT: "_$$GET1^DIQ(9.7,XPDA,6,"I")
+45 SET CNT=CNT+1
SET MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
+46 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,XPDA,9,"E")
+47 SET CNT=CNT+1
SET MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,XPDA,.01,"E")
+48 SET DDATE=$$GET1^DIQ(9.7,XPDA,51,"I")
+49 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
+50 if $GET(CVT)'=""
SET CNT=CNT+1
SET MAGMSG(CNT)="Conversion time: "_CVT
+51 SET XMSUB=XPDNM_" INSTALLATION"
+52 SET XMID=$GET(DUZ)
if 'XMID
SET XMID=.5
+53 SET XMY(XMID)=""
+54 SET XMY("G.MAG SERVER")=""
+55 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+56 SET XMSUB=$EXTRACT(XMSUB,1,63)
+57 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+58 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+59 QUIT
End DoDot:1
+60 QUIT
+61 ;
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 ;
