MAGIPS51 ;Post init routine to queue site activity at install. ; 06/09/2005 09:45
;;3.0;IMAGING;**51**;26-August-2005
;; +---------------------------------------------------------------+
;; | 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 ;
N DIU
; Remove obsolete DD definitions
F DIU=2006.574,2006.575,2006.5762,2006.587 D
. S DIU(0)="" D EN^DIU2
. Q
; File-roots can be left.
Q
;
POST N CVT
; 1. Convert simple pointers to variable pointers
; 2. Add RPCs to secondary menus
; 3. Clean up obsolete cross-references
; 4. Clean up obsolete FileMan header
; 5. Create missing PT pointers (QA issue)
; 6. Pre-populate AutoRoute Prior Studies table
; 7. Re-Cross-Reference file # 2006.587
; 8. Send confirmation message
;
D ; Pointer Conversion
. N D0,DE,H1,H2,IM,N,OR,PR,ST,T,TY,X
. S H1=$H L +^MAGQUEUE(2006.035):1E9 ; Background process MUST wait.
. W !,"Starting correction of variable pointers in SEND QUEUE."
. K ^MAGQUEUE(2006.035,"DEST")
. K ^MAGQUEUE(2006.035,"STS")
. S N=0,D0=0 F S D0=$O(^MAGQUEUE(2006.035,D0)) Q:'D0 D
. . S X=$G(^MAGQUEUE(2006.035,D0,1)),N=N+1
. . S ST=$P(X,"^",1),PR=$P(X,"^",2)
. . S X=$G(^MAGQUEUE(2006.035,D0,0))
. . S IM=$P(X,"^",1),DE=$P(X,"^",2),TY=$P(X,"^",3)
. . S ME=$P(X,"^",4),OR=$P(X,"^",5)
. . I DE,ME=1 S DE=(+DE)_";MAG(2005.2,"
. . I DE,ME=2 S DE=(+DE)_";MAG(2006.587,"
. . I 'DE!(DE'[";") S DE=""
. . S $P(X,"^",2)=DE,^MAGQUEUE(2006.035,D0,0)=X
. . Q:DE="" Q:ST=""
. . I IM'="",TY'="" S ^MAGQUEUE(2006.035,"DEST",DE,ST,IM,TY,D0)=""
. . I OR'="",PR'="" S ^MAGQUEUE(2006.035,"STS",OR,ST,PR,DE,D0)=""
. . Q
. L -^MAGQUEUE(2006.035)
. S H2=$H,H1=H1*86400+$P(H1,",",2),H2=H2*86400+$P(H2,",",2)
. S X=H2-H1,CVT=N_" entr"_$S(N=1:"y",1:"ies")_" in "
. S T=X\3600 S:T CVT=CVT_T_" hour" S:T>1 CVT=CVT_"s"
. S T=X\60#60 I T S:CVT'="" CVT=CVT_", " S SVT=CVT_T_" minute" S:T>1 CVT=CVT_"s"
. S T=X#60 I T S:CVT'="" CVT=CVT_", " S SVT=CVT_T_" second" S:T>1 CVT=CVT_"s"
. S:'X CVT=CVT_"less than 1 second."
. Q
;
D ADDRPC("MAG CFIND QUERY","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG STUDY UID QUERY","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG DICOM CHECK MACHINE ID","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG DICOM UPDATE MACHINE ID","MAG DICOM GATEWAY FULL")
D ADDRPC("MAG VISTA CHECKSUMS","MAG DICOM GATEWAY FULL")
;
D ADDRPC("MAG CFIND QUERY","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG STUDY UID QUERY","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG DICOM CHECK MACHINE ID","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG DICOM UPDATE MACHINE ID","MAG DICOM GATEWAY VIEW")
D ADDRPC("MAG VISTA CHECKSUMS","MAG DICOM GATEWAY VIEW")
;
F X="C","DPAT","E" K ^MAGD(2006.575,X)
K ^MAGDICOM("HL7")
;
S ^DD(2006.587,0,"PT",2005.0111,3)=""
S ^DD(2006.587,0,"PT",2005.1111,3)=""
;
D ; Pre-populate AutoRoute Prior Studies Table
. N A,D0,D1,X
. S D0=0 F S D0=$O(^MAG(2006.65,D0)) Q:'D0 D
. . S D1=0 F S D1=$O(^MAG(2006.65,D0,1,D1)) Q:'D1 D
. . . S X=$G(^MAG(2006.65,D0,1,D1,0)),A=0
. . . I $P(X,"^",2)="" S:$P(X,"^",5) $P(X,"^",2)=$P(X,"^",5),A=1
. . . I $P(X,"^",3)="" S $P(X,"^",3)=1800,A=1
. . . I $P(X,"^",4)="" S $P(X,"^",4)=1,A=1
. . . S:A ^MAG(2006.65,D0,1,D1,0)=X
. . . Q
. . Q
. Q
;
; Re-Crossreference
;
F X="B","C","D" K ^MAG(2006.587,X)
S DIK="^MAG(2006.587," D IXALL^DIK
;
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[HMAGIPS51 6127 printed Sep 23, 2025@19:42:33 Page 2
MAGIPS51 ;Post init routine to queue site activity at install. ; 06/09/2005 09:45
+1 ;;3.0;IMAGING;**51**;26-August-2005
+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 NEW DIU
+2 ; Remove obsolete DD definitions
+3 FOR DIU=2006.574,2006.575,2006.5762,2006.587
Begin DoDot:1
+4 SET DIU(0)=""
DO EN^DIU2
+5 QUIT
End DoDot:1
+6 ; File-roots can be left.
+7 QUIT
+8 ;
POST NEW CVT
+1 ; 1. Convert simple pointers to variable pointers
+2 ; 2. Add RPCs to secondary menus
+3 ; 3. Clean up obsolete cross-references
+4 ; 4. Clean up obsolete FileMan header
+5 ; 5. Create missing PT pointers (QA issue)
+6 ; 6. Pre-populate AutoRoute Prior Studies table
+7 ; 7. Re-Cross-Reference file # 2006.587
+8 ; 8. Send confirmation message
+9 ;
+10 ; Pointer Conversion
Begin DoDot:1
+11 NEW D0,DE,H1,H2,IM,N,OR,PR,ST,T,TY,X
+12 ; Background process MUST wait.
SET H1=$HOROLOG
LOCK +^MAGQUEUE(2006.035):1E9
+13 WRITE !,"Starting correction of variable pointers in SEND QUEUE."
+14 KILL ^MAGQUEUE(2006.035,"DEST")
+15 KILL ^MAGQUEUE(2006.035,"STS")
+16 SET N=0
SET D0=0
FOR
SET D0=$ORDER(^MAGQUEUE(2006.035,D0))
if 'D0
QUIT
Begin DoDot:2
+17 SET X=$GET(^MAGQUEUE(2006.035,D0,1))
SET N=N+1
+18 SET ST=$PIECE(X,"^",1)
SET PR=$PIECE(X,"^",2)
+19 SET X=$GET(^MAGQUEUE(2006.035,D0,0))
+20 SET IM=$PIECE(X,"^",1)
SET DE=$PIECE(X,"^",2)
SET TY=$PIECE(X,"^",3)
+21 SET ME=$PIECE(X,"^",4)
SET OR=$PIECE(X,"^",5)
+22 IF DE
IF ME=1
SET DE=(+DE)_";MAG(2005.2,"
+23 IF DE
IF ME=2
SET DE=(+DE)_";MAG(2006.587,"
+24 IF 'DE!(DE'[";")
SET DE=""
+25 SET $PIECE(X,"^",2)=DE
SET ^MAGQUEUE(2006.035,D0,0)=X
+26 if DE=""
QUIT
if ST=""
QUIT
+27 IF IM'=""
IF TY'=""
SET ^MAGQUEUE(2006.035,"DEST",DE,ST,IM,TY,D0)=""
+28 IF OR'=""
IF PR'=""
SET ^MAGQUEUE(2006.035,"STS",OR,ST,PR,DE,D0)=""
+29 QUIT
End DoDot:2
+30 LOCK -^MAGQUEUE(2006.035)
+31 SET H2=$HOROLOG
SET H1=H1*86400+$PIECE(H1,",",2)
SET H2=H2*86400+$PIECE(H2,",",2)
+32 SET X=H2-H1
SET CVT=N_" entr"_$SELECT(N=1:"y",1:"ies")_" in "
+33 SET T=X\3600
if T
SET CVT=CVT_T_" hour"
if T>1
SET CVT=CVT_"s"
+34 SET T=X\60#60
IF T
if CVT'=""
SET CVT=CVT_", "
SET SVT=CVT_T_" minute"
if T>1
SET CVT=CVT_"s"
+35 SET T=X#60
IF T
if CVT'=""
SET CVT=CVT_", "
SET SVT=CVT_T_" second"
if T>1
SET CVT=CVT_"s"
+36 if 'X
SET CVT=CVT_"less than 1 second."
+37 QUIT
End DoDot:1
+38 ;
+39 DO ADDRPC("MAG CFIND QUERY","MAG DICOM GATEWAY FULL")
+40 DO ADDRPC("MAG STUDY UID QUERY","MAG DICOM GATEWAY FULL")
+41 DO ADDRPC("MAG DICOM CHECK MACHINE ID","MAG DICOM GATEWAY FULL")
+42 DO ADDRPC("MAG DICOM UPDATE MACHINE ID","MAG DICOM GATEWAY FULL")
+43 DO ADDRPC("MAG VISTA CHECKSUMS","MAG DICOM GATEWAY FULL")
+44 ;
+45 DO ADDRPC("MAG CFIND QUERY","MAG DICOM GATEWAY VIEW")
+46 DO ADDRPC("MAG STUDY UID QUERY","MAG DICOM GATEWAY VIEW")
+47 DO ADDRPC("MAG DICOM CHECK MACHINE ID","MAG DICOM GATEWAY VIEW")
+48 DO ADDRPC("MAG DICOM UPDATE MACHINE ID","MAG DICOM GATEWAY VIEW")
+49 DO ADDRPC("MAG VISTA CHECKSUMS","MAG DICOM GATEWAY VIEW")
+50 ;
+51 FOR X="C","DPAT","E"
KILL ^MAGD(2006.575,X)
+52 KILL ^MAGDICOM("HL7")
+53 ;
+54 SET ^DD(2006.587,0,"PT",2005.0111,3)=""
+55 SET ^DD(2006.587,0,"PT",2005.1111,3)=""
+56 ;
+57 ; Pre-populate AutoRoute Prior Studies Table
Begin DoDot:1
+58 NEW A,D0,D1,X
+59 SET D0=0
FOR
SET D0=$ORDER(^MAG(2006.65,D0))
if 'D0
QUIT
Begin DoDot:2
+60 SET D1=0
FOR
SET D1=$ORDER(^MAG(2006.65,D0,1,D1))
if 'D1
QUIT
Begin DoDot:3
+61 SET X=$GET(^MAG(2006.65,D0,1,D1,0))
SET A=0
+62 IF $PIECE(X,"^",2)=""
if $PIECE(X,"^",5)
SET $PIECE(X,"^",2)=$PIECE(X,"^",5)
SET A=1
+63 IF $PIECE(X,"^",3)=""
SET $PIECE(X,"^",3)=1800
SET A=1
+64 IF $PIECE(X,"^",4)=""
SET $PIECE(X,"^",4)=1
SET A=1
+65 if A
SET ^MAG(2006.65,D0,1,D1,0)=X
+66 QUIT
End DoDot:3
+67 QUIT
End DoDot:2
+68 QUIT
End DoDot:1
+69 ;
+70 ; Re-Crossreference
+71 ;
+72 FOR X="B","C","D"
KILL ^MAG(2006.587,X)
+73 SET DIK="^MAG(2006.587,"
DO IXALL^DIK
+74 ;
+75 ; Confirmation message
Begin DoDot:1
+76 NEW CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
+77 ;
+78 DO GETENV^%ZOSV
+79 SET CNT=0
+80 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE INSTALL"
+81 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+82 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_XPDNM
+83 SET CNT=CNT+1
SET MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
+84 SET ST=$$GET1^DIQ(9.7,XPDA,11,"I")
+85 SET CNT=CNT+1
SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
+86 SET CT=$$GET1^DIQ(9.7,XPDA,17,"I")
if +CT'=CT
SET CT=$$NOW^XLFDT()
+87 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+88 SET CNT=CNT+1
SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
+89 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+90 SET CNT=CNT+1
SET MAGMSG(CNT)="FILE COMMENT: "_$$GET1^DIQ(9.7,XPDA,6,"I")
+91 SET CNT=CNT+1
SET MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
+92 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,XPDA,9,"E")
+93 SET CNT=CNT+1
SET MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,XPDA,.01,"E")
+94 SET DDATE=$$GET1^DIQ(9.7,XPDA,51,"I")
+95 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
+96 if $GET(CVT)'=""
SET CNT=CNT+1
SET MAGMSG(CNT)="Conversion time: "_CVT
+97 SET XMSUB=XPDNM_" INSTALLATION"
+98 SET XMID=$GET(DUZ)
if 'XMID
SET XMID=.5
+99 SET XMY(XMID)=""
+100 SET XMY("G.MAG SERVER")=""
+101 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+102 SET XMSUB=$EXTRACT(XMSUB,1,63)
+103 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+104 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+105 QUIT
End DoDot:1
+106 QUIT
+107 ;
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 ;
