- 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 Mar 13, 2025@21:11:09 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 ;
