MAGIPS20 ;Pre-init routine to queue site activity at install.
;;3.0;IMAGING;**20**;Apr 12, 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. |
;; +---------------------------------------------------------------+
;;
EC ; This is the Patch 20 Environment Check Routine
N MESSAGE,ERR
S ERR=0
I DUZ(2)'=$$KSP^XUPARAM("INST") D
. S MESSAGE="You must be logged in to the same institution on which you"
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="are installing this KIDS package"
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="Your DUZ(2) is: "_$G(DUZ(2))_" and the host system is: "_$$KSP^XUPARAM("INST")
. D BMES^XPDUTL(MESSAGE)
. S XPDQUIT=2 Q
I '$P($G(^MAG(2006.1,$O(^MAG(2006.1," "),-1),0)),U),(+$P($G(^MAG(2006.1,0)),U,4))>1 D
. S MESSAGE="Your Site Parameter file has more than one entry."
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="In order for the post-install"
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="to successfully convert your system it is necessary"
. D BMES^XPDUTL(MESSAGE)
. S MESSAGE="to remove the inactive Site Parameter file entry."
. D BMES^XPDUTL(MESSAGE)
. S XPDQUIT=2 Q
I DUZ(2)=$$KSP^XUPARAM("INST"),ERR=0 D
. S MESSAGE="Environment check: OK!"
. D BMES^XPDUTL(MESSAGE) Q
;
Q
PRE ; Remove DD field definitions so that new definition can be laid down cleanly
N DIK,DA
S DIK="^DD(2005,",DA=1,DA(1)=2005 D ^DIK
S DIK="^DD(2005.1,",DA=1,DA(1)=2005.1 D ^DIK
S DIK="^DD(2005.2,",DA=.04,DA(1)=2005.2 D ^DIK
S DIK="^DD(2005.2,",DA=1,DA(1)=2005.2 D ^DIK
S DIK="^DD(2005.2,",DA=2,DA(1)=2005.2 D ^DIK
S DIK="^DD(2005.2,",DA=3,DA(1)=2005.2 D ^DIK
S DIK="^DD(2005.2,",DA=4,DA(1)=2005.2 D ^DIK
S DIK="^DD(2005.2,",DA=6,DA(1)=2005.2 D ^DIK
S DIK="^DD(2005.2,",DA=14,DA(1)=2005.2 D ^DIK
S DIK="^DD(2005.2,",DA=26,DA(1)=2005.2 D ^DIK
S DIK="^DD(2005.04,",DA=1,DA(1)=2005.04 D ^DIK
S DIK="^DD(2005.04,",DA=2,DA(1)=2005.04 D ^DIK
S DIK="^DD(2006.1,",DA=.01,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=.02,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=.03,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=.04,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=.07,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=.08,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=1.01,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=1.02,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=1.03,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=2.01,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=2.02,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=2.03,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=6,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=8,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=9,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=11,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=21,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=22,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=25,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=64,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=102,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=103,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.1,",DA=201,DA(1)=2006.1 D ^DIK
S DIK="^DD(2006.81,",DA=.04,DA(1)=2006.81 D ^DIK
S DIK="^DD(2006.82,",DA=.04,DA(1)=2006.82 D ^DIK
S DIK="^DD(2006.82,",DA=2,DA(1)=2006.82 D ^DIK
D RX ;Remove "A" cross-references from the site parameter file
;remove file definitions so that the new file definitions will lay down cleanly
N DIU
F DIU=2006.03,2006.031,2006.032,2006.8,2006.12,2006.1201,2006.12201 D
. S DIU(0)="" D EN^DIU2
. Q
D RMRPC("MAGQ FS CHNGE") ; Removing an RPC so that the revison installs cleanly
Q
RX ; REMOVE A SET OF CROSS REFERENCES
N FILE,FIELD,CROSSREF,IEN,NAME
S CROSSREF="^ALTR^ARITE^AIMPORT^AIMDELBIG^AIMDELPACS^AIMDELPACS2^AIMDELPACS3^AIMDELPACSBIG^"
S CROSSREF=CROSSREF_"AJBXDEV^AJBXTOT^AJBXPTR^APACS^APXDR^APXWRITE^ATRABS^"
S FILE=2006.1,NAME=""
F FIELD=.02,.03,.08,22,9,102,103,21,2.01,2.02,2.03,1.01,1.02,1.03,6 D
. S IEN=$$CREF(FILE,FIELD,CROSSREF,.NAME) I IEN D
. . K RXERR
. . D DELIX^DDMOD(FILE,FIELD,IEN,"KW","MYOUT","RXERR")
. . I $D(^DD(FILE,0,"IX",NAME,FILE,FIELD)) K ^DD(FILE,0,"IX",NAME,FILE,FIELD)
. . Q
. Q
Q
CREF(FILE,FIELD,CROSSREF,NAME) ;
N I,J
S I=0 F S I=I+1 Q:'$D(^DD(FILE,FIELD,1,I,0)) Q:CROSSREF[("^"_$P(^DD(FILE,FIELD,1,I,0),U,2)_"^")
S J=1 F S J=J+1 S NAME=$P(CROSSREF,U,J) Q:NAME="" Q:$D(^DD(FILE,0,"IX",NAME,FILE,FIELD))
Q $S(NAME'="":I,1:0)
RMRPC(NAME) ; Removing an RPC in order to revise
N MW,RPC,MWE,DIERR
S MW=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","")
D CLEAN^DILF
Q:'MW
S RPC=$$FIND1^DIC(8994,"","X",NAME,"","","")
D CLEAN^DILF
Q:'RPC
S MWE=$$FIND1^DIC(19.05,","_MW_",","X","NAME","","","")
D CLEAN^DILF
Q:'MWE
S DA=MWE,DA(1)=MW,DIK="^DIC(19,"_DA(1)_",""RPC"","
D ^DIK
K DA,DIK
S DA=RPC,DIK="^XWB(8994,"
D ^DIK
K DA,DIK
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIPS20 5636 printed Nov 22, 2024@17:16:18 Page 2
MAGIPS20 ;Pre-init routine to queue site activity at install.
+1 ;;3.0;IMAGING;**20**;Apr 12, 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 |
+12 ;; | in any way. Modifications to this software may result in an |
+13 ;; | adulterated medical device under 21CFR820, the use of which |
+14 ;; | is considered to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
EC ; This is the Patch 20 Environment Check Routine
+1 NEW MESSAGE,ERR
+2 SET ERR=0
+3 IF DUZ(2)'=$$KSP^XUPARAM("INST")
Begin DoDot:1
+4 SET MESSAGE="You must be logged in to the same institution on which you"
+5 DO BMES^XPDUTL(MESSAGE)
+6 SET MESSAGE="are installing this KIDS package"
+7 DO BMES^XPDUTL(MESSAGE)
+8 SET MESSAGE="Your DUZ(2) is: "_$GET(DUZ(2))_" and the host system is: "_$$KSP^XUPARAM("INST")
+9 DO BMES^XPDUTL(MESSAGE)
+10 SET XPDQUIT=2
QUIT
End DoDot:1
+11 IF '$PIECE($GET(^MAG(2006.1,$ORDER(^MAG(2006.1," "),-1),0)),U)
IF (+$PIECE($GET(^MAG(2006.1,0)),U,4))>1
Begin DoDot:1
+12 SET MESSAGE="Your Site Parameter file has more than one entry."
+13 DO BMES^XPDUTL(MESSAGE)
+14 SET MESSAGE="In order for the post-install"
+15 DO BMES^XPDUTL(MESSAGE)
+16 SET MESSAGE="to successfully convert your system it is necessary"
+17 DO BMES^XPDUTL(MESSAGE)
+18 SET MESSAGE="to remove the inactive Site Parameter file entry."
+19 DO BMES^XPDUTL(MESSAGE)
+20 SET XPDQUIT=2
QUIT
End DoDot:1
+21 IF DUZ(2)=$$KSP^XUPARAM("INST")
IF ERR=0
Begin DoDot:1
+22 SET MESSAGE="Environment check: OK!"
+23 DO BMES^XPDUTL(MESSAGE)
QUIT
End DoDot:1
+24 ;
+25 QUIT
PRE ; Remove DD field definitions so that new definition can be laid down cleanly
+1 NEW DIK,DA
+2 SET DIK="^DD(2005,"
SET DA=1
SET DA(1)=2005
DO ^DIK
+3 SET DIK="^DD(2005.1,"
SET DA=1
SET DA(1)=2005.1
DO ^DIK
+4 SET DIK="^DD(2005.2,"
SET DA=.04
SET DA(1)=2005.2
DO ^DIK
+5 SET DIK="^DD(2005.2,"
SET DA=1
SET DA(1)=2005.2
DO ^DIK
+6 SET DIK="^DD(2005.2,"
SET DA=2
SET DA(1)=2005.2
DO ^DIK
+7 SET DIK="^DD(2005.2,"
SET DA=3
SET DA(1)=2005.2
DO ^DIK
+8 SET DIK="^DD(2005.2,"
SET DA=4
SET DA(1)=2005.2
DO ^DIK
+9 SET DIK="^DD(2005.2,"
SET DA=6
SET DA(1)=2005.2
DO ^DIK
+10 SET DIK="^DD(2005.2,"
SET DA=14
SET DA(1)=2005.2
DO ^DIK
+11 SET DIK="^DD(2005.2,"
SET DA=26
SET DA(1)=2005.2
DO ^DIK
+12 SET DIK="^DD(2005.04,"
SET DA=1
SET DA(1)=2005.04
DO ^DIK
+13 SET DIK="^DD(2005.04,"
SET DA=2
SET DA(1)=2005.04
DO ^DIK
+14 SET DIK="^DD(2006.1,"
SET DA=.01
SET DA(1)=2006.1
DO ^DIK
+15 SET DIK="^DD(2006.1,"
SET DA=.02
SET DA(1)=2006.1
DO ^DIK
+16 SET DIK="^DD(2006.1,"
SET DA=.03
SET DA(1)=2006.1
DO ^DIK
+17 SET DIK="^DD(2006.1,"
SET DA=.04
SET DA(1)=2006.1
DO ^DIK
+18 SET DIK="^DD(2006.1,"
SET DA=.07
SET DA(1)=2006.1
DO ^DIK
+19 SET DIK="^DD(2006.1,"
SET DA=.08
SET DA(1)=2006.1
DO ^DIK
+20 SET DIK="^DD(2006.1,"
SET DA=1.01
SET DA(1)=2006.1
DO ^DIK
+21 SET DIK="^DD(2006.1,"
SET DA=1.02
SET DA(1)=2006.1
DO ^DIK
+22 SET DIK="^DD(2006.1,"
SET DA=1.03
SET DA(1)=2006.1
DO ^DIK
+23 SET DIK="^DD(2006.1,"
SET DA=2.01
SET DA(1)=2006.1
DO ^DIK
+24 SET DIK="^DD(2006.1,"
SET DA=2.02
SET DA(1)=2006.1
DO ^DIK
+25 SET DIK="^DD(2006.1,"
SET DA=2.03
SET DA(1)=2006.1
DO ^DIK
+26 SET DIK="^DD(2006.1,"
SET DA=6
SET DA(1)=2006.1
DO ^DIK
+27 SET DIK="^DD(2006.1,"
SET DA=8
SET DA(1)=2006.1
DO ^DIK
+28 SET DIK="^DD(2006.1,"
SET DA=9
SET DA(1)=2006.1
DO ^DIK
+29 SET DIK="^DD(2006.1,"
SET DA=11
SET DA(1)=2006.1
DO ^DIK
+30 SET DIK="^DD(2006.1,"
SET DA=21
SET DA(1)=2006.1
DO ^DIK
+31 SET DIK="^DD(2006.1,"
SET DA=22
SET DA(1)=2006.1
DO ^DIK
+32 SET DIK="^DD(2006.1,"
SET DA=25
SET DA(1)=2006.1
DO ^DIK
+33 SET DIK="^DD(2006.1,"
SET DA=64
SET DA(1)=2006.1
DO ^DIK
+34 SET DIK="^DD(2006.1,"
SET DA=102
SET DA(1)=2006.1
DO ^DIK
+35 SET DIK="^DD(2006.1,"
SET DA=103
SET DA(1)=2006.1
DO ^DIK
+36 SET DIK="^DD(2006.1,"
SET DA=201
SET DA(1)=2006.1
DO ^DIK
+37 SET DIK="^DD(2006.81,"
SET DA=.04
SET DA(1)=2006.81
DO ^DIK
+38 SET DIK="^DD(2006.82,"
SET DA=.04
SET DA(1)=2006.82
DO ^DIK
+39 SET DIK="^DD(2006.82,"
SET DA=2
SET DA(1)=2006.82
DO ^DIK
+40 ;Remove "A" cross-references from the site parameter file
DO RX
+41 ;remove file definitions so that the new file definitions will lay down cleanly
+42 NEW DIU
+43 FOR DIU=2006.03,2006.031,2006.032,2006.8,2006.12,2006.1201,2006.12201
Begin DoDot:1
+44 SET DIU(0)=""
DO EN^DIU2
+45 QUIT
End DoDot:1
+46 ; Removing an RPC so that the revison installs cleanly
DO RMRPC("MAGQ FS CHNGE")
+47 QUIT
RX ; REMOVE A SET OF CROSS REFERENCES
+1 NEW FILE,FIELD,CROSSREF,IEN,NAME
+2 SET CROSSREF="^ALTR^ARITE^AIMPORT^AIMDELBIG^AIMDELPACS^AIMDELPACS2^AIMDELPACS3^AIMDELPACSBIG^"
+3 SET CROSSREF=CROSSREF_"AJBXDEV^AJBXTOT^AJBXPTR^APACS^APXDR^APXWRITE^ATRABS^"
+4 SET FILE=2006.1
SET NAME=""
+5 FOR FIELD=.02,.03,.08,22,9,102,103,21,2.01,2.02,2.03,1.01,1.02,1.03,6
Begin DoDot:1
+6 SET IEN=$$CREF(FILE,FIELD,CROSSREF,.NAME)
IF IEN
Begin DoDot:2
+7 KILL RXERR
+8 DO DELIX^DDMOD(FILE,FIELD,IEN,"KW","MYOUT","RXERR")
+9 IF $DATA(^DD(FILE,0,"IX",NAME,FILE,FIELD))
KILL ^DD(FILE,0,"IX",NAME,FILE,FIELD)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
CREF(FILE,FIELD,CROSSREF,NAME) ;
+1 NEW I,J
+2 SET I=0
FOR
SET I=I+1
if '$DATA(^DD(FILE,FIELD,1,I,0))
QUIT
if CROSSREF[("^"_$PIECE(^DD(FILE,FIELD,1,I,0),U,2)_"^")
QUIT
+3 SET J=1
FOR
SET J=J+1
SET NAME=$PIECE(CROSSREF,U,J)
if NAME=""
QUIT
if $DATA(^DD(FILE,0,"IX",NAME,FILE,FIELD))
QUIT
+4 QUIT $SELECT(NAME'="":I,1:0)
RMRPC(NAME) ; Removing an RPC in order to revise
+1 NEW MW,RPC,MWE,DIERR
+2 SET MW=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","")
+3 DO CLEAN^DILF
+4 if 'MW
QUIT
+5 SET RPC=$$FIND1^DIC(8994,"","X",NAME,"","","")
+6 DO CLEAN^DILF
+7 if 'RPC
QUIT
+8 SET MWE=$$FIND1^DIC(19.05,","_MW_",","X","NAME","","","")
+9 DO CLEAN^DILF
+10 if 'MWE
QUIT
+11 SET DA=MWE
SET DA(1)=MW
SET DIK="^DIC(19,"_DA(1)_",""RPC"","
+12 DO ^DIK
+13 KILL DA,DIK
+14 SET DA=RPC
SET DIK="^XWB(8994,"
+15 DO ^DIK
+16 KILL DA,DIK
+17 QUIT
+18 ;
